looksee 0.4.0 → 0.5.0

raw patch · 3 files changed

+152/−101 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• looksee.cabal +1/−1
• src/Looksee.hs +73/−90
• test/Main.hs +78/−10

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           looksee-version:        0.4.0+version:        0.5.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

@@ -10,7 +10,6 @@   , lookupLineCol   , Label (..)   , textSpan-  , SplitComp (..)   , Reason (..)   , ErrF (..)   , Err (..)@@ -29,8 +28,6 @@   , emptyP   , endP   , optP-  , greedyP-  , greedy1P   , lookP   , labelP   , textP@@ -40,7 +37,6 @@   , breakP   , someBreakP   , splitP-  , splitCompP   , split1P   , split2P   , leadP@@ -62,7 +58,11 @@   , takeAll1P   , dropAll1P   , betweenP+  , repeatP+  , repeat1P   , sepByP+  , sepBy1P+  , sepBy2P   , spaceP   , stripP   , stripStartP@@ -80,14 +80,10 @@   , usciP   , numP   , unumP-  , repeatP-  , repeat1P   , space1P   , strip1P   , stripStart1P   , stripEnd1P-  , sepBy1P-  , sepBy2P   , transP   , scopeP   , iterP@@ -228,13 +224,9 @@ data InfixPhase = InfixPhaseLeft | InfixPhaseRight | InfixPhaseCont   deriving stock (Eq, Ord, Show, Enum, Bounded) -data SplitComp = SplitCompEQ | SplitCompGE | SplitCompGT-  deriving stock (Eq, Ord, Show, Enum, Bounded)- -- | Reason for parse failure data Reason e r   = ReasonCustom !e-  | ReasonSplitComp !SplitComp !Int !Text !Int   | ReasonExpect !Text !Text   | ReasonDemand !Int !Int   | ReasonLeftover !Int@@ -346,8 +338,8 @@ instance Monad m => Alternative (ParserT e m) where   empty = emptyP   p1 <|> p2 = altP [p1, p2]-  many = fmap toList . greedyP-  some = fmap toList . greedy1P+  many = fmap toList . repeatP+  some = fmap toList . repeat1P  -- | The parser monad type Parser e = ParserT e Identity@@ -482,20 +474,6 @@ emptyP :: Monad m => ParserT e m a emptyP = ParserT (\j -> mkErrT ReasonEmpty >>= j . Left) --- | Parse repeatedly until the parser fails-greedyP :: Monad m => ParserT e m a -> ParserT e m (Seq a)-greedyP p = go Empty- where-  go !acc = do-    ma <- optP p-    case ma of-      Nothing -> pure acc-      Just a -> go (acc :|> a)---- | Same as 'greedyP' but ensure at least one result-greedy1P :: Monad m => ParserT e m a -> ParserT e m (Seq a)-greedy1P p = liftA2 (:<|) p (greedyP p)- -- | Lookahead - rewinds state if the parser succeeds, otherwise throws error lookP :: Monad m => ParserT e m a -> ParserT e m a lookP (ParserT g) = ParserT $ \j -> do@@ -539,36 +517,39 @@ someBreakP :: Monad m => Text -> ParserT e m a -> ParserT e m a someBreakP tx pa = fmap fst (someInfixRP tx pa (pure ())) --- | 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),--- 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 = getP >>= go Empty+-- private+splitTailP :: Monad m => Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)+splitTailP tx pa = go  where   go !acc !st = do-    mz <- ignoreErrorInfixRP tx pa (pure ())+    mz <- optInfixRP tx pa (pure ())     case mz of       Nothing -> optP pa >>= maybe (acc <$ putP st) (pure . (acc :|>))       Just (a, st', _) -> go (acc :|> a) st' -splitCompP :: Monad m => SplitComp -> Int -> Text -> ParserT e m a -> ParserT e m (Seq a)-splitCompP comp n tx pa = do-  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 as else errP (ReasonSplitComp comp n tx len)+-- | 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),+-- 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 = getP >>= splitTailP tx pa Empty  -- | 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+split1P tx pa = do+  mz <- optInfixRP tx pa (pure ())+  case mz of+    Nothing -> fmap Seq.singleton pa+    Just (a, st', _) -> splitTailP tx pa (Seq.singleton a) st'  -- | 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+split2P tx pa = do+  a0 <- someBreakP tx pa+  mz <- optInfixRP tx pa (pure ())+  case mz of+    Nothing -> fmap (Empty :|> a0 :|>) pa+    Just (a1, st', _) -> splitTailP tx pa (Empty :|> a0 :|> a1) st'  -- | Like 'splitP' but ensures a leading delimiter leadP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)@@ -627,22 +608,23 @@                 Right c -> pure c  -- private-ignoreErrorInfixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, St, b))-ignoreErrorInfixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (ignoreErrorInfix j) (breakAllRP tx st0))+optInfixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, St, b))+optInfixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (optInfixFn j) (breakAllRP tx st0)) -ignoreErrorInfix+-- private+optInfixFn   :: (Either (Err e) (Maybe (a, St, b)) -> T e m r)   -> (Either (Err e) (Maybe (a, St, b)) -> T e m r)-ignoreErrorInfix j e = case e of+optInfixFn j e = case e of   Right _ -> j e   Left _ -> j (Right Nothing)  -- private-requireInfix+requireInfixFn   :: Monad m   => (Either (Err e) (a, b) -> T e m r)   -> (Either (Err e) (Maybe (a, St, b)) -> T e m r)-requireInfix j = \case+requireInfixFn j = \case   Right mxab ->     case mxab of       Nothing -> mkErrT ReasonEmpty >>= j . Left@@ -652,12 +634,12 @@ -- | Right-associative infix parsing. Searches for the operator from START to END of range, -- trying only the first break point. infixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)-infixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (requireInfix j) (maybeToList (breakRP tx st0)))+infixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (requireInfixFn j) (maybeToList (breakRP tx st0)))  -- | Right-associative infix parsing. Searches for the operator from START to END of range, -- trying subsequent break points until success. someInfixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)-someInfixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (requireInfix j) (breakAllRP tx st0))+someInfixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (requireInfixFn j) (breakAllRP tx st0))  -- | Take the given number of characters from the start of the range, or fewer if empty takeP :: Monad m => Int -> ParserT e m Text@@ -811,23 +793,49 @@ betweenP :: ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a betweenP px py pa = px *> pa <* py --- | Parse a sequence of items delimited by the first parser-sepByP :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)-sepByP c p = go+repeatTailP :: Monad m => ParserT e m a -> Seq a -> ParserT e m (Seq a)+repeatTailP p = go  where-  go = do+  go !acc = do     ma <- optP p     case ma of-      Nothing -> pure Empty-      Just a -> goNext (Empty :|> a)-  goNext !acc = do-    mc <- optP c-    case mc of       Nothing -> pure acc-      Just _ -> do-        a <- p-        goNext (acc :|> a)+      Just a -> go (acc :|> a) +-- | Repeat a parser until it fails, collecting the results.+repeatP :: Monad m => ParserT e m a -> ParserT e m (Seq a)+repeatP p = repeatTailP p Empty++-- | Like 'repeatP' but ensures at least one result.+repeat1P :: Monad m => ParserT e m a -> ParserT e m (Seq a)+repeat1P p = p >>= repeatTailP p . Seq.singleton++-- private+sepByTailP :: Monad m => ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)+sepByTailP pu pa = go+ where+  go !acc = do+    ma <- optP (pu >> pa)+    case ma of+      Nothing -> pure acc+      Just a -> go (acc :|> a)++-- | Parse a sequence of items delimited by the first parser+sepByP :: Monad m => ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)+sepByP pu pa = optP pa >>= maybe (pure Empty) (sepByTailP pu pa . Seq.singleton)++-- | Like 'sepByP' but ensures at least one result.+sepBy1P :: Monad m => ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)+sepBy1P pu pa = pa >>= sepByTailP pu pa . Seq.singleton++-- | Like 'sepByP' but ensures at least two results (and at least one delimiter).+sepBy2P :: Monad m => ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)+sepBy2P pu pa = do+  a0 <- pa+  pu+  a1 <- pa+  sepByTailP pu pa (Empty :|> a0 :|> a1)+ -- | Consumes many spaces at the start of the range spaceP :: Monad m => ParserT e m () spaceP = void (dropWhileP isSpace)@@ -945,20 +953,6 @@           partS = S.scientific frac (ex - places)       pure (Right (wholeS + partS)) --- | Repeat a parser until it fails, collecting the results.-repeatP :: Monad m => ParserT e m a -> ParserT e m (Seq a)-repeatP p = go Empty- where-  go !acc = do-    ma <- optP p-    case ma of-      Nothing -> pure acc-      Just a -> go (acc :|> a)---- | Like 'repeatP' but ensures at least 1-repeat1P :: Monad m => ParserT e m a -> ParserT e m (Seq a)-repeat1P p = liftA2 (:<|) p (repeatP p)- -- | Like 'spaceP' but ensures at least 1 space removed space1P :: Monad m => ParserT e m () space1P = void (dropWhile1P isSpace)@@ -975,14 +969,6 @@ stripEnd1P :: Monad m => ParserT e m a -> ParserT e m a stripEnd1P p = p <* space1P --- | Like 'sepByP' but ensures at least 1 element-sepBy1P :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)-sepBy1P px pa = liftA2 (:<|) pa (fmap (fromMaybe Empty) (optP (px *> sepByP px pa)))---- | Like 'sepBy1P' but ensures at least 2 elements (i.e. there was a delimiter)-sepBy2P :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)-sepBy2P px pa = liftA2 (:<|) (pa <* px) (sepBy1P px pa)- -- | Implement this to format custom errors. The list will be joined with `unlines`. class HasErrMessage e where   getErrMessage :: e -> [Text]@@ -1002,9 +988,6 @@             let hd = "Custom error:"                 tl = indent 1 (getErrMessage e)             in  hd : tl-          ReasonSplitComp comp n tx len ->-            let op = case comp of SplitCompEQ -> "=="; SplitCompGE -> ">="; SplitCompGT -> ">"-            in  ["Split on \"" <> tx <> "\" with length " <> T.pack (show len) <> " not " <> op <> " " <> T.pack (show n)]           ReasonExpect expected actual ->             ["Expected text: '" <> expected <> "' but found: '" <> actual <> "'"]           ReasonDemand expected actual ->

@@ -65,8 +65,8 @@       , ("end", testEnd)       , ("expectHead", testExpectHead)       , ("expect", testExpect)-      , ("greedy", testGreedy)-      , ("greedy1", testGreedy1)+      , ("repeat", testRepeat)+      , ("repeat1", testRepeat1)       , ("or", testOr)       , ("alt", testAlt)       , ("opt (empty)", testOptEmpty)@@ -93,6 +93,10 @@       , ("someBreak", testSomeBreak)       , ("split", testSplit)       , ("split1", testSplit1)+      , ("split2", testSplit2)+      , ("sepBy", testSepBy)+      , ("sepBy1", testSepBy1)+      , ("sepBy2", testSepBy2)       ]  testEmpty :: [TestTree]@@ -185,10 +189,10 @@     , ParserCase "short" parser "h" (err (Span 1 1) (ReasonExpect "hi" "h"))     ] -testGreedy :: [TestTree]-testGreedy = fmap testParserCase cases+testRepeat :: [TestTree]+testRepeat = fmap testParserCase cases  where-  parser = fmap (T.pack . toList) (greedyP (charP 'h')) :: TestParser Text+  parser = fmap (T.pack . toList) (repeatP (charP 'h')) :: TestParser Text   cases =     [ ParserCase "empty" parser "" (suc "" 0)     , ParserCase "non-empty" parser "hi" (suc "h" 1)@@ -197,10 +201,10 @@     , ParserCase "non-match" parser "bye" (suc "" 3)     ] -testGreedy1 :: [TestTree]-testGreedy1 = fmap testParserCase cases+testRepeat1 :: [TestTree]+testRepeat1 = fmap testParserCase cases  where-  parser = fmap (T.pack . toList) (greedy1P (charP 'h')) :: TestParser Text+  parser = fmap (T.pack . toList) (repeat1P (charP 'h')) :: TestParser Text   cases =     [ ParserCase "empty" parser "" (err (Span 0 0) (ReasonExpect "h" ""))     , ParserCase "non-empty" parser "hi" (suc "h" 1)@@ -515,15 +519,79 @@  where   parser = fmap toList (split1P "+" (takeWhile1P (== 'x')))   cases =-    [ ParserCase "empty" parser "" (err (Span 0 0) (ReasonSplitComp SplitCompGE 1 "+" 0))+    [ ParserCase "empty" parser "" (err (Span 0 0) ReasonTakeNone)     , 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 first" parser "y+x" (err (Span 0 3) ReasonTakeNone)     , ParserCase "fail second" parser "x+y" (suc ["x"] 2)+    ]++testSplit2 :: [TestTree]+testSplit2 = fmap testParserCase cases+ where+  parser = fmap toList (split2P "+" (takeWhile1P (== 'x')))+  cases =+    [ ParserCase "empty" parser "" (err (Span 0 0) ReasonEmpty)+    , ParserCase "single" parser "x" (err (Span 0 1) ReasonEmpty)+    , ParserCase "no delim" parser "xy" (err (Span 0 2) ReasonEmpty)+    , 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" (errInfix (Span 0 3) [(1, InfixPhaseLeft, Span 0 1, ReasonTakeNone)])+    , ParserCase "fail second" parser "x+y" (errInfix (Span 0 3) [(1, InfixPhaseCont, Span 2 3, ReasonTakeNone)])+    ]++testSepBy :: [TestTree]+testSepBy = fmap testParserCase cases+ where+  parser = fmap toList (sepByP (charP_ '+') (takeWhile1P (== 'x')))+  cases =+    [ 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)+    ]++testSepBy1 :: [TestTree]+testSepBy1 = fmap testParserCase cases+ where+  parser = fmap toList (sepBy1P (charP_ '+') (takeWhile1P (== 'x')))+  cases =+    [ ParserCase "empty" parser "" (err (Span 0 0) ReasonTakeNone)+    , 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) ReasonTakeNone)+    , ParserCase "fail second" parser "x+y" (suc ["x"] 2)+    ]++testSepBy2 :: [TestTree]+testSepBy2 = fmap testParserCase cases+ where+  parser = fmap toList (sepBy2P (charP_ '+') (takeWhile1P (== 'x')))+  cases =+    [ ParserCase "empty" parser "" (err (Span 0 0) ReasonTakeNone)+    , ParserCase "single" parser "x" (err (Span 1 1) (ReasonExpect "+" ""))+    , ParserCase "no delim" parser "xy" (err (Span 2 2) (ReasonExpect "+" "y"))+    , 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) ReasonTakeNone)+    , ParserCase "fail second" parser "x+y" (err (Span 2 3) ReasonTakeNone)     ]  testSpan :: TestTree