Use Text for html

This commit is contained in:
Niels G. W. Serup 2024-09-26 23:02:29 +02:00
parent 8ff8726abe
commit 6c36a53ec9
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
6 changed files with 48 additions and 17 deletions

View File

@ -18,10 +18,13 @@ module DependencyGenerator
, appendStrings , appendStrings
, concatStrings , concatStrings
, appendTexts
, concatTexts
, joinPaths , joinPaths
, fileComponents , fileComponents
, isImageExtension , isImageExtension
, applyTemplate , applyTemplate
, toText
, listDirectory , listDirectory
, readTemplate , readTemplate
, convertImage , convertImage
@ -41,6 +44,7 @@ import Types.Dependency (Action(..), Dependency, makeDependency)
import Control.Monad.State (MonadState, State, runState, put, get) import Control.Monad.State (MonadState, State, runState, put, get)
import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell) import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell)
import Data.Text (Text)
newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a } newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency]) deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency])
@ -167,6 +171,15 @@ appendStrings (a, b) = do
concatStrings :: TokenableTo [String] a => a -> DepGenM' String concatStrings :: TokenableTo [String] a => a -> DepGenM' String
concatStrings a = runFunction ConcatStrings =<< toToken a concatStrings a = runFunction ConcatStrings =<< toToken a
appendTexts :: (TokenableTo Text a, TokenableTo Text b) => (a, b) -> DepGenM' Text
appendTexts (a, b) = do
a' <- toToken a
b' <- toToken b
runFunction AppendTexts $ TupleToken (a', b')
concatTexts :: TokenableTo [Text] a => a -> DepGenM' Text
concatTexts a = runFunction ConcatTexts =<< toToken a
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath
joinPaths (a, b) = do joinPaths (a, b) = do
a' <- toToken a a' <- toToken a
@ -179,12 +192,15 @@ fileComponents a = runFunction FileComponents =<< toToken a
isImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool isImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool
isImageExtension a = runFunction IsImageExtension =<< toToken a isImageExtension a = runFunction IsImageExtension =<< toToken a
applyTemplate :: (TokenableTo Template a, TokenableTo String b) => (a, b) -> DepGenM' String applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => (a, b) -> DepGenM' Text
applyTemplate (a, b) = do applyTemplate (a, b) = do
a' <- toToken a a' <- toToken a
b' <- toToken b b' <- toToken b
runFunction ApplyTemplate $ TupleToken (a', b') runFunction ApplyTemplate $ TupleToken (a', b')
toText :: TokenableTo String a => a -> DepGenM' Text
toText a = runFunction ToText =<< toToken a
listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath] listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath]
listDirectory a = runFunctionIO ListDirectory =<< toToken a listDirectory a = runFunctionIO ListDirectory =<< toToken a
@ -197,7 +213,7 @@ convertImage (a, b) = do
b' <- toToken b b' <- toToken b
runFunctionIO' ConvertImage $ TupleToken (a', b') runFunctionIO' ConvertImage $ TupleToken (a', b')
saveFile :: (TokenableTo String a, TokenableTo FilePath b) => (a, b) -> DepGenM () saveFile :: (TokenableTo Text a, TokenableTo FilePath b) => (a, b) -> DepGenM ()
saveFile (a, b) = do saveFile (a, b) = do
a' <- toToken a a' <- toToken a
b' <- toToken b b' <- toToken b
@ -215,5 +231,5 @@ copyFile' = runFunctionIO' CopyFile
makeDir :: TokenableTo FilePath a => a -> DepGenM () makeDir :: TokenableTo FilePath a => a -> DepGenM ()
makeDir a = runFunctionIO' MakeDir =<< toToken a makeDir a = runFunctionIO' MakeDir =<< toToken a
runPandoc :: TokenableTo FilePath a => a -> DepGenM' String runPandoc :: TokenableTo FilePath a => a -> DepGenM' Text
runPandoc a = runFunctionIO RunPandoc =<< toToken a runPandoc a = runFunctionIO RunPandoc =<< toToken a

View File

@ -12,6 +12,12 @@ evalFunction f x = case (f, x) of
(ConcatStrings, List _) -> (ConcatStrings, List _) ->
String undefined String undefined
(AppendTexts, Tuple (Text _, Text _)) ->
Text undefined
(ConcatTexts, List _) ->
Text undefined
(JoinPaths, Tuple (String _, String _)) -> (JoinPaths, Tuple (String _, String _)) ->
String undefined String undefined
@ -21,8 +27,11 @@ evalFunction f x = case (f, x) of
(IsImageExtension, String _) -> (IsImageExtension, String _) ->
Bool undefined Bool undefined
(ApplyTemplate, Tuple (Template _, String _)) -> (ApplyTemplate, Tuple (Template _, Text _)) ->
String undefined Text undefined
(ToText, String _) ->
Text undefined
_ -> _ ->
error "unexpected combination of function and argument type" error "unexpected combination of function and argument type"

View File

@ -15,7 +15,7 @@ evalFunctionIO f x = case (f, x) of
(ConvertImage, Tuple (Tuple (String _, String _), ImageConversionSettings _)) -> (ConvertImage, Tuple (Tuple (String _, String _), ImageConversionSettings _)) ->
pure $ Empty pure $ Empty
(SaveFile, Tuple (String _, String _)) -> (SaveFile, Tuple (Text _, String _)) ->
pure $ Empty pure $ Empty
(CopyFile, Tuple (String _, String _)) -> (CopyFile, Tuple (String _, String _)) ->
@ -25,7 +25,7 @@ evalFunctionIO f x = case (f, x) of
pure $ Empty pure $ Empty
(RunPandoc, String _) -> (RunPandoc, String _) ->
pure $ String undefined pure $ Text undefined
_ -> _ ->
error "unexpected combination of function and argument type" error "unexpected combination of function and argument type"

View File

@ -4,18 +4,20 @@ module SiteGenerator (generateSite) where
import Types import Types
import DependencyGenerator import DependencyGenerator
import Data.Text (Text)
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
thumbnailImageFilename filename = do thumbnailImageFilename filename = do
(base, ext) <- untupleDepGenM (fileComponents filename) (base, ext) <- untupleDepGenM (fileComponents filename)
appendStrings (appendStrings (base, inject "-thumbnail."), ext) appendStrings (appendStrings (base, inject "-thumbnail."), ext)
makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' String makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' Text
makeImageHTML t = do makeImageHTML t = do
(thumbnail, actual) <- untupleDepGenM t (thumbnail, actual) <- untupleDepGenM t
appendStrings (inject "<p><a href=\"", appendTexts (inject "<p><a href=\"",
appendStrings (actual, appendTexts (toText actual,
appendStrings (inject "\"><img src=\"", appendTexts (inject "\"><img src=\"",
appendStrings (thumbnail, appendTexts (toText thumbnail,
inject "\"></a></p>")))) inject "\"></a></p>"))))
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM () handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
@ -36,8 +38,8 @@ handleRecipeDir outputDir template indexName dir = do
(ZipToken (imagePaths, thumbnailImagePaths)) (ZipToken (imagePaths, thumbnailImagePaths))
htmlBodyBase <- runPandoc (joinPaths (dir, inject "ret.md")) htmlBodyBase <- runPandoc (joinPaths (dir, inject "ret.md"))
htmlBodyImages <- mapDepGenM makeImageHTML (ZipToken (thumbnailImageFilenames, imageFilenames)) htmlBodyImages <- mapDepGenM makeImageHTML (ZipToken (thumbnailImageFilenames, imageFilenames))
imagesHtml <- concatStrings htmlBodyImages imagesHtml <- concatTexts htmlBodyImages
htmlBody <- appendStrings (htmlBodyBase, imagesHtml) htmlBody <- appendTexts (htmlBodyBase, imagesHtml)
html <- applyTemplate (template, htmlBody) html <- applyTemplate (template, htmlBody)
saveFile (html, joinPaths (recipeDirOut, indexName)) saveFile (html, joinPaths (recipeDirOut, indexName))

View File

@ -6,9 +6,12 @@ import Language.Haskell.TH.Syntax (Lift)
data Function = AppendStrings data Function = AppendStrings
| ConcatStrings | ConcatStrings
| AppendTexts
| ConcatTexts
| JoinPaths | JoinPaths
| FileComponents | FileComponents
| IsImageExtension | IsImageExtension
| ApplyTemplate | ApplyTemplate
| ToText
deriving (Show, Lift) deriving (Show, Lift)

View File

@ -4,13 +4,14 @@ module Types.Values
, Template(..) , Template(..)
) where ) where
import Data.Text (Text)
import Language.Haskell.TH.Syntax (Lift) import Language.Haskell.TH.Syntax (Lift)
data ImageConversionSettings = ResizeToWidth Int data ImageConversionSettings = ResizeToWidth Int
deriving (Show, Lift) deriving (Show, Lift)
data TemplatePart = Literal String data TemplatePart = Literal Text
| KeyValue String | KeyValue Text
deriving (Show, Lift) deriving (Show, Lift)
data Template = TemplateParts [TemplatePart] data Template = TemplateParts [TemplatePart]