diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 51e5e03..3d96aaf 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -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 diff --git a/byg/src/Evaluation/Function.hs b/byg/src/Evaluation/Function.hs index 48e919d..1885833 100644 --- a/byg/src/Evaluation/Function.hs +++ b/byg/src/Evaluation/Function.hs @@ -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" diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs index bcd7cbb..63a6a27 100644 --- a/byg/src/Evaluation/FunctionIO.hs +++ b/byg/src/Evaluation/FunctionIO.hs @@ -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" diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index 7c54666..396840b 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -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 "

")))) + appendTexts (inject "

")))) 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)) diff --git a/byg/src/Types/Function.hs b/byg/src/Types/Function.hs index 56d319c..c72e3a4 100644 --- a/byg/src/Types/Function.hs +++ b/byg/src/Types/Function.hs @@ -6,9 +6,12 @@ import Language.Haskell.TH.Syntax (Lift) data Function = AppendStrings | ConcatStrings + | AppendTexts + | ConcatTexts | JoinPaths | FileComponents | IsImageExtension | ApplyTemplate + | ToText deriving (Show, Lift) diff --git a/byg/src/Types/Values.hs b/byg/src/Types/Values.hs index 8db11ca..e388a77 100644 --- a/byg/src/Types/Values.hs +++ b/byg/src/Types/Values.hs @@ -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]