packages feed

definitive-parser 1.0 → 1.2

raw patch · 9 files changed

+333/−293 lines, 9 filesdep ~definitive-base

Dependency ranges changed: definitive-base

Files

− Algebra/Parser.hs 
@@ -1,183 +0,0 @@--- |A module providing simple Parser combinator functionality. Useful--- for small parsing tasks such as identifier parsing or command-line--- argument parsing-module Algebra.Parser (-  module Algebra,-  -- * The ParserT Type-  ParserT(..),Parser,ParserA(..),_ParserA,--  -- ** The Stream class-  Stream(..),emptyStream,--  -- ** Converting to/from Parsers-  parserT,parser,ioParser,--  -- * Basic combinators-  (<+>),(>*>),(<*<),-  token,satisfy,-  oneOf,noneOf,single,-  several,-  remaining,eoi,--  -- ** Specialized utilities-  readable,number,digit,letter,alNum,quotedString,space,spaces,eol,-  -  -- * Basic combinators-  many,many1,sepBy,sepBy1,skipMany,skipMany1,-  chainl,chainr,option                   -  ) where--import Algebra--import Data.Char-import Data.Containers.Sequence--newtype ParserT s m a = ParserT (StateT s (ListT m) a)-                        deriving (Unit,Functor,Applicative,Monoid,Semigroup,-                                  Monad,MonadFix,MonadList,MonadState s,MonadWriter w)-type Parser c a = ParserT c Id a-deriving instance Monad m => MonadError Void (ParserT c m)-instance MonadTrans (ParserT s) where-  lift = ParserT . lift . lift-instance ConcreteMonad (ParserT s) where-  generalize = parserT %%~ map (pure.yb _Id)-_ParserT :: Iso (ParserT s m a) (ParserT t n b) (StateT s (ListT m) a) (StateT t (ListT n) b)-_ParserT = iso ParserT (\(ParserT p) -> p)-parserT :: (Functor n,Functor m) => Iso (ParserT s m a) (ParserT t n b) (s -> m [(s,a)]) (t -> n [(t,b)])-parserT = mapping listT.stateT._ParserT-parser :: Iso (Parser s a) (Parser t b) (s -> [(s,a)]) (t -> [(t,b)])-parser = mapping _Id.parserT--ioParser :: Parser a b -> (a -> IO b)-ioParser p s = case (p^..parser) s of-  [] -> error "Error in parsing"-  (_,a):_ -> return a---- |The @(+)@ operator with lower priority-(<+>) :: Semigroup m => m -> m -> m-(<+>) = (+)-(>*>) :: Monad m => ParserT a m b -> ParserT b m c -> ParserT a m c-(>*>) = (>>>)^..(_ParserA<.>_ParserA<.>_ParserA)-(<*<) :: Monad m => ParserT b m c -> ParserT a m b -> ParserT a m c-(<*<) = flip (>*>)--newtype ParserA m s a = ParserA (ParserT s m a)-_ParserA :: Iso (ParserA m s a) (ParserA m' s' a') (ParserT s m a) (ParserT s' m' a')-_ParserA = iso ParserA (\(ParserA p) -> p)-parserA :: Iso (ParserA m s a) (ParserA m' s' a') (StateA (ListT m) s a) (StateA (ListT m') s' a') -parserA = from stateA._ParserT._ParserA-instance Monad m => Category (ParserA m) where-  id = ParserA get-  (.) = (.)^.(parserA<.>parserA<.>parserA)-instance Monad m => Split (ParserA m) where-  (<#>) = (<#>)^.(parserA<.>parserA<.>parserA)-instance Monad m => Choice (ParserA m) where-  (<|>) = (<|>)^.(parserA<.>parserA<.>parserA)-instance Monad m => Arrow (ParserA m) where-  arr f = arr f^.parserA---- |The remaining Stream to parse-remaining :: Monad m => ParserT s m s-remaining = get--- |Consume a token from the Stream-token :: (Monad m,Stream c s) => ParserT s m c-{-# SPECIALIZE token :: Monad m => ParserT [c] m c #-}-token = get >>= \s -> case uncons s of-  Nothing -> zero-  Just (c,t) -> put t >> pure c---- |Parse zero, one or more successive occurences of a parser.-many :: Monad m => ParserT c m a -> ParserT c m [a]-many p = many1 p <+> pure []--- |Parse one or more successiveé occurences of a parser.-many1 :: Monad m => ParserT c m a -> ParserT c m [a]-many1 p = (:)<$>p<*>many p--- |Skip many occurences of a parser-skipMany :: Monad m => ParserT c m a -> ParserT c m ()-skipMany p = skipMany1 p <+> pure () --- |Skip multiple occurences of a parser-skipMany1 :: Monad m => ParserT c m a -> ParserT c m ()-skipMany1 p = p >> skipMany p---- |Consume a token and succeed if it verifies a predicate-satisfy :: (Monad m, Stream c s) => (c -> Bool) -> ParserT s m c-{-# SPECIALIZE satisfy :: Monad m => (c -> Bool) -> ParserT [c] m c #-}-satisfy p = token <*= guard . p--- |Consume a single fixed token or fail.-single :: (Eq c, Monad m, Stream c s) => c -> ParserT s m ()-single = void . satisfy . (==)---- |Consume a structure of characters or fail-several :: (Eq c, Monad m, Foldable t, Stream c s) => t c -> ParserT s m ()-{-# SPECIALIZE several :: (Eq c, Monad m) => [c] -> ParserT [c] m () #-}-several l = traverse_ single l---- |Try to consume a parser. Return a default value when it fails.-option :: Monad m => a -> ParserT s m a -> ParserT s m a-option a p = p+pure a---- |Succeed only if we are by the End Of Input.-eoi :: (Monad m,Stream c s) => ParserT s m ()-eoi = remaining >>= guard.emptyStream--- |The end of line-eol :: (Monad m,Stream Char s) => ParserT s m ()-eol = single '\n'---- |Parse one or more successive occurences of a parser separated by--- occurences of a second parser.-sepBy1 ::Monad m => ParserT c m a -> ParserT c m b -> ParserT c m [a]-sepBy1 p sep = (:)<$>p<*>many (sep >> p)--- |Parse zero or more successive occurences of a parser separated by--- occurences of a second parser.-sepBy ::Monad m => ParserT c m a -> ParserT c m b -> ParserT c m [a]-sepBy p sep = option [] (sepBy1 p sep)---- |Parse a member of a set of values-oneOf :: (Eq c, Monad m, Foldable t, Stream c s) => t c -> ParserT s m c-oneOf = satisfy . flip elem--- |Parse anything but a member of a set-noneOf :: (Eq c, Monad m, Foldable t, Stream c s) => t c -> ParserT s m c-noneOf = satisfy . map not . flip elem---- |Parse a litteral decimal number-number :: (Monad m,Stream Char s,Num n) => ParserT s m n-number = fromInteger.read <$> many1 digit--- |Parse a single decimal digit-digit :: (Monad m,Stream Char s) => ParserT s m Char-digit = satisfy isDigit-alNum :: (Monad m,Stream Char s) => ParserT s m Char-alNum = satisfy isAlphaNum-letter :: (Monad m,Stream Char s) => ParserT s m Char-letter = satisfy isAlpha--- |Parse a delimited string, unsing '\\' as the quoting character-quotedString :: (Monad m,Stream Char s) => Char -> ParserT s m String-quotedString d = between (single d) (single d) (many ch)-  where ch = single '\\' >> unquote<$>token-             <+> noneOf (d:"\\")-        unquote 'n' = '\n'-        unquote 't' = '\t'-        unquote c = c--- |A single space-space :: (Monad m,Stream Char s) => ParserT s m Char-space = satisfy isSpace--- |Many spaces-spaces :: (Monad m,Stream Char s) => ParserT s m String-spaces = many1 space--infixl 1 `sepBy`,`sepBy1`-infixr 0 <+>---- |Chain an operator with an initial value and several tail values.-chainr :: (Stream c s,Monad m) => ParserT s m a -> ParserT s m (b -> a -> a) -> ParserT s m b -> ParserT s m a-chainr expr op e = compose<$>many (op<**>e)<*>expr--- |Chain an operator with an initial value-chainl :: (Stream c s,Monad m) => ParserT s m a -> ParserT s m (a -> b -> a) -> ParserT s m b -> ParserT s m a-chainl expr op e = compose<$>many (flip<$>op<*>e)<**>expr---- |Test if a Stream is empty-emptyStream :: Stream c s => s -> Bool-emptyStream = maybe True (const False) . uncons--readable :: (Monad m,Read a) => ParserT String m a -readable = generalize $ map2 swap (readsPrec 0)^.parser-
− Algebra/Parser/Regex.hs 
@@ -1,29 +0,0 @@-module Algebra.Parser.Regex (regex,runRegex) where--import Algebra.Parser--runRegex :: String -> String -> [([(String,String)],String)]-runRegex re = join (pure re >*> regex)^..parser <&> map snd--regex :: Parser String (Parser String ([(String,String)],String))-regex = _union-  where _union = (adjacent`sepBy`single '|') <&> sum-        adjacent = many postfixed <&> map concat.sequence-        atom = dot <+> range <+> otherChar <+> between (single '(') (single ')') _union-        postfixed = comp<$>atom<*>many postfun-          where postfun = satisfy (`elem`"*+?") <&> \c -> case c of-                  '*' -> map sum.many-                  '+' -> map sum.many1-                  '?' -> (+ pure ([],""))-                  _ -> undefined-                comp a fs = compose fs a-        dot = shallow token <$ single '.'-        otherChar = shallow.char<$>noneOf "()[*?|+"-        range = between (single '[') (single ']') ranges-          where ranges = sum <$> many subRange-                subRange = mkRange<$>subChar<*single '-' <*>subChar-                           <+> shallow.char<$>subChar-                mkRange a b = shallow $ satisfy (\c -> c>=a && c<=b)-                subChar = noneOf "]"-        shallow = (([],).pure<$>)-        char c = c<$single c
Data/Serialize.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE ScopedTypeVariables, LambdaCase #-} module Data.Serialize (   -- * You'll need this-  module Algebra.Parser,+  module Language.Parser,      -- * Serialization   Serializable(..),Builder,bytesBuilder,chunkBuilder,serialize,serial,@@ -9,7 +9,8 @@   word8,Word8,Word32,Word64,Either3(..),   ) where -import Algebra.Parser hiding (uncons)+import Definitive+import Language.Parser hiding (uncons) import Data.ByteString.Lazy.Builder import qualified Data.ByteString as BSS import qualified Data.ByteString.Lazy as BS@@ -20,8 +21,7 @@ import qualified Data.Monoid as M import System.Endian import Data.Bits (shiftR,shiftL)-import Data.Containers-import Data.ByteString.Lazy.UTF8 (uncons)+import qualified Data.ByteString.Lazy.UTF8 as UTF8   class Serializable t where   encode :: t -> Builder@@ -59,7 +59,7 @@    instance Serializable Char where   encode = charUtf8-  serializable = gets uncons >>= \case+  serializable = gets UTF8.uncons >>= \case     Just (c,t) -> c <$ put t     Nothing -> zero instance Serializable Word8 where@@ -104,6 +104,7 @@ instance (Ord a,Serializable a) => Serializable (Set a) where   encode = encode . toList   serializable = serializable <&> fromList . map (,zero)+deriving instance Serializable a => Serializable (Range a) instance (Serializable a,Serializable b) => Serializable (a:*:b) where   encode (a,b) = encode a+encode b   serializable = (,)<$>serializable<*>serializable@@ -124,13 +125,13 @@     1 -> Right<$>serializable     _ -> zero -data Either3 a b c = Alt3_1 a | Alt3_2 b | Alt3_3 c+data Either3 a b c = Alt3l'1 a | Alt3l'2 b | Alt3l'3 c instance (Serializable a,Serializable b,Serializable c) => Serializable (Either3 a b c) where-  encode (Alt3_1 a) = word8 0+encode a-  encode (Alt3_2 b) = word8 1+encode b-  encode (Alt3_3 c) = word8 2+encode c+  encode (Alt3l'1 a) = word8 0+encode a+  encode (Alt3l'2 b) = word8 1+encode b+  encode (Alt3l'3 c) = word8 2+encode c   serializable = storable >>= \x -> case x :: Word8 of-    0 -> Alt3_1<$>serializable-    1 -> Alt3_2<$>serializable-    2 -> Alt3_3<$>serializable+    0 -> Alt3l'1<$>serializable+    1 -> Alt3l'2<$>serializable+    2 -> Alt3l'3<$>serializable     _ -> zero
Data/Syntax.hs view
@@ -1,22 +1,22 @@ {-# LANGUAGE UndecidableInstances, LambdaCase, ParallelListComp, ViewPatterns #-} module Data.Syntax where -import Algebra-import Data.Containers+import Definitive import qualified Prelude as P-import Algebra.Parser.Regex+import Language.Syntax.Regex  type Env f = Map String (ThunkT f)-type Eval f = Env f -> ThunkT f type ThunkT f = f (SyntaxT f) data SyntaxT f = ValList [ThunkT f]               | Dictionary (Env f)               | Text String+              | Quote (SyntaxT f)               | Function (ThunkT f -> ThunkT f) instance Show (ThunkT f) => Show (SyntaxT f) where   show (ValList l) = show l   show (Dictionary d) = "{"+show (toList (map show d^.keyed))+"}"   show (Text t) = show t+  show (Quote s) = "'"+show s   show (Function _) = "<fun>"  dict :: Traversal' (SyntaxT f) (Env f)@@ -32,20 +32,33 @@ variable n v = Dictionary (fromList [("name",pure $ Text n),("value",pure v)]) funcall :: ThunkT f -> ThunkT f -> SyntaxT f funcall f x = ValList [f,x]+builtin :: Unit m => (ThunkT m -> ThunkT m) -> ThunkT m+builtin = pure . Function+builtin2 :: Unit m => (ThunkT m -> ThunkT m -> ThunkT m) -> ThunkT m+builtin2 = builtin . map builtin+builtin3 :: Unit m => (ThunkT m -> ThunkT m -> ThunkT m -> ThunkT m) -> ThunkT m+builtin3 = builtin . map builtin2 +shape :: SyntaxT f -> String+shape (ValList []) = "Nil"+shape (ValList _) = "ValList"+shape (Text _) = "Text"+shape (Dictionary _) = "Dictionary"+shape (Quote _) = "Quote"+shape (Function _) = "Function"+ reduce :: MonadReader (Env m) m => SyntaxT m -> ThunkT m reduce (ValList (map (>>= reduce) -> (fun:args))) = fun >>= \f -> foldlM call f args   where call (Function f) x = f x         call _ _ = error "Invalid function call" reduce (Dictionary d) = pure $ Dictionary $ fix (\d' -> map (local (d'+) . (>>= reduce)) d)+reduce (Quote s) = pure s reduce a = pure a -list_ :: [a] -> [a]-list_ = id lambda :: MonadReader (Env m) m => SyntaxT Id -> SyntaxT m -> (ThunkT m -> ThunkT m) lambda pat e = tryAlt   where tryAlt x = x >>= match >>= maybe (pure nil) bind-          where bind vars = local (compose (_insert<$>list_ vars)) (reduce e)+          where bind vars = local (compose (_insert<$>c'list vars)) (reduce e)                   where _insert (s,v) = insert s (pure v)                 match = matchPat pat matchPat :: Monad f => SyntaxT Id -> (SyntaxT f -> f (Maybe [(String,SyntaxT f)]))@@ -57,12 +70,12 @@   where matchDict (Dictionary d') =            traverse (matches d') (toList pats) <&> map concat.sequence         matchDict _ = pure zero-        pats = (matchPat.yb _Id<$>d)^.keyed+        pats = (matchPat.yb i'Id<$>d)^.keyed         matches d' (k,m) = maybe (pure zero) (>>= m) (d'^.at k) matchPat (ValList l) = matchList   where n = length l         matchList (ValList l') | length (take n l') == n =-          sequence [matchPat p =<< e | p <- yb _Id<$>l | e <- l'] <&> map concat.sequence+          sequence [matchPat p =<< e | p <- yb i'Id<$>l | e <- l'] <&> map concat.sequence         matchList _ = pure zero matchPat _ = pure (pure zero)
LICENSE view
@@ -1,69 +1,39 @@-Bill and Ted's Public License-=============================--Everyone is permitted to copy and distribute verbatim or modified-copies of this license document, and changing it is allowed as long as-the name of the license is changed.--PREAMBLE+THE FREE BEER PUBLIC LICENSE -------- -The “Greater Lunduke License” is inspired, in part, by the wisdom of-the Two Great Ones, Bill S. Preston, Esq. and Ted “Theodore” Logan.-Namely that we should all “be excellent to each other”, that being-“bogus” is “most non-triumphant” and that all dudes should “party on”.+The Free Beer Public License is designed to provide free (as in beer,+hence the name), unlimited access to any content for anyone who wishes+it, without restrictions such as property rights or affordability. -This license applies those concepts in such a way that it is-applicable to all forms of content, including, but not limited to:-software, books, music, movies and various works of art.+This license embodies the philosophy that all software (and more+generally all good ideas) is designed to solve a particular problem,+and that the only way to judge its quality is by how well it solves+that problem, rather than other unrelated criteria such as sellability+or merchandability. +All kinds of works may be licensed under the FBPL, as long as the+aforementioned works are within the legal rights of the provider to+give.+ TERMS AND CONDITIONS -------------------- -### 1. Be Excellent To Each Other.--The consumer of this work is granted the right to utilize this work in-conjunction with any mechanism that is capable of utilizing it, in the-form supplied by the content creator, without limitation as to-specific hardware or software.--The consumer of this work may make copies of this work (physical or-otherwise) for backup purposes.--The consumer of this work may lend this work to another individual-provided that the following two conditions are met :-  -  1. the lender no longer utilizes or possesses the work-  2. the work is not presently lent to another individual--The consumer of this work may sell this work to another individual-provided that the following two conditions are met :--  1. the seller no longer utilizes or possesses the work -  2. once the work is sold, the seller relinquishes all rights and-      copies of the work to the buyer.+### 1. Free as in Beer -### 2. Don’t Be Bogus.+The provider of this work shall make it available, free of any charge,+monetary or otherwise, to the consumer, to use without restrictions or+any kind of supervision. -The consumer of this work shall not redistribute modified, or-unmodified, copies of this work without explicit written permission-from the creator of this work.  The only exceptions allowed to this-rule are the provisions outlined in section 1 of this license+### 2. Freely taken is freely given -The consumer of this work shall not hold the creator of this work-liable for anything the consumer does, or does not, do, or the results-of utilizing this work.+The consumer of this work may redistribute it as well as derived works+in any way he or she chooses, as long as the work itself and any+derived work remain Free as in Beer, as per the first clause. -### 3. Party On, Dudes!+### 3. The Burden of Proof -The creator of this work provides the work in a form that contains no-mechanism to disable the utilization of the work after a specific-date, period of time or number of uses.+The provider of this work shall also supply explanations for how the+work was realized if requested, in the form of source code for example, or+supply the means to access such explanations. -If additional works, which are created and wholly owned by the work’s-creator, are required to utilize this work, those additional works-must also be made available to the consumer so long as the following-conditions are met :-  -  1. doing so is possible-  2. doing so does not cause harm to the creator of the work.+Every such explanation shall be Free as in Beer, as per the first clause.
+ Language/Parser.hs view
@@ -0,0 +1,185 @@+-- |A module providing simple Parser combinator functionality. Useful+-- for small parsing tasks such as identifier parsing or command-line+-- argument parsing+module Language.Parser (+  module Definitive,+  -- * The ParserT Type+  ParserT(..),Parser,ParserA(..),_ParserA,++  -- ** The Stream class+  Stream(..),emptyStream,++  -- ** Converting to/from Parsers+  parserT,parser,ioParser,++  -- * Basic combinators+  (<+>),(>*>),(<*<),cut,+  token,satisfy,+  oneOf,noneOf,single,+  several,+  remaining,eoi,++  -- ** Specialized utilities+  readable,number,digit,letter,alNum,quotedString,space,spaces,eol,+  +  -- * Basic combinators+  many,many1,sepBy,sepBy1,skipMany,skipMany1,+  chainl,chainr,option                   +  ) where++import Definitive hiding (take)++import Data.Char+import Data.Containers.Sequence++newtype ParserT s m a = ParserT (StateT s (ListT m) a)+                        deriving (Unit,Functor,Semigroup,Monoid,Applicative,+                                  Monad,MonadFix,MonadList,MonadState s,MonadWriter w)+type Parser c a = ParserT c Id a+deriving instance Monad m => MonadError Void (ParserT c m)+instance MonadTrans (ParserT s) where+  lift = ParserT . lift . lift+instance ConcreteMonad (ParserT s) where+  generalize = parserT %%~ map (pure.yb i'Id)+_ParserT :: Iso (ParserT s m a) (ParserT t n b) (StateT s (ListT m) a) (StateT t (ListT n) b)+_ParserT = iso ParserT (\(ParserT p) -> p)+parserT :: (Functor n,Functor m) => Iso (ParserT s m a) (ParserT t n b) (s -> m [(s,a)]) (t -> n [(t,b)])+parserT = mapping listT.stateT._ParserT+parser :: Iso (Parser s a) (Parser t b) (s -> [(s,a)]) (t -> [(t,b)])+parser = mapping i'Id.parserT++ioParser :: Parser a b -> (a -> IO b)+ioParser p s = case (p^..parser) s of+  [] -> error "Error in parsing"+  (_,a):_ -> return a++-- |The @(+)@ operator with lower priority+(<+>) :: Semigroup m => m -> m -> m+(<+>) = (+)+(>*>) :: Monad m => ParserT a m b -> ParserT b m c -> ParserT a m c+(>*>) = (>>>)^..(_ParserA<.>_ParserA<.>_ParserA)+(<*<) :: Monad m => ParserT b m c -> ParserT a m b -> ParserT a m c+(<*<) = flip (>*>)+cut :: Monad m => ParserT s m a -> ParserT s m a+cut = parserT %%~ map2 (take 1)++newtype ParserA m s a = ParserA (ParserT s m a)+_ParserA :: Iso (ParserA m s a) (ParserA m' s' a') (ParserT s m a) (ParserT s' m' a')+_ParserA = iso ParserA (\(ParserA p) -> p)+parserA :: Iso (ParserA m s a) (ParserA m' s' a') (StateA (ListT m) s a) (StateA (ListT m') s' a') +parserA = from stateA._ParserT._ParserA+instance Monad m => Category (ParserA m) where+  id = ParserA get+  (.) = (.)^.(parserA<.>parserA<.>parserA)+instance Monad m => Split (ParserA m) where+  (<#>) = (<#>)^.(parserA<.>parserA<.>parserA)+instance Monad m => Choice (ParserA m) where+  (<|>) = (<|>)^.(parserA<.>parserA<.>parserA)+instance Monad m => Arrow (ParserA m) where+  arr f = arr f^.parserA++-- |The remaining Stream to parse+remaining :: Monad m => ParserT s m s+remaining = get+-- |Consume a token from the Stream+token :: (Monad m,Stream c s) => ParserT s m c+{-# SPECIALIZE token :: Monad m => ParserT [c] m c #-}+token = get >>= \s -> case uncons s of+  Nothing -> zero+  Just (c,t) -> put t >> pure c++-- |Parse zero, one or more successive occurences of a parser.+many :: Monad m => ParserT c m a -> ParserT c m [a]+many p = many1 p <+> pure []+-- |Parse one or more successiveé occurences of a parser.+many1 :: Monad m => ParserT c m a -> ParserT c m [a]+many1 p = (:)<$>p<*>many p+-- |Skip many occurences of a parser+skipMany :: Monad m => ParserT c m a -> ParserT c m ()+skipMany p = skipMany1 p <+> pure () +-- |Skip multiple occurences of a parser+skipMany1 :: Monad m => ParserT c m a -> ParserT c m ()+skipMany1 p = p >> skipMany p++-- |Consume a token and succeed if it verifies a predicate+satisfy :: (Monad m, Stream c s) => (c -> Bool) -> ParserT s m c+{-# SPECIALIZE satisfy :: Monad m => (c -> Bool) -> ParserT [c] m c #-}+satisfy p = token <*= guard . p+-- |Consume a single fixed token or fail.+single :: (Eq c, Monad m, Stream c s) => c -> ParserT s m ()+single = void . satisfy . (==)++-- |Consume a structure of characters or fail+several :: (Eq c, Monad m, Foldable t, Stream c s) => t c -> ParserT s m ()+{-# SPECIALIZE several :: (Eq c, Monad m) => [c] -> ParserT [c] m () #-}+several l = traverse_ single l++-- |Try to consume a parser. Return a default value when it fails.+option :: Monad m => a -> ParserT s m a -> ParserT s m a+option a p = p <+> pure a++-- |Succeed only at the End Of Input.+eoi :: (Monad m,Stream c s) => ParserT s m ()+eoi = remaining >>= guard.emptyStream+-- |The end of a line+eol :: (Monad m,Stream Char s) => ParserT s m ()+eol = single '\n'++-- |Parse one or more successive occurences of a parser separated by+-- occurences of a second parser.+sepBy1 ::Monad m => ParserT c m a -> ParserT c m b -> ParserT c m [a]+sepBy1 p sep = (:)<$>p<*>many (sep >> p)+-- |Parse zero or more successive occurences of a parser separated by+-- occurences of a second parser.+sepBy ::Monad m => ParserT c m a -> ParserT c m b -> ParserT c m [a]+sepBy p sep = option [] (sepBy1 p sep)++-- |Parse a member of a set of values+oneOf :: (Eq c, Monad m, Foldable t, Stream c s) => t c -> ParserT s m c+oneOf = satisfy . flip elem+-- |Parse anything but a member of a set+noneOf :: (Eq c, Monad m, Foldable t, Stream c s) => t c -> ParserT s m c+noneOf = satisfy . map not . flip elem++-- |Parse a litteral decimal number+number :: (Monad m,Stream Char s,Num n) => ParserT s m n+number = fromInteger.read <$> many1 digit+-- |Parse a single decimal digit+digit :: (Monad m,Stream Char s) => ParserT s m Char+digit = satisfy isDigit+alNum :: (Monad m,Stream Char s) => ParserT s m Char+alNum = satisfy isAlphaNum+letter :: (Monad m,Stream Char s) => ParserT s m Char+letter = satisfy isAlpha+-- |Parse a delimited string, unsing '\\' as the quoting character+quotedString :: (Monad m,Stream Char s) => Char -> ParserT s m String+quotedString d = between (single d) (single d) (many ch)+  where ch = single '\\' >> unquote<$>token+             <+> noneOf (d:"\\")+        unquote 'n' = '\n'+        unquote 't' = '\t'+        unquote c = c+-- |A single space+space :: (Monad m,Stream Char s) => ParserT s m Char+space = satisfy isSpace+-- |Many spaces+spaces :: (Monad m,Stream Char s) => ParserT s m String+spaces = many1 space++infixl 1 `sepBy`,`sepBy1`+infixr 0 <+>++-- |Chain an operator with an initial value and several tail values.+chainr :: (Stream c s,Monad m) => ParserT s m a -> ParserT s m (b -> a -> a) -> ParserT s m b -> ParserT s m a+chainr expr op e = compose<$>many (op<**>e)<*>expr+-- |Chain an operator with an initial value+chainl :: (Stream c s,Monad m) => ParserT s m a -> ParserT s m (a -> b -> a) -> ParserT s m b -> ParserT s m a+chainl expr op e = compose<$>many (flip<$>op<*>e)<**>expr++-- |Test if a Stream is empty+emptyStream :: Stream c s => s -> Bool+emptyStream = maybe True (const False) . uncons++readable :: (Monad m,Read a) => ParserT String m a +readable = generalize $ map2 swap (readsPrec 0)^.parser+
+ Language/Syntax/CmdArgs.hs view
@@ -0,0 +1,47 @@+module Language.Syntax.CmdArgs (+  -- * Exported modules+  module Language.Parser,++  -- * Preprocessing command-line arguments+  OptDescr(..),ArgDescr(..),usageInfo,+  tokenize,+  +  -- * Example usage+  -- $tutorial+ ) where++import Language.Parser+import System.Console.GetOpt++-- |Create a Parser that preprocesses the command-line arguments,+-- splitting options and their arguments into a user-defined data+-- type.+tokenize :: [OptDescr a] -> (String -> a) -> ParserT [String] (WriterT String Id) [a]+tokenize options wrap = p^.mapping writer.parserT+  where p a = (concat err,pure (a,bs))+          where (bs,_,err) = getOpt (ReturnInOrder wrap) options a++{- $tutorial++This module is intended to provide simple parsing functionality to the+handling of command-line arguments. Here is an example of how this module+may be used.+++>data Option = Help | Version | Other String+>           deriving Eq+>  +>options = [+>  Option ['h'] ["help"] (NoArg Help) "Display this menu.",+>  Option ['v'] ["version"] (NoArg Version) "Show the version of this program"+>  ]+>+>mainAxiom = single Help >> lift (putStrLn (usageInfo options))+>          <+> single Version >> lift (putStrLn "Version: 1.0")+>+>main = void $ do+>    getArgs >>= (mainAxiom <*< tokenize options Other)++-}++
+ Language/Syntax/Regex.hs view
@@ -0,0 +1,32 @@+module Language.Syntax.Regex (regex,runRegex) where++import Language.Parser++runRegex :: String -> String -> [([(String,String)],String)]+runRegex re = join (pure re >*> regex)^..parser <&> map snd++regex :: Parser String (Parser String ([(String,String)],String))+regex = _union+  where _union = (adjacent`sepBy`single '|') <&> sum+        adjacent = many postfixed <&> map concat.sequence+        atom = dot <+> range <+> otherChar <+> between (single '(') (single ')') (named _union)+        named p = cut (option id (map . register<$>between (single '<') (single '>') (many1 (satisfy (/='>'))))) <*> p+          where register n (l,s) = ((n,s):l,s)+        postfixed = comp<$>atom<*>many postfun+          where postfun = satisfy (`elem`"*+?") <&> \c -> case c of+                  '*' -> map sum.many+                  '+' -> map sum.many1+                  '?' -> (+ pure ([],""))+                  _ -> undefined+                comp a fs = compose fs a+        dot = shallow token <$ single '.'+        otherChar = shallow.char<$>noneOf "()[*?|+"+        range = between (single '[') (single ']') t'ranges+          where t'ranges = shallow . satisfy <$> (option id (map not <$ single '^')+                                                <*> (many subRange <&> \rs c -> any ($c) rs))+                subRange = mkRange<$>subChar<*single '-' <*>subChar+                           <+> (==)<$>subChar+                mkRange a b = \c -> c>=a && c<=b+                subChar = noneOf "]"+        shallow = (([],).pure<$>)+        char c = c<$single c
definitive-parser.cabal view
@@ -1,19 +1,23 @@+-- content information name:          definitive-parser-version:       1.0-+category:      Parsers synopsis:      A parser combinator library for the Definitive framework description:   ++-- meta-information author:        Marc Coiffier maintainer:    marc.coiffier@gmail.com+version:       1.2 license:       OtherLicense license-file:  LICENSE +-- build information build-type:    Simple cabal-version: >=1.10  library-  exposed-modules: Algebra.Parser Data.Syntax Algebra.Parser.Regex Data.Serialize-  build-depends: base (== 4.6.*), definitive-base (== 1.0.*), containers (== 0.5.*), deepseq (== 1.3.*), array (== 0.5.*), bytestring (== 0.10.*), vector (== 0.10.*), primitive (== 0.5.*), cpu (== 0.1.*), utf8-string (== 0.3.*)+  exposed-modules: Data.Serialize Language.Parser Data.Syntax Language.Syntax.Regex Language.Syntax.CmdArgs+  build-depends: base (== 4.6.*), definitive-base (== 1.2.*), containers (== 0.5.*), deepseq (== 1.3.*), array (== 0.5.*), bytestring (== 0.10.*), vector (== 0.10.*), primitive (== 0.5.*), cpu (== 0.1.*), utf8-string (== 0.3.*)   default-extensions: TypeSynonymInstances NoMonomorphismRestriction StandaloneDeriving GeneralizedNewtypeDeriving TypeOperators RebindableSyntax FlexibleInstances FlexibleContexts FunctionalDependencies TupleSections MultiParamTypeClasses Rank2Types   ghc-options: -Wall -fno-warn-orphans -threaded   default-language: Haskell2010