Move SiteGenerator into executable only and rename library to Byg.*
This commit is contained in:
26
byg/app/Main.hs
Normal file
26
byg/app/Main.hs
Normal file
@@ -0,0 +1,26 @@
|
||||
module Main where
|
||||
|
||||
import Byg.Types (Dependency)
|
||||
import qualified Byg.DependencyRunner as DR
|
||||
import qualified Byg.Types.Dependency as D
|
||||
import Byg.DependencyGenerator (evalDepGenM)
|
||||
|
||||
import SiteGenerator (generateSite)
|
||||
|
||||
import System.Environment (getArgs)
|
||||
import qualified Data.Text.IO as T
|
||||
|
||||
dependencies :: [Dependency]
|
||||
dependencies = evalDepGenM generateSite
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
case args of
|
||||
["run"] -> do
|
||||
((), filesWritten) <- DR.runDepRunMIO $ DR.runDeps dependencies
|
||||
putStrLn ("Files which could have been written: " ++ show filesWritten)
|
||||
["tree"] ->
|
||||
T.putStr $ D.formatDependencyTrees dependencies
|
||||
_ ->
|
||||
error "unexpected arguments"
|
||||
163
byg/app/SiteGenerator.hs
Normal file
163
byg/app/SiteGenerator.hs
Normal file
@@ -0,0 +1,163 @@
|
||||
module SiteGenerator (generateSite) where
|
||||
|
||||
import Byg.Types (Token(..), Date(..), formatDate, formatDateShort)
|
||||
import Byg.DependencyGenerator
|
||||
import Byg.Functions
|
||||
|
||||
import Data.List (sort, elemIndex)
|
||||
import Data.Function ((&))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Control.Monad (forM_, (<=<))
|
||||
|
||||
elemIndex' :: (Show a, Eq a) => a -> [a] -> Int
|
||||
elemIndex' x xs = case elemIndex x xs of
|
||||
Just i -> i
|
||||
Nothing -> error ("unexpected unknown directory index for " ++ show x ++ " in " ++ show xs)
|
||||
|
||||
head' :: [a] -> a
|
||||
head' [] = error "error"
|
||||
head' (x : _) = x
|
||||
|
||||
handleRecipeDir :: Token FilePath -> Token FilePath
|
||||
-> Token Template -> Token FilePath
|
||||
-> Token [FilePath] -> Token FilePath
|
||||
-> DepGenM (Token ((Text, Date), FilePath))
|
||||
handleRecipeDir recipesDir outputDir htmlTemplate indexName recipeSubDirs name = do
|
||||
dir <- joinPaths recipesDir name
|
||||
recipeDirOut <- joinPaths outputDir dir
|
||||
makeDir recipeDirOut
|
||||
imageFilenames <-
|
||||
listDirectory dir
|
||||
& filterDepGenM (hasExtension (inject ["jpg"]))
|
||||
htmlBodyImages <- forDepGenM imageFilenames $ \filename -> do
|
||||
path <- joinPaths dir filename
|
||||
path `copyTo` outputDir
|
||||
(base, ext) <- untupleDepGenM $ fileComponents filename
|
||||
thumbnailName <- onToken concat [ pure base, inject "-thumbnail.", pure ext ]
|
||||
imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800))
|
||||
saveImage imageResized (joinPaths recipeDirOut thumbnailName)
|
||||
onToken T.concat [ inject "<p class=\"image\"><a href=\""
|
||||
, onToken T.pack filename
|
||||
, inject "\"><img src=\""
|
||||
, onToken T.pack thumbnailName
|
||||
, inject "\"></a></p>\n"
|
||||
]
|
||||
ingredienserHeadline <- inject "## Ingredienser"
|
||||
mdTemplate <- makeTemplate
|
||||
(readTextFile (joinPaths dir (inject "ret.md")))
|
||||
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
|
||||
date <- extractDate name
|
||||
pandoc' <- injectAfterTitle (
|
||||
(onToken T.concat [ inject "<p class=\"date\">Offentliggjort "
|
||||
, onToken formatDate date
|
||||
, inject "</p>"
|
||||
]))
|
||||
pandoc
|
||||
dirIndex <- onTupleToken elemIndex' name recipeSubDirs
|
||||
prev <- onTupleToken (
|
||||
\ds i -> if i < length ds - 1
|
||||
then T.concat [ "<a class=\"prev\" href=\"/retter/"
|
||||
, T.pack (ds !! (i + 1))
|
||||
, "\">Forrige</a>"
|
||||
]
|
||||
else "")
|
||||
recipeSubDirs dirIndex
|
||||
next <- onTupleToken (
|
||||
\ds i -> if i > 0
|
||||
then T.concat [ "<a class=\"next\" href=\"/retter/"
|
||||
, T.pack (ds !! (i - 1))
|
||||
, "\">Næste</a>"
|
||||
]
|
||||
else "")
|
||||
recipeSubDirs dirIndex
|
||||
prevnext <- onToken T.concat [ inject "<p class=\"prevnext\">", pure prev, pure next, inject "</p>" ]
|
||||
html <-
|
||||
pandoc'
|
||||
& writeHtml
|
||||
& onTupleToken T.append prevnext
|
||||
& onTupleToken (flip T.append) prevnext
|
||||
& applyTemplate htmlTemplate
|
||||
saveTextFile html (joinPaths recipeDirOut indexName)
|
||||
pure $ TupleToken (TupleToken title date) dir
|
||||
|
||||
handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
|
||||
handleFontDir outputDir dir = do
|
||||
makeDir $ joinPaths outputDir dir
|
||||
paths <-
|
||||
listDirectory dir
|
||||
& mapDepGenM (joinPaths dir)
|
||||
& filterDepGenM (hasExtension (inject ["woff2", "css"]))
|
||||
mapDepGenM_ (`copyTo` outputDir) paths
|
||||
|
||||
generateSite :: DepGenM ()
|
||||
generateSite = do
|
||||
outputDir <- inject "site"
|
||||
makeDir outputDir
|
||||
htmlTemplate <- makeTemplate (readTextFile (inject "template.html")) (inject "CONTENT")
|
||||
indexName <- inject "index.html"
|
||||
|
||||
-- Handle recipes
|
||||
recipesDir <- inject "retter"
|
||||
outputRecipesDir <- joinPaths outputDir recipesDir
|
||||
makeDir $ outputRecipesDir
|
||||
recipeSubDirs <-
|
||||
listDirectory recipesDir
|
||||
& onToken (reverse . sort)
|
||||
& filterDepGenM (isDirectory <=< joinPaths recipesDir)
|
||||
infos <- mapDepGenM (handleRecipeDir recipesDir outputDir htmlTemplate indexName recipeSubDirs) recipeSubDirs
|
||||
allRecipesHtml <-
|
||||
infos
|
||||
& onToken (T.append "# Alle retter\n\n"
|
||||
. T.intercalate "\n"
|
||||
. map (\((t, d), u) -> T.concat ["- ", "[", t, " *(", formatDateShort d, ")*](/", T.pack u, ")"]))
|
||||
& markdownToHtml
|
||||
& applyTemplate htmlTemplate
|
||||
saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)
|
||||
|
||||
newest <- onToken (snd . fst . head') infos
|
||||
atomText <- generateAtom newest infos
|
||||
saveTextFile atomText (joinPaths outputDir (inject "atom.xml"))
|
||||
|
||||
redirectTemplate <- makeTemplate (readTextFile (inject "redirect.html")) (inject "URL")
|
||||
newestSlug <- onToken (T.pack . snd . head') infos
|
||||
saveTextFile (applyTemplate redirectTemplate newestSlug) (joinPaths outputDir indexName)
|
||||
|
||||
-- Handle about page
|
||||
outputAboutDir <- joinPaths outputDir (inject "om")
|
||||
makeDir outputAboutDir
|
||||
aboutHtml <-
|
||||
inject "om.md"
|
||||
& readTextFile
|
||||
& markdownToHtml
|
||||
& applyTemplate htmlTemplate
|
||||
saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
|
||||
|
||||
-- Handle style
|
||||
inject "style.css" `copyTo` outputDir
|
||||
|
||||
-- Handle images
|
||||
imgDir <- inject "img"
|
||||
makeDir $ joinPaths outputDir imgDir
|
||||
forM_ ["mad-icon.png", "mad-logo.png"] $ \name ->
|
||||
joinPaths imgDir (inject name) `copyTo` outputDir
|
||||
|
||||
-- Handle fonts
|
||||
fontsDir <- inject "fonts"
|
||||
makeDir $ joinPaths outputDir fontsDir
|
||||
fontSubDirs <-
|
||||
fontsDir
|
||||
& listDirectory
|
||||
& mapDepGenM (joinPaths fontsDir)
|
||||
& filterDepGenM isDirectory
|
||||
mapDepGenM_ (handleFontDir outputDir) fontSubDirs
|
||||
Reference in New Issue
Block a user