{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
module Rib.Document
(
Document,
mkDocumentFrom,
documentPath,
documentVal,
documentHtml,
documentMeta,
documentUrl,
)
where
import Control.Monad.Except hiding (fail)
import Data.Aeson
import Development.Shake.FilePath ((-<.>))
import Lucid (Html)
import Named
import Path hiding ((-<.>))
import Rib.Markup
import qualified Text.Show
data Document repr meta
= Document
{
_document_path :: Path Rel File,
_document_val :: repr,
_document_html :: Html (),
_document_meta :: meta
}
deriving (Generic, Show)
documentPath :: Document repr meta -> Path Rel File
documentPath = _document_path
documentVal :: Document repr meta -> repr
documentVal = _document_val
documentHtml :: Document repr meta -> Html ()
documentHtml = _document_html
documentMeta :: Document repr meta -> meta
documentMeta = _document_meta
documentUrl :: Document repr meta -> Text
documentUrl doc = toText $ toFilePath ([absdir|/|] </> (documentPath doc)) -<.> ".html"
data DocumentError
= DocumentError_MarkupError Text
| DocumentError_MetadataMissing
| DocumentError_MetadataMalformed Text
instance Show DocumentError where
show = \case
DocumentError_MarkupError e -> toString e
DocumentError_MetadataMissing -> "Metadata missing"
DocumentError_MetadataMalformed msg -> "Bad metadata JSON: " <> toString msg
mkDocumentFrom ::
forall m b repr meta.
(MonadError DocumentError m, MonadIO m, Markup repr, FromJSON meta) =>
"relpath" :! Path Rel File ->
"path" :! Path b File ->
m (Document repr meta)
mkDocumentFrom k@(arg #relpath -> k') f = do
v <-
liftEither . first DocumentError_MarkupError
=<< readDoc k f
html <-
liftEither . first DocumentError_MarkupError $
renderDoc v
metaValue <-
liftEither . (first DocumentError_MetadataMalformed)
=<< maybeToEither DocumentError_MetadataMissing (extractMeta v)
meta <-
liftEither . first (DocumentError_MetadataMalformed . toText) $
resultToEither (fromJSON metaValue)
pure $ Document k' v html meta
where
maybeToEither e = liftEither . maybeToRight e
resultToEither = \case
Error e -> Left e
Success v -> Right v