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