From af2b9202ef9cbc2f8526df29e67edc08a480f892 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Sat, 21 Sep 2024 18:49:50 +0200
Subject: [PATCH] Get rid of the final traversable cruft

---
 byg/src/ComputationM.hs | 32 +++++++++++++++-----------------
 byg/src/Main.hs         |  4 ++--
 2 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/byg/src/ComputationM.hs b/byg/src/ComputationM.hs
index c8fef31..213bb0b 100644
--- a/byg/src/ComputationM.hs
+++ b/byg/src/ComputationM.hs
@@ -16,26 +16,24 @@ data TypedRun a b where
   FIO :: IsFIO f a b => f -> TypedRun a b
   TInject :: b -> TypedRun () b
   GetListElem :: TypedRun () b
-  InList :: ComputationM TokenNotTraversable b -> TypedRun [a] [b]
+  InList :: ComputationM b -> TypedRun [a] [b]
 
-instance Show (ComputationM t a) where
+instance Show (ComputationM a) where
   show _ = "<computation>"
 
 deriving instance (Show a, Show b) => Show (TypedRun a b)
 
-data Token t a where
-  Token :: Int -> Token t a
-  NoToken :: Token t ()
+data Token a where
+  Token :: Int -> Token a
+  NoToken :: Token ()
 
-deriving instance Show (Token t a)
+deriving instance Show (Token a)
 
-data TokenNotTraversable
-
-data Dependency ta a tb b = Dependency (Token ta a) (TypedRun a b) (Token tb b)
+data Dependency a b = Dependency (Token a) (TypedRun a b) (Token b)
   deriving (Show)
 
 data DependencyUntyped where
-  DependencyUntyped :: Dependency ta a tb b -> String -> DependencyUntyped
+  DependencyUntyped :: Dependency a b -> String -> DependencyUntyped
 
 instance Show DependencyUntyped where
   show (DependencyUntyped _ s) = s
@@ -43,11 +41,11 @@ instance Show DependencyUntyped where
 newtype ComputationM' a = ComputationM { unComputationM :: WriterT [DependencyUntyped] (State Int) a }
   deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [DependencyUntyped])
 
-type ComputationM ta a = ComputationM' (Token ta a)
+type ComputationM a = ComputationM' (Token a)
 
 evalComputationM m = evalState (execWriterT (unComputationM m)) 0
 
-genDependency :: (Show u, Show a) => (Token ta a -> Dependency tu u ta a) -> ComputationM ta a
+genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a
 genDependency g = do
   top <- get
   let top' = top + 1
@@ -57,19 +55,19 @@ genDependency g = do
   tell [DependencyUntyped result (show result)]
   pure target
 
-inject :: Show a => a -> ComputationM ta a
+inject :: Show a => a -> ComputationM a
 inject x = genDependency (Dependency NoToken (TInject x))
 
-getListElem :: Show a => ComputationM ta a
+getListElem :: Show a => ComputationM a
 getListElem = genDependency (Dependency NoToken GetListElem)
 
-run :: (Show a, Show b, IsF f a b) => f -> Token t a -> ComputationM TokenNotTraversable b
+run :: (Show a, Show b, IsF f a b) => f -> Token a -> ComputationM b
 run f input = genDependency (Dependency input (F f))
 
 isImageFilename = run IsImageFilename
 convertedImageFilename = run ConvertedImageFilename
 
-runIO :: (Show a, Show b, IsFIO f a b) => f -> Token t a -> ComputationM TokenNotTraversable b
+runIO :: (Show a, Show b, IsFIO f a b) => f -> Token a -> ComputationM b
 runIO f input = genDependency (Dependency input (FIO f))
 
 listDirectory = runIO ListDirectory
@@ -78,5 +76,5 @@ convertImage = runIO ConvertImage
 saveFile = runIO SaveFile
 runPandoc = runIO RunPandoc
 
-mapListTaken :: (Show a, Show b) => ComputationM TokenNotTraversable b -> Token TokenNotTraversable [a] -> ComputationM TokenNotTraversable [b]
+mapListTaken :: (Show a, Show b) => ComputationM b -> Token [a] -> ComputationM [b]
 mapListTaken f input = genDependency (Dependency input (InList f))
diff --git a/byg/src/Main.hs b/byg/src/Main.hs
index cee6fa3..da7dfed 100644
--- a/byg/src/Main.hs
+++ b/byg/src/Main.hs
@@ -3,12 +3,12 @@ module Main where
 import Types
 import ComputationM
 
-testSub :: ComputationM TokenNotTraversable Image
+testSub :: ComputationM Image
 testSub = do
   inp <- getListElem
   openImage inp
 
-test :: ComputationM TokenNotTraversable ()
+test :: ComputationM ()
 test = do
   dir <- inject "retter"
   dirContents <- listDirectory dir