headed-megaparsec 0.1.0.2 → 0.1.0.3

raw patch · 4 files changed

+432/−299 lines, 4 filesdep ~selectivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: selective

API changes (from Hackage documentation)

Files

• headed-megaparsec.cabal +4/−3
• library/HeadedMegaparsec.hs +0/−296
• library/HeadedMegaparsec/HeadedParsec.hs +296/−0
• library/HeadedMegaparsec/TrailingParsec.hs +132/−0

@@ -1,5 +1,5 @@ name: headed-megaparsec-version: 0.1.0.2+version: 0.1.0.3 category: Parsers, Parsing, Megaparsec synopsis: More informative parser homepage: https://github.com/nikita-volkov/headed-megaparsec@@ -21,7 +21,8 @@   default-extensions: ApplicativeDo, Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language: Haskell2010   exposed-modules:-    HeadedMegaparsec+    HeadedMegaparsec.HeadedParsec+    HeadedMegaparsec.TrailingParsec   other-modules:     HeadedMegaparsec.Megaparsec     HeadedMegaparsec.Prelude@@ -30,4 +31,4 @@     case-insensitive >=1.2 && <2,     megaparsec >=7 && <9,     parser-combinators >=1.1 && <1.3,-    selective >=0.3 && <0.4+    selective >=0.4 && <0.5

@@ -1,296 +0,0 @@-module HeadedMegaparsec-(-  -- * Types-  HeadedParsec,-  -- * Execution-  toParsec,-  -- * Transformation-  wrapToHead,-  label,-  dbg,-  filter,-  -- * Construction-  parse,-  endHead,-)-where--import HeadedMegaparsec.Prelude hiding (try, head, tail, filter)-import Control.Applicative.Combinators-import Text.Megaparsec (Parsec, Stream)-import qualified HeadedMegaparsec.Megaparsec as Megaparsec-import qualified Text.Megaparsec as Megaparsec-import qualified Text.Megaparsec.Debug as Megaparsec-import qualified Text.Megaparsec.Char as MegaparsecChar-import qualified Text.Megaparsec.Char.Lexer as MegaparsecLexer--{- $setup-->>> :set -XApplicativeDo---}---- * Types----------------------------{-|-Headed parser.--Abstracts over explicit composition between consecutive megaparsec `try` blocks,-providing for better error messages.--With headed parser you don't need to use `try` at all.--==__Examples__-->>> import qualified Text.Megaparsec as M->>> import qualified Text.Megaparsec.Char as M->>> import qualified Text.Megaparsec.Char.Lexer as ML->>> :{-  let-    select :: HeadedParsec Void String (Maybe [Either Char Int], Maybe Int)-    select = do-      string' "select"-      endHead-      _targets <- optional (space1 *> targets)-      _limit <- optional (space1 *> limit)-      return (_targets, _limit)-      where-        -- Lifted versions of basic parsers:-        char = parse . M.char-        space = parse M.space-        space1 = parse M.space1-        decimal = parse ML.decimal-        string' = parse . M.string'-        -- Syntax parsers:-        targets = sepBy1 target commaSeparator-        target = Left <$> char '*' <|> Right <$> decimal-        commaSeparator = space *> char ',' *> endHead *> space-        limit = string' "limit" *> endHead *> space1 *> decimal-    test :: String -> IO ()-    test = M.parseTest (toParsec select <* M.eof)-:}-->>> test "select 1, "-1:11:-  |-1 | select 1, -  |           ^-unexpected end of input-expecting '*', integer, or white space-->>> test "select limit "-...-unexpected end of input-expecting integer or white space-->>> test "select 1, 2 limit 2"-(Just [Right 1,Right 2],Just 2)---}-newtype HeadedParsec err strm a = HeadedParsec (Parsec err strm (Either a (Parsec err strm a)))--{-|-A helper required for hacking `dbg`.--}-data Showable a = Showable String a----- * Instances------------------------------ ** Showable----------------------------instance Show (Showable a) where-  show (Showable msg _) = msg---- ** HeadedParsec----------------------------instance Functor (HeadedParsec err strm) where-  fmap fn (HeadedParsec p) = HeadedParsec (fmap (bimap fn (fmap fn)) p)--instance (Ord err, Stream strm) => Applicative (HeadedParsec err strm) where-  pure = HeadedParsec . pure . Left-  (<*>) (HeadedParsec p1) (HeadedParsec p2) = HeadedParsec $ do-    junction1 <- p1-    case junction1 of-      Left aToB -> do-        junction2 <- p2-        case junction2 of-          Left a -> return (Left (aToB a))-          Right tailP2 -> return $ Right $ do-            a <- tailP2-            return (aToB a)-      Right tailP1 -> return $ Right $ do-        aToB <- tailP1-        junction2 <- p2-        case junction2 of-          Left a -> return (aToB a)-          Right tailP2 -> do-            a <- tailP2-            return (aToB a)--instance (Ord err, Stream strm) => Selective (HeadedParsec err strm) where-  select (HeadedParsec p1) (HeadedParsec p2) = HeadedParsec $ do-    junction1 <- p1-    case junction1 of-      Left eitherAOrB -> case eitherAOrB of-        Right b -> return (Left b)-        Left a -> do-          junction2 <- p2-          case junction2 of-            Left aToB -> return (Left (aToB a))-            Right tailP2 -> return (Right (fmap ($ a) tailP2))-      Right tailP1 -> return $ Right $ do-        eitherAOrB <- tailP1-        case eitherAOrB of-          Right b -> return b-          Left a -> do-            junction2 <- p2-            case junction2 of-              Left aToB -> return (aToB a)-              Right tailP2 -> fmap ($ a) tailP2--instance (Ord err, Stream strm) => Monad (HeadedParsec err strm) where-  return = pure-  (>>=) (HeadedParsec p1) k2 = HeadedParsec $ do-    junction1 <- p1-    case junction1 of-      Left a -> case k2 a of HeadedParsec p2 -> p2-      Right tailP1 -> return $ Right $ do-        a <- tailP1-        Megaparsec.contPossibly $ case k2 a of HeadedParsec p2 -> p2--{-|-Alternation is performed only the basis of heads.-Bodies do not participate.--}-instance (Ord err, Stream strm) => Alternative (HeadedParsec err strm) where-  empty = HeadedParsec empty-  (<|>) (HeadedParsec p1) (HeadedParsec p2) = HeadedParsec (Megaparsec.try p1 <|> p2)--{-|-Alternation is performed only the basis of heads.-Bodies do not participate.--}-instance (Ord err, Stream strm) => MonadPlus (HeadedParsec err strm) where-  mzero = empty-  mplus = (<|>)--instance (Ord err, Stream strm) => MonadFail (HeadedParsec err strm) where-  fail = HeadedParsec . fail----- * Execution----------------------------{-|-Convert headed parser into megaparsec parser.--}-toParsec :: (Ord err, Stream strm) => HeadedParsec err strm a -> Parsec err strm a-toParsec (HeadedParsec p) = Megaparsec.contPossibly p----- * Helpers----------------------------mapParsec :: (Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1)) -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2))) -> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2-mapParsec fn (HeadedParsec p) = HeadedParsec (fn p)----- * Transformation----------------------------{-|-Wrap a parser to be usable as a whole in a head block,-allowing it in effect to be composed with the following parsers into a single `try` when executed,-no matter whether it contains `endHead` or not.--}-wrapToHead :: (Ord err, Stream strm) => HeadedParsec err strm a -> HeadedParsec err strm a-wrapToHead = mapParsec $ fmap Left . Megaparsec.contPossibly--{-|-Label a headed parser.-Works the same way as megaparsec's `Megaparsec.label`.--}-label :: (Ord err, Stream strm) => String -> HeadedParsec err strm a -> HeadedParsec err strm a-label label = mapParsec (Megaparsec.label label)--{-|-Make a parser print debugging information when evaluated.-The first parameter is a custom label.--This function is a wrapper around `Megaparsec.dbg`.-It generates two debugging entries: one for head and one for tail.--}-dbg :: (Ord err, Megaparsec.ShowErrorComponent err, Stream strm, Show a) => String -> HeadedParsec err strm a -> HeadedParsec err strm a-dbg label = mapParsec $ \ p -> do-  Showable _ junction <- Megaparsec.dbg (label <> "/head") (fmap (either (\ a -> Showable (show a) (Left a)) (Showable "<tail parser>" . Right)) p)-  case junction of-    Left a -> return (Left a)-    Right tailP -> return $ Right $ Megaparsec.dbg (label <> "/tail") tailP--{-|-Filter the results of parser based on a predicate,-failing with a parameterized message.--}-filter :: (Ord err, Stream strm) => (a -> String) -> (a -> Bool) -> HeadedParsec err strm a -> HeadedParsec err strm a-filter err pred = mapParsec $ \ p -> do-  junction <- p-  case junction of-    Left a -> if pred a-      then return (Left a)-      else fail (err a)-    Right tailP -> return $ Right $ do-      a <- tailP-      if pred a-        then return a-        else fail (err a)----- *----------------------------{-|-Lift a megaparsec parser as a head parser.--}-head :: (Ord err, Stream strm) => Parsec err strm a -> HeadedParsec err strm a-head = HeadedParsec . fmap Left--{-|-Lift a megaparsec parser as a tail parser.--Composing consecutive tails results in one tail.--Composing consecutive head and tail leaves the head still composable with preceding head.--}-tail :: (Stream strm) => Parsec err strm a -> HeadedParsec err strm a-tail = HeadedParsec . return . Right--{-|-Lift both head and tail megaparsec parsers, composing their results.--}-headAndTail :: (Ord err, Stream strm) => (head -> tail -> a) -> Parsec err strm head -> Parsec err strm tail -> HeadedParsec err strm a-headAndTail fn headP tailP = HeadedParsec $ do-  a <- headP-  return $ Right $ do-    b <- tailP-    return (fn a b)--{-|-Lift a megaparsec parser.--}-parse :: (Ord err, Stream strm) => Parsec err strm a -> HeadedParsec err strm a-parse = head----- * Control----------------------------{-|-Make all the following parsers compose as tail.--}-endHead :: (Stream strm) => HeadedParsec err strm ()-endHead = HeadedParsec (return (Right (return ())))

@@ -0,0 +1,296 @@+module HeadedMegaparsec.HeadedParsec+(+  -- * Types+  HeadedParsec,+  -- * Execution+  toParsec,+  -- * Transformation+  wrapToHead,+  label,+  dbg,+  filter,+  -- * Construction+  parse,+  endHead,+)+where++import HeadedMegaparsec.Prelude hiding (try, head, tail, filter)+import Control.Applicative.Combinators+import Text.Megaparsec (Parsec, Stream)+import qualified HeadedMegaparsec.Megaparsec as Megaparsec+import qualified Text.Megaparsec as Megaparsec+import qualified Text.Megaparsec.Debug as Megaparsec+import qualified Text.Megaparsec.Char as MegaparsecChar+import qualified Text.Megaparsec.Char.Lexer as MegaparsecLexer++{- $setup++>>> :set -XApplicativeDo++-}++-- * Types+-------------------------++{-|+Headed parser.++Abstracts over explicit composition between consecutive megaparsec `try` blocks,+providing for better error messages.++With headed parser you don't need to use `try` at all.++==__Examples__++>>> import qualified Text.Megaparsec as M+>>> import qualified Text.Megaparsec.Char as M+>>> import qualified Text.Megaparsec.Char.Lexer as ML+>>> :{+  let+    select :: HeadedParsec Void String (Maybe [Either Char Int], Maybe Int)+    select = do+      string' "select"+      endHead+      _targets <- optional (space1 *> targets)+      _limit <- optional (space1 *> limit)+      return (_targets, _limit)+      where+        -- Lifted versions of basic parsers:+        char = parse . M.char+        space = parse M.space+        space1 = parse M.space1+        decimal = parse ML.decimal+        string' = parse . M.string'+        -- Syntax parsers:+        targets = sepBy1 target commaSeparator+        target = Left <$> char '*' <|> Right <$> decimal+        commaSeparator = space *> char ',' *> endHead *> space+        limit = string' "limit" *> endHead *> space1 *> decimal+    test :: String -> IO ()+    test = M.parseTest (toParsec select <* M.eof)+:}++>>> test "select 1, "+1:11:+  |+1 | select 1, +  |           ^+unexpected end of input+expecting '*', integer, or white space++>>> test "select limit "+...+unexpected end of input+expecting integer or white space++>>> test "select 1, 2 limit 2"+(Just [Right 1,Right 2],Just 2)++-}+newtype HeadedParsec err strm a = HeadedParsec (Parsec err strm (Either a (Parsec err strm a)))++{-|+A helper required for hacking `dbg`.+-}+data Showable a = Showable String a+++-- * Instances+-------------------------++-- ** Showable+-------------------------++instance Show (Showable a) where+  show (Showable msg _) = msg++-- ** HeadedParsec+-------------------------++instance Functor (HeadedParsec err strm) where+  fmap fn (HeadedParsec p) = HeadedParsec (fmap (bimap fn (fmap fn)) p)++instance (Ord err, Stream strm) => Applicative (HeadedParsec err strm) where+  pure = HeadedParsec . pure . Left+  (<*>) (HeadedParsec p1) (HeadedParsec p2) = HeadedParsec $ do+    junction1 <- p1+    case junction1 of+      Left aToB -> do+        junction2 <- p2+        case junction2 of+          Left a -> return (Left (aToB a))+          Right tailP2 -> return $ Right $ do+            a <- tailP2+            return (aToB a)+      Right tailP1 -> return $ Right $ do+        aToB <- tailP1+        junction2 <- p2+        case junction2 of+          Left a -> return (aToB a)+          Right tailP2 -> do+            a <- tailP2+            return (aToB a)++instance (Ord err, Stream strm) => Selective (HeadedParsec err strm) where+  select (HeadedParsec p1) (HeadedParsec p2) = HeadedParsec $ do+    junction1 <- p1+    case junction1 of+      Left eitherAOrB -> case eitherAOrB of+        Right b -> return (Left b)+        Left a -> do+          junction2 <- p2+          case junction2 of+            Left aToB -> return (Left (aToB a))+            Right tailP2 -> return (Right (fmap ($ a) tailP2))+      Right tailP1 -> return $ Right $ do+        eitherAOrB <- tailP1+        case eitherAOrB of+          Right b -> return b+          Left a -> do+            junction2 <- p2+            case junction2 of+              Left aToB -> return (aToB a)+              Right tailP2 -> fmap ($ a) tailP2++instance (Ord err, Stream strm) => Monad (HeadedParsec err strm) where+  return = pure+  (>>=) (HeadedParsec p1) k2 = HeadedParsec $ do+    junction1 <- p1+    case junction1 of+      Left a -> case k2 a of HeadedParsec p2 -> p2+      Right tailP1 -> return $ Right $ do+        a <- tailP1+        Megaparsec.contPossibly $ case k2 a of HeadedParsec p2 -> p2++{-|+Alternation is performed only the basis of heads.+Bodies do not participate.+-}+instance (Ord err, Stream strm) => Alternative (HeadedParsec err strm) where+  empty = HeadedParsec empty+  (<|>) (HeadedParsec p1) (HeadedParsec p2) = HeadedParsec (Megaparsec.try p1 <|> p2)++{-|+Alternation is performed only the basis of heads.+Bodies do not participate.+-}+instance (Ord err, Stream strm) => MonadPlus (HeadedParsec err strm) where+  mzero = empty+  mplus = (<|>)++instance (Ord err, Stream strm) => MonadFail (HeadedParsec err strm) where+  fail = HeadedParsec . fail+++-- * Execution+-------------------------++{-|+Convert headed parser into megaparsec parser.+-}+toParsec :: (Ord err, Stream strm) => HeadedParsec err strm a -> Parsec err strm a+toParsec (HeadedParsec p) = Megaparsec.contPossibly p+++-- * Helpers+-------------------------++mapParsec :: (Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1)) -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2))) -> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2+mapParsec fn (HeadedParsec p) = HeadedParsec (fn p)+++-- * Transformation+-------------------------++{-|+Wrap a parser to be usable as a whole in a head block,+allowing it in effect to be composed with the following parsers into a single `try` when executed,+no matter whether it contains `endHead` or not.+-}+wrapToHead :: (Ord err, Stream strm) => HeadedParsec err strm a -> HeadedParsec err strm a+wrapToHead = mapParsec $ fmap Left . Megaparsec.contPossibly++{-|+Label a headed parser.+Works the same way as megaparsec's `Megaparsec.label`.+-}+label :: (Ord err, Stream strm) => String -> HeadedParsec err strm a -> HeadedParsec err strm a+label label = mapParsec (Megaparsec.label label)++{-|+Make a parser print debugging information when evaluated.+The first parameter is a custom label.++This function is a wrapper around `Megaparsec.dbg`.+It generates two debugging entries: one for head and one for tail.+-}+dbg :: (Ord err, Megaparsec.ShowErrorComponent err, Stream strm, Show a) => String -> HeadedParsec err strm a -> HeadedParsec err strm a+dbg label = mapParsec $ \ p -> do+  Showable _ junction <- Megaparsec.dbg (label <> "/head") (fmap (either (\ a -> Showable (show a) (Left a)) (Showable "<tail parser>" . Right)) p)+  case junction of+    Left a -> return (Left a)+    Right tailP -> return $ Right $ Megaparsec.dbg (label <> "/tail") tailP++{-|+Filter the results of parser based on a predicate,+failing with a parameterized message.+-}+filter :: (Ord err, Stream strm) => (a -> String) -> (a -> Bool) -> HeadedParsec err strm a -> HeadedParsec err strm a+filter err pred = mapParsec $ \ p -> do+  junction <- p+  case junction of+    Left a -> if pred a+      then return (Left a)+      else fail (err a)+    Right tailP -> return $ Right $ do+      a <- tailP+      if pred a+        then return a+        else fail (err a)+++-- *+-------------------------++{-|+Lift a megaparsec parser as a head parser.+-}+head :: (Ord err, Stream strm) => Parsec err strm a -> HeadedParsec err strm a+head = HeadedParsec . fmap Left++{-|+Lift a megaparsec parser as a tail parser.++Composing consecutive tails results in one tail.++Composing consecutive head and tail leaves the head still composable with preceding head.+-}+tail :: (Stream strm) => Parsec err strm a -> HeadedParsec err strm a+tail = HeadedParsec . return . Right++{-|+Lift both head and tail megaparsec parsers, composing their results.+-}+headAndTail :: (Ord err, Stream strm) => (head -> tail -> a) -> Parsec err strm head -> Parsec err strm tail -> HeadedParsec err strm a+headAndTail fn headP tailP = HeadedParsec $ do+  a <- headP+  return $ Right $ do+    b <- tailP+    return (fn a b)++{-|+Lift a megaparsec parser.+-}+parse :: (Ord err, Stream strm) => Parsec err strm a -> HeadedParsec err strm a+parse = head+++-- * Control+-------------------------++{-|+Make all the following parsers compose as tail.+-}+endHead :: (Stream strm) => HeadedParsec err strm ()+endHead = HeadedParsec (return (Right (return ())))

@@ -0,0 +1,132 @@+module HeadedMegaparsec.TrailingParsec+(+  TrailingParsec,+  -- * Execution+  toHeadedParsec,+  toParsec,+  -- * Transformation+  label,+  dbg,+  filter,+  -- * Construction+  parse,+  parseHeaded,+  endHead,+)+where++import HeadedMegaparsec.Prelude hiding (try, head, tail, filter)+import HeadedMegaparsec.HeadedParsec (HeadedParsec)+import Control.Applicative.Combinators+import Text.Megaparsec (Parsec, Stream)+import qualified HeadedMegaparsec.Megaparsec as Megaparsec+import qualified Text.Megaparsec as Megaparsec+import qualified Text.Megaparsec.Debug as Megaparsec+import qualified Text.Megaparsec.Char as MegaparsecChar+import qualified Text.Megaparsec.Char.Lexer as MegaparsecLexer+import qualified HeadedMegaparsec.HeadedParsec as HeadedParsec+++{-|+Accumulates the sequently composed alternatives,+alternating between all combinations when executed.+-}+newtype TrailingParsec err strm a = TrailingParsec [HeadedParsec err strm a]++deriving instance Functor (TrailingParsec err strm)++instance (Ord err, Stream strm) => Applicative (TrailingParsec err strm) where+  pure a = TrailingParsec [pure a]+  (<*>) = ap++instance (Ord err, Stream strm) => Selective (TrailingParsec err strm) where+  select = selectA++instance (Ord err, Stream strm) => Monad (TrailingParsec err strm) where+  return = pure+  (>>=) (TrailingParsec l1) k2 = TrailingParsec $ do+    hp1 <- l1+    return $ do+      a <- HeadedParsec.wrapToHead hp1+      toHeadedParsec (k2 a)++instance (Ord err, Stream strm) => Alternative (TrailingParsec err strm) where+  empty = TrailingParsec []+  (<|>) (TrailingParsec l1) (TrailingParsec l2) = TrailingParsec (l1 <> l2)++instance (Ord err, Stream strm) => MonadPlus (TrailingParsec err strm) where+  mzero = empty+  mplus = (<|>)++instance (Ord err, Stream strm) => MonadFail (TrailingParsec err strm) where+  fail = TrailingParsec . fail+++-- * Execution+-------------------------++toHeadedParsec :: (Ord err, Stream strm) => TrailingParsec err strm a -> HeadedParsec err strm a+toHeadedParsec (TrailingParsec l) = asum l++toParsec :: (Ord err, Stream strm) => TrailingParsec err strm a -> Parsec err strm a+toParsec = HeadedParsec.toParsec . toHeadedParsec+++-- * Helpers+-------------------------++mapHeadedParsec fn (TrailingParsec l) = TrailingParsec (fmap fn l)+++-- * Transformation+-------------------------++{-|+Label a headed parser.+Works the same way as megaparsec's `Megaparsec.label`.+-}+label :: (Ord err, Stream strm) => String -> TrailingParsec err strm a -> TrailingParsec err strm a+label label = mapHeadedParsec (HeadedParsec.label label)++{-|+Make a parser print debugging information when evaluated.+The first parameter is a custom label.++This function is a wrapper around `Megaparsec.dbg`.+It generates two debugging entries: one for head and one for tail.+-}+dbg :: (Ord err, Megaparsec.ShowErrorComponent err, Stream strm, Show a) => String -> TrailingParsec err strm a -> TrailingParsec err strm a+dbg label = mapHeadedParsec (HeadedParsec.dbg label)++{-|+Filter the results of parser based on a predicate,+failing with a parameterized message.+-}+filter :: (Ord err, Stream strm) => (a -> String) -> (a -> Bool) -> TrailingParsec err strm a -> TrailingParsec err strm a+filter err pred = mapHeadedParsec (HeadedParsec.filter err pred)+++-- *+-------------------------++{-|+Lift a megaparsec parser.+-}+parse :: (Ord err, Stream strm) => Parsec err strm a -> TrailingParsec err strm a+parse = parseHeaded . HeadedParsec.parse++{-|+Lift a headed parser.+-}+parseHeaded :: (Ord err, Stream strm) => HeadedParsec err strm a -> TrailingParsec err strm a+parseHeaded = TrailingParsec . pure+++-- * Control+-------------------------++{-|+Make all the following parsers compose as tail.+-}+endHead :: (Stream strm) => TrailingParsec err strm ()+endHead = TrailingParsec [HeadedParsec.endHead]