core: Debug wrapper for handleParserIO

src/Parser/Interface.md

@@ -116,6 +116,13 @@ runFirstIO f str = do
     | _ => pure . Left $ BeforeParse "Empty input"
   runEff (rundownFirst f) [handleParserStateIO state]
 
+export
+runFirstIODebug : (f : Parser a) -> String -> IO (Either ParseError a)
+runFirstIODebug f str = do
+  Just state <- newInternalIO str
+    | _ => pure . Left $ BeforeParse "Empty input"
+  runEff (rundownFirst f) [handleParserStateIODebug state]
+
 export
 runFirst : (f : Parser a) -> String -> Eff fs (Either ParseError a)
 runFirst f str = do

src/Parser/ParserState.md

@@ -12,6 +12,9 @@ import public Data.Refined.Int64
 import public Data.SortedMap
 import public Data.IORef
 
+import Data.Primitives.Interpolation
+import System.File
+
 import public Control.Eff
 ```
 
@@ -49,11 +52,17 @@ record Index (length : Int64) where
 ```
 
 <!-- idris
+export
 Eq (Index i) where
   x == y = x.index == y.index
 
+export
 Ord (Index i) where
   compare x y = compare x.index y.index
+
+export
+Show (Index i) where
+  show (MkIndex index) = show index
 -->
 
 Stores the location we are currently at in the string, and metadata about it for
@@ -147,6 +156,17 @@ positionPair pi =
           in (linum, col)
 ```
 
+<!-- idris
+export
+Show (ParserInternal Id) where
+  show pi = 
+    let (line, col) = positionPair pi
+        current = assert_total $ strIndex pi.input (cast pi.position.index) 
+        pos = pi.position.index
+        eof = show pi.end_of_input
+    in "Position: \{pos}(\{line}, \{col}}) Value: \{show current} EoF: \{eof}"
+-->
+
 ### More Barbie Functionality
 
 Provide the barbie analogs of `map` and `traverse` for our `ParserInternal`
@@ -195,6 +215,14 @@ data ParserState : Type -> Type where
   ParseEoF : ParserState Bool
 ```
 
+<!-- idris
+Show (ParserState t) where
+  show Save = "Saving state"
+  show (Load pi) = "Loading state \{show pi}"
+  show (ParseChar predicate err) = "Parsing char"
+  show ParseEoF = "Parsing EoF"
+-->
+
 ### Actions
 
 ```idris
@@ -281,6 +309,19 @@ newInternalIO str = do
   map Just $ newIORef internal
 ```
 
+Wrapper with debugging output
+
+```idris
+export
+handleParserStateIODebug : HasIO io => 
+  IORef (ParserInternal IORef) -> ParserState t -> io t
+handleParserStateIODebug x y = do
+  state <- readIORef x
+  state <- btraverse readIORef state
+  _ <- fPutStrLn stderr "\{show y} -> \{show state}"
+  handleParserStateIO x y
+```
+
 ### State context
 
 ```idris