Use Text for html
This commit is contained in:
parent
8ff8726abe
commit
6c36a53ec9
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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]
|
||||||
|
|
Loading…
Reference in New Issue