diff --git a/.shake/.shake.database b/.shake/.shake.database index b54b711..7ccfa30 100644 Binary files a/.shake/.shake.database and b/.shake/.shake.database differ diff --git a/app/Main.hs b/app/Main.hs index ebab481..893705d 100755 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,25 +8,16 @@ module Main where -import Control.Monad (forM, void) -import Data.Aeson.Types (Result (..)) -import Data.List (nub, sortOn) import Data.Text (Text) import Data.Time (UTCTime, defaultTimeLocale, formatTime, parseTimeM) import Deriving.Aeson import Deriving.Aeson.Stock (PrefixedSnake) -import Development.Shake (Action, Rules, (%>), (|%>), (~>)) -import Development.Shake.FilePath ((<.>), ()) -import Text.Pandoc (Block (Plain), Meta (..), MetaValue (..), Pandoc (..)) -import qualified Data.Aeson.Types as A +import Development.Shake (Action, Rules, (|%>), (~>)) +import Development.Shake.FilePath (()) import qualified Data.HashMap.Strict as HM -import qualified Data.Ord as Ord import qualified Data.Text as T import qualified Development.Shake as Shake import qualified Development.Shake.FilePath as Shake -import qualified Text.Mustache as Mus -import qualified Text.Mustache.Compile as Mus -import qualified Text.Pandoc as Pandoc import Config import Utilities import Templates diff --git a/app/Templates.hs b/app/Templates.hs index 60df609..3184327 100644 --- a/app/Templates.hs +++ b/app/Templates.hs @@ -12,7 +12,7 @@ import qualified Data.Aeson as A import qualified Data.Text as T import Development.Shake.FilePath (()) -applyTemplate :: ToJSON a => String -> a -> Text +applyTemplate :: ToJSON a => String -> a -> Action Text applyTemplate templateName context = do tmpl <- readTemplate $ "templates" templateName case Mus.checkedSubstitute tmpl (A.toJSON context) of diff --git a/app/Utilities.hs b/app/Utilities.hs index 5380178..be5d891 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -9,6 +9,8 @@ import qualified Development.Shake.FilePath as Shake import qualified Text.Pandoc as Pandoc import Config import Development.Shake (Action) +import Text.Pandoc +import Data.Aeson as A indexHtmlOutputPath :: FilePath -> FilePath indexHtmlOutputPath srcPath = @@ -21,19 +23,34 @@ indexHtmlSourcePath = . Shake.dropTrailingPathSeparator . Shake.dropFileName -typstToHtml :: FilePath -> Action Text +typstToHtml :: FromJSON a => FilePath -> Action (a, Text) typstToHtml filePath = do content <- Shake.readFile' filePath Shake.quietly . Shake.traced "Typst to HTML" $ do - doc <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content - - runPandoc . Pandoc.writeHtml5String writerOptions $ doc + doc@(Pandoc meta _) <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content + meta' <- fromMeta meta + html <- runPandoc . Pandoc.writeHtml5String writerOptions $ doc + return (meta', html) where readerOptions = Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions} writerOptions = Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions} - -runPandoc action = - Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) - >>= either (fail . show) return + fromMeta (Meta meta) = + A.fromJSON . A.toJSON <$> traverse metaValueToJSON meta >>= \case + Success res -> pure res + Error err -> fail $ "json conversion error:" <> err + metaValueToJSON = \case + MetaMap m -> A.toJSON <$> traverse metaValueToJSON m + MetaList m -> A.toJSONList <$> traverse metaValueToJSON m + MetaBool m -> pure $ A.toJSON m + MetaString m -> pure $ A.toJSON $ T.strip m + MetaInlines m -> metaValueToJSON $ MetaBlocks [Plain m] + MetaBlocks m -> + fmap (A.toJSON . T.strip) + . runPandoc + . Pandoc.writePlain Pandoc.def + $ Pandoc mempty m + runPandoc action = + Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) + >>= either (fail . show) return