diff --git a/app/Main.hs b/app/Main.hs index e1d37ab..399ceaf 100755 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,10 +11,6 @@ module Main where import Control.Monad (forM) import Data.List (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 qualified Data.HashMap.Strict as HM @@ -23,6 +19,7 @@ import qualified Data.Text as T import qualified Development.Shake as Shake import qualified Development.Shake.FilePath as Shake import Config +import Types import Utilities import Templates -- target = thing we want @@ -59,7 +56,7 @@ buildRules = do home assets pages - posts + postsRule rss -- make a rule of the pattern outputDir/asset_name which copes from outputDir/../pages @@ -69,31 +66,18 @@ assets = map (outputDir ) assetGlobs |%> \target -> do Shake.copyFileChanged src target Shake.putInfo $ "Copied " <> target <> " from " <> src -data Page = Page {pageTitle :: Text, pageContent :: Text} - deriving (Show, Generic) - deriving (ToJSON) via PrefixedSnake "page" Page pages :: Rules () pages = map indexHtmlOutputPath pagePaths |%> \target -> do let src = indexHtmlSourcePath target (meta, html) <- typstToHtml src - let page = Page (meta HM.! "title") html + let page = Page (postTitle meta) html applyTemplateAndWrite "default.html" page target Shake.putInfo $ "Built " <> target <> " from " <> src -data Post = Post - { postTitle :: Text, - postAuthor :: Maybe Text, - postTags :: [Text], - postDate :: Maybe Text, - postContent :: Maybe Text, - postLink :: Maybe Text - } deriving (Show, Generic) - deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post - -posts :: Rules () -posts = map indexHtmlOutputPath postGlobs |%> \target -> do +postsRule :: Rules () +postsRule = map indexHtmlOutputPath postGlobs |%> \target -> do let src = indexHtmlSourcePath target post <- readPost src postHtml <- applyTemplate "post.html" post @@ -125,17 +109,11 @@ rss = outputDir "index.xml" %> \target -> do readPost :: FilePath -> Action Post readPost postPath = do - date <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" - . take 10 - . Shake.takeBaseName - $ postPath - let formattedDate = - T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date - (post, html) <- typstToHtml postPath + Shake.putInfo $ show post Shake.putInfo $ "Read " <> postPath return $ post - { postDate = Just formattedDate, + { postContent = Just html, postLink = Just . T.pack $ "/" <> Shake.dropExtension postPath <> "/" } diff --git a/app/Types.hs b/app/Types.hs new file mode 100644 index 0000000..28861e8 --- /dev/null +++ b/app/Types.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-} +{-# LANGUAGE DerivingVia, TypeApplications #-} + +module Types where + +import Deriving.Aeson +import Deriving.Aeson.Stock (PrefixedSnake) +import Data.Text (Text) + +data Page = Page {pageTitle :: Text, pageContent :: Text} + deriving (Show, Generic) + deriving (ToJSON) via PrefixedSnake "page" Page + +data Post = Post + { postTitle :: Text, + postAuthor :: Maybe Text, + postTags :: [Text], + postDate :: Maybe Text, + postContent :: Maybe Text, + postLink :: Maybe Text + } deriving (Show, Generic) + deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post diff --git a/app/Utilities.hs b/app/Utilities.hs index 29357f5..e3a56c0 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE ApplicativeDo, DataKinds, DeriveGeneric #-} +{-# 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 @@ -11,6 +12,9 @@ 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) indexHtmlOutputPath :: FilePath -> FilePath indexHtmlOutputPath srcPath = @@ -23,14 +27,15 @@ indexHtmlSourcePath = . Shake.dropTrailingPathSeparator . Shake.dropFileName -typstToHtml :: FromJSON a => FilePath -> Action (a, Text) +typstToHtml :: FilePath -> Action (Post, 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' html <- runPandoc . Pandoc.writeHtml5String writerOptions $ doc - return (meta', html) + return (fromJust dateTransformedMeta, html) where readerOptions = Pandoc.def {Pandoc.readerExtensions = Pandoc.pandocExtensions} @@ -54,3 +59,11 @@ typstToHtml filePath = do runPandoc action = Pandoc.runIO (Pandoc.setVerbosity Pandoc.ERROR >> action) >>= either (fail . show) return + dateTransform post@(Post{postDate}) = do + postDate' <- dateStrTransform $ T.unpack $ fromJust postDate + Just post { + postDate = Just postDate' + } + dateStrTransform date = do + date' <- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" date + Just $ T.pack $ formatTime @UTCTime defaultTimeLocale "%b %e, %Y" date' diff --git a/psb.cabal b/psb.cabal index 4341821..cd29e8e 100644 --- a/psb.cabal +++ b/psb.cabal @@ -62,7 +62,7 @@ executable psb main-is: Main.hs -- Modules included in this executable, other than Main. - other-modules: Config Utilities Templates + other-modules: Config Utilities Templates Types -- LANGUAGE extensions used by modules in this package. -- other-extensions: