Add ApplyTemplate and use NoToken less
This commit is contained in:
parent
8bf1e107a0
commit
f4ff6d6d98
|
@ -1,5 +1,6 @@
|
||||||
module DependencyGenerator
|
module DependencyGenerator
|
||||||
( DepGenM
|
( DepGenM
|
||||||
|
, DepGenM'
|
||||||
, evalDepGenM
|
, evalDepGenM
|
||||||
, inject
|
, inject
|
||||||
, runFunction
|
, runFunction
|
||||||
|
@ -8,8 +9,10 @@ module DependencyGenerator
|
||||||
, mapDepGenM_
|
, mapDepGenM_
|
||||||
, filterDepGenM
|
, filterDepGenM
|
||||||
|
|
||||||
|
, joinPaths
|
||||||
, isImageFilename
|
, isImageFilename
|
||||||
, convertedImageFilename
|
, convertedImageFilename
|
||||||
|
, applyTemplate
|
||||||
, listDirectory
|
, listDirectory
|
||||||
, readTemplate
|
, readTemplate
|
||||||
, convertImage
|
, convertImage
|
||||||
|
@ -33,10 +36,10 @@ newtype DepGenM' a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
|
||||||
|
|
||||||
type DepGenM a = DepGenM' (Token a)
|
type DepGenM a = DepGenM' (Token a)
|
||||||
|
|
||||||
evalDepGenM' :: Int -> DepGenM () -> ([Dependency], Int)
|
evalDepGenM' :: Int -> DepGenM' () -> ([Dependency], Int)
|
||||||
evalDepGenM' top m = runState (execWriterT (unDepGenM m)) top
|
evalDepGenM' top m = runState (execWriterT (unDepGenM m)) top
|
||||||
|
|
||||||
evalDepGenM :: DepGenM () -> [Dependency]
|
evalDepGenM :: DepGenM' () -> [Dependency]
|
||||||
evalDepGenM m = fst (evalDepGenM' 0 m)
|
evalDepGenM m = fst (evalDepGenM' 0 m)
|
||||||
|
|
||||||
tellDep :: Dependency -> DepGenM' ()
|
tellDep :: Dependency -> DepGenM' ()
|
||||||
|
@ -61,10 +64,9 @@ inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
|
||||||
getListElem :: Token [a] -> DepGenM a
|
getListElem :: Token [a] -> DepGenM a
|
||||||
getListElem outer = genDependency (makeDependency outer GetListElem)
|
getListElem outer = genDependency (makeDependency outer GetListElem)
|
||||||
|
|
||||||
setListElem :: Token a -> Token [a] -> DepGenM ()
|
setListElem :: Token a -> Token [a] -> DepGenM' ()
|
||||||
setListElem a outer = do
|
setListElem a outer = do
|
||||||
tellDep (makeDependency a SetListElem outer)
|
tellDep (makeDependency a SetListElem outer)
|
||||||
pure NoToken
|
|
||||||
|
|
||||||
runFunction :: Function -> Token a -> DepGenM b
|
runFunction :: Function -> Token a -> DepGenM b
|
||||||
runFunction f input = genDependency (makeDependency input (Function f))
|
runFunction f input = genDependency (makeDependency input (Function f))
|
||||||
|
@ -82,9 +84,9 @@ mapDepGenM f input = genDependencyM $ \target -> do
|
||||||
put top'
|
put top'
|
||||||
pure (makeDependency input (MapComp res) target)
|
pure (makeDependency input (MapComp res) target)
|
||||||
|
|
||||||
mapDepGenM_ :: (Token a -> DepGenM ()) -> Token [a] -> DepGenM' ()
|
mapDepGenM_ :: (Token a -> DepGenM' ()) -> Token [a] -> DepGenM' ()
|
||||||
mapDepGenM_ f input = do
|
mapDepGenM_ f input = do
|
||||||
_ <- mapDepGenM f input
|
_ <- mapDepGenM (\x -> f x >> pure NoToken) input
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
filterDepGenM :: (Token a -> DepGenM Bool) -> Token [a] -> DepGenM [a]
|
filterDepGenM :: (Token a -> DepGenM Bool) -> Token [a] -> DepGenM [a]
|
||||||
|
@ -93,28 +95,38 @@ filterDepGenM f input = do
|
||||||
genDependency (makeDependency (TupleToken input conds) FilterComp)
|
genDependency (makeDependency (TupleToken input conds) FilterComp)
|
||||||
|
|
||||||
|
|
||||||
|
joinPaths :: Token (FilePath, FilePath) -> DepGenM FilePath
|
||||||
|
joinPaths = runFunction JoinPaths
|
||||||
|
|
||||||
isImageFilename :: Token FilePath -> DepGenM Bool
|
isImageFilename :: Token FilePath -> DepGenM Bool
|
||||||
isImageFilename = runFunction IsImageFilename
|
isImageFilename = runFunction IsImageFilename
|
||||||
|
|
||||||
convertedImageFilename :: Token FilePath -> DepGenM FilePath
|
convertedImageFilename :: Token FilePath -> DepGenM FilePath
|
||||||
convertedImageFilename = runFunction ConvertedImageFilename
|
convertedImageFilename = runFunction ConvertedImageFilename
|
||||||
|
|
||||||
|
applyTemplate :: Token (Template, String) -> DepGenM String
|
||||||
|
applyTemplate = runFunction ApplyTemplate
|
||||||
|
|
||||||
listDirectory :: Token FilePath -> DepGenM [FilePath]
|
listDirectory :: Token FilePath -> DepGenM [FilePath]
|
||||||
listDirectory = runFunctionIO ListDirectory
|
listDirectory = runFunctionIO ListDirectory
|
||||||
|
|
||||||
readTemplate :: Token FilePath -> DepGenM Template
|
readTemplate :: Token FilePath -> DepGenM Template
|
||||||
readTemplate = runFunctionIO ReadTemplate
|
readTemplate = runFunctionIO ReadTemplate
|
||||||
|
|
||||||
convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> DepGenM ()
|
convertImage :: Token ((FilePath, FilePath), ImageConversionSettings) -> DepGenM' ()
|
||||||
convertImage = runFunctionIO ConvertImage
|
convertImage input = do
|
||||||
|
_ <- runFunctionIO ConvertImage input
|
||||||
|
pure ()
|
||||||
|
|
||||||
saveFile :: Token (String, FilePath) -> DepGenM ()
|
saveFile :: Token (String, FilePath) -> DepGenM' ()
|
||||||
saveFile = runFunctionIO SaveFile
|
saveFile input = do
|
||||||
|
_ <- runFunctionIO SaveFile input
|
||||||
|
pure ()
|
||||||
|
|
||||||
makeDir :: Token FilePath -> DepGenM' ()
|
makeDir :: Token FilePath -> DepGenM' ()
|
||||||
makeDir input = do
|
makeDir input = do
|
||||||
_ <- runFunctionIO MakeDir input
|
_ <- runFunctionIO MakeDir input
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
runPandoc :: Token (FilePath, FilePath) -> DepGenM ()
|
runPandoc :: Token FilePath -> DepGenM String
|
||||||
runPandoc = runFunctionIO RunPandoc
|
runPandoc = runFunctionIO RunPandoc
|
||||||
|
|
|
@ -6,11 +6,17 @@ import Types (Function(..), Value(..))
|
||||||
|
|
||||||
evalFunction :: Function -> Value -> Value
|
evalFunction :: Function -> Value -> Value
|
||||||
evalFunction f x = case (f, x) of
|
evalFunction f x = case (f, x) of
|
||||||
|
(JoinPaths, Tuple (String _, String _)) ->
|
||||||
|
String undefined
|
||||||
|
|
||||||
(IsImageFilename, String _) ->
|
(IsImageFilename, String _) ->
|
||||||
Bool undefined
|
Bool undefined
|
||||||
|
|
||||||
(ConvertedImageFilename, String _) ->
|
(ConvertedImageFilename, String _) ->
|
||||||
String undefined
|
String undefined
|
||||||
|
|
||||||
|
(ApplyTemplate, Tuple (Template _, String _)) ->
|
||||||
|
String undefined
|
||||||
|
|
||||||
_ ->
|
_ ->
|
||||||
error "unexpected combination of function and argument type"
|
error "unexpected combination of function and argument type"
|
||||||
|
|
|
@ -21,8 +21,8 @@ evalFunctionIO f x = case (f, x) of
|
||||||
(MakeDir, String _) ->
|
(MakeDir, String _) ->
|
||||||
pure $ Empty
|
pure $ Empty
|
||||||
|
|
||||||
(RunPandoc, Tuple (String _, String _)) ->
|
(RunPandoc, String _) ->
|
||||||
pure $ Empty
|
pure $ String undefined
|
||||||
|
|
||||||
_ ->
|
_ ->
|
||||||
error "unexpected combination of function and argument type"
|
error "unexpected combination of function and argument type"
|
||||||
|
|
|
@ -3,7 +3,7 @@ module SiteGenerator (generateSite) where
|
||||||
import Types
|
import Types
|
||||||
import DependencyGenerator
|
import DependencyGenerator
|
||||||
|
|
||||||
handleRecipeDir :: Token Template -> Token FilePath -> DepGenM ()
|
handleRecipeDir :: Token Template -> Token FilePath -> DepGenM' ()
|
||||||
handleRecipeDir _template dir = do
|
handleRecipeDir _template dir = do
|
||||||
dirContents <- listDirectory dir
|
dirContents <- listDirectory dir
|
||||||
imageFilenames <- filterDepGenM isImageFilename dirContents
|
imageFilenames <- filterDepGenM isImageFilename dirContents
|
||||||
|
@ -11,9 +11,8 @@ handleRecipeDir _template dir = do
|
||||||
flip mapDepGenM_ (ZipToken imageFilenames convertedImageFilenames) $ \files -> do
|
flip mapDepGenM_ (ZipToken imageFilenames convertedImageFilenames) $ \files -> do
|
||||||
settings <- inject $ ResizeToWidth 800
|
settings <- inject $ ResizeToWidth 800
|
||||||
convertImage $ TupleToken files settings
|
convertImage $ TupleToken files settings
|
||||||
pure NoToken
|
|
||||||
|
|
||||||
generateSite :: DepGenM ()
|
generateSite :: DepGenM' ()
|
||||||
generateSite = do
|
generateSite = do
|
||||||
outputDir <- inject "site"
|
outputDir <- inject "site"
|
||||||
makeDir outputDir
|
makeDir outputDir
|
||||||
|
@ -23,6 +22,9 @@ generateSite = do
|
||||||
dirContents <- listDirectory dir
|
dirContents <- listDirectory dir
|
||||||
mapDepGenM_ (handleRecipeDir template) dirContents
|
mapDepGenM_ (handleRecipeDir template) dirContents
|
||||||
|
|
||||||
aboutFilenameIn <- inject "om.md"
|
aboutPathIn <- inject "om.md"
|
||||||
|
aboutHtmlBody <- runPandoc aboutPathIn
|
||||||
|
aboutHtml <- applyTemplate $ TupleToken template aboutHtmlBody
|
||||||
aboutFilenameOut <- inject "om.html"
|
aboutFilenameOut <- inject "om.html"
|
||||||
runPandoc $ TupleToken aboutFilenameIn aboutFilenameOut
|
aboutPathOut <- joinPaths $ TupleToken outputDir aboutFilenameOut
|
||||||
|
saveFile $ TupleToken aboutHtml aboutPathOut
|
||||||
|
|
|
@ -4,7 +4,9 @@ module Types.Function
|
||||||
|
|
||||||
import Language.Haskell.TH.Syntax (Lift)
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
data Function = IsImageFilename
|
data Function = JoinPaths
|
||||||
|
| IsImageFilename
|
||||||
| ConvertedImageFilename
|
| ConvertedImageFilename
|
||||||
|
| ApplyTemplate
|
||||||
deriving (Show, Lift)
|
deriving (Show, Lift)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue