Склейка: конвертация, обход каталогов и CLI

У нас есть два конца: парсер разметки слева, EDSL для HTML справа. Пора их соединить и обвязать миром. Сначала чистый мост Markup.Document в Html.Html через маленький типокласс. Потом грязная оболочка: обход каталога через directory и filepath, копирование картинок, сборка index.html, аккуратная обработка ошибок ввода-вывода. И CLI на optparse-applicative, который сам описывается значением. Сквозная мысль урока та же, что в уроке про IO: чистое ядро в центре, тонкая грязная оболочка снаружи.

Чистый мост: типокласс конвертации

Соединить два типа это чистая функция: разобранный блок разметки превращается в HTML-блок. Можно было бы написать просто функцию, но мы заведём типокласс ToStructure. Сегодня у него один инстанс, и функция справилась бы. Класс окупится в тот момент, когда источников контента станет несколько (элемент RSS, комментарий, другой диалект разметки): каждый получит свой инстанс и переиспользует тот же convert без единой правки.

module Press.Convert
  ( ToStructure (..)
  , convert
  )
where

import qualified Press.Html as Html
import qualified Press.Markup as Markup

class ToStructure a where
  toStructure :: a -> Html.Structure

instance ToStructure Markup.Structure where
  toStructure = \case
    Markup.Heading n txt ->
      Html.h_ n (Html.txt_ txt)
    Markup.Paragraph p ->
      Html.p_ (Html.txt_ p)
    Markup.UnorderedList list ->
      Html.ul_ (map (Html.p_ . Html.txt_) list)
    Markup.OrderedList list ->
      Html.ol_ (map (Html.p_ . Html.txt_) list)
    Markup.CodeBlock list ->
      Html.code_ (unlines list)

convert :: Html.Title -> Markup.Document -> Html.Html
convert title = Html.html_ title . foldMap toStructure

Тут два разных Structure встречаются под одной крышей, поэтому оба модуля импортированы qualified: Markup.Structure слева, Html.Structure справа. Инстанс тотален: ветка есть на каждый конструктор Markup.Structure, забудешь один, компилятор предупредит.

И посмотри на convert: вся склейка документа это foldMap toStructure. Каждый блок превращается в Html.Structure, а foldMap склеивает их через <> из урока 26. Тот самый Monoid из публичного API EDSL тут и работает: это он позволяет написать сборку страницы в одну строку.

Чистое ядро программы

Прежде чем лезть в файловую систему, выделим саму суть генератора как чистую функцию. Это process: заголовок плюс текст разметки дают строку HTML.

process :: Html.Title -> String -> String
process title = Html.render . convert title . Markup.parse

Читается справа налево как конвейер: parse разбирает текст в Document, convert строит Html, render сериализует в строку. Ни одного обращения к диску. Именно потому, что process чистая, тесты в уроке 30 смогут проверить весь генератор, не трогая файловую систему. Это и есть приём “чистое ядро, грязная оболочка”: бизнес-логика в process, ввод-вывод вокруг неё.

Грязная оболочка: обход каталога

Теперь модуль Press.Directory. Его задача: прочитать входной каталог, сконвертировать .txt файлы, скопировать остальные (картинки, стили), собрать index.html и записать всё в выходной каталог. И всё это не падая на первой же кривой ссылке: плохой файл логируем в stderr и пропускаем.

Импорты сразу показывают, на что опираемся:

module Press.Directory
  ( convertDirectory
  , buildIndex
  )
where

import Control.Exception (SomeException (..), catch, displayException)
import Control.Monad (void, when)
import Data.List (partition)
import System.Directory
  ( copyFile, createDirectory, doesDirectoryExist
  , listDirectory, removeDirectoryRecursive
  )
import System.Exit (exitFailure)
import System.FilePath (takeBaseName, takeExtension, takeFileName, (<.>), (</>))
import System.IO (hPutStrLn, stderr)

import Press.Convert (convert)
import Press.Env (Env (..))
import qualified Press.Html as Html
import qualified Press.Markup as Markup

Пакет directory даёт операции с файловой системой, а filepath разбирает и собирает пути по правилам ОС, не вручную через слеши. Это важно: руками склеивать пути значит ломаться на Windows и на пробелах в именах.

Сначала тип, который держит результат чтения каталога: что конвертировать, что копировать.

data DirContents = DirContents
  { dcFilesToProcess :: [(FilePath, String)]
  , dcFilesToCopy :: [FilePath]
  }

getDirFilesAndContent :: FilePath -> IO DirContents
getDirFilesAndContent inputDir = do
  files <- map (inputDir </>) <$> listDirectory inputDir
  let (txtFiles, otherFiles) = partition ((== ".txt") . takeExtension) files
  txtFilesAndContent <-
    applyIoOnList readFile txtFiles >>= filterAndReportFailures
  pure $
    DirContents
      { dcFilesToProcess = txtFilesAndContent
      , dcFilesToCopy = otherFiles
      }

partition делит список файлов надвое по предикату: .txt идут в обработку, остальные в копирование. readFile каждого txt оборачиваем в безопасный прогон (об этом ниже) и отбрасываем те, что не прочитались.

Главная функция оркеструет всё:

convertDirectory :: Env -> FilePath -> FilePath -> IO ()
convertDirectory env inputDir outputDir = do
  DirContents filesToProcess filesToCopy <- getDirFilesAndContent inputDir
  createOutputDirectoryOrExit outputDir
  let outputHtmls = txtsToRenderedHtml env filesToProcess
  copyFiles outputDir filesToCopy
  writeFiles outputDir outputHtmls
  putStrLn "Done."

Сердцевина опять чистая. txtsToRenderedHtml берёт пары (путь, содержимое) и возвращает пары (имя.html, строка-HTML), попутно подставляя в начало индексную страницу:

txtsToRenderedHtml :: Env -> [(FilePath, String)] -> [(FilePath, String)]
txtsToRenderedHtml env txtFiles =
  let txtOutputFiles = map toOutputMarkupFile txtFiles
      index = ("index.html", buildIndex env txtOutputFiles)
   in map (fmap Html.render) (index : map convertFile txtOutputFiles)
  where
    toOutputMarkupFile (file, content) =
      (takeBaseName file <.> "html", Markup.parse content)
    convertFile (file, doc) =
      (file, convert file doc)

takeBaseName file <.> "html" превращает posts/hello.txt в hello.html. fmap Html.render рендерит вторую половину пары: fmap тут работает на паре (,) a, это функтор, и fmap меняет только второй элемент.

Индексная страница строится из уже разобранных документов, поэтому её можно озаглавить первым заголовком каждого поста:

buildIndex :: Env -> [(FilePath, Markup.Document)] -> Html.Html
buildIndex env files =
  let previews =
        map
          ( \(file, doc) ->
              case doc of
                Markup.Heading _ heading : _ ->
                  Html.h_ 3 (Html.link_ file (Html.txt_ heading))
                _ ->
                  Html.h_ 3 (Html.link_ file (Html.txt_ file))
          )
          files
   in Html.html_
        (eBlogName env)
        ( Html.h_ 1 (Html.link_ "index.html" (Html.txt_ (eBlogName env)))
            <> Html.h_ 2 (Html.txt_ "Posts")
            <> mconcat previews
        )

mconcat previews склеивает список блоков в один через Monoid. Снова та же абстракция работает на нас.