ngws
/
mad
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use tuples for tuples

This commit is contained in:
Niels G. W. Serup 2024-09-25 19:42:15 +02:00
parent 4a0ea4d5ef
commit 544b02c3a6
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
4 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
byg/src/DependencyGenerator.hs
View File

@ -92,7 +92,7 @@ mapDepGenM_ f input = do
filterDepGenM :: (Token a -> DepGenM' Bool) -> Token [a] -> DepGenM' [a] filterDepGenM :: (Token a -> DepGenM' Bool) -> Token [a] -> DepGenM' [a]
filterDepGenM f input = do filterDepGenM f input = do
conds <- mapDepGenM f input conds <- mapDepGenM f input
genDependency (makeDependency (TupleToken input conds) FilterComp) genDependency (makeDependency (TupleToken (input, conds)) FilterComp)
joinPaths :: Token (FilePath, FilePath) -> DepGenM' FilePath joinPaths :: Token (FilePath, FilePath) -> DepGenM' FilePath

20
byg/src/SiteGenerator.hs
View File

@ -8,18 +8,18 @@ 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 flip mapDepGenM_ (ZipToken (imageFilenames, convertedImageFilenames)) $ \files -> do
settings <- inject $ ResizeToWidth 800 settings <- inject $ ResizeToWidth 800
convertImage $ TupleToken files settings convertImage $ TupleToken (files, settings)
recipeFilenameIn <- inject "ret.md" recipeFilenameIn <- inject "ret.md"
recipePathIn <- joinPaths $ TupleToken dir recipeFilenameIn recipePathIn <- joinPaths $ TupleToken (dir, recipeFilenameIn)
recipeDirOut <- joinPaths $ TupleToken outputDir dir recipeDirOut <- joinPaths $ TupleToken (outputDir, dir)
makeDir recipeDirOut makeDir recipeDirOut
recipeFilenameOut <- inject "index.html" recipeFilenameOut <- inject "index.html"
recipePathOut <- joinPaths $ TupleToken recipeDirOut recipeFilenameOut recipePathOut <- joinPaths $ TupleToken (recipeDirOut, recipeFilenameOut)
htmlBody <- runPandoc recipePathIn htmlBody <- runPandoc recipePathIn
html <- applyTemplate $ TupleToken template htmlBody html <- applyTemplate $ TupleToken (template, htmlBody)
saveFile $ TupleToken html recipePathOut saveFile $ TupleToken (html, recipePathOut)
generateSite :: DepGenM () generateSite :: DepGenM ()
generateSite = do generateSite = do
@ -33,7 +33,7 @@ generateSite = do
aboutPathIn <- inject "om.md" aboutPathIn <- inject "om.md"
aboutFilenameOut <- inject "om.html" aboutFilenameOut <- inject "om.html"
aboutPathOut <- joinPaths $ TupleToken outputDir aboutFilenameOut aboutPathOut <- joinPaths $ TupleToken (outputDir, aboutFilenameOut)
aboutHtmlBody <- runPandoc aboutPathIn aboutHtmlBody <- runPandoc aboutPathIn
aboutHtml <- applyTemplate $ TupleToken template aboutHtmlBody aboutHtml <- applyTemplate $ TupleToken (template, aboutHtmlBody)
saveFile $ TupleToken aboutHtml aboutPathOut saveFile $ TupleToken (aboutHtml, aboutPathOut)

12
byg/src/Types/Dependency.hs
View File

@ -27,8 +27,8 @@ data Action = Function Function
deriving (Show, Lift) deriving (Show, Lift)
data UToken = UToken Int data UToken = UToken Int
| UTupleToken UToken UToken | UTupleToken (UToken, UToken)
| UZipToken UToken UToken | UZipToken (UToken, UToken)
| UNoToken | UNoToken
deriving (Show, Lift) deriving (Show, Lift)
@ -41,8 +41,8 @@ makeDependency a action b = Dependency (makeUToken a) action (makeUToken b)
makeUToken :: Token a -> UToken makeUToken :: Token a -> UToken
makeUToken = \case makeUToken = \case
Token i -> UToken i Token i -> UToken i
TupleToken a b -> UTupleToken (makeUToken a) (makeUToken b) TupleToken (a, b) -> UTupleToken (makeUToken a, makeUToken b)
ZipToken a b -> UZipToken (makeUToken a) (makeUToken b) ZipToken (a, b) -> UZipToken (makeUToken a, makeUToken b)
NoToken -> UNoToken NoToken -> UNoToken
formatDependencyTrees :: [Dependency] -> Text formatDependencyTrees :: [Dependency] -> Text
@ -61,14 +61,14 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "")
formatUToken = \case formatUToken = \case
UToken i -> UToken i ->
[ T.pack (printf "%02d" i) ] [ T.pack (printf "%02d" i) ]
UTupleToken a b -> UTupleToken (a, b) ->
concat [ [ "tup(" ] concat [ [ "tup(" ]
, formatUToken a , formatUToken a
, [ ", " ] , [ ", " ]
, formatUToken b , formatUToken b
, [ ")" ] , [ ")" ]
] ]
UZipToken a b -> UZipToken (a, b) ->
concat [ [ "zip(" ] concat [ [ "zip(" ]
, formatUToken a , formatUToken a
, [ ", " ] , [ ", " ]

4
byg/src/Types/Token.hs
View File

@ -7,8 +7,8 @@ import Language.Haskell.TH.Syntax (Lift)
data Token a where data Token a where
Token :: Int -> Token a Token :: Int -> Token a
TupleToken :: Token a -> Token b -> Token (a, b) TupleToken :: (Token a, Token b) -> Token (a, b)
ZipToken :: Token [a] -> Token [b] -> Token [(a, b)] ZipToken :: (Token [a], Token [b]) -> Token [(a, b)]
NoToken :: Token () NoToken :: Token ()
deriving instance Show (Token a) deriving instance Show (Token a)