rethrow :: ( Show e ) => Exceptional ea -> IO a<br>
rethrow = switch ( throwIO . userError . show ) return<br>
<br>
jsonAt url = simpleHTTP ( getRequest url ) >>= getResponseBody >>= rethrow . decode_ json<br>
<br>
str s = member_ ( literal s ) JSON . string<br>
num n = member_ ( literal n ) JSON . number<br>
rethrow
function rethrow
throw an exception in case of erroneous parsing, and str
and num
will simplify specifying the required fields in JSON.comics = jsonAt "http://xkcd.com/info.0.json" >>= fmap ( fromIntegral . numerator ) . rethrow . decode_ ( num "num" ) <br>
<br>
comic n = jsonAt ( concat [ "http://xkcd.com/" , show n , "/info.0.json" ] ) >>= rethrow . decode_ ( str "img" <&> str "title" ) <br>
decode_
function decode_
received data in accordance with the specified pattern. In the case of num "num"
num "num"
we get from JSON a numeric term named num , in the case of str "img" <&> str "title"
str "img" <&> str "title"
- stupid of two lines for the picture and the title, respectively.image url = simpleHTTP ( getRequest url ) >>= getResponseBody<br>
retrieve ch li = tryGet `onException` onFail where <br>
onFail = do <br>
writeChan ch ( i , Nothing ) <br>
writeLogger l Error $ "Comic " ++ show i ++ " failed to download" <br>
tryGet = do <br>
( imgUrl , title ) <- comic i<br>
imgData <- image imgUrl<br>
jpg <- writeBinaryFile fname imgData >> readJpegFile fname >>= either ( throwIO . userError . show ) return<br>
writeChan ch ( i , Just ( jpg , title ) ) <br>
writeLogger l Info $ "Comic " ++ show i ++ " downloaded" <br>
fname = show i ++ ".jpg" <br>
ch
channel ( Control.Concurrent.Chan
), to which we will send the download results, as well as the thread-safe l
log.pdf imgs = runPdf "Xkcd.pdf" doc ( PDFRect 0 0 800 600 ) $ forM_ imgs genPage where <br>
genPage ( jpeg , title ) = do <br>
img <- createPDFJpeg jpeg<br>
page <- addPage Nothing <br>
drawWithPage page ( drawText ( text ( PDFFont Times_Roman 12 ) 0 0 ( toPDFString title ) ) >> drawXObject img ) <br>
doc = PDFDocumentInfo { <br>
author = toPDFString "xkcd" , <br>
subject = toPDFString "xkcd" , <br>
pageMode = UseNone , <br>
pageLayout = OneColumn , <br>
viewerPreferences = standardViewerPrefs , <br>
compressed = False } <br>
main = bracket ( newLogger Console ) closeLogger $ \ l -> do <br>
n <- comics<br>
writeLogger l Info $ "Number of comics to download: " ++ show n<br>
ch <- newChan<br>
mapM_ ( fork . retrieve ch l ) [ 1 .. n ] <br>
cts <- fmap ( take n ) $ getChanContents ch<br>
let imgs = catMaybes $ mapMaybe ( `lookup` cts ) [ 1 .. n ] <br>
pdf imgs `onException` ( writeLogger l Error "Unable to generate PDF" ) <br>
writeLogger l Info "PDF generated." <br>
bracket
function is similar to using
, guaranteeing the closure of the log.mapM_ ( fork . retrieve ch l ) [ 1 .. n ] <br>
mapM_ ( fork . retrieve ch l ) [ 1 .. n ] <br>
we create an injection stream for each number, i.e. call retrieve ch li
in a separate thread.fmap ( take n ) $ getChanContents ch<br>
returns us a lazy list with the first n
results. Take the whole list does not make sense, since the channel is endless.lookup
function, with each index in order, from 1
to n
. It is necessary to get a lazy list as a result, but in which the pictures are strictly in order. Thus, we will always write pictures in the correct order.main = bracket ( newLogger Console ) closeLogger $ \ l -> do <br>
n <- comics<br>
writeLogger l Info $ "Number of comics to download: " ++ show n<br>
ch <- newChan<br>
mapM_ ( fork . retrieve ch l ) [ 1 .. n ] <br>
cts <- fmap ( take n ) $ getChanContents ch<br>
let imgs = catMaybes $ mapMaybe ( `lookup` cts ) [ 1 .. n ] <br>
pdf imgs `onException` ( writeLogger l Error "Unable to generate PDF" ) <br>
writeLogger l Info "PDF generated." <br>
<br>
retrieve ch li = tryGet `onException` onFail where <br>
onFail = do <br>
writeChan ch ( i , Nothing ) <br>
writeLogger l Error $ "Comic " ++ show i ++ " failed to download" <br>
tryGet = do <br>
( imgUrl , title ) <- comic i<br>
imgData <- image imgUrl<br>
jpg <- writeBinaryFile fname imgData >> readJpegFile fname >>= either ( throwIO . userError . show ) return<br>
writeChan ch ( i , Just ( jpg , title ) ) <br>
writeLogger l Info $ "Comic " ++ show i ++ " downloaded" <br>
fname = show i ++ ".jpg" <br>
<br>
pdf imgs = runPdf "Xkcd.pdf" doc ( PDFRect 0 0 800 600 ) $ forM_ imgs genPage where <br>
genPage ( jpeg , title ) = do <br>
img <- createPDFJpeg jpeg<br>
page <- addPage Nothing <br>
drawWithPage page ( drawText ( text ( PDFFont Times_Roman 12 ) 0 0 ( toPDFString title ) ) >> drawXObject img ) <br>
doc = PDFDocumentInfo { <br>
author = toPDFString "voidex" , <br>
subject = toPDFString "xkcd" , <br>
pageMode = UseNone , <br>
pageLayout = OneColumn , <br>
viewerPreferences = standardViewerPrefs , <br>
compressed = False } <br>
<br>
rethrow :: ( Show e ) => Exceptional ea -> IO a<br>
rethrow = switch ( throwIO . userError . show ) return<br>
<br>
jsonAt url = simpleHTTP ( getRequest url ) >>= getResponseBody >>= rethrow . decode_ json<br>
<br>
str s = member_ ( literal s ) JSON . string<br>
num n = member_ ( literal n ) JSON . number<br>
<br>
comics = jsonAt "http://xkcd.com/info.0.json" >>= fmap ( fromIntegral . numerator ) . rethrow . decode_ ( num "num" ) <br>
<br>
comic n = jsonAt ( concat [ "http://xkcd.com/" , show n , "/info.0.json" ] ) >>= rethrow . decode_ ( str "img" <&> str "title" ) <br>
<br>
image url = simpleHTTP ( getRequest url ) >>= getResponseBody<br>
<br>
writeBinaryFile fname str = withBinaryFile fname WriteMode ( \ h -> hPutStr h str ) <br>
fork
to the asynchronous function. In the general case, not everything is so simple, of course, but from my own experience I will say that I have never had to change the architecture for this.Source: https://habr.com/ru/post/113001/
All Articles