Added direct file suport

biparsing-binary/tests/Biparse/Binary/GenericsSpec.hs

@@ -13,6 +13,7 @@ spec = do
     (genericBinaryAdtIsoClass :: Iso IndexContext IO IO () ByteStringBuilder () (IndexPosition LazyByteString) ABC)
     ()
     ()
+    ()
     (\fw -> do
       it "A" $ fw (startIndex [0]) `shouldReturn` (A, IndexPosition 1 [])
       it "B" $ fw (startIndex [1,2]) `shouldReturn` (B 2, IndexPosition 2 [])

biparsing-binary/tests/Biparse/BinarySpec.hs

@@ -21,7 +21,11 @@ spec = do
   test "int128" int128
 
 test :: (Binary b, Arbitrary b, Eq b, Show b) => String -> Iso IndexContext IO IO () ByteStringBuilder () (IndexPosition LazyByteString) b -> Spec
-test name bp = fb @IndexContext @(IndexPosition LazyByteString) @IO @IO name bp () ()
+test name bp = fb @IndexContext @(IndexPosition LazyByteString) @IO @IO name
+  bp
+  ()
+  ()
+  ()
   (\fw -> prop "same as binary" \ss -> case decodeOrFail ss of
     Right (remainder, i, x) -> fw (startIndex ss) `shouldReturn` (x, IndexPosition i remainder)
     Left _ -> fw (startIndex ss) `shouldThrow` isUserError

biparsing-core-tests/biparsing-core-tests.cabal

@@ -20,7 +20,6 @@ test-suite spec
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-      Biparse.AlternativeAttributesSpec
       Biparse.Biparser.StateReaderWriterSpec
       Biparse.BiparserSpec
       Biparse.ConstructorSpec
@@ -31,6 +30,8 @@ test-suite spec
       Biparse.UnorderedSpec
       Control.Monad.StateErrorSpec
       Control.Monad.UnrecoverableSpec
+      Control.Profunctor.FwdBwdSpec
+      SpecHook
   hs-source-dirs:
       tests/
   default-extensions:

biparsing-core-tests/tests/Biparse/Biparser/StateReaderWriterSpec.hs

@@ -15,6 +15,7 @@ spec = do
       :: Iso LinesOnly (FM [Text]) IO () [Text] () (Position () [Text]) Word)
       ()
       ()
+      ()
       (\f -> do
         it "empty" $ f [] `shouldSatisfy` errorPosition 1 1
 
@@ -40,6 +41,7 @@ spec = do
       :: Iso UnixLC (FM Text) IO () Text () (Position () Text) [Int])
       ()
       ()
+      ()
       (\f -> do
         it "empty" $ f "" `shouldBe` Right ([],"")
 
@@ -79,7 +81,7 @@ spec = do
         bp = do
           c <- askBw undefined
           cons (c2w c) <$> rest
-        b = runBackward bp 'A' ()
+        b = runBackward bp () 'A' ()
     b "cd" `shouldBe` EValue ("Acd", "cd")
 
 instance Monoid text => ChangeMonad ListToElement (EEP dataId e [text]) (EEP dataId e text) () where

biparsing-core-tests/tests/Biparse/BiparserSpec.hs

@@ -1,16 +1,87 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 module Biparse.BiparserSpec where
 
+import Biparse.Biparser qualified as B
 import Data.Sequences qualified as MT
 
 spec :: Spec
 spec = do
+  describe "instances" do
+    it "Functor" do
+      let bp0 = pure 1 :: B.Biparser () () (FM ()) EitherString () Int
+      (+ 1) <$> bp0 `shouldBe` pure 2
+      let bp1 = pure 1 :: B.Biparser () () IO IO () Int
+      (+ 1) <$> bp1 `shouldBe` pure 2
+
+    describe "Applicative" do
+      it "<*>" do
+        let bp0 = pure 1 :: B.Biparser () () (FM ()) EitherString () Int
+        pure (+ 1) <*> bp0 `shouldBe` pure 2
+        let bp1 = pure 1 :: B.Biparser () () IO IO () Int
+        pure (+ 1) <*> bp1 `shouldBe` pure 2
+
+      it "*>" do
+        let bp0 = pure 1 :: B.Biparser () () (FM ()) EitherString () Int
+        bp0 *> pure () `shouldBe` pure ()
+        let bp1 = pure 1 :: B.Biparser () () IO IO () Int
+        bp1 *> pure () `shouldBe` pure ()
+
+    describe "Monad" do
+      it ">>=" do
+        let bp0 = pure 1 :: B.Biparser () () (FM ()) EitherString () Int
+        (bp0 >>= \x -> pure $ x + 1) `shouldBe` pure 2
+        let bp1 = pure 1 :: B.Biparser () () IO IO () Int
+        (bp1 >>= \x -> pure $ x + 1) `shouldBe` pure 2
+
+    describe "MonadFail" do
+      it "fail" do
+        let msg0 = "bp0 fail" :: String
+            bp0 = fail msg0 :: B.Biparser () () EitherString EitherString () Int
+        bp0 `shouldBe` B.Biparser (EString msg0) (\() -> EString msg0)
+
+      describe "*>" do
+        it "B.Biparser" do
+          let msg0 = "bp0 fail" :: String
+              bp0 = fail msg0 *> pure ():: B.Biparser () () EitherString EitherString () ()
+          bp0 `shouldBe` B.Biparser (EString msg0) (\() -> EString msg0)
+
+        fb "SRW.Biparser Maybe"
+          (let bp :: Biparser ColumnsOnly (Position () (Vector Char)) (FM (Vector Char)) Maybe () Text () () ()
+               bp = fail "test fail" *> bp
+           in bp)
+          ()
+          ()
+          ()
+          (\f -> do
+            it "should be 2" do
+              f "" `shouldSatisfy` errorPosition 1 1
+          )
+          \b -> do
+            it "should be 2" do
+              b () `shouldBe` Nothing
+
+        fb "SRW.Biparser"
+          (let bp :: Biparser ColumnsOnly (Position () (Vector Char)) (FM (Vector Char)) EitherString () Text () () Int
+               bp = fail "test fail" *> bp <!> pure 2
+           in bp)
+          ()
+          ()
+          ()
+          (\f -> do
+            it "should be 2" do
+              f "" `shouldBe` Right (2, Position () 1 1 "")
+          )
+          \b -> do
+            it "should be 2" do
+              b () `shouldBe` EValue (2, "")
+
   describe "one" do
     describe "Identity" do
       fb "id"
         (one :: Iso () IO IO () String () (Identity String) Char)
         ()
         ()
+        ()
         (\f -> do
           it "one use" do
             x <- f "abc"
@@ -26,6 +97,7 @@ spec = do
         ((,) <$> one `upon` fst <*> one `upon` snd :: Iso () IO IO () String () (Identity String) (Char,Char))
         ()
         ()
+        ()
         (\f -> do
           it "used twice" do
             x <- f "abc"
@@ -38,6 +110,7 @@ spec = do
       (one :: Iso UnixLC (FM Text) IO () Text () (Position () Text) Char)
       ()
       ()
+      ()
       (\f -> do
         it "empty" do
           f "" `shouldSatisfy` errorPosition 1 1
@@ -53,6 +126,7 @@ spec = do
       (one :: Iso LinesOnly (FM [Text]) IO () [Text] () (Position () [Text]) Text)
       ()
       ()
+      ()
       (\f -> do
         it "empty" $ f [] `shouldSatisfy` errorPosition 1 1
 
@@ -65,6 +139,7 @@ spec = do
       (one :: Iso UnixLC (FM ByteString) EitherString () ByteStringBuilder () (Position () ByteString) Word8)
       ()
       ()
+      ()
       (\f -> do
         it "ByteString" do
           f "abc" `shouldBe` Right (fromChar 'a', Position () 1 2 "bc")
@@ -73,26 +148,6 @@ spec = do
         it "Builder" do
           b (fromChar 'd') `shouldBe` EValue (fromChar 'd', "d")
 
-    describe "Handle" $ do
-      fb "as state"
-        (one :: Iso UnixLC (FileM StrictByteString) (FileM StrictByteString) () (File StrictByteString) () (Position () (File StrictByteString)) Word8)
-        ()
-        ()
-        (\f -> do
-          it "empty" $ withFile "/dev/null" ReadMode \h ->
-            runFileM h (f $ startLineColumn File) `shouldThrow` isUserError
-        )
-        \b -> do
-          it "write character" do
-            (_,h) <- openTempFile "/tmp" ""
-            x <- runFileM h $ b $ fromChar 'a'
-            x `shouldBe` (fromChar 'a', File)
-            hSeek h AbsoluteSeek 0
-            w <- hGetContents h
-            w `shouldBe` "a"
-
-      it "LineColumn" pending
-
   describe "split" do
     fb "Identity"
       -- take two
@@ -105,6 +160,7 @@ spec = do
       ) :: Iso () IO IO () String () (Identity String) String)
       ()
       ()
+      ()
       (\f -> do
         it "succeeds" $ f "abc" >>= (`shouldBe` ("ab", "c"))
 
@@ -123,6 +179,7 @@ spec = do
       ) :: Iso ColumnsOnly (FM String) EitherString () Text () (Position () String) String)
       ()
       ()
+      ()
       (\f -> do
         it "String" do
           f "abc" `shouldBe` Right ("abc", Position () 1 4 "")
@@ -136,6 +193,7 @@ spec = do
       (peek one :: Iso () IO IO () String () (Identity String) Char)
       ()
       ()
+      ()
       (\f -> do
         it "none consumed" do
           x <- f "abc"
@@ -149,6 +207,7 @@ spec = do
         (peek (takeUni 'x') <!> takeUni 'a' :: Iso () IO IO () String () (Identity String) Char)
         ()
         ()
+        ()
         (\f -> do
           it "take first" do
             x <- f "xa"
@@ -169,6 +228,7 @@ spec = do
         (peek (takeUni 'x') <!> takeUni 'a' :: Iso UnixLC (FM String) IO () String () (Position () String) Char)
         ()
         ()
+        ()
         (\f -> do
           it "take first" $ f "xa" `shouldBe` Right ('x', Position () 1 1 "xa")
 
@@ -185,7 +245,7 @@ spec = do
     let bp :: Biparser ColumnsOnly (Position () (Seq Char)) (FM (Seq Char)) IO () (Seq Char) () Char Char
         bp = try $ one <* take 'b'
         f = runForward bp
-        b = runBackward bp () ()
+        b = runBackward bp () () ()
 
     describe "forward" do
       it "success" $ f "abc" `shouldBe` Right ('a', Position () 1 3 "c")
@@ -200,14 +260,15 @@ spec = do
         it "prints correctly" $ b 'a' >>= (`shouldBe` ('a',"ab"))
 
         it "prints second if first fails (more of a test for the Biparser Alternative instance and should proabaly moved there)" do
-          x <- runBackward (setBackward bp (const empty) <!> bp) () () 'z'
+          x <- runBackward (setBackward bp (const empty) <!> bp) () () () 'z'
           x `shouldBe` ('z',"zb")
 
   describe "isNull" do
     fb "Identity"
       (isNull :: ConstU () (Identity String) Identity Identity () String () [()] Bool)
       ()
       ()
+      ()
       (\f -> do
         it "true" $ f mempty `shouldBe` Identity (True,mempty)
 
@@ -222,6 +283,7 @@ spec = do
       (isNull :: ConstU UnixLC (Position () String) Identity Identity () String () [()] Bool)
       ()
       ()
+      ()
       (\f -> do
         it "true" $ f "" `shouldBe` Identity (True,"")
 
@@ -237,6 +299,7 @@ spec = do
       (breakWhen' $ stripPrefix "ab" :: Iso UnixLC (FM String) IO () ByteString () (Position () String) String)
       ()
       ()
+      ()
       (\f -> do
         it "empty" $ limit $
           f "" `shouldSatisfy` errorPosition 1 1
@@ -266,6 +329,7 @@ spec = do
       (breakWhen' $ stripPrefix "ab" :: Iso () IO IO () String () (Identity String) String)
       ()
       ()
+      ()
       (\f -> do
         it "empty" $ limit $
           f "" `shouldThrow` isUserError
@@ -296,6 +360,7 @@ spec = do
       (count $ takeElementsWhile (== 'a') :: Biparser UnixLC (Position () Text) (FM Text) IO () Text () [Char] (Natural,[Char]))
       ()
       ()
+      ()
       (\f -> do
         prop "correct count" \(NonNegative x, NonNegative y) -> let
           as :: (IsSequence a, Element a ~ Char, Index a ~ Int) => a
@@ -311,6 +376,7 @@ spec = do
       (count $ takeWhile (== 'a') :: Biparser UnixLC (Position () Text) (FM Text) IO () Text () Text (Natural,Text))
       ()
       ()
+      ()
       (\f -> do
         prop "correct count" \(NonNegative x, NonNegative y) -> let
           as :: (IsSequence a, Element a ~ Char, Index a ~ Int) => a

biparsing-core-tests/tests/Biparse/ConstructorSpec.hs

@@ -14,6 +14,7 @@ spec = do
       :: Biparser () (Identity [(Int,Double)]) EitherString EitherString () [(Int,Double)] () [(Int,Double)] Double)
       ()
       ()
+      ()
       (\f -> do
         it "empty" $ f mempty `shouldSatisfy` isString
 

biparsing-core-tests/tests/Biparse/Context/IndexSpec.hs

@@ -6,10 +6,10 @@ spec = do
     let bp :: Iso IndexContext (EISP String) EitherString () Text () (IndexPosition String) Char
         bp = one
     runForward bp "abcd" `shouldBe` Right ('a', IndexPosition 1 "bcd")
-    runBackward bp () () 'b' `shouldBe` EValue ('b', "b")
+    runBackward bp () () () 'b' `shouldBe` EValue ('b', "b")
 
   it "take" do
     let bp :: Iso IndexContext (EISP ByteString) EitherString () ByteStringBuilder () (IndexPosition ByteString) ()
         bp = take 48
     runForward bp "0123" `shouldBe` Right ((), IndexPosition 1 "123")
-    runBackward bp () () () `shouldBe` EValue ((), "0")
+    runBackward bp () () () () `shouldBe` EValue ((), "0")