Простой xkcd комиксов загрузчик


Я действительно ценю некоторые суровые/конструктивная критика того, что я хотел бы рассмотреть как моя первая программа на Haskell. Программа должна скачать все комиксы xkcd в папку в текущем каталоге.

Я просто бросил все это, через все, что я нашел немного интересного в ПСВ и на Хаскеле Вики, так что я на 99% уверен, что большинство из них является ненужным или излишним. Я попытался с помощью самых популярных библиотек я могу найти. Я не ясно о том, как обрабатывать ошибки, как эффективно справляться с файловой системой, и как использовать текст.В JSON правильно.

зубная паста ссылке

    {-# Language PackageImports #-}
module Main where

import System.FilePath (takeFileName, (</>))
import System.IO 
import System.Environment
import System.Posix.User
import System.Directory
import Control.Monad (liftM, forM_, replicateM_)
import Control.Concurrent (forkIO)
import Control.Concurrent.STM
import Data.List (delete)
import Network.HTTP
import qualified Data.ByteString.Lazy.Char8 as L
import "mtl" Control.Monad.Error
import Network.URI (parseURI)
import Control.Applicative
import Control.Exception
import qualified Network.Stream as Stream (Result) 
import Control.Arrow
import Text.JSON

----------------------------------------------------------------------
main = do
  dir <- makeComicDir
  putStrLn $ "Created " ++ dir
  Right json <- xkcdFetchJSON Current
  let curNum = xkcdGetNumber json "num"
      comics = take curNum $ iterate (subtract 1) curNum
  putStrLn $ "Downloading " ++ (show $ length comics) ++ " comics..."
  comicQueue <- newTChanIO
  atomically $ forM_ (ComicNumber <$> comics) $ writeTChan comicQueue
  workers <- newTVarIO 8
  replicateM_ 8  . forkIO $ worker comicQueue workers dir
  waitFor workers
  putStrLn "DONE"
----------------------------------------------------------------------
data ComicNumber = Current | ComicNumber Int deriving (Show)

getReq = fmap (mkRequest GET) . parseURI

getRequestE = maybe (throwError "invalid url") return . getReq

tryRequest :: Request_String
           -> IO (Either IOException (Stream.Result (Response String)))

tryRequest = try . simpleHTTP

simpleHttpE request = do
  response <- liftIO $ tryRequest request
  case response of
    Left  err -> throwError $ show err
    Right rsp -> return rsp

getResponseBodyE = either (throwError.show) (return.rspBody)

fetchHtmlA = Kleisli getRequestE >>>
             Kleisli simpleHttpE >>>
             Kleisli getResponseBodyE

fetchHTMLBody url = runErrorT $ runKleisli fetchHtmlA url
----------------------------------------------------------------------
xkcd = "http://xkcd.com/"

xkcdJSONUrl Current          = xkcd ++ "info.0.json"
xkcdJSONUrl (ComicNumber n)  = xkcd ++ show n ++ "/info.0.json"

xkcdFetchJSON :: ComicNumber -> IO (Either String String)
xkcdFetchJSON num = runErrorT $ runKleisli fetchHtmlA $ xkcdJSONUrl num

xkcdComicUrl :: ComicNumber -> IO String
xkcdComicUrl num = do
  Right jstr <- xkcdFetchJSON num
  let (Ok (JSObject jobj)) = decode jstr
      (Ok img) = valFromObj "img" jobj
  return img

xkcdGetNumber :: String -> String -> Int
xkcdGetNumber jstr key = 
  let (Ok (JSObject jobj)) = decode jstr
      (Ok jval) = valFromObj key jobj
  in jval

----------------------------------------------------------------------
getImgName = takeFileName

downloadComic dir num = do
  url <- xkcdComicUrl num 
  let (ComicNumber n) = num
      name = (show n) ++ "_" ++ getImgName url
      path = dir </> name
  comic <- fetchHTMLBody url
  case comic of
    Left  err -> putStrLn $ "ERROR: " ++ show err
    Right img -> do
      file <- openBinaryFile path WriteMode
      hPutStr file img
      hClose file
      putStrLn $ "Saving " ++ name

makeComicDir = do 
  homedir <- getHomeDirectory
  let imgdir = homedir </> ".xkcd"
  createDirectory imgdir
  return imgdir

worker jobs alive dir = work
  where quit = atomically $ readTVar alive >>= writeTVar alive . (subtract 1)
        cont = do job@(ComicNumber n) <- atomically $ readTChan jobs
                  if' (n == 404) work $ downloadComic dir job >> work
        work = (atomically $ isEmptyTChan jobs) >>= \x -> if' x quit cont

waitFor alive = atomically $ readTVar alive >>= check . (==0)

----------------------------------------------------------------------
if' :: Bool -> a -> a -> a
if' True x _  = x
if' False _ y = y


1254
15
задан 23 мая 2011 в 01:05 Источник Поделиться
Комментарии
1 ответ

Выглядит довольно хорошо. Вы получаете на вершине вещи красиво. Некоторые критики:


  • не используйте импортирует пакет

  • писать подписями типа для функции верхнего уровня

  • пишите комментарии!

  • конструкция резьбы выглядит хорошо.

  • не используйте , если'. В Haskell , если уже.

  • Kleisli нужна документация. Начинает зашкаливать на данный момент.

  • не смешивайте слишком много понятий в одной программе: Код не ремонтопригодны.

10
ответ дан 23 мая 2011 в 02:05 Источник Поделиться