Make the functions easier to call inline
This commit is contained in:
parent
ad83c8c941
commit
6ecb577402
|
@ -1,3 +1,4 @@
|
||||||
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
module DependencyGenerator
|
module DependencyGenerator
|
||||||
( DepGenM
|
( DepGenM
|
||||||
, DepGenM'
|
, DepGenM'
|
||||||
|
@ -99,33 +100,53 @@ filterDepGenM f input = do
|
||||||
conds <- mapDepGenM f input
|
conds <- mapDepGenM f input
|
||||||
genDependency (makeDependency (TupleToken (input, conds)) FilterComp)
|
genDependency (makeDependency (TupleToken (input, conds)) FilterComp)
|
||||||
|
|
||||||
|
class TokenableTo t s | s -> t where
|
||||||
|
toToken :: s -> DepGenM' t
|
||||||
|
|
||||||
joinPaths :: (Token FilePath, Token FilePath) -> DepGenM' FilePath
|
instance TokenableTo a (Token a) where
|
||||||
joinPaths = runFunction JoinPaths . TupleToken
|
toToken = pure
|
||||||
|
|
||||||
isImageFilename :: Token FilePath -> DepGenM' Bool
|
instance TokenableTo a (DepGenM' a) where
|
||||||
isImageFilename = runFunction IsImageFilename
|
toToken = id
|
||||||
|
|
||||||
convertedImageFilename :: Token FilePath -> DepGenM' FilePath
|
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath
|
||||||
convertedImageFilename = runFunction ConvertedImageFilename
|
joinPaths (a, b) = do
|
||||||
|
a' <- toToken a
|
||||||
|
b' <- toToken b
|
||||||
|
runFunction JoinPaths $ TupleToken (a', b')
|
||||||
|
|
||||||
applyTemplate :: (Token Template, Token String) -> DepGenM' String
|
isImageFilename :: TokenableTo FilePath a => a -> DepGenM' Bool
|
||||||
applyTemplate = runFunction ApplyTemplate . TupleToken
|
isImageFilename a = runFunction IsImageFilename =<< toToken a
|
||||||
|
|
||||||
listDirectory :: Token FilePath -> DepGenM' [FilePath]
|
convertedImageFilename :: TokenableTo FilePath a => a -> DepGenM' FilePath
|
||||||
listDirectory = runFunctionIO ListDirectory
|
convertedImageFilename a = runFunction ConvertedImageFilename =<< toToken a
|
||||||
|
|
||||||
readTemplate :: Token FilePath -> DepGenM' Template
|
applyTemplate :: (TokenableTo Template a, TokenableTo String b) => (a, b) -> DepGenM' String
|
||||||
readTemplate = runFunctionIO ReadTemplate
|
applyTemplate (a, b) = do
|
||||||
|
a' <- toToken a
|
||||||
|
b' <- toToken b
|
||||||
|
runFunction ApplyTemplate $ TupleToken (a', b')
|
||||||
|
|
||||||
convertImage :: (Token (FilePath, FilePath), Token ImageConversionSettings) -> DepGenM ()
|
listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath]
|
||||||
convertImage = runFunctionIO' ConvertImage . TupleToken
|
listDirectory a = runFunctionIO ListDirectory =<< toToken a
|
||||||
|
|
||||||
saveFile :: (Token String, Token FilePath) -> DepGenM ()
|
readTemplate :: TokenableTo FilePath a => a -> DepGenM' Template
|
||||||
saveFile = runFunctionIO' SaveFile . TupleToken
|
readTemplate a = runFunctionIO ReadTemplate =<< toToken a
|
||||||
|
|
||||||
makeDir :: Token FilePath -> DepGenM ()
|
convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversionSettings b) => (a, b) -> DepGenM ()
|
||||||
makeDir = runFunctionIO' MakeDir
|
convertImage (a, b) = do
|
||||||
|
a' <- toToken a
|
||||||
|
b' <- toToken b
|
||||||
|
runFunctionIO' ConvertImage $ TupleToken (a', b')
|
||||||
|
|
||||||
runPandoc :: Token FilePath -> DepGenM' String
|
saveFile :: (TokenableTo String a, TokenableTo FilePath b) => (a, b) -> DepGenM ()
|
||||||
runPandoc = runFunctionIO RunPandoc
|
saveFile (a, b) = do
|
||||||
|
a' <- toToken a
|
||||||
|
b' <- toToken b
|
||||||
|
runFunctionIO' SaveFile $ TupleToken (a', b')
|
||||||
|
|
||||||
|
makeDir :: TokenableTo FilePath a => a -> DepGenM ()
|
||||||
|
makeDir a = runFunctionIO' MakeDir =<< toToken a
|
||||||
|
|
||||||
|
runPandoc :: TokenableTo FilePath a => a -> DepGenM' String
|
||||||
|
runPandoc a = runFunctionIO RunPandoc =<< toToken a
|
||||||
|
|
|
@ -8,32 +8,22 @@ handleRecipeDir outputDir template dir = do
|
||||||
dirContents <- listDirectory dir
|
dirContents <- listDirectory dir
|
||||||
imageFilenames <- filterDepGenM isImageFilename dirContents
|
imageFilenames <- filterDepGenM isImageFilename dirContents
|
||||||
convertedImageFilenames <- mapDepGenM convertedImageFilename imageFilenames
|
convertedImageFilenames <- mapDepGenM convertedImageFilename imageFilenames
|
||||||
flip mapDepGenM_ (ZipToken (imageFilenames, convertedImageFilenames)) $ \files -> do
|
mapDepGenM_
|
||||||
settings <- inject $ ResizeToWidth 800
|
(\files -> convertImage (files, inject $ ResizeToWidth 800))
|
||||||
convertImage (files, settings)
|
(ZipToken (imageFilenames, convertedImageFilenames))
|
||||||
recipeFilenameIn <- inject "ret.md"
|
|
||||||
recipePathIn <- joinPaths (dir, recipeFilenameIn)
|
|
||||||
recipeDirOut <- joinPaths (outputDir, dir)
|
recipeDirOut <- joinPaths (outputDir, dir)
|
||||||
makeDir recipeDirOut
|
makeDir recipeDirOut
|
||||||
recipeFilenameOut <- inject "index.html"
|
htmlBody <- runPandoc (joinPaths (dir, inject "ret.md"))
|
||||||
recipePathOut <- joinPaths (recipeDirOut, recipeFilenameOut)
|
|
||||||
htmlBody <- runPandoc recipePathIn
|
|
||||||
html <- applyTemplate (template, htmlBody)
|
html <- applyTemplate (template, htmlBody)
|
||||||
saveFile (html, recipePathOut)
|
saveFile (html, joinPaths (recipeDirOut, inject "index.html"))
|
||||||
|
|
||||||
generateSite :: DepGenM ()
|
generateSite :: DepGenM ()
|
||||||
generateSite = do
|
generateSite = do
|
||||||
outputDir <- inject "site"
|
outputDir <- inject "site"
|
||||||
makeDir outputDir
|
makeDir outputDir
|
||||||
templateFilename <- inject "template.html"
|
template <- readTemplate (inject "template.html")
|
||||||
template <- readTemplate templateFilename
|
dirContents <- listDirectory (inject "retter")
|
||||||
dir <- inject "retter"
|
|
||||||
dirContents <- listDirectory dir
|
|
||||||
mapDepGenM_ (handleRecipeDir outputDir template) dirContents
|
mapDepGenM_ (handleRecipeDir outputDir template) dirContents
|
||||||
|
htmlBody <- runPandoc (inject "om.md")
|
||||||
aboutPathIn <- inject "om.md"
|
html <- applyTemplate (template, htmlBody)
|
||||||
aboutFilenameOut <- inject "om.html"
|
saveFile (html, joinPaths (outputDir, inject "om.html"))
|
||||||
aboutPathOut <- joinPaths (outputDir, aboutFilenameOut)
|
|
||||||
aboutHtmlBody <- runPandoc aboutPathIn
|
|
||||||
aboutHtml <- applyTemplate (template, aboutHtmlBody)
|
|
||||||
saveFile (aboutHtml, aboutPathOut)
|
|
||||||
|
|
Loading…
Reference in New Issue