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
, concatStrings
, appendTexts
, concatTexts
, joinPaths
, fileComponents
, isImageExtension
, applyTemplate
, toText
, listDirectory
, readTemplate
, convertImage
@ -41,6 +44,7 @@ import Types.Dependency (Action(..), Dependency, makeDependency)
import Control.Monad.State (MonadState, State, runState, put, get)
import Control.Monad.Writer (MonadWriter, WriterT, execWriterT, tell)
import Data.Text (Text)
newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency])
@ -167,6 +171,15 @@ appendStrings (a, b) = do
concatStrings :: TokenableTo [String] a => a -> DepGenM' String
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 (a, b) = do
a' <- toToken a
@ -179,12 +192,15 @@ fileComponents a = runFunction FileComponents =<< toToken a
isImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool
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
a' <- toToken a
b' <- toToken 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 a = runFunctionIO ListDirectory =<< toToken a
@ -197,7 +213,7 @@ convertImage (a, b) = do
b' <- toToken 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
a' <- toToken a
b' <- toToken b
@ -215,5 +231,5 @@ copyFile' = runFunctionIO' CopyFile
makeDir :: TokenableTo FilePath a => a -> DepGenM ()
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

View File

@ -12,6 +12,12 @@ evalFunction f x = case (f, x) of
(ConcatStrings, List _) ->
String undefined
(AppendTexts, Tuple (Text _, Text _)) ->
Text undefined
(ConcatTexts, List _) ->
Text undefined
(JoinPaths, Tuple (String _, String _)) ->
String undefined
@ -21,8 +27,11 @@ evalFunction f x = case (f, x) of
(IsImageExtension, String _) ->
Bool undefined
(ApplyTemplate, Tuple (Template _, String _)) ->
String undefined
(ApplyTemplate, Tuple (Template _, Text _)) ->
Text undefined
(ToText, String _) ->
Text undefined
_ ->
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 _)) ->
pure $ Empty
(SaveFile, Tuple (String _, String _)) ->
(SaveFile, Tuple (Text _, String _)) ->
pure $ Empty
(CopyFile, Tuple (String _, String _)) ->
@ -25,7 +25,7 @@ evalFunctionIO f x = case (f, x) of
pure $ Empty
(RunPandoc, String _) ->
pure $ String undefined
pure $ Text undefined
_ ->
error "unexpected combination of function and argument type"

View File

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

View File

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

View File

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