From 7504c083a132529d56e50e428eabfc65f5eaaf82 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Sat, 5 Oct 2024 19:56:53 +0200
Subject: [PATCH] Refactor TupleToken building

---
 byg/src/DependencyGenerator.hs | 71 +++++++++++-----------------------
 1 file changed, 23 insertions(+), 48 deletions(-)

diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs
index 17a69d2..d1e1cb3 100644
--- a/byg/src/DependencyGenerator.hs
+++ b/byg/src/DependencyGenerator.hs
@@ -98,6 +98,18 @@ runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
 runFunctionIO' :: FunctionIO -> Token a -> DepGenM ()
 runFunctionIO' f input = tellDep $ makeDependency input (FunctionIO f) NoToken
 
+class TokenableTo t s | s -> t where
+  toToken :: s -> DepGenM' t
+
+instance TokenableTo a (Token a) where
+  toToken = pure
+
+instance TokenableTo a (DepGenM' a) where
+  toToken = id
+
+toTupleToken :: (TokenableTo ta a, TokenableTo tb b) => a -> b -> DepGenM' (ta, tb)
+toTupleToken a b = TupleToken <$> toToken a <*> toToken b
+
 mapDepGenM :: TokenableTo [a] v => (Token a -> DepGenM' b) -> v -> DepGenM' [b]
 mapDepGenM f input = do
   input' <- toToken input
@@ -117,9 +129,8 @@ mapDepGenM_ f input = do
 
 filterDepGenM :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM' [a]
 filterDepGenM mask input = do
-  mask' <- toToken mask
-  input' <- toToken input
-  genDependency (makeDependency (TupleToken input' mask') FilterComp)
+  tup <- toTupleToken mask input
+  genDependency (makeDependency tup FilterComp)
 
 zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM' [(a, b)]
 zipDepGenM a b = do
@@ -169,38 +180,20 @@ unzipDepGenM t = do
   b <- unzipSndDepGenM t'
   pure (a, b)
 
-class TokenableTo t s | s -> t where
-  toToken :: s -> DepGenM' t
-
-instance TokenableTo a (Token a) where
-  toToken = pure
-
-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'
+appendStrings a b = runFunction AppendStrings =<< TupleToken <$> toToken a <*> toToken b
 
 concatStrings :: TokenableTo [String] a => a -> DepGenM' String
 concatStrings a = runFunction ConcatStrings =<< toToken a
 
 appendTexts :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Text
-appendTexts a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunction AppendTexts $ TupleToken a' b'
+appendTexts a b = runFunction AppendTexts =<< toTupleToken a b
 
 concatTexts :: TokenableTo [Text] a => a -> DepGenM' Text
 concatTexts a = runFunction ConcatTexts =<< toToken a
 
 joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM' FilePath
-joinPaths a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunction JoinPaths $ TupleToken a' b'
+joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b
 
 fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String)
 fileComponents a = runFunction FileComponents =<< toToken a
@@ -209,22 +202,13 @@ lowerString :: TokenableTo String a => a -> DepGenM' String
 lowerString a = runFunction LowerString =<< toToken a
 
 elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM' Bool
-elemOf a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunction ElemOf $ TupleToken a' b'
+elemOf a b = runFunction ElemOf =<< toTupleToken a b
 
 makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Template
-makeTemplate a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunction MakeTemplate $ TupleToken a' b'
+makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b
 
 applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text
-applyTemplate a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunction ApplyTemplate $ TupleToken a' b'
+applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b
 
 toText :: TokenableTo String a => a -> DepGenM' Text
 toText a = runFunction ToText =<< toToken a
@@ -239,22 +223,13 @@ readTextFile :: TokenableTo FilePath a => a -> DepGenM' Text
 readTextFile a = runFunctionIO ReadTextFile =<< toToken a
 
 convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM ()
-convertImage a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunctionIO' ConvertImage $ TupleToken a' b'
+convertImage a b = runFunctionIO' ConvertImage =<< toTupleToken a b
 
 saveFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
-saveFile a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunctionIO' SaveFile $ TupleToken a' b'
+saveFile a b = runFunctionIO' SaveFile =<< toTupleToken a b
 
 copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
-copyFile a b = do
-  a' <- toToken a
-  b' <- toToken b
-  runFunctionIO' CopyFile $ TupleToken a' b'
+copyFile a b = runFunctionIO' CopyFile =<< toTupleToken a b
 
 copyFile' :: Token (FilePath, FilePath) -> DepGenM ()
 copyFile' = runFunctionIO' CopyFile