now I just need to fix shake rules so things are needed/provided correctly

This commit is contained in:
Pagwin 2024-07-20 20:30:21 -04:00
parent fb421d59ae
commit 9485e9af58
No known key found for this signature in database
GPG key ID: 81137023740CA260
4 changed files with 28 additions and 20 deletions

Binary file not shown.

View file

@ -8,25 +8,16 @@
module Main where module Main where
import Control.Monad (forM, void)
import Data.Aeson.Types (Result (..))
import Data.List (nub, sortOn)
import Data.Text (Text) import Data.Text (Text)
import Data.Time (UTCTime, defaultTimeLocale, formatTime, parseTimeM) import Data.Time (UTCTime, defaultTimeLocale, formatTime, parseTimeM)
import Deriving.Aeson import Deriving.Aeson
import Deriving.Aeson.Stock (PrefixedSnake) import Deriving.Aeson.Stock (PrefixedSnake)
import Development.Shake (Action, Rules, (%>), (|%>), (~>)) import Development.Shake (Action, Rules, (|%>), (~>))
import Development.Shake.FilePath ((<.>), (</>)) import Development.Shake.FilePath ((</>))
import Text.Pandoc (Block (Plain), Meta (..), MetaValue (..), Pandoc (..))
import qualified Data.Aeson.Types as A
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Ord as Ord
import qualified Data.Text as T import qualified Data.Text as T
import qualified Development.Shake as Shake import qualified Development.Shake as Shake
import qualified Development.Shake.FilePath 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 Config
import Utilities import Utilities
import Templates import Templates

View file

@ -12,7 +12,7 @@ import qualified Data.Aeson as A
import qualified Data.Text as T import qualified Data.Text as T
import Development.Shake.FilePath ((</>)) import Development.Shake.FilePath ((</>))
applyTemplate :: ToJSON a => String -> a -> Text applyTemplate :: ToJSON a => String -> a -> Action Text
applyTemplate templateName context = do applyTemplate templateName context = do
tmpl <- readTemplate $ "templates" </> templateName tmpl <- readTemplate $ "templates" </> templateName
case Mus.checkedSubstitute tmpl (A.toJSON context) of case Mus.checkedSubstitute tmpl (A.toJSON context) of

View file

@ -9,6 +9,8 @@ import qualified Development.Shake.FilePath as Shake
import qualified Text.Pandoc as Pandoc import qualified Text.Pandoc as Pandoc
import Config import Config
import Development.Shake (Action) import Development.Shake (Action)
import Text.Pandoc
import Data.Aeson as A
indexHtmlOutputPath :: FilePath -> FilePath indexHtmlOutputPath :: FilePath -> FilePath
indexHtmlOutputPath srcPath = indexHtmlOutputPath srcPath =
@ -21,19 +23,34 @@ indexHtmlSourcePath =
. Shake.dropTrailingPathSeparator . Shake.dropTrailingPathSeparator
. Shake.dropFileName . Shake.dropFileName
typstToHtml :: FilePath -> Action Text typstToHtml :: FromJSON a => FilePath -> Action (a, Text)
typstToHtml filePath = do typstToHtml filePath = do
content <- Shake.readFile' filePath content <- Shake.readFile' filePath
Shake.quietly . Shake.traced "Typst to HTML" $ do Shake.quietly . Shake.traced "Typst to HTML" $ do
doc <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content doc@(Pandoc meta _) <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content
meta' <- fromMeta meta
runPandoc . Pandoc.writeHtml5String writerOptions $ doc html <- runPandoc . Pandoc.writeHtml5String writerOptions $ doc
return (meta', html)
where where
readerOptions = readerOptions =
Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions} Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions}
writerOptions = writerOptions =
Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions} Pandoc.def {Pandoc.writerExtensions = Pandoc.pandocExtensions}
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 = runPandoc action =
Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action)
>>= either (fail . show) return >>= either (fail . show) return