trifecta 0.14 → 0.15
raw patch · 10 files changed
+779/−71 lines, 10 files
Files
- LICENSE +1/−0
- Text/Trifecta.hs +15/−10
- Text/Trifecta/Parser/Char.hs +1/−1
- Text/Trifecta/Parser/Class.hs +41/−17
- Text/Trifecta/Parser/Combinators.hs +219/−0
- Text/Trifecta/Parser/Prim.hs +30/−2
- Text/Trifecta/Parser/Step.hs +5/−11
- Text/Trifecta/Parser/Token.hs +374/−0
- Text/Trifecta/Parser/Token/Class.hs +60/−0
- trifecta.cabal +33/−30
LICENSE view
@@ -1,4 +1,5 @@ Copyright 2011 Edward Kmett+Copyright 1999-2000 Daan Leijen All rights reserved.
Text/Trifecta.hs view
@@ -1,28 +1,31 @@ module Text.Trifecta ( module Text.Trifecta.Bytes+-- , module System.Console.Terminfo.Color+ , module System.Console.Terminfo.PrettyPrint+-- , module Text.PrettyPrint.Free , module Text.Trifecta.Delta , module Text.Trifecta.Diagnostic , module Text.Trifecta.Diagnostic.Level , module Text.Trifecta.Hunk- , module Text.Trifecta.Parser.It , module Text.Trifecta.Parser.Char , module Text.Trifecta.Parser.Class+ , module Text.Trifecta.Parser.Combinators , module Text.Trifecta.Parser.Err , module Text.Trifecta.Parser.Err.State+ , module Text.Trifecta.Parser.It , module Text.Trifecta.Parser.Prim , module Text.Trifecta.Parser.Result , module Text.Trifecta.Parser.Step+ , module Text.Trifecta.Parser.Token+ , module Text.Trifecta.Parser.Token.Class , module Text.Trifecta.Path- , module Text.Trifecta.Render.Prim , module Text.Trifecta.Render.Caret , module Text.Trifecta.Render.Fixit+ , module Text.Trifecta.Render.Prim , module Text.Trifecta.Render.Span , module Text.Trifecta.Rope , module Text.Trifecta.Strand , module Text.Trifecta.Util.MaybePair- , module Text.PrettyPrint.Free- , module System.Console.Terminfo.PrettyPrint- , module System.Console.Terminfo.Color ) where import Text.Trifecta.Bytes@@ -30,23 +33,25 @@ import Text.Trifecta.Diagnostic import Text.Trifecta.Diagnostic.Level import Text.Trifecta.Hunk-import Text.Trifecta.Parser.It import Text.Trifecta.Parser.Char import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Combinators import Text.Trifecta.Parser.Err import Text.Trifecta.Parser.Err.State+import Text.Trifecta.Parser.It import Text.Trifecta.Parser.Prim import Text.Trifecta.Parser.Result import Text.Trifecta.Parser.Step+import Text.Trifecta.Parser.Token+import Text.Trifecta.Parser.Token.Class import Text.Trifecta.Path-import Text.Trifecta.Render.Prim import Text.Trifecta.Render.Caret import Text.Trifecta.Render.Fixit+import Text.Trifecta.Render.Prim import Text.Trifecta.Render.Span import Text.Trifecta.Rope import Text.Trifecta.Strand import Text.Trifecta.Util.MaybePair--import Text.PrettyPrint.Free hiding (column, char, line, string, space)+-- import Text.PrettyPrint.Free hiding (column, char, line, string, space) import System.Console.Terminfo.PrettyPrint-import System.Console.Terminfo.Color+-- import System.Console.Terminfo.Color
Text/Trifecta/Parser/Char.hs view
@@ -125,7 +125,7 @@ -- > <|> string "mod" byteString :: MonadParser m => ByteString -> m ByteString byteString bs = do- r <- rest+ r <- restOfLine let lr = Strict.length r lbs = Strict.length bs guard $ lr > 0
Text/Trifecta/Parser/Class.hs view
@@ -1,15 +1,29 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module : Text.Trifecta.Parser.Class+-- Copyright : (c) Edward Kmett 2011+-- License : BSD3+-- +-- Maintainer : ekmett@gmail.com+-- Stability : experimental+-- Portability : non-portable+-- +----------------------------------------------------------------------------- module Text.Trifecta.Parser.Class ( MonadParser(..)- , rest+ , restOfLine+ , skipping , (<?>)+ , slicedWith , sliced ) where import Control.Applicative import Control.Monad (MonadPlus(..)) import Control.Monad.Trans.Class-import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.State.Lazy as Lazy import Data.ByteString as Strict import Data.Semigroup import Data.Set as Set@@ -17,8 +31,9 @@ import Text.Trifecta.Rope import Text.Trifecta.Parser.It -class ( Alternative m, MonadPlus m) => MonadParser m where+infix 0 <?> +class ( Alternative m, MonadPlus m) => MonadParser m where -- * non-committal actions try :: m a -> m a labels :: m a -> Set String -> m a@@ -27,22 +42,17 @@ unexpected :: MonadParser m => String -> m a line :: m ByteString - -- * actions that commit- satisfy :: (Char -> Bool) -> m Char+ -- * actions that definitely commit release :: Delta -> m ()+ satisfy :: (Char -> Bool) -> m Char satisfyAscii :: (Char -> Bool) -> m Char satisfyAscii f = toEnum . fromEnum <$> satisfy (f . toEnum . fromEnum) - skipping :: HasDelta d => d -> m d- skipping d = do- m <- mark- d <$ release (m <> delta d)--instance MonadParser m => MonadParser (StateT s m) where+instance MonadParser m => MonadParser (Lazy.StateT s m) where satisfy = lift . satisfy- try (StateT m) = StateT $ try . m- labels (StateT m) ss = StateT $ \s -> labels (m s) ss+ try (Lazy.StateT m) = Lazy.StateT $ try . m+ labels (Lazy.StateT m) ss = Lazy.StateT $ \s -> labels (m s) ss line = lift line liftIt = lift . liftIt mark = lift mark @@ -50,17 +60,31 @@ unexpected = lift . unexpected satisfyAscii = lift . satisfyAscii -rest :: MonadParser m => m ByteString-rest = do+-- useful when we've just recognized something out of band using access to the current line +skipping :: (MonadParser m, HasDelta d) => d -> m d+skipping d = do m <- mark+ d <$ release (m <> delta d)++-- | grab the remainder of the current line+restOfLine :: MonadParser m => m ByteString+restOfLine = do+ m <- mark Strict.drop (columnByte m) <$> line +-- | label a parser with a name (<?>) :: MonadParser m => m a -> String -> m a p <?> msg = labels p (Set.singleton msg) -sliced :: MonadParser m => (a -> Strict.ByteString -> r) -> m a -> m r-sliced f pa = do+-- | run a parser, grabbing all of the text between its start and end points+slicedWith :: MonadParser m => (a -> Strict.ByteString -> r) -> m a -> m r+slicedWith f pa = do m <- mark a <- pa r <- mark liftIt $ f a <$> sliceIt m r++-- | run a parser, grabbing all of the text between its start and end points and discarding the original result+sliced :: MonadParser m => m a -> m ByteString+sliced = slicedWith (\_ bs -> bs)+
+ Text/Trifecta/Parser/Combinators.hs view
@@ -0,0 +1,219 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Trifecta.Parser.Combinators+-- Copyright : (c) Edward Kmett 2011+-- License : BSD3+-- +-- Maintainer : ekmett@gmail.com+-- Stability : experimental+-- Portability : non-portable+-- +-- Commonly used generic combinators+-- +-----------------------------------------------------------------------------++module Text.Trifecta.Parser.Combinators + ( choice+ , option+ , optional -- from Control.Applicative, parsec optionMaybe+ , skipOptional -- parsec optional+ , between+ , skipSome -- parsec skipMany1+ , skipMany+ , some -- from Control.Applicative, parsec many1+ , many -- from Control.Applicative+ , sepBy+ , sepBy1+ , sepEndBy1+ , sepEndBy+ , endBy1+ , endBy+ , count+ , chainl+ , chainr+ , chainl1+ , chainr1+ , eof+ , manyTill+ , notFollowedBy+ , lookAhead+ ) where++import Data.Traversable+import Control.Applicative+import Text.Trifecta.Parser.Class++-- | @choice ps@ tries to apply the parsers in the list @ps@ in order,+-- until one of them succeeds. Returns the value of the succeeding+-- parser.+choice :: Alternative m => [m a] -> m a+choice = foldr (<|>) empty++-- | @option x p@ tries to apply parser @p@. If @p@ fails without+-- consuming input, it returns the value @x@, otherwise the value+-- returned by @p@.+--+-- > priority = option 0 (do{ d <- digit+-- > ; return (digitToInt d) +-- > })+option :: Alternative m => a -> m a -> m a+option x p = p <|> pure x++-- | @skipOptional p@ tries to apply parser @p@. It will parse @p@ or nothing.+-- It only fails if @p@ fails after consuming input. It discards the result+-- of @p@. (Plays the role of parsec's optional, which conflicts with Applicative's optional)+skipOptional :: Alternative m => m a -> m ()+skipOptional p = (() <$ p) <|> pure ()++-- | @between open close p@ parses @open@, followed by @p@ and @close@.+-- Returns the value returned by @p@.+--+-- > braces = between (symbol "{") (symbol "}")+between :: Applicative m => m bra -> m ket -> m a -> m a+between bra ket p = bra *> p <* ket++-- | @skipSome p@ applies the parser @p@ /one/ or more times, skipping+-- its result. (aka skipMany1 in parsec)+skipSome :: Alternative m => m a -> m ()+skipSome p = p *> skipMany p++-- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping+-- its result. +skipMany :: Alternative m => m a -> m ()+skipMany p = ps where ps = (p *> ps) <|> pure ()++-- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of values returned by @p@.+--+-- > commaSep p = p `sepBy` (symbol ",")+sepBy :: Alternative m => m a -> m sep -> m [a]+sepBy p sep = sepBy1 p sep <|> pure []++-- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of values returned by @p@. +sepBy1 :: Alternative m => m a -> m sep -> m [a]+sepBy1 p sep = (:) <$> p <*> many (sep *> p)++-- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,+-- separated and optionally ended by @sep@. Returns a list of values+-- returned by @p@. +sepEndBy1 :: Alternative m => m a -> m sep -> m [a]+sepEndBy1 p sep = flip id <$> p <*> ((flip (:) <$> (sep *> sepEndBy p sep)) <|> pure pure)++-- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,+-- separated and optionally ended by @sep@, ie. haskell style+-- statements. Returns a list of values returned by @p@.+--+-- > haskellStatements = haskellStatement `sepEndBy` semi+sepEndBy :: Alternative m => m a -> m sep -> m [a]+sepEndBy p sep = sepEndBy1 p sep <|> pure []++-- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, seperated+-- and ended by @sep@. Returns a list of values returned by @p@. +endBy1 :: Alternative m => m a -> m sep -> m [a]+endBy1 p sep = some (p <* sep)++-- | @endBy p sep@ parses /zero/ or more occurrences of @p@, seperated+-- and ended by @sep@. Returns a list of values returned by @p@.+--+-- > cStatements = cStatement `endBy` semi+endBy :: Alternative m => m a -> m sep -> m [a]+endBy p sep = many (p <* sep)+++-- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or+-- equal to zero, the parser equals to @return []@. Returns a list of+-- @n@ values returned by @p@. +count :: Applicative m => Int -> m a -> m [a]+count n p | n <= 0 = pure []+ | otherwise = sequenceA (replicate n p)+++-- | @chainr p op x@ parser /zero/ or more occurrences of @p@,+-- separated by @op@ Returns a value obtained by a /right/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. If there are no occurrences of @p@, the value @x@ is+-- returned.+chainr :: Alternative m => m a -> m (a -> a -> a) -> a -> m a+chainr p op x = chainr1 p op <|> pure x++-- | @chainl p op x@ parser /zero/ or more occurrences of @p@,+-- separated by @op@. Returns a value obtained by a /left/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. If there are zero occurrences of @p@, the value @x@ is+-- returned.+chainl :: Alternative m => m a -> m (a -> a -> a) -> a -> m a+chainl p op x = chainl1 p op <|> pure x++-- | @chainl1 p op x@ parser /one/ or more occurrences of @p@,+-- separated by @op@ Returns a value obtained by a /left/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. . This parser can for example be used to eliminate left+-- recursion which typically occurs in expression grammars.+--+-- > expr = term `chainl1` addop+-- > term = factor `chainl1` mulop+-- > factor = parens expr <|> integer+-- >+-- > mulop = do{ symbol "*"; return (*) }+-- > <|> do{ symbol "/"; return (div) }+-- >+-- > addop = do{ symbol "+"; return (+) }+-- > <|> do{ symbol "-"; return (-) }+chainl1 :: Alternative m => m a -> m (a -> a -> a) -> m a+chainl1 p op = scan where+ scan = flip id <$> p <*> rst+ rst = (\f y g x -> g (f x y)) <$> op <*> p <*> rst <|> pure id++-- | @chainr1 p op x@ parser /one/ or more occurrences of |p|,+-- separated by @op@ Returns a value obtained by a /right/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@.+chainr1 :: Alternative m => m a -> m (a -> a -> a) -> m a+chainr1 p op = scan where+ scan = flip id <$> p <*> rst+ rst = (flip <$> op <*> scan) <|> pure id++-- | @manyTill p end@ applies parser @p@ /zero/ or more times until+-- parser @end@ succeeds. Returns the list of values returned by @p@.+-- This parser can be used to scan comments:+--+-- > simpleComment = do{ string "<!--"+-- > ; manyTill anyChar (try (string "-->"))+-- > }+--+-- Note the overlapping parsers @anyChar@ and @string \"-->\"@, and+-- therefore the use of the 'try' combinator.+manyTill :: Alternative m => m a -> m end -> m [a]+manyTill p end = go where go = ([] <$ end) <|> ((:) <$> p <*> go)++-- * MonadParsers ++-- | This parser only succeeds at the end of the input. This is not a+-- primitive parser but it is defined using 'notFollowedBy'.+--+-- > eof = notFollowedBy anyChar <?> "end of input"+eof :: MonadParser m => m ()+eof = notFollowedBy (satisfy (const True)) <?> "end of input"++-- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser+-- does not consume any input. This parser can be used to implement the+-- \'longest match\' rule. For example, when recognizing keywords (for+-- example @let@), we want to make sure that a keyword is not followed+-- by a legal identifier character, in which case the keyword is+-- actually an identifier (for example @lets@). We can program this+-- behaviour as follows:+--+-- > keywordLet = try (do{ string "let"+-- > ; notFollowedBy alphaNum+-- > })+notFollowedBy :: (MonadParser m, Show a) => m a -> m ()+notFollowedBy p = try ((try p >>= unexpected . show) <|> pure ())++-- | @lookAhead p@ parses @p@ without consuming any input.+lookAhead :: MonadParser m => m a -> m a+lookAhead p = try $ do + m <- mark+ p <* release m++
Text/Trifecta/Parser/Prim.hs view
@@ -1,4 +1,15 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, Rank2Types, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Trifecta.Parser.Prim+-- Copyright : (c) Edward Kmett 2011+-- License : BSD3+-- +-- Maintainer : ekmett@gmail.com+-- Stability : experimental+-- Portability : non-portable+-- +----------------------------------------------------------------------------- module Text.Trifecta.Parser.Prim ( Parser(..) , why@@ -47,6 +58,8 @@ instance Functor (Parser e) where fmap f (Parser m) = Parser $ \ eo ee co -> m (eo . f) ee (co . f) {-# INLINE fmap #-}+ a <$ Parser m = Parser $ \ eo ee co -> m (\_ -> eo a) ee (\_ -> co a)+ {-# INLINE (<$) #-} instance Apply (Parser e) where (<.>) = (<*>) instance Applicative (Parser e) where@@ -56,6 +69,14 @@ m (\f e -> n (\a e' -> eo (f a) (e <> e')) ee (\a e' -> co (f a) (e <> e')) ce) ee (\f e -> n (\a e' -> co (f a) (e <> e')) ce (\a e' -> co (f a) (e <> e')) ce) ce {-# INLINE (<*>) #-}+ Parser m <* Parser n = Parser $ \ eo ee co ce -> + m (\a e -> n (\_ e' -> eo a (e <> e')) ee (\_ e' -> co a (e <> e')) ce) ee+ (\a e -> n (\_ e' -> co a (e <> e')) ce (\_ e' -> co a (e <> e')) ce) ce+ {-# INLINE (<*) #-}+ Parser m *> Parser n = Parser $ \ eo ee co ce -> + m (\_ e -> n (\a e' -> eo a (e <> e')) ee (\a e' -> co a (e <> e')) ce) ee+ (\_ e -> n (\a e' -> co a (e <> e')) ce (\a e' -> co a (e <> e')) ce) ce+ {-# INLINE (*>) #-} instance Alt (Parser e) where (<!>) = (<|>) instance Plus (Parser e) where zero = empty@@ -69,9 +90,14 @@ co ce) co ce- {-# INLINE (<|>) #-}+instance Semigroup (Parser e a) where+ (<>) = (<|>) +instance Monoid (Parser e a) where+ mappend = (<|>)+ mempty = empty+ instance Bind (Parser e) where (>>-) = (>>=) instance Monad (Parser e) where return a = Parser $ \ eo _ _ _ -> eo a mempty@@ -80,6 +106,8 @@ m (\a e -> unparser (k a) (\b e' -> eo b (e <> e')) (\e' -> ee (e <> e')) co ce) ee (\a e -> unparser (k a) (\b e' -> co b (e <> e')) (\e' -> ce (e <> e')) co ce) ce {-# INLINE (>>=) #-}+ (>>) = (*>) + {-# INLINE (>>) #-} fail = throwError . FailErr {-# INLINE fail #-} @@ -184,7 +212,7 @@ expected doc = doc <> text ", expected" <+> fillSep (punctuate (char ',') $ text <$> toList ss) parseTest :: Show a => Parser TermDoc a -> String -> IO ()-parseTest p s = case eof (feed st (UTF8.fromString s)) of+parseTest p s = case starve (feed st (UTF8.fromString s)) of Failure xs e -> displayLn $ prettyTerm $ toList (xs |> e) Success xs a -> do displayLn $ prettyTerm $ toList xs
Text/Trifecta/Parser/Step.hs view
@@ -2,8 +2,7 @@ module Text.Trifecta.Parser.Step ( Step(..) , feed- , eof- , eof'+ , starve , stepResult ) where @@ -42,15 +41,10 @@ feed (StepFail r xs e) t = StepFail (snoc r t) xs e feed (StepCont r _ k) t = k (snoc r t) -eof :: Step e a -> Result e a-eof (StepDone _ xs a) = Success xs a-eof (StepFail _ xs e) = Failure xs e-eof (StepCont _ z _) = z--eof' :: Step e a -> Result e (Rope, a)-eof' (StepDone r xs a) = Success xs (r, a)-eof' (StepFail _ xs e) = Failure xs e-eof' (StepCont r z _) = fmap ((,) r) z+starve :: Step e a -> Result e a+starve (StepDone _ xs a) = Success xs a+starve (StepFail _ xs e) = Failure xs e+starve (StepCont _ z _) = z stepResult :: Rope -> Result e a -> Step e a stepResult r (Success xs a) = StepDone r xs a
+ Text/Trifecta/Parser/Token.hs view
@@ -0,0 +1,374 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Trifecta.Parser.Token+-- Copyright : (c) Edward Kmett 2011,+-- (c) Daan Leijen 1999-2001+-- License : BSD3+-- +-- Maintainer : ekmett@gmail.com+-- Stability : provisional+-- Portability : non-portable+-- +-----------------------------------------------------------------------------+module Text.Trifecta.Parser.Token+ ( identifier+ , reserved+ , operator+ , reservedOp+ , charLiteral+ , stringLiteral+ , natural+ , integer+ , double+ , naturalOrDouble+ , decimal+ , hexadecimal+ , octal+ , symbol+ , symbolic+ , lexeme+ , parens+ , braces+ , angles+ , brackets+ , semi+ , comma+ , colon+ , dot+ , semiSep+ , semiSep1+ , commaSep+ , commaSep1+ ) where++import Data.Char (digitToInt)+import Data.ByteString as Strict hiding (map, zip, foldl, foldr)+import Control.Applicative+import Control.Monad (when)+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Char+import Text.Trifecta.Parser.Combinators+import Text.Trifecta.Parser.Token.Class++-- | This lexeme parser parses a legal identifier. Returns the identifier+-- string. This parser will fail on identifiers that are reserved+-- words. Legal identifier (start) characters and reserved words are+-- defined in the 'LanguageDef' that is passed to+-- 'makeTokenParser'. An @identifier@ is treated as+-- a single token using 'try'.+identifier :: MonadTokenParser m => m ByteString+identifier = lexeme $ try $ do + name <- sliced ident + b <- isReservedName name+ when b $ unexpected $ "reserved word " ++ show name+ return name+ where + ident = identStart *> skipMany identLetter+ <?> "identifier"++-- | The lexeme parser @reserved name@ parses @symbol +-- name@, but it also checks that the @name@ is not a prefix of a+-- valid identifier. A @reserved@ word is treated as a single token+-- using 'try'. +reserved :: MonadTokenParser m => ByteString -> m ()+reserved name = lexeme $ try $ do+ _ <- byteString name+ notFollowedBy identLetter <?> "end of " ++ show name++-- | This lexeme parser parses a legal operator. Returns the name of the+-- operator. This parser will fail on any operators that are reserved+-- operators. Legal operator (start) characters and reserved operators+-- are defined in the 'LanguageDef' that is passed to+-- 'makeTokenParser'. An @operator@ is treated as a+-- single token using 'try'. +operator :: MonadTokenParser m => m ByteString+operator = lexeme $ try $ do+ name <- sliced (opStart *> skipMany opLetter) <?> "operator"+ b <- isReservedOpName name+ when b $ unexpected $ "reserved operator " ++ show name+ return name++-- |The lexeme parser @reservedOp name@ parses @symbol+-- name@, but it also checks that the @name@ is not a prefix of a+-- valid operator. A @reservedOp@ is treated as a single token using+-- 'try'. +reservedOp :: MonadTokenParser m => String -> m ()+reservedOp name = lexeme $ try $ do+ _ <- string name + notFollowedBy opLetter <?> "end of " ++ show name++-- | This lexeme parser parses a single literal character. Returns the+-- literal character value. This parsers deals correctly with escape+-- sequences. The literal character is parsed according to the grammar+-- rules defined in the Haskell report (which matches most programming+-- languages quite closely). +charLiteral :: MonadTokenParser m => m Char+charLiteral = lexeme (between (char '\'') (char '\'' <?> "end of character") characterChar)+ <?> "character" ++characterChar, charEscape, charLetter :: MonadTokenParser m => m Char+characterChar = charLetter <|> charEscape+ <?> "literal character"+charEscape = char '\\' *> escapeCode+charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))++-- | This lexeme parser parses a literal string. Returns the literal+-- string value. This parsers deals correctly with escape sequences and+-- gaps. The literal string is parsed according to the grammar rules+-- defined in the Haskell report (which matches most programming+-- languages quite closely). ++stringLiteral :: MonadTokenParser m => m String+stringLiteral = lexeme lit where+ lit = foldr (maybe id (:)) "" <$> between (char '"') (char '"' <?> "end of string") (many stringChar) + <?> "literal string"+ stringChar = Just <$> stringLetter + <|> stringEscape + <?> "string character"+ stringLetter = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))++ stringEscape = char '\\' *> esc where+ esc = Nothing <$ escapeGap + <|> Nothing <$ escapeEmpty + <|> Just <$> escapeCode+ escapeEmpty = char '&'+ escapeGap = do skipSome space+ char '\\' <?> "end of string gap"++escapeCode :: MonadTokenParser m => m Char+escapeCode = (charEsc <|> charNum <|> charAscii <|> charControl) <?> "escape code"+ where + charControl = (\c -> toEnum (fromEnum c - fromEnum 'A')) <$> (char '^' *> upper)+ charNum = toEnum . fromInteger <$> num where+ num = decimal + <|> (char 'o' *> number 8 octDigit)+ <|> (char 'x' *> number 16 hexDigit)+ charEsc = choice $ parseEsc <$> escMap+ parseEsc (c,code) = code <$ char c+ escMap = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")+ charAscii = choice $ parseAscii <$> asciiMap+ parseAscii (asc,code) = try $ code <$ string asc+ asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2)+ ascii2codes, ascii3codes :: [String]+ ascii2codes = [ "BS","HT","LF","VT","FF","CR","SO"+ , "SI","EM","FS","GS","RS","US","SP"]+ ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK"+ ,"BEL","DLE","DC1","DC2","DC3","DC4","NAK"+ ,"SYN","ETB","CAN","SUB","ESC","DEL"]+ ascii2, ascii3 :: [Char]+ ascii2 = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI'+ ,'\EM','\FS','\GS','\RS','\US','\SP']+ ascii3 = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK'+ ,'\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK'+ ,'\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']+ ++-- | This lexeme parser parses a natural number (a positive whole+-- number). Returns the value of the number. The number can be+-- specified in 'decimal', 'hexadecimal' or+-- 'octal'. The number is parsed according to the grammar+-- rules in the Haskell report. ++natural :: MonadTokenParser m => m Integer+natural = lexeme nat <?> "natural"++number :: MonadTokenParser m => Integer -> m Char -> m Integer+number base baseDigit = do+ digits <- some baseDigit+ return $! foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits++-- | This lexeme parser parses an integer (a whole number). This parser+-- is like 'natural' except that it can be prefixed with+-- sign (i.e. \'-\' or \'+\'). Returns the value of the number. The+-- number can be specified in 'decimal', 'hexadecimal'+-- or 'octal'. The number is parsed according+-- to the grammar rules in the Haskell report. + +integer :: MonadTokenParser m => m Integer+integer = lexeme int <?> "integer"++sign :: MonadTokenParser m => m (Integer -> Integer)+sign = negate <$ char '-'+ <|> id <$ char '+'+ <|> pure id++nat, int, zeroNumber :: MonadTokenParser m => m Integer+nat = zeroNumber <|> decimal+int = lexeme sign <*> nat+zeroNumber = char '0' *> (hexadecimal <|> octal <|> decimal <|> return 0) <?> ""++-- | This lexeme parser parses a floating point value. Returns the value+-- of the number. The number is parsed according to the grammar rules+-- defined in the Haskell report. ++double :: MonadTokenParser m => m Double+double = lexeme floating <?> "double"++floating :: MonadTokenParser m => m Double+floating = decimal >>= fractExponent++fractExponent :: MonadTokenParser m => Integer -> m Double+fractExponent n = (\fract expo -> (fromInteger n + fract) * expo) <$> fraction <*> option 1.0 exponent'+ <|> (fromInteger n *) <$> exponent' where+ fraction = foldr op 0.0 <$> (char '.' *> (some digit <?> "fraction"))+ op d f = (f + fromIntegral (digitToInt d))/10.0+ exponent' = do+ _ <- oneOf "eE"+ f <- sign+ e <- decimal <?> "exponent"+ return (power (f e))+ <?> "exponent"+ power e + | e < 0 = 1.0/power(-e)+ | otherwise = fromInteger (10^e)++-- | This lexeme parser parses either 'natural' or a 'float'.+-- Returns the value of the number. This parsers deals with+-- any overlap in the grammar rules for naturals and floats. The number+-- is parsed according to the grammar rules defined in the Haskell report. ++naturalOrDouble :: MonadTokenParser m => m (Either Integer Double)+naturalOrDouble = lexeme natDouble <?> "number"++natDouble , zeroNumFloat, decimalFloat :: MonadTokenParser m => m (Either Integer Double)+natDouble + = char '0' *> zeroNumFloat+ <|> decimalFloat+zeroNumFloat+ = Left <$> (hexadecimal <|> octal)+ <|> decimalFloat+ <|> fractFloat 0+ <|> return (Left 0)+decimalFloat = do + n <- decimal+ option (Left n) (fractFloat n)++fractFloat :: MonadTokenParser m => Integer -> m (Either Integer Double)+fractFloat n = Right <$> fractExponent n++-- | Parses a positive whole number in the decimal system. Returns the+-- value of the number. ++decimal :: MonadTokenParser m => m Integer+decimal = number 10 digit++-- | Parses a positive whole number in the hexadecimal system. The number+-- should be prefixed with \"0x\" or \"0X\". Returns the value of the+-- number. ++hexadecimal :: MonadTokenParser m => m Integer+hexadecimal = oneOf "xX" *> number 16 hexDigit++-- | Parses a positive whole number in the octal system. The number+-- should be prefixed with \"0o\" or \"0O\". Returns the value of the+-- number. ++octal :: MonadTokenParser m => m Integer+octal = oneOf "oO" *> number 8 octDigit++-- | Lexeme parser @symbol s@ parses 'string' @s@ and skips+-- trailing white space. ++symbol :: MonadTokenParser m => ByteString -> m ByteString+symbol name = lexeme (byteString name)++-- | Lexeme parser @symbolic s@ parses 'char' @s@ and skips+-- trailing white space. ++symbolic :: MonadTokenParser m => Char -> m Char+symbolic name = lexeme (char name)++-- | @lexeme p@ first applies parser @p@ and than the 'whiteSpace'+-- parser, returning the value of @p@. Every lexical+-- token (lexeme) is defined using @lexeme@, this way every parse+-- starts at a point without white space. Parsers that use @lexeme@ are+-- called /lexeme/ parsers in this document.+-- +-- The only point where the 'whiteSpace' parser should be+-- called explicitly is the start of the main parser in order to skip+-- any leading white space.+--+-- > mainParser = do{ whiteSpace+-- > ; ds <- many (lexeme digit)+-- > ; eof+-- > ; return (sum ds)+-- > }++lexeme :: MonadTokenParser m => m a -> m a+lexeme p = p <* whiteSpace++-- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis,+-- returning the value of @p@.++parens :: MonadTokenParser m => m a -> m a+parens = between (symbolic '(') (symbolic ')')+++-- | Lexeme parser @braces p@ parses @p@ enclosed in braces (\'{\' and+-- \'}\'), returning the value of @p@. ++braces :: MonadTokenParser m => m a -> m a+braces = between (symbolic '{') (symbolic '}')++-- | Lexeme parser @angles p@ parses @p@ enclosed in angle brackets (\'\<\'+-- and \'>\'), returning the value of @p@. ++angles :: MonadTokenParser m => m a -> m a+angles = between (symbolic '<') (symbolic '>')++-- | Lexeme parser @brackets p@ parses @p@ enclosed in brackets (\'[\'+-- and \']\'), returning the value of @p@. ++brackets :: MonadTokenParser m => m a -> m a+brackets = between (symbolic '<') (symbolic '>')++-- | Lexeme parser |semi| parses the character \';\' and skips any+-- trailing white space. Returns the string \";\". ++semi :: MonadTokenParser m => m Char+semi = symbolic ';'++-- | Lexeme parser @comma@ parses the character \',\' and skips any+-- trailing white space. Returns the string \",\". ++comma :: MonadTokenParser m => m Char+comma = symbolic ','++-- | Lexeme parser @colon@ parses the character \':\' and skips any+-- trailing white space. Returns the string \":\". ++colon :: MonadTokenParser m => m Char+colon = symbolic ':'++-- | Lexeme parser @dot@ parses the character \'.\' and skips any+-- trailing white space. Returns the string \".\". ++dot :: MonadTokenParser m => m Char+dot = symbolic '.'++-- | Lexeme parser @semiSep p@ parses /zero/ or more occurrences of @p@+-- separated by 'semi'. Returns a list of values returned by+-- @p@.++semiSep :: MonadTokenParser m => m a -> m [a]+semiSep p = sepBy p semi++-- | Lexeme parser @semiSep1 p@ parses /one/ or more occurrences of @p@+-- separated by 'semi'. Returns a list of values returned by @p@. ++semiSep1 :: MonadTokenParser m => m a -> m [a]+semiSep1 p = sepBy1 p semi++-- | Lexeme parser @commaSep p@ parses /zero/ or more occurrences of+-- @p@ separated by 'comma'. Returns a list of values returned+-- by @p@. ++commaSep :: MonadTokenParser m => m a -> m [a]+commaSep p = sepBy p comma++-- | Lexeme parser @commaSep1 p@ parses /one/ or more occurrences of+-- @p@ separated by 'comma'. Returns a list of values returned+-- by @p@. ++commaSep1 :: MonadTokenParser m => m a -> m [a]+commaSep1 p = sepBy p comma
+ Text/Trifecta/Parser/Token/Class.hs view
@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Trifecta.Parser.Token.Class+-- Copyright : (c) Edward Kmett 2011+-- License : BSD3+-- +-- Maintainer : ekmett@gmail.com+-- Stability : experimental+-- Portability : non-portable+-- +-----------------------------------------------------------------------------+module Text.Trifecta.Parser.Token.Class+ ( MonadTokenParser(..)+ ) where++import Control.Monad.Trans.Class+import Data.ByteString+import Control.Monad.Trans.State.Lazy as Lazy+import Text.Trifecta.Parser.Class++class MonadParser m => MonadTokenParser m where+ -- | Parses any white space. White space consists of /zero/ or more+ -- occurrences of a 'space', a line comment or a block (multi+ -- line) comment. Block comments may be nested. How comments are+ -- started and ended is defined by this method.+ whiteSpace :: m ()++ -- | This parser should accept any start characters of identifiers. For+ -- example @letter \<|> char \"_\"@. + identStart :: m Char++ -- | This parser should accept any legal tail characters of identifiers.+ -- For example @alphaNum \<|> char \"_\"@. + identLetter :: m Char++ -- | This parser should accept any start characters of operators. For+ -- example @oneOf \":!#$%&*+.\/\<=>?\@\\\\^|-~\"@ + opStart :: m Char++ -- | This parser should accept any legal tail characters of operators.+ -- Note that this parser should even be defined if the language doesn't+ -- support user-defined operators, or otherwise the 'reservedOp'+ -- parser won't work correctly. + opLetter :: m Char++ -- | Check the list of reserved identifiers. + isReservedName :: ByteString -> m Bool++ -- | Check the list of reserved operators. + isReservedOpName :: ByteString -> m Bool++instance MonadTokenParser m => MonadTokenParser (Lazy.StateT s m) where+ whiteSpace = lift whiteSpace+ identStart = lift identStart+ identLetter = lift identLetter+ opStart = lift opStart+ opLetter = lift opLetter+ isReservedName = lift . isReservedName+ isReservedOpName = lift . isReservedOpName+
trifecta.cabal view
@@ -1,6 +1,6 @@ name: trifecta-category: Text, Parsing-version: 0.14+category: Text, Parsing, Diagnostics, Pretty Printer, Logging+version: 0.15 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -9,8 +9,8 @@ stability: experimental homepage: http://github.com/ekmett/trifecta/ copyright: Copyright (C) 2011 Edward A. Kmett-synopsis: Parser combinators with slicing and diagnostic support-description: Parser combinators with slicing and diagnostic support+synopsis: A modern parser combinator library with convenient diagnostics+description: A modern parser combinator library with slicing and Clang-style colored diagnostics build-type: Simple source-repository head@@ -18,32 +18,6 @@ location: git://github.com/ekmett/trifecta.git library- build-depends: - base >= 4 && < 5,- array >= 0.3.0.2 && < 0.4, - containers >= 0.3 && < 0.5,- bifunctors >= 0.1.1.3 && < 0.2,- intern >= 0.5.1.1 && < 0.6,- hashable >= 1.1.2.1 && < 1.2,- bytestring >= 0.9.1 && < 0.10,- mtl >= 2.0.1 && < 2.1,- semigroups >= 0.7.1 && < 0.8, - fingertree >= 0.0.1 && < 0.1,- reducers >= 0.1.2 && < 0.2,- profunctors >= 0.1.1 && < 0.2,- parsec >= 3.1.1 && < 3.2,- utf8-string >= 0.3.6 && < 0.4,- semigroupoids >= 1.2.4 && < 1.3,- parallel >= 3.1.0.1 && < 3.2,- transformers >= 0.2.2 && < 0.3,- comonad >= 1.1.1 && < 1.2,- terminfo >= 0.3.2 && < 0.4,- keys >= 2.0.1 && < 2.1,- wl-pprint-extras >= 1.4 && < 1.5,- wl-pprint-terminfo >= 0.4 && < 0.5-- ghc-options: -Wall- exposed-modules: Text.Trifecta Text.Trifecta.Bytes@@ -58,7 +32,10 @@ Text.Trifecta.Parser.Err.State Text.Trifecta.Parser.Prim Text.Trifecta.Parser.Result+ Text.Trifecta.Parser.Combinators Text.Trifecta.Parser.Step+ Text.Trifecta.Parser.Token+ Text.Trifecta.Parser.Token.Class Text.Trifecta.Path Text.Trifecta.Render.Prim Text.Trifecta.Render.Caret@@ -70,3 +47,29 @@ other-modules: Text.Trifecta.Util++ ghc-options: -Wall++ build-depends: + base >= 4 && < 5,+ array >= 0.3.0.2 && < 0.4, + containers >= 0.3 && < 0.5,+ bifunctors >= 0.1.1.3 && < 0.2,+ intern >= 0.5.1.1 && < 0.6,+ hashable >= 1.1.2.1 && < 1.2,+ bytestring >= 0.9.1 && < 0.10,+ mtl >= 2.0.1 && < 2.1,+ semigroups >= 0.7.1 && < 0.8, + fingertree >= 0.0.1 && < 0.1,+ reducers >= 0.1.2 && < 0.2,+ profunctors >= 0.1.1 && < 0.2,+ parsec >= 3.1.1 && < 3.2,+ utf8-string >= 0.3.6 && < 0.4,+ semigroupoids >= 1.2.4 && < 1.3,+ parallel >= 3.1.0.1 && < 3.2,+ transformers >= 0.2.2 && < 0.3,+ comonad >= 1.1.1 && < 1.2,+ terminfo >= 0.3.2 && < 0.4,+ keys >= 2.0.1 && < 2.1,+ wl-pprint-extras >= 1.4 && < 1.5,+ wl-pprint-terminfo >= 0.4 && < 0.5