{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Shakebook.Defaults where
import Control.Comonad
import Control.Comonad.Cofree
import Control.Comonad.Store.Class
import Control.Comonad.Store.Zipper
import Control.Monad.Extra
import Data.Aeson as A
import Data.List.Split
import Data.Text.Time
import Development.Shake as S
import Development.Shake.Classes
import Development.Shake.FilePath
import RIO hiding (view)
import qualified RIO.ByteString.Lazy as LBS
import RIO.List
import RIO.List.Partial
import qualified RIO.Map as M
import RIO.Partial
import qualified RIO.Text as T
import RIO.Time
import Shakebook.Aeson
import Shakebook.Data
import Shakebook.Rules
import Shakebook.Conventions
import Shakebook.Zipper
import Text.DocTemplates
import Text.Pandoc.Class
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.PDF
import Text.Pandoc.Readers
import Text.Pandoc.Templates
import Text.Pandoc.Walk
import Text.Pandoc.Writers
monthURLFormat :: UTCTime -> String
monthURLFormat = formatTime defaultTimeLocale "%Y-%m"
prettyMonthFormat :: UTCTime -> String
prettyMonthFormat = formatTime defaultTimeLocale "%B, %Y"
prettyTimeFormat :: UTCTime -> String
prettyTimeFormat = formatTime defaultTimeLocale "%A, %B %d, %Y"
monthIndexUrlFormat :: UTCTime -> String
monthIndexUrlFormat t = "/posts/months" </> monthURLFormat t
enrichPost :: Value -> Value
enrichPost = enrichTeaser "<!--more-->"
. enrichTagLinks ("/posts/tags/" <>)
. enrichPrettyDate prettyTimeFormat
. enrichTypicalUrl
markdownReaderOptions :: ReaderOptions
markdownReaderOptions = def { readerExtensions = pandocExtensions }
html5WriterOptions :: WriterOptions
html5WriterOptions = def { writerHTMLMathMethod = MathJax ""}
latexWriterOptions :: WriterOptions
latexWriterOptions = def { writerTableOfContents = True
, writerVariables = Context $ M.fromList [
("geometry", SimpleVal "margin=3cm")
, ("fontsize", SimpleVal "10")
, ("linkcolor",SimpleVal "blue")]
}
makePDFLaTeX :: Pandoc -> PandocIO (Either LBS.ByteString LBS.ByteString)
makePDFLaTeX p = do
t <- compileDefaultTemplate "latex"
makePDF "pdflatex" [] writeLaTeX latexWriterOptions { writerTemplate = Just t } p
handleImages :: (Text -> Text) -> Inline -> Inline
handleImages f (Image attr ins (src,txt)) =
if T.takeEnd 4 src == ".mp4" then Str (f src)
else Image attr ins ("public/" <> src, txt)
handleImages _ x = x
handleHeaders :: Int -> Block -> Block
handleHeaders i (Header a as xs) = Header (max 1 (a + i)) as xs
handleHeaders _ x = x
pushHeaders :: Int -> Cofree [] Pandoc -> Cofree [] Pandoc
pushHeaders i (x :< xs) = walk (handleHeaders i) x :< map (pushHeaders (i+1)) xs
defaultDocsPatterns :: Cofree [] FilePath
-> FilePath
-> (Value -> Value)
-> Shakebook ()
defaultDocsPatterns toc tmpl withData = Shakebook $ ask >>= \SbConfig {..} -> do
let r = readMarkdownFile' sbMdRead sbHTWrite
lift $ cofreeRuleGen toc ((sbOutDir </>) . (-<.> ".html")) (
\xs -> \out -> do
ys <- mapM r (fmap (sbSrcDir </>) toc)
zs <- mapM r (fmap (sbSrcDir </>) xs)
void $ genBuildPageAction (sbSrcDir </> tmpl)
(loadIfExists r . (-<.> ".md") . (sbSrcDir </>) . dropDirectory1)
(withData . withJSON (genTocNavbarData (fmap enrichTypicalUrl ys)) . withSubsections (lower (enrichTypicalUrl <$> zs)))
out)
defaultPostIndexData :: [FilePattern] -> (a -> Value -> Bool) -> (a -> Text) -> (a -> Text -> Text) -> a -> ShakebookA (Zipper [] Value)
defaultPostIndexData pat f t l a = ask >>= \SbConfig {..} -> do
xs <- loadSortFilterEnrich pat (Down . viewPostTime) (f a) enrichPost
let ys = genIndexPageData (snd <$> xs) (t a) (l a) sbPPP
return $ fromJust $ ys
defaultPagerPattern :: FilePattern
-> FilePath
-> (FilePattern -> Int)
-> (FilePattern -> a)
-> (a -> ShakebookA (Zipper [] Value))
-> (Zipper [] Value -> ShakebookA (Zipper [] Value))
-> Shakebook ()
defaultPagerPattern fp tmpl f g h w = Shakebook $ ask >>= \x@SbConfig{..} -> lift $
comonadStoreRuleGen (sbOutDir </> fp) (f . dropDirectory1) (g . dropDirectory1) (runShakebookA x . (w <=< h))
(\a -> void <$> genBuildPageAction (sbSrcDir </> tmpl) (const $ return a) id)
defaultPostIndexPatterns :: [FilePattern] -> FilePath -> (Zipper [] Value -> ShakebookA (Zipper [] Value)) -> Shakebook ()
defaultPostIndexPatterns pat tmpl extData = do
defaultPagerPattern "posts/index.html" tmpl
(const 0)
(const ())
(defaultPostIndexData pat (const $ (const True))
(const "Posts")
(const ("/posts/pages/" <>)))
extData
defaultPagerPattern ("posts/pages/*/index.html") tmpl
((+ (-1)) . read . (!! 2) . splitOn "/")
(const ())
(defaultPostIndexData pat (const $ (const True))
(const "Posts")
(const ("/posts/pages/" <>)))
extData
defaultTagIndexPatterns :: [FilePattern] -> FilePath -> (Zipper [] Value -> ShakebookA (Zipper [] Value)) -> Shakebook ()
defaultTagIndexPatterns pat tmpl extData = do
defaultPagerPattern ("posts/tags/*/index.html") tmpl
(const 0)
(T.pack . (!! 2) . splitOn "/")
(defaultPostIndexData pat (\x y -> elem x (viewTags y) )
("Posts tagged " <>)
(\x y -> ("/posts/tags/" <> x <> "/pages/" <> y)))
extData
defaultPagerPattern ("posts/tags/*/pages/*/index.html") tmpl
((+ (-1)) . read . (!! 4) . splitOn "/")
(T.pack . (!! 2) . splitOn "/")
(defaultPostIndexData pat (\x y -> elem x (viewTags y))
("Posts tagged " <>)
(\x y -> ("/posts/tags/" <> x <> "/pages/" <> y)))
extData
defaultMonthIndexPatterns :: [FilePattern] -> FilePath -> (Zipper [] Value -> ShakebookA (Zipper [] Value)) -> Shakebook ()
defaultMonthIndexPatterns pat tmpl extData = do
defaultPagerPattern "posts/months/*/index.html" tmpl
(const 0)
(parseISODateTime . T.pack . (!! 2) . splitOn "/")
(defaultPostIndexData pat
(\x y -> sameMonth x (viewPostTime y))
(("Posts from " <>) . T.pack . prettyMonthFormat)
(\x y -> ("/posts/months/" <> T.pack (monthURLFormat x) <> "/pages" <> y)))
extData
defaultPagerPattern "posts/months/*/pages/*/index.html" tmpl
((+ (-1)) . read . (!! 4) . splitOn "/")
(parseISODateTime . T.pack . (!! 2) . splitOn "/")
(defaultPostIndexData pat
(\x y -> sameMonth x (viewPostTime y))
(("Posts from " <>) . T.pack . prettyMonthFormat)
(\x y -> ("/posts/months/" <> T.pack (monthURLFormat x) <> "/pages" <> y)))
extData
defaultPostsPatterns :: FilePattern -> FilePath -> (Zipper [] Value -> ShakebookA (Zipper [] Value)) -> Shakebook ()
defaultPostsPatterns pat tmpl extData = Shakebook $ ask >>= \sbc@(SbConfig {..}) -> lift $
sbOutDir </> pat %> \out -> do
sortedPosts <- runShakebookA sbc $ loadSortEnrich [pat] (Down . viewPostTime) enrichPost
let i = (-<.> ".md") . dropDirectory1 $ out
let k = fromJust $ elemIndex i (fst <$> sortedPosts)
let z = fromJust $ seek k <$> zipper (snd <$> sortedPosts)
void $ genBuildPageAction (sbSrcDir </> tmpl)
(const $ runShakebookA sbc $ extract <$> extData z)
id out
buildPDF :: Cofree [] String -> String -> FilePath -> ShakebookA ()
buildPDF toc meta out = ShakebookA $ ask >>= \SbConfig {..} -> lift $ do
y <- mapM readFile' ((sbSrcDir </>) <$> toc)
m <- readFile' $ sbSrcDir </> meta
Right f <- liftIO . runIOorExplode $ do
k <- mapM (readMarkdown sbMdRead . T.pack) y
a <- readMarkdown sbMdRead . T.pack $ m
let z = walk (handleImages (\x -> "[Video available at " <> sbBaseUrl <> x <> "]")) $ foldr (<>) a $ pushHeaders (-1) k
makePDFLaTeX z
LBS.writeFile out f
defaultSinglePagePattern :: FilePath
-> FilePath
-> (Value -> ShakebookA Value)
-> Shakebook ()
defaultSinglePagePattern out tmpl withDataM = Shakebook $ ask >>= \sbc@(SbConfig {..}) -> lift $
sbOutDir </> out %> void . genBuildPageAction
(sbSrcDir </> tmpl)
(\fp -> do
x <- readMarkdownFile' sbMdRead sbHTWrite . (-<.> ".md") . (sbSrcDir </>) . dropDirectory1 $ fp
runShakebookA sbc $ withDataM x)
id
defaultStaticsPatterns :: [FilePattern] -> Shakebook ()
defaultStaticsPatterns xs = Shakebook $ ask >>= \SbConfig {..} -> lift $
mconcat $ map (\x -> sbOutDir </> x %> \y -> copyFileChanged ((sbSrcDir </>) . dropDirectory1 $ y) y) xs
defaultCleanPhony :: Shakebook ()
defaultCleanPhony = Shakebook $ ask >>= \SbConfig {..} -> lift $
phony "clean" $ do
putInfo $ "Cleaning files in " ++ sbOutDir
removeFilesAfter sbOutDir ["//*"]
defaultStaticsPhony :: Shakebook ()
defaultStaticsPhony = Shakebook $ ask >>= \SbConfig {..} -> lift $
phony "statics" $ do
fp <- getDirectoryFiles sbSrcDir ["images//*", "css//*", "js//*", "webfonts//*"]
need $ [sbOutDir </> x | x <- fp]
defaultPostsPhony :: [FilePattern] -> Shakebook ()
defaultPostsPhony pattern = Shakebook $ ask >>= \SbConfig {..} -> lift $
phony "posts" $ do
fp <- getDirectoryFiles sbSrcDir pattern
need [sbOutDir </> x -<.> ".html" | x <- fp]
defaultPostIndexPhony :: [FilePattern] -> Shakebook ()
defaultPostIndexPhony pattern = Shakebook $ ask >>= \SbConfig {..} -> lift $
phony "posts-index" $ do
fp <- getDirectoryMarkdown sbMdRead sbHTWrite sbSrcDir pattern
need [sbOutDir </> "posts/index.html"]
need [sbOutDir </> "posts/pages/" ++ show x ++ "/index.html"
| x <- [1..size (fromJust $ paginate sbPPP fp)]]
defaultTagIndexPhony :: [FilePattern] -> Shakebook ()
defaultTagIndexPhony pattern = Shakebook $ ask >>= \SbConfig {..} -> lift $
phony "tag-index" $ do
fp <- getDirectoryMarkdown sbMdRead sbHTWrite sbSrcDir pattern
let tags = viewAllPostTags fp
need [sbOutDir </> "posts/tags" </> T.unpack x </> "index.html" | x <- tags]
need [sbOutDir </> "posts/tags" </> T.unpack x </> "pages" </> show p </> "index.html"
| x <- tags
, p <- [1..size (fromJust $ paginate sbPPP $ tagFilterPosts x fp)]
]
defaultMonthIndexPhony :: [FilePattern] -> Shakebook ()
defaultMonthIndexPhony pattern = Shakebook $ ask >>= \SbConfig {..} -> lift $
phony "month-index" $ do
fp <- getDirectoryMarkdown sbMdRead sbHTWrite sbSrcDir pattern
let times = viewAllPostTimes fp
need [sbOutDir </> "posts/months" </> monthURLFormat t </> "index.html" | t <- times]
need [sbOutDir </> "posts/months" </> monthURLFormat t </> "pages" </> show p </> "index.html"
| t <- times
, p <- [1..length (fromJust $ paginate sbPPP $ monthFilterPosts t fp)]
]
defaultDocsPhony :: Cofree [] String -> Shakebook ()
defaultDocsPhony toc = Shakebook $ ask >>= \SbConfig {..} -> lift $
phony "docs" $ do
fp <- getDirectoryFiles sbSrcDir (foldr ((<>) . pure) [] toc)
need $ [ (sbOutDir </>) . (-<.> ".html") $ x | x <- fp]