packages feed

headed-megaparsec 0.2.0.2 → 0.2.1

raw patch · 5 files changed

+192/−223 lines, 5 filesdep ~megaparsecdep ~parser-combinatorssetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: megaparsec, parser-combinators

API changes (from Hackage documentation)

+ HeadedMegaparsec: hidden :: (Ord err, Stream strm) => HeadedParsec err strm a -> HeadedParsec err strm a

Files

− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
headed-megaparsec.cabal view
@@ -1,5 +1,5 @@ name: headed-megaparsec-version: 0.2.0.2+version: 0.2.1 category: Parsers, Parsing, Megaparsec synopsis: More informative parser homepage: https://github.com/nikita-volkov/headed-megaparsec@@ -28,6 +28,6 @@   build-depends:     base >=4.12 && <5,     case-insensitive >=1.2 && <2,-    megaparsec >=9 && <10,-    parser-combinators >=1.1 && <1.4,+    megaparsec >=9.2 && <10,+    parser-combinators >=1.3 && <1.4,     selective >=0.5 && <0.6
library/HeadedMegaparsec.hs view
@@ -1,115 +1,108 @@ module HeadedMegaparsec-(-  -- * Types-  HeadedParsec,-  -- * Execution-  toParsec,-  -- * Transformation-  wrapToHead,-  label,-  dbg,-  filter,-  -- * Construction-  parse,-  endHead,-)+  ( -- * Types+    HeadedParsec,++    -- * Execution+    toParsec,++    -- * Transformation+    wrapToHead,+    label,+    hidden,+    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 HeadedMegaparsec.Prelude hiding (filter, head, tail, try)+import Text.Megaparsec (Parsec, Stream) 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+import qualified Text.Megaparsec.Debug as Megaparsec --}+-- $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 Prelude->>> import Control.Applicative->>> import Data.Void->>> 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 = M.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)---}+-- |+-- 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 Prelude+-- >>> import Control.Applicative+-- >>> import Data.Void+-- >>> 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 = M.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`.--}+-- |+-- 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)@@ -123,17 +116,19 @@         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)+          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@@ -146,15 +141,16 @@           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+      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@@ -162,22 +158,21 @@     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+      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.--}+-- |+-- 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.--}+-- |+-- 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 = (<|>)@@ -185,115 +180,103 @@ instance (Ord err, Stream strm) => MonadFail (HeadedParsec err strm) where   fail = HeadedParsec . fail - -- * Execution-------------------------- -{-|-Convert headed parser into megaparsec parser.--}+-- |+-- 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.--}+-- |+-- 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 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.+-- |+-- Adaptation of 'Megaparsec.hidden'.+hidden :: (Ord err, Stream strm) => HeadedParsec err strm a -> HeadedParsec err strm a+hidden = mapParsec Megaparsec.hidden -This function is a wrapper around `Megaparsec.dbg`.-It generates two debugging entries: one for head and one for tail.--}+-- |+-- 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, Megaparsec.VisualStream 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)+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 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+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+    Left a ->       if pred a-        then return 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.--}+-- |+-- 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.--}+-- |+-- 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.--}+-- |+-- 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)+  return $+    Right $ do+      b <- tailP+      return (fn a b) -{-|-Lift a megaparsec parser.--}+-- |+-- 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.--}+-- |+-- Make all the following parsers compose as tail. endHead :: (Stream strm) => HeadedParsec err strm () endHead = HeadedParsec (return (Right (return ())))
library/HeadedMegaparsec/Megaparsec.hs view
@@ -1,15 +1,12 @@-{-|-Extra megaparsec combinators.--}-module HeadedMegaparsec.Megaparsec-where+-- |+-- Extra megaparsec combinators.+module HeadedMegaparsec.Megaparsec where -import HeadedMegaparsec.Prelude hiding (try, head, body)-import Text.Megaparsec hiding (some, endBy1, someTill, sepBy1, sepEndBy1)-import Text.Megaparsec.Char import Control.Applicative.Combinators+import HeadedMegaparsec.Prelude hiding (body, head, try)+import Text.Megaparsec hiding (endBy1, sepBy1, sepEndBy1, some, someTill)+import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as Lexer-  contPossibly :: (Ord err, Stream strm) => Parsec err strm (Either a (Parsec err strm a)) -> Parsec err strm a contPossibly p = do
library/HeadedMegaparsec/Prelude.hs view
@@ -1,24 +1,23 @@ module HeadedMegaparsec.Prelude-( -  module Exports,-)+  ( module Exports,+  ) where --- base-------------------------- import Control.Applicative as Exports import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports-import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports+import Control.Selective as Exports import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports+import Data.CaseInsensitive as Exports (CI, FoldCase) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports@@ -30,18 +29,18 @@ import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports import Data.Functor.Identity as Exports-import Data.Int as Exports import Data.IORef as Exports+import Data.Int as Exports import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.List.NonEmpty as Exports (NonEmpty(..))+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports-import Data.Monoid as Exports hiding (Last(..), First(..), (<>))+import Data.Monoid as Exports hiding (First (..), Last (..), (<>)) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports-import Data.Semigroup as Exports import Data.STRef as Exports+import Data.Semigroup as Exports import Data.String as Exports import Data.Traversable as Exports import Data.Tuple as Exports@@ -53,13 +52,12 @@ import Foreign.ForeignPtr as Exports import Foreign.Ptr as Exports import Foreign.StablePtr as Exports-import Foreign.Storable as Exports hiding (sizeOf, alignment)-import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(fromList, Item))+import Foreign.Storable as Exports hiding (alignment, sizeOf)+import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (IsList (Item, fromList), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic, Generic1) import GHC.IO.Exception as Exports import Numeric as Exports-import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports@@ -69,15 +67,8 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports---- selective---------------------------import Control.Selective as Exports---- case-insensitive---------------------------import Data.CaseInsensitive as Exports (CI, FoldCase)+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))