looksee 0.2.0 → 0.3.0
raw patch · 3 files changed
+65/−28 lines, 3 files
Files
- looksee.cabal +1/−1
- src/Looksee.hs +45/−11
- test/Main.hs +19/−16
looksee.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: looksee-version: 0.2.0+version: 0.3.0 synopsis: parser with looksee description: Please see the README on GitHub at <https://github.com/ejconlon/looksee#readme> homepage: https://github.com/ejconlon/looksee#readme
src/Looksee.hs view
@@ -42,6 +42,11 @@ , splitP , splitCompP , split1P+ , split2P+ , leadP+ , lead1P+ , trailP+ , trail1P , infixRP , someInfixRP , takeP@@ -551,16 +556,16 @@ :: Monad m => St -> ParserT e m a- -> (Either (Err e) (Seq a, Bool) -> T e m r)+ -> (Either (Err e) (Seq a) -> T e m r) -> [(St, Int)] -> T e m r subSplitP st0 pa j = go Empty where go !acc = \case- [] -> j (Right (acc, True))+ [] -> j (Right acc) (st, start') : sts -> do put st- unParserT (pa <* endP) $ \case+ unParserT pa $ \case Left _ -> do let rng = stSpan st0 start = spanStart rng@@ -568,28 +573,57 @@ range' = rng {spanStart = start'} st' = st0 {stHay = hay', stSpan = range'} put st'- j (Right (acc, False))+ j (Right acc) Right a -> go (acc :|> a) sts -- | Split on the delimiter, parsing segments with a narrowed range, until parsing fails. -- Returns the sequence of successes with state at the delimiter preceding the failure (or end of input),--- and True if there are no more delimiters in the tail.-splitP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a, Bool)+-- Note that this will always succeed, sometimes consuming no input and yielding empty results.+splitP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a) splitP tx pa = ParserT (\j -> get >>= \st0 -> subSplitP st0 pa j (splitRP tx st0)) -splitCompP :: Monad m => SplitComp -> Int -> Text -> ParserT e m a -> ParserT e m (Seq a, Bool)+splitCompP :: Monad m => SplitComp -> Int -> Text -> ParserT e m a -> ParserT e m (Seq a) splitCompP comp n tx pa = do- p@(as, _) <- splitP tx pa+ as <- splitP tx pa let len = Seq.length as ok = case comp of SplitCompEQ -> len == n SplitCompGE -> len >= n SplitCompGT -> len > n- if ok then pure p else errP (ReasonSplitComp comp n tx len)+ if ok then pure as else errP (ReasonSplitComp comp n tx len) --- | Like 'splitP' but ensures the sequence is at least length 1-split1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a, Bool)+-- | Like 'splitP' but ensures the sequence is at least length 1.+split1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a) split1P = splitCompP SplitCompGE 1++-- | Like 'splitP' but ensures the sequence is at least length 2.+-- (This ensures there is at least one delimiter included.)+split2P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)+split2P = splitCompP SplitCompGE 2++-- | Like 'splitP' but ensures a leading delimiter+leadP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)+leadP tx pa = do+ mu <- optP (textP tx)+ case mu of+ Nothing -> pure Empty+ Just _ -> split1P tx pa++-- | Like 'split1P' but ensures a leading delimiter+lead1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)+lead1P tx pa = textP tx >> split1P tx pa++-- | Like 'splitP' but ensures a trailing delimiter+trailP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)+trailP tx pa = do+ as <- splitP tx pa+ case as of+ Empty -> pure Empty+ _ -> as <$ textP tx++-- | Like 'split1P' but ensures a trailing delimiter+trail1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)+trail1P tx pa = split1P tx pa <* textP tx -- private subInfixP
test/Main.hs view
@@ -5,7 +5,6 @@ import Control.Applicative (Alternative (..), liftA2) import Control.Exception (throwIO)-import Data.Bifunctor (first) import Data.Foldable (toList) import Data.Sequence (Seq (..)) import Data.Sequence qualified as Seq@@ -497,29 +496,33 @@ testSplit :: [TestTree] testSplit = fmap testParserCase cases where- parser = fmap (first toList) (splitP "+" (takeWhileP (== 'x')))+ parser = fmap toList (splitP "+" (takeWhile1P (== 'x'))) cases =- [ ParserCase "empty" parser "" (suc ([""], True) 0)- , ParserCase "single" parser "x" (suc (["x"], True) 0)- , ParserCase "fail" parser "xy" (suc ([], False) 2)- , ParserCase "double" parser "x+x" (suc (["x", "x"], True) 0)- , ParserCase "triple" parser "x+x+x" (suc (["x", "x", "x"], True) 0)- , ParserCase "fail first" parser "y+x" (suc ([], False) 3)- , ParserCase "fail second" parser "x+y" (suc (["x"], False) 2)+ [ ParserCase "empty" parser "" (suc [] 0)+ , ParserCase "single" parser "x" (suc ["x"] 0)+ , ParserCase "no delim" parser "xy" (suc ["x"] 1)+ , ParserCase "double" parser "x+x" (suc ["x", "x"] 0)+ , ParserCase "triple" parser "x+x+x" (suc ["x", "x", "x"] 0)+ , ParserCase "two + fail" parser "x+x+y" (suc ["x", "x"] 2)+ , ParserCase "two fail" parser "x+xy" (suc ["x", "x"] 1)+ , ParserCase "fail first" parser "y+x" (suc [] 3)+ , ParserCase "fail second" parser "x+y" (suc ["x"] 2) ] testSplit1 :: [TestTree] testSplit1 = fmap testParserCase cases where- parser = fmap (first toList) (split1P "+" (takeWhileP (== 'x')))+ parser = fmap toList (split1P "+" (takeWhile1P (== 'x'))) cases =- [ ParserCase "empty" parser "" (suc ([""], True) 0)- , ParserCase "single" parser "x" (suc (["x"], True) 0)- , ParserCase "fail" parser "xy" (err (Span 0 2) (ReasonSplitComp SplitCompGE 1 "+" 0))- , ParserCase "double" parser "x+x" (suc (["x", "x"], True) 0)- , ParserCase "triple" parser "x+x+x" (suc (["x", "x", "x"], True) 0)+ [ ParserCase "empty" parser "" (err (Span 0 0) (ReasonSplitComp SplitCompGE 1 "+" 0))+ , ParserCase "single" parser "x" (suc ["x"] 0)+ , ParserCase "no delim" parser "xy" (suc ["x"] 1)+ , ParserCase "double" parser "x+x" (suc ["x", "x"] 0)+ , ParserCase "triple" parser "x+x+x" (suc ["x", "x", "x"] 0)+ , ParserCase "two + fail" parser "x+x+y" (suc ["x", "x"] 2)+ , ParserCase "two fail" parser "x+xy" (suc ["x", "x"] 1) , ParserCase "fail first" parser "y+x" (err (Span 0 3) (ReasonSplitComp SplitCompGE 1 "+" 0))- , ParserCase "fail second" parser "x+y" (suc (["x"], False) 2)+ , ParserCase "fail second" parser "x+y" (suc ["x"] 2) ] testSpan :: TestTree