diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 2d7fa20..a376d15 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -92,7 +92,7 @@ mapDepGenM_ f input = do filterDepGenM :: (Token a -> DepGenM' Bool) -> Token [a] -> DepGenM' [a] filterDepGenM f input = do conds <- mapDepGenM f input - genDependency (makeDependency (TupleToken input conds) FilterComp) + genDependency (makeDependency (TupleToken (input, conds)) FilterComp) joinPaths :: Token (FilePath, FilePath) -> DepGenM' FilePath diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index b55dcae..05615f4 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -8,18 +8,18 @@ handleRecipeDir outputDir template dir = do dirContents <- listDirectory dir imageFilenames <- filterDepGenM isImageFilename dirContents convertedImageFilenames <- mapDepGenM convertedImageFilename imageFilenames - flip mapDepGenM_ (ZipToken imageFilenames convertedImageFilenames) $ \files -> do + flip mapDepGenM_ (ZipToken (imageFilenames, convertedImageFilenames)) $ \files -> do settings <- inject $ ResizeToWidth 800 - convertImage $ TupleToken files settings + convertImage $ TupleToken (files, settings) recipeFilenameIn <- inject "ret.md" - recipePathIn <- joinPaths $ TupleToken dir recipeFilenameIn - recipeDirOut <- joinPaths $ TupleToken outputDir dir + recipePathIn <- joinPaths $ TupleToken (dir, recipeFilenameIn) + recipeDirOut <- joinPaths $ TupleToken (outputDir, dir) makeDir recipeDirOut recipeFilenameOut <- inject "index.html" - recipePathOut <- joinPaths $ TupleToken recipeDirOut recipeFilenameOut + recipePathOut <- joinPaths $ TupleToken (recipeDirOut, recipeFilenameOut) htmlBody <- runPandoc recipePathIn - html <- applyTemplate $ TupleToken template htmlBody - saveFile $ TupleToken html recipePathOut + html <- applyTemplate $ TupleToken (template, htmlBody) + saveFile $ TupleToken (html, recipePathOut) generateSite :: DepGenM () generateSite = do @@ -33,7 +33,7 @@ generateSite = do aboutPathIn <- inject "om.md" aboutFilenameOut <- inject "om.html" - aboutPathOut <- joinPaths $ TupleToken outputDir aboutFilenameOut + aboutPathOut <- joinPaths $ TupleToken (outputDir, aboutFilenameOut) aboutHtmlBody <- runPandoc aboutPathIn - aboutHtml <- applyTemplate $ TupleToken template aboutHtmlBody - saveFile $ TupleToken aboutHtml aboutPathOut + aboutHtml <- applyTemplate $ TupleToken (template, aboutHtmlBody) + saveFile $ TupleToken (aboutHtml, aboutPathOut) diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index d188745..7a43dda 100644 --- a/byg/src/Types/Dependency.hs +++ b/byg/src/Types/Dependency.hs @@ -27,8 +27,8 @@ data Action = Function Function deriving (Show, Lift) data UToken = UToken Int - | UTupleToken UToken UToken - | UZipToken UToken UToken + | UTupleToken (UToken, UToken) + | UZipToken (UToken, UToken) | UNoToken deriving (Show, Lift) @@ -41,8 +41,8 @@ makeDependency a action b = Dependency (makeUToken a) action (makeUToken b) makeUToken :: Token a -> UToken makeUToken = \case Token i -> UToken i - TupleToken a b -> UTupleToken (makeUToken a) (makeUToken b) - ZipToken a b -> UZipToken (makeUToken a) (makeUToken b) + TupleToken (a, b) -> UTupleToken (makeUToken a, makeUToken b) + ZipToken (a, b) -> UZipToken (makeUToken a, makeUToken b) NoToken -> UNoToken formatDependencyTrees :: [Dependency] -> Text @@ -61,14 +61,14 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "") formatUToken = \case UToken i -> [ T.pack (printf "%02d" i) ] - UTupleToken a b -> + UTupleToken (a, b) -> concat [ [ "tup(" ] , formatUToken a , [ ", " ] , formatUToken b , [ ")" ] ] - UZipToken a b -> + UZipToken (a, b) -> concat [ [ "zip(" ] , formatUToken a , [ ", " ] diff --git a/byg/src/Types/Token.hs b/byg/src/Types/Token.hs index f84f2bf..c18f3c6 100644 --- a/byg/src/Types/Token.hs +++ b/byg/src/Types/Token.hs @@ -7,8 +7,8 @@ import Language.Haskell.TH.Syntax (Lift) data Token a where Token :: Int -> Token a - TupleToken :: Token a -> Token b -> Token (a, b) - ZipToken :: Token [a] -> Token [b] -> Token [(a, b)] + TupleToken :: (Token a, Token b) -> Token (a, b) + ZipToken :: (Token [a], Token [b]) -> Token [(a, b)] NoToken :: Token () deriving instance Show (Token a)