right track
This commit is contained in:
parent
f3be772986
commit
e5d9673fc4
76
Shakefile.hs
76
Shakefile.hs
|
@ -9,27 +9,29 @@ import Development.Shake.FilePath
|
||||||
import Development.Shake.Util
|
import Development.Shake.Util
|
||||||
|
|
||||||
import Control.Monad.Fail
|
import Control.Monad.Fail
|
||||||
import Data.Default ( Default(def) )
|
import Data.Aeson
|
||||||
import qualified Data.Set as Set
|
import Text.Megaparsec
|
||||||
import qualified Data.Text as T
|
import Data.Default ( Default(def) )
|
||||||
import Text.Pandoc.Class ( PandocPure
|
import qualified Data.Set as Set
|
||||||
, PandocMonad
|
import qualified Data.Text as T
|
||||||
)
|
import Text.Mustache
|
||||||
import qualified Text.Pandoc.Class as Pandoc
|
import Text.Pandoc.Class ( PandocPure, PandocMonad)
|
||||||
import Text.Pandoc.Definition ( Pandoc(..)
|
import qualified Text.Pandoc.Class as Pandoc
|
||||||
, Block(..)
|
import Text.Pandoc.Definition ( Pandoc(..)
|
||||||
, Inline
|
, Block(..)
|
||||||
, nullMeta
|
, Inline
|
||||||
, docTitle
|
, nullMeta
|
||||||
, docDate
|
, docTitle
|
||||||
, docAuthors
|
, docDate
|
||||||
)
|
, docAuthors
|
||||||
import Text.Pandoc.Extensions ( getDefaultExtensions )
|
)
|
||||||
import Text.Pandoc.Options ( ReaderOptions(..)
|
import Text.Pandoc.Extensions ( getDefaultExtensions )
|
||||||
|
import Text.Pandoc.Options ( ReaderOptions(..)
|
||||||
, TrackChanges(RejectChanges)
|
, TrackChanges(RejectChanges)
|
||||||
)
|
)
|
||||||
import qualified Text.Pandoc.Readers as Readers
|
import qualified Text.Pandoc.Readers as Readers
|
||||||
import qualified Text.Pandoc.Writers as Writers
|
import qualified Text.Pandoc.Templates as PandocTemplates
|
||||||
|
import qualified Text.Pandoc.Writers as Writers
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = shakeArgs shOpts buildRules
|
main = shakeArgs shOpts buildRules
|
||||||
|
@ -90,35 +92,37 @@ buildRules = do
|
||||||
allRule
|
allRule
|
||||||
getPost <- mkGetPost
|
getPost <- mkGetPost
|
||||||
getPosts <- mkGetPosts getPost
|
getPosts <- mkGetPosts getPost
|
||||||
|
getTemplate <- mkGetTemplate
|
||||||
let cssDeps = map (siteDir </>) <$> getDirectoryFiles "src" ["css/*.css"]
|
let cssDeps = map (siteDir </>) <$> getDirectoryFiles "src" ["css/*.css"]
|
||||||
-- build "index.html" %> \out -> do
|
-- templateDeps = getDirectoryFiles "templates" ["*.mustache"]
|
||||||
-- css <- cssDeps
|
|
||||||
-- need $ css <> ["src/index.org"]
|
|
||||||
-- bp <- getPost "src/index.org"
|
|
||||||
-- eitherHtml <- liftIO $ Pandoc.runIO $ Writers.writeHtml5String def (postBody bp)
|
|
||||||
-- case eitherHtml of
|
|
||||||
-- Left _ -> fail "BAD"
|
|
||||||
-- Right htmlFile -> writeFile' out (T.unpack htmlFile)
|
|
||||||
build "//*.html" %> \out -> do
|
build "//*.html" %> \out -> do
|
||||||
css <- cssDeps
|
css <- cssDeps
|
||||||
|
-- templates <- templateDeps
|
||||||
|
template <- getTemplate ("templates" </> "main.mustache")
|
||||||
let srcFile = "src" </> (dropDirectory1 (replaceExtension out "org"))
|
let srcFile = "src" </> (dropDirectory1 (replaceExtension out "org"))
|
||||||
liftIO $ putText $ "need: " <> (T.pack srcFile) <> " <- " <> (T.pack out)
|
liftIO $ putText $ "need: " <> (toS srcFile) <> " <- " <> (toS out)
|
||||||
need $ css <> [srcFile]
|
need $ css <> [srcFile]
|
||||||
bp <- getPost srcFile
|
bp <- getPost srcFile
|
||||||
eitherHtml <- liftIO $ Pandoc.runIO $ Writers.writeHtml5String def (postBody bp)
|
eitherHtml <- liftIO $ Pandoc.runIO $ Writers.writeHtml5String def (postBody bp)
|
||||||
case eitherHtml of
|
case eitherHtml of
|
||||||
Left _ -> fail "BAD"
|
Left _ -> fail "BAD"
|
||||||
Right htmlFile -> writeFile' out (T.unpack htmlFile)
|
Right innerHtml ->
|
||||||
|
let htmlContent = renderMustache template $ object [ "title" .= postTitle bp
|
||||||
|
, "authors" .= postAuthors bp
|
||||||
|
, "date" .= postDate bp
|
||||||
|
, "body" .= innerHtml
|
||||||
|
]
|
||||||
|
in writeFile' out (toS htmlContent)
|
||||||
build "articles.html" %> \out -> do
|
build "articles.html" %> \out -> do
|
||||||
css <- cssDeps
|
css <- cssDeps
|
||||||
posts <- getPosts ()
|
posts <- getPosts ()
|
||||||
need $ css <> map postUrl (sortByPostDate posts)
|
need $ css <> map postUrl (sortByPostDate posts)
|
||||||
let titles = T.unpack $ T.intercalate "\n" $ map postTitle posts
|
let titles = toS $ T.intercalate "\n" $ map postTitle posts
|
||||||
writeFile' out titles
|
writeFile' out titles
|
||||||
build "css/*.css" %> \out -> do
|
build "css/*.css" %> \out -> do
|
||||||
let src = "src" </> (dropDirectory1 out)
|
let src = "src" </> (dropDirectory1 out)
|
||||||
dst = out
|
dst = out
|
||||||
liftIO $ putText $ T.pack $ "src:" <> src <> " => dst: " <> dst
|
liftIO $ putText $ toS $ "src:" <> src <> " => dst: " <> dst
|
||||||
copyFile' src dst
|
copyFile' src dst
|
||||||
|
|
||||||
allRule :: Rules ()
|
allRule :: Rules ()
|
||||||
|
@ -134,10 +138,18 @@ cleanRule =
|
||||||
putInfo "Cleaning files in _site and _optim"
|
putInfo "Cleaning files in _site and _optim"
|
||||||
forM_ [siteDir,optimDir] $ flip removeFilesAfter ["//*"]
|
forM_ [siteDir,optimDir] $ flip removeFilesAfter ["//*"]
|
||||||
|
|
||||||
|
mkGetTemplate :: Rules (FilePath -> Action Template)
|
||||||
|
mkGetTemplate = newCache $ \path -> do
|
||||||
|
fileContent <- readFile' path
|
||||||
|
let res = compileMustacheText "page" (toS fileContent)
|
||||||
|
case res of
|
||||||
|
Left _ -> fail "BAD"
|
||||||
|
Right template -> return template
|
||||||
|
|
||||||
mkGetPost :: Rules (FilePath -> Action BlogPost)
|
mkGetPost :: Rules (FilePath -> Action BlogPost)
|
||||||
mkGetPost = newCache $ \path -> do
|
mkGetPost = newCache $ \path -> do
|
||||||
fileContent <- readFile' path
|
fileContent <- readFile' path
|
||||||
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg def (T.pack fileContent)
|
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg def (toS fileContent)
|
||||||
case eitherResult of
|
case eitherResult of
|
||||||
Left _ -> fail "BAD"
|
Left _ -> fail "BAD"
|
||||||
Right pandoc -> getBlogpostFromMetas path pandoc
|
Right pandoc -> getBlogpostFromMetas path pandoc
|
||||||
|
|
|
@ -7,6 +7,7 @@ let
|
||||||
data-default
|
data-default
|
||||||
protolude
|
protolude
|
||||||
pkgs1909.haskellPackages.sws
|
pkgs1909.haskellPackages.sws
|
||||||
|
stache
|
||||||
];
|
];
|
||||||
ghc = pkgs.haskellPackages.ghcWithPackages haskellDeps;
|
ghc = pkgs.haskellPackages.ghcWithPackages haskellDeps;
|
||||||
in
|
in
|
||||||
|
|
9
templates/main.mustache
Normal file
9
templates/main.mustache
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<title>{{title}}</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<h1> {{title}} </h1>
|
||||||
|
{{{ body }}}
|
||||||
|
</body>
|
||||||
|
</html>
|
Loading…
Reference in a new issue