Use tuples for tuples

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

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)

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
                    , [ ", " ]

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)