Use Text for html
This commit is contained in:
		@@ -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]
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user