Use Text for html
This commit is contained in:
parent
8ff8726abe
commit
6c36a53ec9
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -6,9 +6,12 @@ import Language.Haskell.TH.Syntax (Lift)
|
|||
|
||||
data Function = AppendStrings
|
||||
| ConcatStrings
|
||||
| AppendTexts
|
||||
| ConcatTexts
|
||||
| JoinPaths
|
||||
| FileComponents
|
||||
| IsImageExtension
|
||||
| ApplyTemplate
|
||||
| ToText
|
||||
deriving (Show, Lift)
|
||||
|
||||
|
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue