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