rewrite with custom Monad (without monad transformer)

Doug/Basic.lean

@@ -4,6 +4,31 @@ structure Config where
   useASCII : Bool := false
   currentPrefix : String := ""
 
+def ConfigIO (α : Type) : Type :=
+  Config → IO α
+
+instance : Monad ConfigIO where
+  pure x := fun _ => pure x
+  bind result next := fun cfg => do
+    let v ← result cfg
+    next v cfg
+
+#print ConfigIO
+#check (Monad ConfigIO)
+#check Monad.mk
+
+def ConfigIO.run (action : ConfigIO α) (cfg : Config) : IO α :=
+  action cfg
+
+def currentConfig : ConfigIO Config :=
+  fun cfg => pure cfg
+
+def locally (change : Config → Config) (action : ConfigIO α) : ConfigIO α :=
+  fun cfg => action (change cfg)
+
+def runIO (action : IO α) : ConfigIO α :=
+  fun _ => action
+
 def usage : String :=
   "Usage: doug [--ascii]
 Options:
@@ -43,11 +68,11 @@ Modify `cfg` on entering a directory.
 def Config.inDirectory (cfg : Config) : Config :=
   {cfg with currentPrefix := cfg.preDir ++ " " ++ cfg.currentPrefix}
 
-def showFileName (cfg : Config) (file : String) : IO Unit := do
+def showFileName (file : String) : ConfigIO Unit := do
-  IO.println (cfg.fileName file)
+  runIO (IO.println ((← currentConfig).fileName file))
 
-def showDirName (cfg : Config) (dir : String) : IO Unit := do
+def showDirName (dir : String) : ConfigIO Unit := do
-  IO.println (cfg.dirName dir)
+  runIO (IO.println ((← currentConfig).dirName dir))
 
 def doList [Applicative f] : List α → (α → f Unit) → f Unit
   | [], _ => pure ()
@@ -55,21 +80,21 @@ def doList [Applicative f] : List α → (α → f Unit) → f Unit
     action x *>
     doList xs action
 
-partial def dirTree (cfg : Config) (path : System.FilePath) : IO Unit := do
+partial def dirTree (path : System.FilePath) : ConfigIO Unit := do
-  match ← toEntry path with
+  match ← runIO (toEntry path) with
   | none => pure ()
-  | some (.file name) => showFileName cfg name
+  | some (.file name) => showFileName name
   | some (.dir name) =>
-    showDirName cfg name
+    showDirName name
-    let contents ← path.readDir
+    let contents ← runIO path.readDir
-    let newConfig := cfg.inDirectory
+    locally (·.inDirectory)
-    doList contents.toList fun d =>
+      (doList contents.toList fun d =>
-      dirTree newConfig d.path
+        dirTree d.path)
 
 def main (args : List String) : IO UInt32 := do
   match configFromArgs args with
   | some config =>
-    dirTree config (← IO.currentDir)
+    (dirTree (← IO.currentDir)).run config
     pure 0
   | none =>
     IO.eprintln s!"Didn't understand argument(s) {" ".intercalate args}\n"