refactored to use ToMustache instead of ToJSON
This commit is contained in:
parent
d8d126a4c5
commit
27e08cbc7a
3 changed files with 21 additions and 4 deletions
|
|
@ -9,6 +9,7 @@ module Psb.Main where
|
||||||
|
|
||||||
import Config
|
import Config
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
import Data.Aeson (ToJSON (toJSON))
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.HashMap.Strict as HM
|
||||||
import Data.List (sortOn)
|
import Data.List (sortOn)
|
||||||
import qualified Data.Ord as Ord
|
import qualified Data.Ord as Ord
|
||||||
|
|
@ -22,6 +23,7 @@ import Development.Shake.FilePath ((</>))
|
||||||
import qualified Development.Shake.FilePath as FP
|
import qualified Development.Shake.FilePath as FP
|
||||||
import Templates
|
import Templates
|
||||||
import Text.Megaparsec (errorBundlePretty)
|
import Text.Megaparsec (errorBundlePretty)
|
||||||
|
import Text.Mustache (ToMustache (toMustache))
|
||||||
import Types
|
import Types
|
||||||
import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now, psbProgress)
|
import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now, psbProgress)
|
||||||
import qualified Utilities.CSS as CSS
|
import qualified Utilities.CSS as CSS
|
||||||
|
|
@ -173,6 +175,9 @@ data Rss = Rss
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
deriving (ToJSON) via Vanilla Rss
|
deriving (ToJSON) via Vanilla Rss
|
||||||
|
|
||||||
|
instance ToMustache Rss where
|
||||||
|
toMustache = toMustache . toJSON
|
||||||
|
|
||||||
rss :: Rules ()
|
rss :: Rules ()
|
||||||
rss =
|
rss =
|
||||||
outputDir </> "index.xml" %> \target -> do
|
outputDir </> "index.xml" %> \target -> do
|
||||||
|
|
|
||||||
|
|
@ -8,16 +8,17 @@ import Development.Shake
|
||||||
import qualified Development.Shake as Shake
|
import qualified Development.Shake as Shake
|
||||||
import Development.Shake.FilePath ((</>))
|
import Development.Shake.FilePath ((</>))
|
||||||
import GHC.Stack (HasCallStack)
|
import GHC.Stack (HasCallStack)
|
||||||
|
import Text.Mustache (ToMustache)
|
||||||
import qualified Text.Mustache as Mus
|
import qualified Text.Mustache as Mus
|
||||||
import qualified Text.Mustache.Compile as Mus
|
import qualified Text.Mustache.Compile as Mus
|
||||||
import Types (Post (postAuthor, postContent, postDate, postDescription, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostId, rPostIsoDate, rPostLink, rPostSummary, rPostTags, rPostTitle))
|
import Types (Post (postAuthor, postContent, postDate, postDescription, postLink, postTags, postTitle), RenderedPost (RenderedPost, rPostAuthor, rPostContent, rPostDate, rPostHasTags, rPostId, rPostIsoDate, rPostLink, rPostSummary, rPostTags, rPostTitle))
|
||||||
import Utilities
|
import Utilities
|
||||||
|
|
||||||
applyTemplate :: (HasCallStack, (ToJSON a)) => String -> a -> Action Text
|
applyTemplate :: (HasCallStack, (ToMustache a)) => String -> a -> Action Text
|
||||||
applyTemplate templateName context = do
|
applyTemplate templateName context = do
|
||||||
tmpl <- readTemplate $ "templates" </> templateName
|
tmpl <- readTemplate $ "templates" </> templateName
|
||||||
-- liftIO $ print $ A.toJSON context
|
-- liftIO $ print $ A.toJSON context
|
||||||
case Mus.checkedSubstitute tmpl (A.toJSON context) of
|
case Mus.checkedSubstitute tmpl context of
|
||||||
([], text) -> return text
|
([], text) -> return text
|
||||||
(errs, _) ->
|
(errs, _) ->
|
||||||
error $
|
error $
|
||||||
|
|
@ -26,7 +27,7 @@ applyTemplate templateName context = do
|
||||||
<> ": "
|
<> ": "
|
||||||
<> unlines (map show errs)
|
<> unlines (map show errs)
|
||||||
|
|
||||||
applyTemplateAndWrite :: (ToJSON a) => String -> a -> FilePath -> Action ()
|
applyTemplateAndWrite :: (ToMustache a) => String -> a -> FilePath -> Action ()
|
||||||
applyTemplateAndWrite templateName context outputPath =
|
applyTemplateAndWrite templateName context outputPath =
|
||||||
applyTemplate templateName context
|
applyTemplate templateName context
|
||||||
>>= Shake.writeFile' outputPath . T.unpack
|
>>= Shake.writeFile' outputPath . T.unpack
|
||||||
|
|
|
||||||
11
src/Types.hs
11
src/Types.hs
|
|
@ -1,8 +1,10 @@
|
||||||
module Types where
|
module Types where
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON (toJSON))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Deriving.Aeson
|
import Deriving.Aeson
|
||||||
import Deriving.Aeson.Stock (PrefixedSnake)
|
import Deriving.Aeson.Stock (PrefixedSnake)
|
||||||
|
import Text.Mustache (ToMustache (toMustache))
|
||||||
|
|
||||||
-- pageSection is what css class should be specified in a style html element, I would do an enum but I foresee that being a mistake
|
-- pageSection is what css class should be specified in a style html element, I would do an enum but I foresee that being a mistake
|
||||||
data Page = Page
|
data Page = Page
|
||||||
|
|
@ -16,6 +18,9 @@ data Page = Page
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
deriving (ToJSON) via PrefixedSnake "page" Page
|
deriving (ToJSON) via PrefixedSnake "page" Page
|
||||||
|
|
||||||
|
instance ToMustache Page where
|
||||||
|
toMustache = toMustache . toJSON
|
||||||
|
|
||||||
data RenderedPost = RenderedPost
|
data RenderedPost = RenderedPost
|
||||||
{ rPostTitle :: Text,
|
{ rPostTitle :: Text,
|
||||||
rPostAuthor :: Maybe Text,
|
rPostAuthor :: Maybe Text,
|
||||||
|
|
@ -31,6 +36,9 @@ data RenderedPost = RenderedPost
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
deriving (FromJSON, ToJSON) via PrefixedSnake "rPost" RenderedPost
|
deriving (FromJSON, ToJSON) via PrefixedSnake "rPost" RenderedPost
|
||||||
|
|
||||||
|
instance ToMustache RenderedPost where
|
||||||
|
toMustache = toMustache . toJSON
|
||||||
|
|
||||||
data Post = Post
|
data Post = Post
|
||||||
{ postTitle :: Text,
|
{ postTitle :: Text,
|
||||||
postAuthor :: Maybe Text,
|
postAuthor :: Maybe Text,
|
||||||
|
|
@ -43,3 +51,6 @@ data Post = Post
|
||||||
}
|
}
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post
|
deriving (FromJSON, ToJSON) via PrefixedSnake "post" Post
|
||||||
|
|
||||||
|
instance ToMustache Post where
|
||||||
|
toMustache = toMustache . toJSON
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue