Implement untupling and use more general append instead of ConvertedImageFilename
This commit is contained in:
parent
fe87351976
commit
992edea3ee
|
@ -9,14 +9,17 @@ module DependencyGenerator
|
|||
, mapDepGenM
|
||||
, mapDepGenM_
|
||||
, filterDepGenM
|
||||
, untupleFstDepGenM
|
||||
, untupleSndDepGenM
|
||||
, untupleDepGenM
|
||||
, unzipFstDepGenM
|
||||
, unzipSndDepGenM
|
||||
, unzipDepGenM
|
||||
|
||||
, appendStrings
|
||||
, joinPaths
|
||||
, fileComponents
|
||||
, isImageExtension
|
||||
, convertedImageFilename
|
||||
, applyTemplate
|
||||
, listDirectory
|
||||
, readTemplate
|
||||
|
@ -101,6 +104,27 @@ filterDepGenM :: Token [Bool] -> Token [a] -> DepGenM' [a]
|
|||
filterDepGenM mask input = do
|
||||
genDependency (makeDependency (TupleToken (input, mask)) FilterComp)
|
||||
|
||||
untupleFstDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token a)
|
||||
untupleFstDepGenM t = do
|
||||
t' <- toToken t
|
||||
case t' of
|
||||
TupleToken (a, _) -> pure a
|
||||
Token _ -> genDependency (makeDependency t' UntupleFst)
|
||||
|
||||
untupleSndDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token b)
|
||||
untupleSndDepGenM t = do
|
||||
t' <- toToken t
|
||||
case t' of
|
||||
TupleToken (_, b) -> pure b
|
||||
Token _ -> genDependency (makeDependency t' UntupleSnd)
|
||||
|
||||
untupleDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token a, Token b)
|
||||
untupleDepGenM t = do
|
||||
t' <- toToken t
|
||||
a <- untupleFstDepGenM t'
|
||||
b <- untupleSndDepGenM t'
|
||||
pure (a, b)
|
||||
|
||||
unzipFstDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a])
|
||||
unzipFstDepGenM t = do
|
||||
t' <- toToken t
|
||||
|
@ -131,6 +155,12 @@ instance TokenableTo a (Token a) where
|
|||
instance TokenableTo a (DepGenM' a) where
|
||||
toToken = id
|
||||
|
||||
appendStrings :: (TokenableTo String a, TokenableTo String b) => (a, b) -> DepGenM' String
|
||||
appendStrings (a, b) = do
|
||||
a' <- toToken a
|
||||
b' <- toToken b
|
||||
runFunction AppendStrings $ TupleToken (a', b')
|
||||
|
||||
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath
|
||||
joinPaths (a, b) = do
|
||||
a' <- toToken a
|
||||
|
@ -143,9 +173,6 @@ fileComponents a = runFunction FileComponents =<< toToken a
|
|||
isImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool
|
||||
isImageExtension a = runFunction IsImageExtension =<< toToken a
|
||||
|
||||
convertedImageFilename :: TokenableTo FilePath a => a -> DepGenM' FilePath
|
||||
convertedImageFilename a = runFunction ConvertedImageFilename =<< toToken a
|
||||
|
||||
applyTemplate :: (TokenableTo Template a, TokenableTo String b) => (a, b) -> DepGenM' String
|
||||
applyTemplate (a, b) = do
|
||||
a' <- toToken a
|
||||
|
|
|
@ -6,6 +6,9 @@ import Types (Function(..), Value(..))
|
|||
|
||||
evalFunction :: Function -> Value -> Value
|
||||
evalFunction f x = case (f, x) of
|
||||
(AppendStrings, Tuple (String _, String _)) ->
|
||||
String undefined
|
||||
|
||||
(JoinPaths, Tuple (String _, String _)) ->
|
||||
String undefined
|
||||
|
||||
|
@ -15,9 +18,6 @@ evalFunction f x = case (f, x) of
|
|||
(IsImageExtension, String _) ->
|
||||
Bool undefined
|
||||
|
||||
(ConvertedImageFilename, String _) ->
|
||||
String undefined
|
||||
|
||||
(ApplyTemplate, Tuple (Template _, String _)) ->
|
||||
String undefined
|
||||
|
||||
|
|
|
@ -3,16 +3,21 @@ module SiteGenerator (generateSite) where
|
|||
import Types
|
||||
import DependencyGenerator
|
||||
|
||||
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
|
||||
thumbnailImageFilename filename = do
|
||||
(base, ext) <- untupleDepGenM (fileComponents filename)
|
||||
appendStrings (appendStrings (base, inject "-thumbnail."), ext)
|
||||
|
||||
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> DepGenM ()
|
||||
handleRecipeDir outputDir template dir = do
|
||||
dirContents <- listDirectory dir
|
||||
exts <- unzipSndDepGenM (mapDepGenM fileComponents dirContents)
|
||||
areImageFilenames <- mapDepGenM isImageExtension exts
|
||||
imageFilenames <- filterDepGenM areImageFilenames dirContents
|
||||
convertedImageFilenames <- mapDepGenM convertedImageFilename imageFilenames
|
||||
thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
|
||||
mapDepGenM_
|
||||
(\files -> convertImage (files, inject $ ResizeToWidth 800))
|
||||
(ZipToken (imageFilenames, convertedImageFilenames))
|
||||
(ZipToken (imageFilenames, thumbnailImageFilenames))
|
||||
recipeDirOut <- joinPaths (outputDir, dir)
|
||||
makeDir recipeDirOut
|
||||
htmlBody <- runPandoc (joinPaths (dir, inject "ret.md"))
|
||||
|
|
|
@ -23,6 +23,8 @@ data Action = Function Function
|
|||
| FilterComp
|
||||
| GetListElem
|
||||
| SetListElem
|
||||
| UntupleFst
|
||||
| UntupleSnd
|
||||
| UnzipFst
|
||||
| UnzipSnd
|
||||
| MapComp [Dependency]
|
||||
|
|
|
@ -4,10 +4,10 @@ module Types.Function
|
|||
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
|
||||
data Function = JoinPaths
|
||||
data Function = AppendStrings
|
||||
| JoinPaths
|
||||
| FileComponents
|
||||
| IsImageExtension
|
||||
| ConvertedImageFilename
|
||||
| ApplyTemplate
|
||||
deriving (Show, Lift)
|
||||
|
||||
|
|
Loading…
Reference in New Issue