mirror of
https://github.com/srid/rib.git
synced 2024-08-16 16:40:56 +03:00
Handle parsing errors in Pandoc metadata
This commit is contained in:
parent
a1909b0d54
commit
4d9ffe2c34
@ -1,4 +1,4 @@
|
||||
Rib is designed to be used not only its author, but also by others. To that end, if you notice that the library can be changed or improved in anyway so as to make it easier to write your own static sites, please do not hesitate to write a short proposal in the Issue tracker.
|
||||
Rib is designed to be used by not only its author, but also others. To that end, if you notice that the library can be changed or improved in anyway so as to make it easier to write your own static sites, please do not hesitate to write a short proposal in the Issue tracker.
|
||||
|
||||
## Coding style
|
||||
|
||||
|
@ -36,9 +36,6 @@ data Document repr meta
|
||||
_document_val :: repr,
|
||||
-- | HTML rendering of the parsed representation.
|
||||
_document_html :: Html (),
|
||||
-- | Metadata associated with the document as an aeson Value. If no metadata
|
||||
-- is provided this will be Nothing.
|
||||
_document_metaValue :: Maybe Value,
|
||||
-- | The parsed metadata.
|
||||
_document_meta :: meta
|
||||
}
|
||||
@ -47,13 +44,13 @@ data Document repr meta
|
||||
data DocumentError
|
||||
= DocumentError_MarkupError Text
|
||||
| DocumentError_MetadataMissing
|
||||
| DocumentError_MetadataBadJSON Text
|
||||
| DocumentError_MetadataMalformed Text
|
||||
|
||||
instance Show DocumentError where
|
||||
show = \case
|
||||
DocumentError_MarkupError e -> toString e
|
||||
DocumentError_MetadataMissing -> "Metadata missing"
|
||||
DocumentError_MetadataBadJSON msg -> "Bad metadata JSON: " <> toString msg
|
||||
DocumentError_MetadataMalformed msg -> "Bad metadata JSON: " <> toString msg
|
||||
|
||||
-- | Parse, render to HTML and extract metadata from the given file.
|
||||
--
|
||||
@ -75,17 +72,16 @@ mkDocumentFrom k@(arg #relpath -> k') f = do
|
||||
liftEither
|
||||
$ first DocumentError_MarkupError
|
||||
$ renderDoc v
|
||||
let metaValueM = extractMeta v
|
||||
metaValue <-
|
||||
maybeToEither
|
||||
DocumentError_MetadataMissing
|
||||
metaValueM
|
||||
liftEither
|
||||
. (first DocumentError_MetadataMalformed)
|
||||
=<< maybeToEither DocumentError_MetadataMissing (extractMeta v)
|
||||
meta <-
|
||||
liftEither
|
||||
$ first (DocumentError_MetadataBadJSON . toText)
|
||||
$ first (DocumentError_MetadataMalformed . toText)
|
||||
$ resultToEither
|
||||
$ fromJSON metaValue
|
||||
pure $ Document k' v html metaValueM meta
|
||||
pure $ Document k' v html meta
|
||||
where
|
||||
maybeToEither e = \case
|
||||
Nothing -> throwError e
|
||||
|
@ -13,7 +13,7 @@ module Rib.Markup
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson (Value)
|
||||
import Lucid (Html)
|
||||
import Named
|
||||
import Path
|
||||
@ -42,7 +42,7 @@ class Markup repr where
|
||||
|
||||
extractMeta ::
|
||||
repr ->
|
||||
Maybe Value
|
||||
Maybe (Either Text Value)
|
||||
|
||||
-- | Render the document as Lucid HTML
|
||||
renderDoc ::
|
||||
|
@ -44,7 +44,7 @@ instance Markup MMark where
|
||||
content <- readFileText (toFilePath f)
|
||||
pure $ parseDoc k content
|
||||
|
||||
extractMeta = MMark.projectYaml
|
||||
extractMeta = fmap Right . MMark.projectYaml
|
||||
|
||||
renderDoc = Right . MMark.render
|
||||
|
||||
|
@ -77,10 +77,8 @@ instance Markup Pandoc where
|
||||
extractMeta (Pandoc meta _) = flattenMeta meta
|
||||
|
||||
renderDoc =
|
||||
bimap show toHtmlRaw
|
||||
. first RibPandocError_PandocError
|
||||
bimap (show . RibPandocError_PandocError) toHtmlRaw
|
||||
. liftEither
|
||||
. fmap toHtmlRaw
|
||||
. runPure
|
||||
. writeHtml5String writerSettings
|
||||
|
||||
@ -170,16 +168,20 @@ detectReader f = do
|
||||
-- | Flatten a Pandoc 'Meta' into a well-structured JSON object.
|
||||
--
|
||||
-- Renders Pandoc text objects into plain strings along the way.
|
||||
flattenMeta :: Meta -> Maybe Value
|
||||
flattenMeta (Meta meta) = toJSON . fmap go <$> guarded null meta
|
||||
flattenMeta :: Meta -> Maybe (Either Text Value)
|
||||
flattenMeta (Meta meta) = fmap toJSON . traverse go <$> guarded null meta
|
||||
where
|
||||
go :: MetaValue -> Value
|
||||
go (MetaMap m) = toJSON $ fmap go m
|
||||
go (MetaList m) = toJSONList $ fmap go m
|
||||
go (MetaBool m) = toJSON m
|
||||
go (MetaString m) = toJSON m
|
||||
go (MetaInlines m) = toJSON (runPure' . writer $ Pandoc mempty [Plain m])
|
||||
go (MetaBlocks m) = toJSON (runPure' . writer $ Pandoc mempty m)
|
||||
runPure' :: PandocPure a -> a
|
||||
runPure' = either (error . show) id . runPure
|
||||
writer = writePlain def
|
||||
go :: MetaValue -> Either Text Value
|
||||
go (MetaMap m) = toJSON <$> traverse go m
|
||||
go (MetaList m) = toJSONList <$> traverse go m
|
||||
go (MetaBool m) = pure $ toJSON m
|
||||
go (MetaString m) = pure $ toJSON m
|
||||
go (MetaInlines m) =
|
||||
bimap show toJSON
|
||||
$ runPure . plainWriter
|
||||
$ Pandoc mempty [Plain m]
|
||||
go (MetaBlocks m) =
|
||||
bimap show toJSON
|
||||
$ runPure . plainWriter
|
||||
$ Pandoc mempty m
|
||||
plainWriter = writePlain def
|
||||
|
Loading…
Reference in New Issue
Block a user