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