mirror of
https://github.com/srid/rib.git
synced 2024-08-17 00:50:40 +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
|
## Coding style
|
||||||
|
|
||||||
|
@ -36,9 +36,6 @@ data Document repr meta
|
|||||||
_document_val :: repr,
|
_document_val :: repr,
|
||||||
-- | HTML rendering of the parsed representation.
|
-- | HTML rendering of the parsed representation.
|
||||||
_document_html :: Html (),
|
_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.
|
-- | The parsed metadata.
|
||||||
_document_meta :: meta
|
_document_meta :: meta
|
||||||
}
|
}
|
||||||
@ -47,13 +44,13 @@ data Document repr meta
|
|||||||
data DocumentError
|
data DocumentError
|
||||||
= DocumentError_MarkupError Text
|
= DocumentError_MarkupError Text
|
||||||
| DocumentError_MetadataMissing
|
| DocumentError_MetadataMissing
|
||||||
| DocumentError_MetadataBadJSON Text
|
| DocumentError_MetadataMalformed Text
|
||||||
|
|
||||||
instance Show DocumentError where
|
instance Show DocumentError where
|
||||||
show = \case
|
show = \case
|
||||||
DocumentError_MarkupError e -> toString e
|
DocumentError_MarkupError e -> toString e
|
||||||
DocumentError_MetadataMissing -> "Metadata missing"
|
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.
|
-- | Parse, render to HTML and extract metadata from the given file.
|
||||||
--
|
--
|
||||||
@ -75,17 +72,16 @@ mkDocumentFrom k@(arg #relpath -> k') f = do
|
|||||||
liftEither
|
liftEither
|
||||||
$ first DocumentError_MarkupError
|
$ first DocumentError_MarkupError
|
||||||
$ renderDoc v
|
$ renderDoc v
|
||||||
let metaValueM = extractMeta v
|
|
||||||
metaValue <-
|
metaValue <-
|
||||||
maybeToEither
|
liftEither
|
||||||
DocumentError_MetadataMissing
|
. (first DocumentError_MetadataMalformed)
|
||||||
metaValueM
|
=<< maybeToEither DocumentError_MetadataMissing (extractMeta v)
|
||||||
meta <-
|
meta <-
|
||||||
liftEither
|
liftEither
|
||||||
$ first (DocumentError_MetadataBadJSON . toText)
|
$ first (DocumentError_MetadataMalformed . toText)
|
||||||
$ resultToEither
|
$ resultToEither
|
||||||
$ fromJSON metaValue
|
$ fromJSON metaValue
|
||||||
pure $ Document k' v html metaValueM meta
|
pure $ Document k' v html meta
|
||||||
where
|
where
|
||||||
maybeToEither e = \case
|
maybeToEither e = \case
|
||||||
Nothing -> throwError e
|
Nothing -> throwError e
|
||||||
|
@ -13,7 +13,7 @@ module Rib.Markup
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson (Value)
|
||||||
import Lucid (Html)
|
import Lucid (Html)
|
||||||
import Named
|
import Named
|
||||||
import Path
|
import Path
|
||||||
@ -42,7 +42,7 @@ class Markup repr where
|
|||||||
|
|
||||||
extractMeta ::
|
extractMeta ::
|
||||||
repr ->
|
repr ->
|
||||||
Maybe Value
|
Maybe (Either Text Value)
|
||||||
|
|
||||||
-- | Render the document as Lucid HTML
|
-- | Render the document as Lucid HTML
|
||||||
renderDoc ::
|
renderDoc ::
|
||||||
|
@ -44,7 +44,7 @@ instance Markup MMark where
|
|||||||
content <- readFileText (toFilePath f)
|
content <- readFileText (toFilePath f)
|
||||||
pure $ parseDoc k content
|
pure $ parseDoc k content
|
||||||
|
|
||||||
extractMeta = MMark.projectYaml
|
extractMeta = fmap Right . MMark.projectYaml
|
||||||
|
|
||||||
renderDoc = Right . MMark.render
|
renderDoc = Right . MMark.render
|
||||||
|
|
||||||
|
@ -77,10 +77,8 @@ instance Markup Pandoc where
|
|||||||
extractMeta (Pandoc meta _) = flattenMeta meta
|
extractMeta (Pandoc meta _) = flattenMeta meta
|
||||||
|
|
||||||
renderDoc =
|
renderDoc =
|
||||||
bimap show toHtmlRaw
|
bimap (show . RibPandocError_PandocError) toHtmlRaw
|
||||||
. first RibPandocError_PandocError
|
|
||||||
. liftEither
|
. liftEither
|
||||||
. fmap toHtmlRaw
|
|
||||||
. runPure
|
. runPure
|
||||||
. writeHtml5String writerSettings
|
. writeHtml5String writerSettings
|
||||||
|
|
||||||
@ -170,16 +168,20 @@ detectReader f = do
|
|||||||
-- | Flatten a Pandoc 'Meta' into a well-structured JSON object.
|
-- | Flatten a Pandoc 'Meta' into a well-structured JSON object.
|
||||||
--
|
--
|
||||||
-- Renders Pandoc text objects into plain strings along the way.
|
-- Renders Pandoc text objects into plain strings along the way.
|
||||||
flattenMeta :: Meta -> Maybe Value
|
flattenMeta :: Meta -> Maybe (Either Text Value)
|
||||||
flattenMeta (Meta meta) = toJSON . fmap go <$> guarded null meta
|
flattenMeta (Meta meta) = fmap toJSON . traverse go <$> guarded null meta
|
||||||
where
|
where
|
||||||
go :: MetaValue -> Value
|
go :: MetaValue -> Either Text Value
|
||||||
go (MetaMap m) = toJSON $ fmap go m
|
go (MetaMap m) = toJSON <$> traverse go m
|
||||||
go (MetaList m) = toJSONList $ fmap go m
|
go (MetaList m) = toJSONList <$> traverse go m
|
||||||
go (MetaBool m) = toJSON m
|
go (MetaBool m) = pure $ toJSON m
|
||||||
go (MetaString m) = toJSON m
|
go (MetaString m) = pure $ toJSON m
|
||||||
go (MetaInlines m) = toJSON (runPure' . writer $ Pandoc mempty [Plain m])
|
go (MetaInlines m) =
|
||||||
go (MetaBlocks m) = toJSON (runPure' . writer $ Pandoc mempty m)
|
bimap show toJSON
|
||||||
runPure' :: PandocPure a -> a
|
$ runPure . plainWriter
|
||||||
runPure' = either (error . show) id . runPure
|
$ Pandoc mempty [Plain m]
|
||||||
writer = writePlain def
|
go (MetaBlocks m) =
|
||||||
|
bimap show toJSON
|
||||||
|
$ runPure . plainWriter
|
||||||
|
$ Pandoc mempty m
|
||||||
|
plainWriter = writePlain def
|
||||||
|
Loading…
Reference in New Issue
Block a user