LParse 0.2.3.0 → 0.3.0.0

raw patch · 11 files changed

+460/−230 lines, 11 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• LICENSE +1/−1
• LParse.cabal +3/−3
• src/Control/DoubleContinuations.hs +55/−47
• src/Text/LParse/Atomics.hs +0/−87
• src/Text/LParse/Metaparser.hs +179/−0
• src/Text/LParse/Parser.hs +13/−3
• src/Text/LParse/Prebuilt.hs +151/−0
• src/Text/LParse/TokenStream.hs +14/−18
• src/Text/LParse/Transformers.hs +0/−62
• test/Test.hs +27/−9

@@ -1,5 +1,22 @@ # Changelog +## 0.3++Highlights:++* Adding `Metaparser`, a parser that constructs a parser from a grammar similar to EBNF++### 0.3.0++* Merged `Atomics` and `Transformers` into `Prebuilt`+* Removed deprecated `skipN`+* Renamed `TokenStream` functions to share the names of `Prelude` functions on lists+* Added `Metaparser`, a parser parsing a grammar into a parser+* Added `pfix`, a fixed point combinator for parsers depending on their own result+* Added convenience function `wrap` to `DCont`+* Added `forceParse` function to parse assuming success+* Added `surround` parser transformer for parsing parenthesised expressions+ ## 0.2  Highlights:

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2017 Marcus Völker+Copyright (c) 2017-2018 Marcus Völker  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,5 +1,5 @@ name:                LParse-version:             0.2.3.0+version:             0.3.0.0 synopsis:            A continuation-based parser library description:         A parser library using continuations with a possibility for failure to build parsers in a clear and concise manner. homepage:            https://github.com/MarcusVoelker/LParse#readme@@ -15,8 +15,8 @@  library   hs-source-dirs:      src-  exposed-modules:     Control.DoubleContinuations Text.LParse.Atomics, Text.LParse.Parser, Text.LParse.Transformers, Text.LParse.TokenStream-  build-depends:       base >= 4.7 && < 5+  exposed-modules:     Control.DoubleContinuations, Text.LParse.Metaparser, Text.LParse.Parser, Text.LParse.Prebuilt, Text.LParse.TokenStream+  build-depends:       base >= 4.7 && < 5, containers   default-language:    Haskell2010  source-repository head

@@ -1,48 +1,56 @@-{-|
-Module      : Control.DoubleContinuations 
-Description : Continuations that can succeed or fail
-Copyright   : (c) Marcus Völker, 2017
-License     : MIT
-Maintainer  : marcus.voelker@rwth-aachen.de
-
-This module describes DoubleContinuations, which are Continuations that may have succeeded or failed.
-Instead of just taking a single function (a -> r) -> r to execute after the computation has run,
-a double continuation takes two functions: one to call in case of success and one to call in case of error
-This allows for easy implementation of exception handling and structuring control flow in a pass/fail manner
--}
-module Control.DoubleContinuations where 
-
-import Control.Applicative
-import Control.Monad
-import Data.Either
-
--- | The double continuation. Takes two functions, one to invoke if the computation is successful, one if it errors
-data DCont r e a = DCont {run :: (a -> r) -> (e -> r) -> r}
-
--- | Generates a continuation that always fails. For a continuation that always succeeds, see return
-throw :: e  -- ^ The error to return
-    -> DCont r e a
-throw x = DCont (\_ g -> g x)
-
--- | Binding a Continuation means running it, then feeding the result into f to generate a new continuation, and running that
-instance Monad (DCont r e) where
-    return x = DCont (\f _ -> f x)
-    c >>= f = DCont (\btr etr -> run c (\x -> run (f x) btr etr) etr)
-
--- | via Monad/Functor laws
-instance Functor (DCont r e) where
-    fmap = liftM
-
--- | via Monad/Applicative laws
-instance Applicative (DCont r e) where
-    pure = return
-    f <*> a = f >>= (<$> a)
-
--- | An empty alternative just fails with an undefined error. Branching means first trying one, and in case of failure, the other
-instance Alternative (DCont r e) where
-    empty = throw undefined
-    p1 <|> p2 = DCont (\atr etr -> run p1 atr (\_ -> run p2 atr etr))
-
--- | Convenience function to run a computation and put the result into an Either (with Left being the error and Right being the success)
-invoke :: DCont (Either e a) e a -> (Either e a)
+{-|+Module      : Control.DoubleContinuations +Description : Continuations that can succeed or fail+Copyright   : (c) Marcus Völker, 2017-2018+License     : MIT+Maintainer  : marcus.voelker@rwth-aachen.de++This module describes DoubleContinuations, which are Continuations that may have succeeded or failed.+Instead of just taking a single function (a -> r) -> r to execute after the computation has run,+a double continuation takes two functions: one to call in case of success and one to call in case of error+This allows for easy implementation of exception handling and structuring control flow in a pass/fail manner+-}+module Control.DoubleContinuations where ++import Control.Applicative+import Control.Monad+import Data.Either++-- | The double continuation. Takes two functions, one to invoke if the computation is successful, one if it errors+data DCont r e a = DCont {run :: (a -> r) -> (e -> r) -> r}++-- | Generates a continuation that always fails. For a continuation that always succeeds, see return+throw :: e  -- ^ The error to return+    -> DCont r e a+throw x = DCont (\_ g -> g x)++-- | Binding a Continuation means running it, then feeding the result into f to generate a new continuation, and running that+instance Monad (DCont r e) where+    return x = DCont (\f _ -> f x)+    c >>= f = DCont (\btr etr -> run c (\x -> run (f x) btr etr) etr)++-- | @MonadFix@-analogue for DoubleContinuations. Since it doesn't fit in the signature of @mfix@, it is defined separately+dfix :: (Either e a -> DCont (Either e a) e a) -> DCont r e a+dfix f = let ea = run (f ea) Right Left in wrap ea++-- | via Monad/Functor laws+instance Functor (DCont r e) where+    fmap = liftM++-- | via Monad/Applicative laws+instance Applicative (DCont r e) where+    pure = return+    f <*> a = f >>= (<$> a)++-- | An empty alternative just fails with an undefined error. Branching means first trying one, and in case of failure, the other+instance Alternative (DCont r e) where+    empty = throw undefined+    p1 <|> p2 = DCont (\atr etr -> run p1 atr (\_ -> run p2 atr etr))++-- | Convenience function to run a computation and put the result into an Either (with Left being the error and Right being the success)+invoke :: DCont (Either e a) e a -> Either e a invoke c = run c Right Left++-- | Convenience function to put an @Either@ into a @DCont@+wrap :: Either e a -> DCont r e a+wrap = either throw return

@@ -1,87 +0,0 @@-{-|-Module      : Text.LParse.Atomics-Description : Atomic parsers for use with LParse-Copyright   : (c) Marcus Völker, 2017-License     : MIT-Maintainer  : marcus.voelker@rwth-aachen.de--This module implements LParse's atomic parsers, i.e., parsers that are not built up from other parsers.--}-module Text.LParse.Atomics where --import Control.DoubleContinuations--import Control.Applicative-import Control.Monad-import Data.Char-import Text.LParse.Parser-import Text.LParse.Transformers-import Text.LParse.TokenStream---- | A parser that always succeeds, parses nothing and returns unit-noop :: Parser r t ()-noop = return ()---- | A parser that consumes the whole input and returns it unchanged-full :: Parser r [t] [t]-full = many tokenReturn---- | A parser that consumes the whole input and discards it, successfully-discard :: Parser r [t] ()-discard = void full---- | A parser that parses nothing, but only succeeds if the input is empty-eoi :: Parser r [t] ()-eoi = cParse null noop ("Input not fully consumed")---- | Extracts the first token from the input and applies the given function to it-tokenParse :: (TokenStream s) => (t -> a) -> Parser r (s t) a-tokenParse f = Parser (\s -> DCont (\btr etr -> if null s then etr "Unexpected EOI" else btr (f $ top s,rest s)))---- | Consumes and returns the first token of the input-tokenReturn :: (TokenStream s) => Parser r (s a) a-tokenReturn = tokenParse id---- | Succeeds exactly if the input begins with the given sequence. On success, consumes that sequence-consume :: (Eq t, Show (s t), TokenStream s) => (s t) -> Parser r (s t) ()-consume pre = cParse ((&&) <$> (all id . sZipWith (==) pre) <*> ((>= length pre) . length)) (pParse (sDrop (length pre)) noop) ("Expected " ++ show pre)---- | Succeeds exactly if the input begins with the given token. On success, consumes that token-consumeSingle :: (Eq t, Show t, TokenStream s) => t -> Parser r (s t) ()-consumeSingle t = cParse (\s -> not (null s) && top s == t) (pParse rest noop) ("Expected " ++ show t)---- | Extracts the first digit and returns it-digit :: Parser r String Integer-digit = read . return <$> cParse (\s -> not (null s) && isDigit (head s)) tokenReturn "Expected digit"---- | Extracts the first digit and returns it-letter :: Parser r String Char-letter = cParse (\s -> not (null s) && isLetter (head s)) tokenReturn "Expected letter"---- | Extracts the first word (i.e. contiguous string of letters) from the input and returns it-word :: Parser r String String-word = some letter ---- | Extracts the first integer (i.e. contiguous string of digits) from the input and returns it-integer :: Parser r String Integer-integer = foldl (\x y -> x*10+y) 0 <$> some digit---- | Extracts the first signed integer (i.e. contiguous string of digits) from the input and returns it-sInteger :: Parser r String Integer-sInteger = (\m i -> case m of (Just _) -> -i; Nothing -> i) <$> try (consumeSingle '-') <*> integer---- | Succeeds if the first token matches the given function, without consuming it-peek :: (TokenStream s) => (t -> Bool) -> String -> Parser r (s t) ()-peek c = cParse (c . top) noop---- | A parser that always succeeds with the given function-success :: (t -> (a,t)) -> Parser r t a-success = Parser . (return .)---- | Parses an integer by removing a single digit in the given base from it. Zero is considered to have no digits-bDigit :: Integer -> Parser r Integer Integer-bDigit b = cParse (> 0) (success (\i -> (i `mod` b,i `div` b))) "Empty number!"---- | Parses an integer by removing a single digit in the given base from it. Zero is considered to have no digits-bDigits :: Integer -> Parser r Integer [Integer]-bDigits b = many $ bDigit b

@@ -0,0 +1,179 @@+{-|+Module      : Text.LParse.Metaparser+Description : Underlying data structure for sequential parsing+Copyright   : (c) Marcus Völker, 2018+License     : MIT+Maintainer  : marcus.voelker@rwth-aachen.de++This module contains the Metaparser, which is a parser that parses a grammar in EBNF and returns a parser that parses that grammar into an AST+-}+module Text.LParse.Metaparser (specParse,metaParser,AST) where++import Control.Applicative+import Control.Arrow+import Control.Monad.Fix++import Data.Char+import Data.List+import qualified Data.Map.Strict as M+import Data.Maybe++import Text.LParse.Parser+import Text.LParse.Prebuilt++data Token = Literal Char | CharClass String | RuleName String | Integer | Digit | Word | Star | Plus | May | Or | Is | Eoi | LParen | RParen | Sep | Whitespace deriving (Show,Eq)++-- | Abstract Syntax Tree generated by the metaparser, suitable for postprocessing+data AST = Node String [AST] | ILeaf Integer | SLeaf String | EOI deriving Eq++instance Show AST where+    show (Node s cs) = s ++ "(" ++ intercalate "," (map show cs) ++ ")"+    show (ILeaf i) = show i+    show (SLeaf s) = s+    show EOI = "$"++escaped :: Parser r String Token+escaped = consumeSReturn 'i' Integer+    <|> consumeSReturn 'd' Digit+    <|> consumeSReturn 'w' Word+    <|> consumeSReturn '\\' (Literal '\\')+    <|> consumeSReturn '*' (Literal '*')+    <|> consumeSReturn '+' (Literal '+')+    <|> consumeSReturn '?' (Literal '?')+    <|> consumeSReturn '[' (Literal '[')+    <|> consumeSReturn ']' (Literal ']')+    <|> consumeSReturn '(' (Literal '(')+    <|> consumeSReturn ')' (Literal ')')+    <|> consumeSReturn '$' (Literal '$')++charclass :: Parser r String Token+charclass = CharClass <$> some (nParse (/=']') tokenReturn "Expected character")++simpleSpecial :: Parser r String Token+simpleSpecial = consumeSReturn '*' Star+    <|> consumeSReturn '+' Plus+    <|> consumeSReturn '?' May+    <|> consumeSReturn '|' Or+    <|> consumeSReturn '$' Eoi+    <|> consumeSReturn '(' LParen+    <|> consumeSReturn ')' RParen+    <|> consumeReturn "::=" Is+    <|> consumeSReturn ';' Sep++whitespace :: Parser r String Token+whitespace = some (nParse isSpace tokenReturn "Expected Space") >> return Whitespace++ruleName :: Parser r String Token+ruleName = consumeSingle '%' >> (RuleName <$> word)++metaTokenizer :: Parser r String [Token]+metaTokenizer = many (+    (consumeSingle '\\' >> escaped)+    <|> surround "[]" charclass+    <|> simpleSpecial+    <|> ruleName+    <|> whitespace+    <|> (Literal <$> tokenReturn)+    )++iLeafParser :: Parser r [Token] (Parser r' String AST)+iLeafParser = consumeSReturn Integer (ILeaf <$> integer)++dLeafParser :: Parser r [Token] (Parser r' String AST)+dLeafParser = consumeSReturn Digit (ILeaf <$> digit)++sLeafParser :: Parser r [Token] (Parser r' String AST)+sLeafParser = consumeSReturn Word (SLeaf <$> word)++eoiParser :: Parser r [Token] (Parser r' String AST)+eoiParser = consumeSReturn Eoi (eoi >> return EOI)++isRuleName :: Token -> Bool+isRuleName (RuleName _) = True+isRuleName _ = False++getRuleName :: Token -> String+getRuleName (RuleName s) = s++subRuleParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (Parser r' String AST)+subRuleParser m = nParse isRuleName (tokenParse ((m M.!) . getRuleName)) "Expected RuleName"++charClassCharParser :: String -> Parser r String Char+charClassCharParser (c:s) | c == '^' = nParse (not . (`elem` s)) tokenReturn ("Expected not [" ++ s ++ "]")+charClassCharParser s = nParse (`elem` s) tokenReturn ("Expected [" ++ s ++ "]")++isCharClass :: Token -> Bool+isCharClass (CharClass _) = True+isCharClass _ = False++getCharClass :: Token -> String+getCharClass (CharClass s) = s++charClassParser :: Parser r [Token] (Parser r' String AST)+charClassParser = nParse isCharClass (tokenParse (fmap (SLeaf . return) . charClassCharParser . getCharClass)) "Expected character class"++isLiteral :: Token -> Bool+isLiteral (Literal _) = True+isLiteral _ = False++getLiteral :: Token -> Char+getLiteral (Literal s) = s++parseLiteral :: Parser r [Token] Char+parseLiteral = nParse isLiteral (tokenParse getLiteral) "Expected Literal"++charParser :: Parser r [Token] (Parser r' String AST)+charParser = fmap (SLeaf . return) . (\c -> consumeSReturn c c) <$> parseLiteral++atomParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (Parser r' String AST)+atomParser m = iLeafParser+    <|> dLeafParser+    <|> sLeafParser+    <|> eoiParser+    <|> charClassParser+    <|> subRuleParser m+    <|> charParser++starFreeParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (Parser r' String [AST])+starFreeParser m = surround [LParen,RParen] (cfexParser m) <|> (fmap return <$> atomParser m)++concatFreeParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (Parser r' String [AST]) +concatFreeParser m = do+    sf <- starFreeParser m+    (consumeSingle Star >> return (concat <$> many sf))+        <|> (consumeSingle Plus >> return (concat <$> some sf))+        <|> (consumeSingle May >> return (concat . maybeToList <$> try sf))+        <|> return sf++orFreeParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (Parser r' String [AST])+orFreeParser m = fmap concat . sequenceA <$> some (concatFreeParser m)++cfexParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (Parser r' String [AST])+cfexParser m = foldl1 (<|>) <$> sepSome (consumeSingle Or) (orFreeParser m)++ruleParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (String,Parser r' String AST)+ruleParser m = (\s as-> (s,Node s <$> as)) <$> (many (nParse isLiteral (tokenParse getLiteral) "Expected Literal") << consumeSingle Is) <*> cfexParser m++rulesetParser :: M.Map String (Parser r' String AST) -> Parser r [Token] (M.Map String (Parser r' String AST))+rulesetParser m = M.fromList<$> sepMany (consumeSingle Sep) (ruleParser m)++rulesetLoop :: Parser r [Token] (M.Map String (Parser r' String AST))+rulesetLoop = pfix rulesetParser++combine :: Maybe (M.Map String (Parser r' String AST)) -> Parser r [Token] (Parser r' String [AST])+combine Nothing = cfexParser M.empty+combine (Just rs) = cfexParser rs ++fullParser :: Parser r [Token] (Parser r' String AST)+fullParser = try (rulesetLoop << consumeSingle Sep) >>= (fmap (fmap (Node "_")) . combine)++parserParser :: Parser r [Token] (Parser r' String AST)+parserParser = fullParser << eoi++-- | Parser that takes a grammar and returns a parser that parses that grammar into an @AST@+metaParser :: Parser r String (Parser r' String AST)+metaParser = metaTokenizer >>> skip [Whitespace] parserParser++-- | Convenience function chaining creation and usage of the @metaParser@ into a single invocation.+specParse :: String -> String -> Either String AST+specParse g i = doParse metaParser g >>= (`doParse` i)

@@ -1,7 +1,7 @@ {-| Module      : Text.LParse.Parser Description : Core for LParse-Copyright   : (c) Marcus Völker, 2017+Copyright   : (c) Marcus Völker, 2017-2018 License     : MIT Maintainer  : marcus.voelker@rwth-aachen.de @@ -12,9 +12,11 @@ import Control.DoubleContinuations  import Control.Applicative-import Control.Monad import Control.Arrow import qualified Control.Category as C+import Control.Monad++import Data.Either import Data.List  -- | The Parser structure itself wraps a function from a collection of tokens (collectively of type t) to a double continuation giving@@ -34,7 +36,7 @@ -- taking the first one that succeeds instance Alternative (Parser r t) where     empty = Parser (const $ throw "Empty Fail")-    p1 <|> p2 = Parser ((<|>) <$> (pFunc p1) <*> (pFunc p2))+    p1 <|> p2 = Parser ((<|>) <$> pFunc p1 <*> pFunc p2)  -- | returning a value means building a parser that consumes no input and just gives back the value (i.e. always succeeds) -- the bind operator means using the parser, creating a second parser from the result (with the given function) and then parsing with that.@@ -48,6 +50,10 @@     mzero = empty     mplus = (<|>) +-- | @MonadFix@-analogue for @Parser@, using the @DCont@ function @dfix@+pfix :: (a -> Parser (Either String (a,t)) t a) -> Parser r t a+pfix f = Parser (dfix . flip (pFunc . f . fst . fromRight undefined)) + -- | The identity parser returns the input. Concatenating two parsers means using the parsing result of the first as tokens for the second instance C.Category (Parser r) where     id = Parser (\s -> return (s,s))@@ -70,6 +76,10 @@ -- | Same as @parse@, but giving back the results via @Either@ doParse :: Parser (Either String a) t a -> t -> Either String a doParse p s = invoke (fst <$> pFunc p s)++-- | Same as @parse@, but assuming the parsing succeeds, hard failing via @undefined@ otherwise+forceParse :: Parser a t a -> t -> a+forceParse p s = parse p s id undefined   -- | Runs the parser and prints the results debugParse :: (Show a) => Parser (IO ()) t a -> t -> IO ()

@@ -0,0 +1,151 @@+{-|+Module      : Text.LParse.Prebuilt+Description : Core for LParse+Copyright   : (c) Marcus Völker, 2017-2018+License     : MIT+Maintainer  : marcus.voelker@rwth-aachen.de++This module contains prebuilt parsers that fulfill a certain job (formerly in @Text.LParse.Atomics@) and parser transformers that one or more parsers and modify/combine them in a certain way (formerly in @Text.LParse.Transformers@)++Some of these parsers depend on their input being given in the form of a @TokenStream@.+-}++module Text.LParse.Prebuilt where+++import Control.Applicative+import Control.DoubleContinuations+import Control.Monad+import Data.Char++import Text.LParse.Parser+import qualified Text.LParse.TokenStream as T+import Text.LParse.TokenStream (TokenStream,top,rest,nil,cons)+++-- | A parser that always succeeds, parses nothing and returns unit+noop :: Parser r t ()+noop = return ()++-- | A parser that consumes the whole input and returns it unchanged+full :: Parser r [t] [t]+full = many tokenReturn++-- | A parser that consumes the whole input and discards it, successfully+discard :: Parser r [t] ()+discard = void full++-- | A parser that parses nothing, but only succeeds if the input is empty+eoi :: Parser r [t] ()+eoi = cParse null noop "Input not fully consumed"++-- | Extracts the first token from the input and applies the given function to it+tokenParse :: (TokenStream s) => (t -> a) -> Parser r (s t) a+tokenParse f = Parser (\s -> DCont (\btr etr -> if null s then etr "Unexpected EOI" else btr (f $ top s,rest s)))++-- | Consumes and returns the first token of the input+tokenReturn :: (TokenStream s) => Parser r (s a) a+tokenReturn = tokenParse id++-- | Succeeds exactly if the input begins with the given sequence. On success, consumes that sequence+consume :: (Eq t, Show (s t), TokenStream s) => s t -> Parser r (s t) ()+consume pre = cParse ((&&) <$> (and . T.zipWith (==) pre) <*> ((>= length pre) . length)) (pParse (T.drop (length pre)) noop) ("Expected " ++ show pre)++-- | Consumes exactly the given input and then returns the given constant result+consumeReturn :: (Eq t, Show (s t), TokenStream s) => s t -> a -> Parser r (s t) a+consumeReturn t a = consume t >> return a++-- | Succeeds exactly if the input begins with the given token. On success, consumes that token+consumeSingle :: (Eq t, Show t, TokenStream s) => t -> Parser r (s t) ()+consumeSingle t = cParse (\s -> not (null s) && top s == t) (pParse rest noop) ("Expected " ++ show t)++-- | Consumes exactly the given token and then returns the given constant result+consumeSReturn :: (Eq t, Show t, TokenStream s) => t -> a -> Parser r (s t) a+consumeSReturn t a = consumeSingle t >> return a++-- | Extracts the first digit and returns it+digit :: Parser r String Integer+digit = read . return <$> cParse (\s -> not (null s) && isDigit (head s)) tokenReturn "Expected digit"++-- | Extracts the first digit and returns it+letter :: Parser r String Char+letter = cParse (\s -> not (null s) && isLetter (head s)) tokenReturn "Expected letter"++-- | Extracts the first word (i.e. contiguous string of letters) from the input and returns it+word :: Parser r String String+word = some letter ++-- | Extracts the first integer (i.e. contiguous string of digits) from the input and returns it+integer :: Parser r String Integer+integer = foldl (\x y -> x*10+y) 0 <$> some digit++-- | Extracts the first signed integer (i.e. contiguous string of digits) from the input and returns it+sInteger :: Parser r String Integer+sInteger = (\m i -> case m of (Just _) -> -i; Nothing -> i) <$> try (consumeSingle '-') <*> integer++-- | Succeeds if the first token matches the given function, without consuming it+peek :: (TokenStream s) => (t -> Bool) -> String -> Parser r (s t) ()+peek c = cParse (c . top) noop++-- | A parser that always succeeds with the given function+success :: (t -> (a,t)) -> Parser r t a+success = Parser . (return .)++-- | Parses an integer by removing a single digit in the given base from it. Zero is considered to have no digits+bDigit :: Integer -> Parser r Integer Integer+bDigit b = cParse (> 0) (success (\i -> (i `mod` b,i `div` b))) "Empty number!"++-- | Parses an integer by removing a single digit in the given base from it. Zero is considered to have no digits+bDigits :: Integer -> Parser r Integer [Integer]+bDigits b = many $ bDigit b++------------------------- Transformers++-- | Executes components in the same order as @(>>)@, but returning the first rather than the second monad. Note that @a >> b /= b << a@+(<<) :: (Monad m) => m a -> m b -> m a+a << b = a >>= ((b >>) . return)++-- | Takes a condition the parser's input has to fulfil in order for the parser to succeed+cParse :: (t -> Bool) -> Parser r t a -> String -> Parser r t a+cParse c p err = Parser (\s -> if c s then pFunc p s else throw err)++-- | Takes  condition the next token has to fulfil in order for the parser to succeed+nParse :: (TokenStream s, Eq (s t)) => (t -> Bool) -> Parser r (s t) a -> String -> Parser r (s t) a+nParse c = cParse (\s -> nil /= s && c (top s))++-- | Transforms the input before applying the parser+pParse :: (t -> t) -> Parser r t a -> Parser r t a+pParse f p = Parser (pFunc p . f)++-- | Takes a parser that consumes separators and a parser that consumes the desired data and returns a non-empty list of desired data (separated by the separator in source)+-- For example: @sepSome (consume " ") word@ applied to @"a banana is tasty"@ returns @["a","banana","is","tasty"]@+sepSome :: Parser r t () -> Parser r t a -> Parser r t [a]+sepSome sep p = ((:) <$> p <*> many (sep >> p)) <|> fmap return p++-- | Same as @sepSome@, but allows empty lists+sepMany :: Parser r t () -> Parser r t a -> Parser r t [a]+sepMany sep p = sepSome sep p <|> return []++-- | Removes all tokens from the given list from the input+skip :: (Eq t, TokenStream s) => [t] -> Parser r (s t) a -> Parser r (s t) a+skip s = skipBy (not . (`elem` s))++-- | Same as skip, but with a custom comparator+skipBy :: (TokenStream s) => (t -> Bool) -> Parser r (s t) a -> Parser r (s t) a+skipBy f = pParse (T.filter f)++-- | Skips standard whitespace characters from a String input+skipWhitespace :: Parser r String a -> Parser r String a+skipWhitespace = skipBy (not . isSpace)++-- | Replaces the first token by applying the given function+replace :: (TokenStream s) => (t -> t) -> Parser r (s t) a -> Parser r (s t) a+replace f p = Parser (pFunc p . (\x -> f (top x) `cons` rest x))++-- | Tries to run the given parser, giving back Just result or Nothing+try :: Parser r t a -> Parser r t (Maybe a)+try p = (Just <$> p) <|> return Nothing++-- | Parses a character before and a character after the given parser, useful for parentheses+surround :: (Eq t, Show t, TokenStream s) => [t] -> Parser r (s t) a -> Parser r (s t) a+surround [l,r] p = consumeSingle l >> p << consumeSingle r

@@ -1,7 +1,7 @@ {-| Module      : Text.LParse.TokenStream Description : Underlying data structure for sequential parsing-Copyright   : (c) Marcus Völker, 2017+Copyright   : (c) Marcus Völker, 2017-2018 License     : MIT Maintainer  : marcus.voelker@rwth-aachen.de @@ -13,7 +13,7 @@ import Data.Maybe import Data.Traversable -{-# DEPRECATED skipN "Use sDrop in place of skipN" #-}+import Prelude hiding (filter,zip,zipWith,drop)  -- | `TokenStream` abstracts a list, i.e., something that has a next element to process and a rest afterwards class (Functor t, Foldable t) => TokenStream t where@@ -44,26 +44,22 @@     nil = Left undefined     cons a _ = Right a --- | Deprecated version of `sDrop`-skipN :: (TokenStream s) => Int -> s a -> s a-skipN = sDrop - -- | `TokenStream` version of `drop` -sDrop ::  (TokenStream s) => Int -> s a -> s a-sDrop 0 x = x-sDrop n x = rest $ sDrop (n-1) x+drop ::  (TokenStream s) => Int -> s a -> s a+drop 0 x = x+drop n x = rest $ drop (n-1) x  -- | `TokenStream` version of `zip`-sZip :: (TokenStream s) => s a -> s b -> s (a,b)-sZip = sZipWith (,)+zip :: (TokenStream s) => s a -> s b -> s (a,b)+zip = zipWith (,)  -- | `TokenStream` version of `zipWith`-sZipWith :: (TokenStream s) => (a -> b -> c) -> s a -> s b -> s c-sZipWith f l r | null l || null r = nil-               | otherwise      = f (top l) (top r) `cons` (sZipWith f (rest l) (rest r))+zipWith :: (TokenStream s) => (a -> b -> c) -> s a -> s b -> s c+zipWith f l r | null l || null r = nil+               | otherwise      = f (top l) (top r) `cons` zipWith f (rest l) (rest r)  -- | `TokenStream` version of `filter`-sFilter :: (TokenStream s) => (a -> Bool) -> s a -> s a-sFilter c x | null x = nil-            | c (top x) = (top x) `cons` sFilter c (rest x)-            | otherwise = sFilter c (rest x)+filter :: (TokenStream s) => (a -> Bool) -> s a -> s a+filter c x | null x = nil+            | c (top x) = top x `cons` filter c (rest x)+            | otherwise = filter c (rest x)

@@ -1,62 +0,0 @@-{-|-Module      : Text.LParse.Transformers-Description : Parser transformers for use with LParse-Copyright   : (c) Marcus Völker, 2017-License     : MIT-Maintainer  : marcus.voelker@rwth-aachen.de--This module implements LParse's transformers, i.e. functions that build new parsers from other parsers--}-module Text.LParse.Transformers where --import Control.DoubleContinuations-import Text.LParse.Parser-import Text.LParse.TokenStream--import Control.Applicative-import Data.Char---- | Executes components in the same order as @(>>)@, but returning the first rather than the second monad. Note that @a >> b /= b << a@-(<<) :: (Monad m) => m a -> m b -> m a-a << b = a >>= ((b >>) . return)---- | Takes a condition the parser's input has to fulfil in order for the parser to succeed-cParse :: (t -> Bool) -> Parser r t a -> String -> Parser r t a-cParse c p err = Parser (\s -> if c s then pFunc p s else throw err)---- | Takes a condition the next token has to fulfil in order for the parser to succeed-nParse :: (TokenStream s, Eq (s t)) => (t -> Bool) -> Parser r (s t) a -> String -> Parser r (s t) a-nParse c p err = cParse (\s -> not (nil == s) && c (top s)) p err---- | Transforms the input before applying the parser-pParse :: (t -> t) -> Parser r t a -> Parser r t a-pParse f p = Parser (pFunc p . f)---- | Takes a parser that consumes separators and a parser that consumes the desired data and returns a non-empty list of desired data (separated by the separator in source)--- For example: @sepSome (consume " ") word@ applied to @"a banana is tasty"@ returns @["a","banana","is","tasty"]@-sepSome :: Parser r t () -> Parser r t a -> Parser r t [a]-sepSome sep p = ((:) <$> p <*> many (sep >> p)) <|> fmap return p---- | Same as @sepSome@, but allows empty lists-sepMany :: Parser r t () -> Parser r t a -> Parser r t [a]-sepMany sep p = sepSome sep p <|> return []---- | Removes all tokens from the given list from the input-skip :: (Eq t, TokenStream s) => [t] -> Parser r (s t) a -> Parser r (s t) a-skip s = skipBy (not . (`elem` s))---- | Same as skip, but with a custom comparator-skipBy :: (TokenStream s) => (t -> Bool) -> Parser r (s t) a -> Parser r (s t) a-skipBy f = pParse (sFilter f)---- | Skips standard whitespace characters from a String input-skipWhitespace :: Parser r String a -> Parser r String a-skipWhitespace = skipBy (not . isSpace)---- | Replaces the first token by applying the given function-replace :: (TokenStream s) => (t -> t) -> Parser r (s t) a -> Parser r (s t) a-replace f p = Parser (pFunc p . (\x -> f (top x) `cons` rest x))---- | Tries to run the given parser, giving back Just result or Nothing-try :: (TokenStream s) => Parser r (s t) a -> Parser r (s t) (Maybe a)-try p = (Just <$> p) <|> return Nothing

@@ -1,8 +1,8 @@ module Main where   import Text.LParse.Parser-import Text.LParse.Atomics-import Text.LParse.Transformers+import Text.LParse.Prebuilt+import Text.LParse.Metaparser  import Control.Applicative import Control.Arrow@@ -13,10 +13,10 @@ import System.Exit (exitSuccess,exitFailure)  bracks :: Parser r String ()-bracks = (consume "(" >> nesting << consume ")")-    <|> (consume "[" >> nesting << consume "]")-    <|> (consume "{" >> nesting << consume "}")-    <|> (consume "<" >> nesting << consume ">")+bracks = surround "()" nesting+    <|> surround "[]" nesting+    <|> surround "{}" nesting+    <|> surround "<>" nesting  nesting :: Parser r String () nesting = void $ many bracks@@ -63,10 +63,23 @@     (sum <$> sepMany (consume " ") integer,"1 4 12 61 192",1+4+12+61+192),     (integer >>> (sum <$> bDigits 2), "19", 3),     (integer >>> (foldr (\x y -> x + y * 2) 0 <$> bDigits 2), "19", 19),-    ((\x y -> x*10+y) <$> sInteger <*> ((consumeSingle ' ') >> sInteger), "-123 123", (-123*10) + 123),+    ((\x y -> x*10+y) <$> sInteger <*> (consumeSingle ' ' >> sInteger), "-123 123", (-123*10) + 123),     (nParse (=='1') integer "Expected '1'", "123", 123)     ] +metaCases :: [(String, String, String)]+metaCases = +    [ ("\\w$","oha","_(oha,$)")+    , ("\\d*$","123123","_(1,2,3,1,2,3,$)")+    , ("(\\w\\d)+$","abc3def1g0","_(abc,3,def,1,g,0,$)")+    , ("abc\\d$","abc3","_(a,b,c,3,$)")+    , ("t::=abc;%t$","abc","_(t(a,b,c),$)")+    , ("t::=a|c;%t$","a","_(t(a),$)")+    , ("t::=a%t|c;%t$","aaac","_(t(a,t(a,t(a,t(c)))),$)")+    , ("t::=t%s|t;s::=s%t|s;%t$","tststs","_(t(t,s(s,t(t,s(s,t(t,s(s)))))),$)")+    , ("t::=t%s?;\ns::=s%t?;\n%t$","tststs","_(t(t,s(s,t(t,s(s,t(t,s(s)))))),$)")+    ]+ runTests :: [(Parser (Either String a) t a,t)] -> [Either String a] runTests = map (uncurry doParse) @@ -74,19 +87,24 @@ eqTest (p,i,e) = parse p i (\r -> if r == e then Right () else Left ("Expected " ++ show e ++ ", but got " ++ show r)) (\e -> Left $ "Parser error: " ++ e)  succTest :: [Either String a] -> IO ()-succTest res = if all isRight res then return () else putStrLn (head $ lefts res) >> exitFailure+succTest res = unless (all isRight res) $ mapM_ putStrLn (lefts res) >> exitFailure  failTest :: [Either String a] -> IO ()-failTest res = if all isLeft res then return () else putStrLn "Fail Test Succeeded" >> exitFailure+failTest res = unless (all isLeft res) $ putStrLn "Fail Test Succeeded" >> exitFailure +metaTest :: (String,String,String) -> Either String AST+metaTest (g,i,a) = either (\a -> Left ("Case " ++ show (g,i)  ++ ": " ++ a)) (\ast -> if show ast == a then Right ast else Left ("Expected AST " ++ a ++ " but got " ++ show ast)) (specParse g i)+ main ::IO () main = do     let sres = runTests succCases     let fres = runTests failCases     let seres = map eqTest stringCases     let ieres = map eqTest intCases+    let mres = map metaTest metaCases     succTest sres     failTest fres     succTest seres     succTest ieres+    succTest mres     exitSuccess