Пытаемся сделать PDF-книгу из веб-комикса при помощи Haskell на примере xkcd

Прочитав статью решил проверить, насколько пригоден для этого Haskell. Сразу скажу, сам Haskell пригоден весьма неплохо, но вот, пробежавшись по hackage.haskell.org, я сразу обнаружил проблемы с библиотеками для работы с PDF, что и поставило крест на полноценной реализации.
Но я решил всё же проделать часть работы, дабы показать, как та же задача могла бы быть сделана на Haskell, если бы да кабы…

Получаем информацию о комиксе

Так как нам придётся запрашивать информацию в виде JSON, сразу напишем полезную функцию:
rethrow :: (Show e) => Exceptional e a -> 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 выкинет исключение при ошибочном парсинге, а str и num упростят указание необходимых полей в 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_ парсит полученные данные в соответствии с указанным паттерном. В случае num "num"
мы получаем из JSON числовой член с именем num, в случае str "img" <&> str "title"
— тупл из двух строк для картинки и названия соответственно.

Код для получения картинки по URL:
image url = simpleHTTP (getRequest url) >>= getResponseBody<br>


Поток закачки

Запишем закачку одного комикса в отдельную функцию.
retrieve ch l i = 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 (Control.Concurrent.Chan), в который будем отсылать результаты закачек, а так же потокобезопасным логом l.

Из-за кривой библиотеки HPDF приходится сначала сохранять картинку в файл, а потом грузить её оттуда вновь. Мне совершенно не ясно, почему автор написал парсинг JPEG с нуля сам (да ещё и только из файла), а не воспользовался готовой библиотекой

Генерация PDF

Теперь стоит написать функцию, которая по списку картинок сгенерирует нам результирующий PDF.
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>

В общем-то, в этой функции ничего интересного. Зовём соответственные функции из библиотек. Важен только тот нюанс, что список картинок ленивый, поэтому работать функция начинает сразу, как только появляется первая картинка.

Собираем воедино

В основной функции мы инициализируем лог, создаём канал, в который легковесные потоки будут писать результат, и вызываем генерацию PDF с ленивым списком картинок из этого канала.
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 аналогична using, гарантируя закрытие лога.
Строкой mapM_ (fork . retrieve ch l) [1..n]<br>
мы на каждый номер создаём поток закачивания, т.е. вызываем retrieve ch l i в отдельном потоке.
fmap (take n) $ getChanContents ch<br>
вернёт нам ленивый список с первыми n результатами. Брать весь список не имеет смысла, так как канал бесконечен.
Затем мы применяем функцию lookup, с каждым индексом по порядку, от 1 до n. Это необходимо, чтобы в результате получить тоже ленивый список, но в котором картинки идут строго по порядку. Таким образом мы всегда будем писать картинки в нужном порядке.

Полный листинг

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 l i = 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 e a -> 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>


Ругань

К сожалению, из-за отсутствия достойной библиотеки для работы с PDF, результат не оправдал себя.
Большую часть картинок HPDF отказывается принимать (благодаря очередной велосипедной реализации загрузки JPEG), с масштабированием картинок я даже и не стал разбираться.

Дифирамбы

Было очень удобно прямо в GHCi протестировать запрос, затем разобрать один из них, скачать и сохранить картинку. Вся разработка велась там, а затем код был перенесён в файл. Многопоточность была прикручена без добавлений интерфейсов и какого-либо лишнего кода. Вместо возврата результата мы просто пишем его в канал, на другом конце которого обработчик. А к асинхронной функции дописываем fork. В общем случае не всё так просто, конечно, но по своему опыту скажу, что ни разу не приходилось менять архитектуру для этого.

В общем, смотрите на hackage.haskell.org, ищите нужные библиотеки, и коли нашли, не упускайте шанс написать всё на Haskell!