From 8f8b33517a31f1696e22552de74ed89a4c7e13f8 Mon Sep 17 00:00:00 2001 From: Pagwin Date: Thu, 1 Aug 2024 01:50:40 -0400 Subject: [PATCH] seems to be working now --- app/Main.hs | 14 ++++++------- app/Templates.hs | 3 --- app/Types.hs | 3 --- app/Utilities.hs | 51 ++++++++++++++++++++++-------------------------- psb.cabal | 4 ++-- 5 files changed, 31 insertions(+), 44 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 399ceaf..bc1149e 100755 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,8 +4,6 @@ -- https://hackage.haskell.org/package/pandoc-3.2.1/docs/doc-index-All.html -- https://hackage.haskell.org/package/mustache-2.4.2/docs/doc-index.html -- -{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-} -{-# LANGUAGE DerivingVia, TypeApplications #-} module Main where @@ -70,8 +68,9 @@ assets = map (outputDir ) assetGlobs |%> \target -> do pages :: Rules () pages = map indexHtmlOutputPath pagePaths |%> \target -> do let src = indexHtmlSourcePath target - (meta, html) <- typstToHtml src - + let metaSrc = indexHtmlMetaPath target + html <- typstToHtml src + meta <- yamlToPost metaSrc let page = Page (postTitle meta) html applyTemplateAndWrite "default.html" page target Shake.putInfo $ "Built " <> target <> " from " <> src @@ -102,15 +101,14 @@ rss :: Rules () rss = outputDir "index.xml" %> \target -> do postPaths <- Shake.getDirectoryFiles "" postGlobs posts <- sortOn (Ord.Down . postDate) <$> forM postPaths readPost - -- figure out how to convert this into applyTemplateAndWrite - feed <- applyTemplate "feed.xml" $ HM.singleton "posts" posts + applyTemplateAndWrite "feed.xml" (HM.singleton "posts" posts) target Shake.putInfo $ "Built " <> target readPost :: FilePath -> Action Post readPost postPath = do - (post, html) <- typstToHtml postPath - Shake.putInfo $ show post + html <- typstToHtml postPath + post <- yamlToPost $ typstMetaPath postPath Shake.putInfo $ "Read " <> postPath return $ post { diff --git a/app/Templates.hs b/app/Templates.hs index 3184327..58d86dd 100644 --- a/app/Templates.hs +++ b/app/Templates.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-} -{-# LANGUAGE DerivingVia, LambdaCase, TypeApplications #-} - module Templates where import Development.Shake import Data.Aeson (ToJSON) diff --git a/app/Types.hs b/app/Types.hs index 28861e8..b61fd7b 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-} -{-# LANGUAGE DerivingVia, TypeApplications #-} - module Types where import Deriving.Aeson diff --git a/app/Utilities.hs b/app/Utilities.hs index e3a56c0..6a0dc2e 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -1,20 +1,17 @@ -{-# LANGUAGE ApplicativeDo, DataKinds, NamedFieldPuns #-} -{-# LANGUAGE DerivingVia, LambdaCase, TypeApplications #-} module Utilities where import Data.Text (Text) import Development.Shake.FilePath ((<.>), ()) import qualified Data.Text as T +import Data.Yaml.Aeson import qualified Development.Shake as Shake 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 -import Data.Time (UTCTime(UTCTime), formatTime, defaultTimeLocale, parseTimeM) import Types -import Data.Maybe (fromJust) +import Data.Maybe (fromMaybe) +import Data.Time indexHtmlOutputPath :: FilePath -> FilePath indexHtmlOutputPath srcPath = @@ -27,42 +24,40 @@ indexHtmlSourcePath = . Shake.dropTrailingPathSeparator . Shake.dropFileName -typstToHtml :: FilePath -> Action (Post, Text) +indexHtmlMetaPath :: FilePath -> FilePath +indexHtmlMetaPath = typstMetaPath . indexHtmlSourcePath + +typstMetaPath :: FilePath -> FilePath +typstMetaPath typstPath = Shake.dropExtension typstPath <.> "yaml" + + +typstToHtml :: FilePath -> Action Text typstToHtml filePath = do content <- Shake.readFile' filePath Shake.quietly . Shake.traced "Typst to HTML" $ do - doc@(Pandoc meta _) <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content - meta' <- fromMeta meta - let dateTransformedMeta = dateTransform meta' + doc <- runPandoc . Pandoc.readTypst readerOptions . T.pack $ content html <- runPandoc . Pandoc.writeHtml5String writerOptions $ doc - return (fromJust dateTransformedMeta, html) + return html where readerOptions = Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions} writerOptions = 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 = Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) >>= either (fail . show) return + +yamlToPost :: FilePath -> Action Post +yamlToPost path = do + post <- decodeFileThrow path + let post' = dateTransform post + return $ fromMaybe post post' + where dateTransform post@(Post{postDate}) = do - postDate' <- dateStrTransform $ T.unpack $ fromJust postDate + postDate' <- postDate + let postDate'' = dateStrTransform $ T.unpack postDate' Just post { - postDate = Just postDate' + postDate = postDate'' } dateStrTransform date = do date' <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" date diff --git a/psb.cabal b/psb.cabal index cd29e8e..a087371 100644 --- a/psb.cabal +++ b/psb.cabal @@ -65,10 +65,10 @@ executable psb other-modules: Config Utilities Templates Types -- LANGUAGE extensions used by modules in this package. - -- other-extensions: + default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric -- Other library packages from which modules are imported. - build-depends: base ^>=4.17.2.1, mustache ^>=2.4.2, pandoc ^>=3.2.1, shake ^>= 0.19.8, deriving-aeson ^>= 0.2.9, aeson, text, time, unordered-containers + build-depends: base ^>=4.17.2.1, mustache ^>=2.4.2, pandoc ^>=3.2.1, shake ^>= 0.19.8, deriving-aeson ^>= 0.2.9, aeson, text, time, unordered-containers, yaml -- Directories containing source files. hs-source-dirs: app