Use the & operator and generate rudimentary retter/index.html
This commit is contained in:
parent
e51e7a5376
commit
9e6c793d54
|
|
@ -1,6 +1,7 @@
|
|||
module Functions.Pandoc
|
||||
( readMarkdown
|
||||
, writeHtml
|
||||
, markdownToHtml
|
||||
, extractTitle
|
||||
) where
|
||||
|
||||
|
|
@ -8,6 +9,7 @@ import Types (Token)
|
|||
import DependencyGenerator (DepGenM, TokenableTo(..), onToken)
|
||||
|
||||
import Data.Text (Text)
|
||||
import Control.Monad ((>=>))
|
||||
import Text.Pandoc.Definition (Pandoc)
|
||||
import qualified Text.Pandoc.Definition as PD
|
||||
import qualified Text.Pandoc.Shared as PS
|
||||
|
|
@ -25,6 +27,9 @@ readMarkdown = onToken $ runPandoc . P.readMarkdown settings
|
|||
writeHtml :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
|
||||
writeHtml = onToken $ runPandoc . P.writeHtml5String P.def
|
||||
|
||||
markdownToHtml :: TokenableTo Text a => a -> DepGenM (Token Text)
|
||||
markdownToHtml = readMarkdown >=> writeHtml
|
||||
|
||||
extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
|
||||
extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of
|
||||
(PD.Header 1 _ inlines : _) -> PS.stringify inlines
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ import Types (Token(..))
|
|||
import DependencyGenerator
|
||||
import Functions
|
||||
|
||||
import Data.Function ((&))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Control.Monad (forM_)
|
||||
|
|
@ -12,8 +13,9 @@ handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token F
|
|||
handleRecipeDir outputDir htmlTemplate indexName dir = do
|
||||
recipeDirOut <- joinPaths outputDir dir
|
||||
makeDir recipeDirOut
|
||||
imageFilenames <- filterDepGenM (hasExtension (inject ["jpg"]))
|
||||
$ listDirectory dir
|
||||
imageFilenames <-
|
||||
listDirectory dir
|
||||
& filterDepGenM (hasExtension (inject ["jpg"]))
|
||||
htmlBodyImages <- forDepGenM imageFilenames $ \name -> do
|
||||
path <- joinPaths dir name
|
||||
path `copyTo` outputDir
|
||||
|
|
@ -31,25 +33,30 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
|
|||
mdTemplate <- makeTemplate
|
||||
(readTextFile (joinPaths dir (inject "ret.md")))
|
||||
ingredienserHeadline
|
||||
pandoc <- readMarkdown
|
||||
$ applyTemplate mdTemplate
|
||||
$ onToken T.concat [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
|
||||
, onToken T.concat htmlBodyImages
|
||||
, inject "\n"
|
||||
, pure ingredienserHeadline
|
||||
]
|
||||
pandoc <-
|
||||
[ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
|
||||
, onToken T.concat htmlBodyImages
|
||||
, inject "\n"
|
||||
, pure ingredienserHeadline
|
||||
]
|
||||
& onToken T.concat
|
||||
& applyTemplate mdTemplate
|
||||
& readMarkdown
|
||||
title <- extractTitle pandoc
|
||||
html <- applyTemplate htmlTemplate
|
||||
$ writeHtml pandoc
|
||||
html <-
|
||||
pandoc
|
||||
& writeHtml
|
||||
& applyTemplate htmlTemplate
|
||||
saveTextFile html (joinPaths recipeDirOut indexName)
|
||||
pure $ TupleToken title dir
|
||||
|
||||
handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
|
||||
handleFontDir outputDir dir = do
|
||||
makeDir $ joinPaths outputDir dir
|
||||
paths <- filterDepGenM (hasExtension (inject ["woff2", "css"]))
|
||||
$ mapDepGenM (joinPaths dir)
|
||||
$ listDirectory dir
|
||||
paths <-
|
||||
listDirectory dir
|
||||
& mapDepGenM (joinPaths dir)
|
||||
& filterDepGenM (hasExtension (inject ["woff2", "css"]))
|
||||
mapDepGenM_ (`copyTo` outputDir) paths
|
||||
|
||||
generateSite :: DepGenM ()
|
||||
|
|
@ -63,24 +70,28 @@ generateSite = do
|
|||
recipesDir <- inject "retter"
|
||||
outputRecipesDir <- joinPaths outputDir recipesDir
|
||||
makeDir $ outputRecipesDir
|
||||
recipeSubDirs <- filterDepGenM isDirectory
|
||||
$ mapDepGenM (joinPaths recipesDir)
|
||||
$ listDirectory recipesDir
|
||||
recipeSubDirs <-
|
||||
listDirectory recipesDir
|
||||
& mapDepGenM (joinPaths recipesDir)
|
||||
& filterDepGenM isDirectory
|
||||
infos <- mapDepGenM (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
|
||||
allRecipesHtml <- applyTemplate htmlTemplate
|
||||
$ writeHtml
|
||||
$ readMarkdown
|
||||
$ onToken (T.append "# Alle retter\n\n" . T.intercalate "\n" . map (\(t, u) -> T.concat ["- ", "[", t, "](/", T.pack u, ")"])) infos
|
||||
allRecipesHtml <-
|
||||
infos
|
||||
& onToken (T.append "# Alle retter\n\n"
|
||||
. T.intercalate "\n"
|
||||
. map (\(t, u) -> T.concat ["- ", "[", t, "](/", T.pack u, ")"]))
|
||||
& markdownToHtml
|
||||
& applyTemplate htmlTemplate
|
||||
saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)
|
||||
|
||||
-- Handle about page
|
||||
outputAboutDir <- joinPaths outputDir (inject "om")
|
||||
makeDir outputAboutDir
|
||||
aboutHtml <- applyTemplate htmlTemplate
|
||||
$ writeHtml
|
||||
$ readMarkdown
|
||||
$ readTextFile
|
||||
$ inject "om.md"
|
||||
aboutHtml <-
|
||||
inject "om.md"
|
||||
& readTextFile
|
||||
& markdownToHtml
|
||||
& applyTemplate htmlTemplate
|
||||
saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
|
||||
|
||||
-- Handle style
|
||||
|
|
@ -95,7 +106,9 @@ generateSite = do
|
|||
-- Handle fonts
|
||||
fontsDir <- inject "fonts"
|
||||
makeDir $ joinPaths outputDir fontsDir
|
||||
fontSubDirs <- filterDepGenM isDirectory
|
||||
$ mapDepGenM (joinPaths fontsDir)
|
||||
$ listDirectory fontsDir
|
||||
fontSubDirs <-
|
||||
fontsDir
|
||||
& listDirectory
|
||||
& mapDepGenM (joinPaths fontsDir)
|
||||
& filterDepGenM isDirectory
|
||||
mapDepGenM_ (handleFontDir outputDir) fontSubDirs
|
||||
|
|
|
|||
Loading…
Reference in New Issue