From 0c677070edf9978cb85a0b521f7e6e0ef6d6b491 Mon Sep 17 00:00:00 2001 From: Chris Wells Date: Mon, 10 Feb 2025 12:48:38 -0600 Subject: A lot of work on aliases and the like --- src/Hakyll/Aeson.hs | 42 ++++++++++++++++++++++++++++++++++++++++++ src/Hakyll/Alias.hs | 23 +++++++++++++++++++++++ src/Hakyll/Parsec.hs | 1 - src/Hakyll/TeX/BibTeX.hs | 2 +- 4 files changed, 66 insertions(+), 2 deletions(-) create mode 100644 src/Hakyll/Aeson.hs create mode 100644 src/Hakyll/Alias.hs (limited to 'src/Hakyll') diff --git a/src/Hakyll/Aeson.hs b/src/Hakyll/Aeson.hs new file mode 100644 index 0000000..f4090d5 --- /dev/null +++ b/src/Hakyll/Aeson.hs @@ -0,0 +1,42 @@ +module Hakyll.Aeson + ( compileJSON + , jsonCompiler + , compileYAML + , yamlCompiler + , JSONWriter (..) + , YAMLWriter (..) + ) where + +import Prolog +import Hakyll +import Hakyll.Error +import Data.Aeson as A +import Data.Yaml qualified as Y + + +compileJSON :: (FromJSON a, StringConv s LazyByteString, Traversable t, MonadError [String] m) => t s -> m (t a) +compileJSON = traverse $ liftErr . A.eitherDecode . toSL + +jsonCompiler :: FromJSON a => Compiler (Item a) +jsonCompiler = getResourceLBS >>= compileJSON + +compileYAML :: (FromJSON a, StringConv s StrictByteString, Traversable t, MonadThrow m) => t s -> m (t a) +compileYAML = traverse $ Y.decodeThrow . toSL + +yamlCompiler :: FromJSON a => Compiler (Item a) +yamlCompiler = getResourceLBS >>= compileYAML + + +newtype JSONWriter a = JSONWriter { runJSONWriter :: a } + deriving stock (Generic, Show) + deriving newtype (FromJSON, ToJSON, Binary) + +instance ToJSON a => Writable (JSONWriter a) where + write p = A.encodeFile p . runJSONWriter . itemBody + +newtype YAMLWriter a = YAMLWriter { runYAMLWriter :: a } + deriving stock (Generic, Show) + deriving newtype (FromJSON, ToJSON, Binary) + +instance ToJSON a => Writable (YAMLWriter a) where + write p = Y.encodeFile p . runYAMLWriter . itemBody diff --git a/src/Hakyll/Alias.hs b/src/Hakyll/Alias.hs new file mode 100644 index 0000000..598f5e2 --- /dev/null +++ b/src/Hakyll/Alias.hs @@ -0,0 +1,23 @@ +module Hakyll.Alias + ( aliasCtxt + , personCtxt + ) where + +import Prolog +import Hakyll +import Data.Alias +import Data.Name +import Data.Person + + +functionField1 :: String -> (String -> Compiler String) -> Context a +functionField1 n f = functionField n $ \case + [x] -> \_ -> f x + _ -> \_ -> fail $ "Expecting exactly one argument to " <> n + +aliasCtxt :: (Ord a, FromAlias a x) => String -> (String -> Compiler a) -> (x -> Compiler String) -> AliasMap a x -> Context c +aliasCtxt name toa fromx amap = functionField1 name $ toa >=> flip resolveAlias amap >=> fromx + + +personCtxt :: AliasMap Name_ Person_ -> Context a +personCtxt = aliasCtxt "person" (parseName . toSL) (pure . toSL . personHtml) diff --git a/src/Hakyll/Parsec.hs b/src/Hakyll/Parsec.hs index edd7b18..a1cc706 100644 --- a/src/Hakyll/Parsec.hs +++ b/src/Hakyll/Parsec.hs @@ -8,7 +8,6 @@ module Hakyll.Parsec import Prolog import Hakyll import Text.Parsec -import Text.Parsec.Error import Hakyll.Error -- evalParsec :: (MonadError [String] m) => Either ParseError a -> m a diff --git a/src/Hakyll/TeX/BibTeX.hs b/src/Hakyll/TeX/BibTeX.hs index a3adce7..eb87c4e 100644 --- a/src/Hakyll/TeX/BibTeX.hs +++ b/src/Hakyll/TeX/BibTeX.hs @@ -31,7 +31,7 @@ instance Writable [B.T] where compileBibtex :: (StringConv s String) => Item s -> Compiler (Item BibTeX) -compileBibtex = compileParsec_ p . fmap toSL +compileBibtex = fmap (B.lowerCaseFieldNames <<$>>) . compileParsec_ p . fmap toSL where p = B.skippingLeadingSpace $ B.file <* P.space <* P.eof -- cgit v1.2.3