packages feed

trifecta 0.29 → 0.30

raw patch · 8 files changed

+326/−3 lines, 8 files

Files

Text/Trifecta/Diagnostic/Rendering/Prim.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE TypeSynonymInstances #-}  -- | Diagnostics rendering+--+-- The type for Lines will very likely change over time, so we can draw lit up control +-- characters for ^Z, ^[, <0xff>, etc. this will make for much nicer diagnostics when +-- working with protocols! module Text.Trifecta.Diagnostic.Rendering.Prim    ( Rendering(..)   , nullRendering@@ -117,13 +121,13 @@     | otherwise           = ( ls + Prelude.length end, draw [soft (Foreground Blue), soft Bold] 0 ls end . draw [] 0 0 s')      where       end = "<EOF>" -      -- end = "\xabEOF\bb"       s' = go 0 s       ls = Prelude.length s'        go n ('\t':xs) = let t = 8 - mod n 8 in P.replicate t ' ' ++ go (n + t) xs       go _ ('\n':_)  = []       go n (x:xs)    = x : go (n + 1) xs       go _ []        = []+        instance Source ByteString where   source = source . UTF8.toString
+ Text/Trifecta/Parser/Char8.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts, PatternGuards #-}+{-# OPTIONS_GHC -fspec-constr -fspec-constr-count=8 #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Char8+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (mptcs, fundeps)+-- +-- This provides a thin backwards compatibility layer for folks who+-- want to write parsers for languages where characters are bytes+-- and don't need to deal with unicode issues. Diagnostics will still+-- report the correct column number in the absence of high ascii characters+-- but if you have those in your source file, you probably aren't going to+-- want to draw those to the screen anyways.+--+-----------------------------------------------------------------------------+++module Text.Trifecta.Parser.Char8+  ( satisfy     -- :: MonadParser m => (Char -> Bool) -> m Char+  , oneOf       -- :: MonadParser m => [Char] -> m Char+  , noneOf      -- :: MonadParser m => [Char] -> m Char+  , oneOfSet    -- :: MonadParser m => ByteSet -> m Char+  , noneOfSet   -- :: MonadParser m => ByteSet -> m Char+  , spaces      -- :: MonadParser m => m ()+  , space       -- :: MonadParser m => m Char+  , newline     -- :: MonadParser m => m Char+  , tab         -- :: MonadParser m => m Char+  , upper       -- :: MonadParser m => m Char+  , lower       -- :: MonadParser m => m Char+  , alphaNum    -- :: MonadParser m => m Char+  , letter      -- :: MonadParser m => m Char+  , digit       -- :: MonadParser m => m Char+  , hexDigit    -- :: MonadParser m => m Char+  , octDigit    -- :: MonadParser m => m Char+  , char        -- :: MonadParser m => Char -> m Char+  , notChar     -- :: MonadParser m => Char -> m Char+  , anyChar     -- :: MonadParser m => m Char+  , string      -- :: MonadParser m => String -> m String+  , byteString  -- :: MonadParser m => ByteString -> m ByteString+  ) where++import Data.Char+import Control.Applicative+import Control.Monad (guard)+import Text.Trifecta.Parser.Class hiding (satisfy)+import Text.Trifecta.Rope.Delta+import Text.Trifecta.ByteSet (ByteSet(..))+import qualified Text.Trifecta.ByteSet as ByteSet+import qualified Data.ByteString as Strict+import Data.ByteString.Internal (w2c,c2w)+import qualified Data.ByteString.Char8 as Char8++-- | Using this instead of 'Text.Trifecta.Parser.Class.satisfy'+-- you too can time travel back to when men were men and characters+-- fit into 8 bits like God intended. It might also be useful+-- when writing lots of fiddly protocol code, where the UTF8 decoding+-- is probably a very bad idea.+satisfy :: MonadParser m => (Char -> Bool) -> m Char+satisfy f = w2c <$> satisfy8 (\w -> f (w2c w))++-- | @oneOf cs@ succeeds if the current character is in the supplied+-- list of characters @cs@. Returns the parsed character. See also+-- 'satisfy'.+-- +-- >   vowel  = oneOf "aeiou"+oneOf :: MonadParser m => [Char] -> m Char+oneOf xs = oneOfSet (ByteSet.fromList (map c2w xs))+{-# INLINE oneOf #-}++-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current+-- character /not/ in the supplied list of characters @cs@. Returns the+-- parsed character.+--+-- >  consonant = noneOf "aeiou"+noneOf :: MonadParser m => [Char] -> m Char+noneOf xs = noneOfSet (ByteSet.fromList (map c2w xs))+{-# INLINE noneOf #-}++-- | @oneOfSet cs@ succeeds if the current character is in the supplied+-- set of characters @cs@. Returns the parsed character. See also+-- 'satisfy'.+-- +-- >   vowel  = oneOf "aeiou"+oneOfSet :: MonadParser m => ByteSet -> m Char+oneOfSet bs = w2c <$> satisfy8 (\w -> ByteSet.member w bs)+{-# INLINE oneOfSet #-}+  +-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current+-- character /not/ in the supplied list of characters @cs@. Returns the+-- parsed character.+--+-- >  consonant = noneOf "aeiou"+noneOfSet :: MonadParser m => ByteSet -> m Char+noneOfSet s = w2c <$> satisfy8 (\w -> not (ByteSet.member w s))+{-# INLINE noneOfSet #-}++-- | Skips /zero/ or more white space characters. See also 'skipMany' and+-- 'whiteSpace'.+spaces :: MonadParser m => m ()+spaces = skipMany space <?> "white space"++-- | Parses a white space character (any character which satisfies 'isSpace')+-- Returns the parsed character. +space :: MonadParser m => m Char+space = satisfy isSpace <?> "space"+{-# INLINE space #-}++-- | Parses a newline character (\'\\n\'). Returns a newline character. +newline :: MonadParser m => m Char+newline = char '\n' <?> "new-line"+{-# INLINE newline #-}++-- | Parses a tab character (\'\\t\'). Returns a tab character. +tab :: MonadParser m => m Char+tab = char '\t' <?> "tab"+{-# INLINE tab #-}++-- | Parses an upper case letter (a character between \'A\' and \'Z\').+-- Returns the parsed character. +upper :: MonadParser m => m Char+upper = satisfy isUpper <?> "uppercase letter"+{-# INLINE upper #-}++-- | Parses a lower case character (a character between \'a\' and \'z\').+-- Returns the parsed character. +lower :: MonadParser m => m Char+lower = satisfy isLower <?> "lowercase letter"+{-# INLINE lower #-}++-- | Parses a letter or digit (a character between \'0\' and \'9\').+-- Returns the parsed character. ++alphaNum :: MonadParser m => m Char+alphaNum = satisfy isAlphaNum <?> "letter or digit"+{-# INLINE alphaNum #-}++-- | Parses a letter (an upper case or lower case character). Returns the+-- parsed character. ++letter :: MonadParser m => m Char+letter = satisfy isAlpha <?> "letter"+{-# INLINE letter #-}++-- | Parses a digit. Returns the parsed character. ++digit :: MonadParser m => m Char+digit = satisfy isDigit <?> "digit"+{-# INLINE digit #-}++-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and+-- \'f\' or \'A\' and \'F\'). Returns the parsed character. +hexDigit :: MonadParser m => m Char+hexDigit = satisfy isHexDigit <?> "hexadecimal digit"+{-# INLINE hexDigit #-}++-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns+-- the parsed character. +octDigit :: MonadParser m => m Char+octDigit = satisfy isOctDigit <?> "octal digit"+{-# INLINE octDigit #-}++-- | @char c@ parses a single character @c@. Returns the parsed+-- character (i.e. @c@).+--+-- >  semiColon  = char ';'+char :: MonadParser m => Char -> m Char+char c = satisfy (c ==) <?> show [c]+{-# INLINE char #-}++-- | @char c@ parses a single character @c@. Returns the parsed+-- character (i.e. @c@).+--+-- >  semiColon  = char ';'+notChar :: MonadParser m => Char -> m Char+notChar c = satisfy (c /=)+{-# INLINE notChar #-}++-- | This parser succeeds for any character. Returns the parsed character. +anyChar :: MonadParser m => m Char+anyChar = satisfy (const True)++-- | @string s@ parses a sequence of characters given by @s@. Returns+-- the parsed string (i.e. @s@).+--+-- >  divOrMod    =   string "div" +-- >              <|> string "mod"+string :: MonadParser m => String -> m String+string s = s <$ byteString (Char8.pack s) <?> show s++-- | @byteString s@ parses a sequence of bytes given by @s@. Returns+-- the parsed byteString (i.e. @s@).+--+-- >  divOrMod    =   string "div" +-- >              <|> string "mod"+byteString :: MonadParser m => Strict.ByteString -> m Strict.ByteString+byteString bs = do+   r <- restOfLine+   let lr = Strict.length r+       lbs = Strict.length bs+   guard $ lr > 0+   case compare lbs lr of+     LT | bs `Strict.isPrefixOf` r -> bs <$ skipping (delta bs)+        | otherwise -> empty+     EQ | bs == r -> bs <$ skipping (delta bs)+        | otherwise -> empty+     GT | r `Strict.isPrefixOf` bs -> bs <$ skipping (delta r) *> byteString (Strict.drop lr bs)+        | otherwise -> empty+ <?> show (Char8.unpack bs)
Text/Trifecta/Parser/Class.hs view
@@ -33,6 +33,7 @@ import Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.Reader import Control.Monad.Trans.Identity+import Control.Monad.Trans.Codensity import Data.Monoid import Data.Word -- import Control.Monad.Trans.Maybe.Strict as Strict
Text/Trifecta/Parser/Combinators.hs view
@@ -180,7 +180,14 @@ -- --    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 :: Alternative m => m a -> m end -> m [a]+manyTill :: (Alternative m, MonadPlus m) => m a -> m end -> m [a]+{-+manyTill p end = scan+  where +    scan = do end; return [] +       <|> do x <- p; xs <- scan; return (x:xs)+-} manyTill p end = go where go = ([] <$ end) <|> ((:) <$> p <*> go)  -- * MonadParsers
Text/Trifecta/Parser/Prim.hs view
@@ -71,6 +71,9 @@ instance Applicative (Parser e) where   pure a = Parser $ \ eo _ _ _ -> eo a mempty   {-# INLINE pure #-}+  (<*>) = ap+  {-# INLINE (<*>) #-}+{-   Parser m <*> Parser n = Parser $ \ eo ee co ce ->      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@@ -83,6 +86,7 @@     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    (<!>) = (<|>)
Text/Trifecta/Util.hs view
@@ -5,6 +5,7 @@   , fromLazy   , toLazy   , takeLine+  , (<$!>)    ) where  import Data.ByteString.Lazy as Lazy@@ -33,3 +34,8 @@   Just i -> Lazy.take (i + 1) s   Nothing -> s +infixl 4 <$!>+(<$!>) :: Monad m => (a -> b) -> m a -> m b+f <$!> m = do+  a <- m +  return $! f a
+ examples/RFC2616.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE BangPatterns #-}+module Main (main) where++import Control.Applicative+import Control.Exception (bracket)+import System.Environment (getArgs)+import System.IO (hClose, openFile, IOMode(ReadMode))+import Text.Trifecta.Parser.Class hiding (satisfy)+import Text.Trifecta.Parser.Token+import Text.Trifecta.Parser.ByteString+import Text.Trifecta.Parser.Combinators+import Text.Trifecta.Parser.Char8+import qualified Text.Trifecta.ByteSet as S+import qualified Data.ByteString as B++infixl 4 <$!>++(<$!>) :: Monad m => (a -> b) -> m a -> m b+f <$!> ma = do+  a <- ma+  return $! f a++token :: MonadParser m => m Char+token = noneOf $ ['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']++isHorizontalSpace :: Char -> Bool+isHorizontalSpace c = c == ' ' || c == '\t'++skipHSpaces :: MonadParser m => m ()+skipHSpaces = skipSome (satisfy isHorizontalSpace)++data Request = Request {+      requestMethod   :: String+    , requestUri      :: String+    , requestProtocol :: String+    } deriving (Eq, Ord, Show)++requestLine :: MonadParser m => m Request+requestLine = Request <$!> (some token <* skipHSpaces)+                       <*> (some (satisfy (not . isHorizontalSpace)) <* skipHSpaces <* string "HTTP/")+                       <*> (many httpVersion <* endOfLine)+ where+  httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.'++endOfLine :: MonadParser m => m ()+endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())++data Header = Header {+      headerName  :: String+    , headerValue :: [String]+    } deriving (Eq, Ord, Show)++messageHeader :: MonadParser m => m Header+messageHeader = (\h b c -> Header h (b : c)) +            <$!> (some token <* char ':' <* skipHSpaces)+             <*> (manyTill anyChar endOfLine)+             <*> (many $ skipHSpaces *> manyTill anyChar endOfLine)++request :: MonadParser m => m (Request, [Header])+request = (,) <$> requestLine <*> many messageHeader <* endOfLine++lumpy arg = do+  r <- parseFromFile (many request) arg+  case r of+    Nothing -> return ()+    Just rs -> print (length rs)++{-+chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->+               loop 0 =<< B.hGetContents h+ where+  loop !n bs+      | B.null bs = print n+      | otherwise = case parse myReq arg bs of+                      Left err      -> putStrLn $ arg ++ ": " ++ show err+                      Right (r,bs') -> loop (n+1) bs'+  myReq :: Parser ((Request, [Header]), B.ByteString)+  myReq = liftA2 (,) request getInput+-}++main :: IO ()+main = mapM_ f =<< getArgs+  where+    f = lumpy+    -- f = chunky
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing, Diagnostics, Pretty Printer, Logging-version:       0.29+version:       0.30 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -12,6 +12,8 @@ synopsis:      A modern parser combinator library with convenient diagnostics description:   A modern unicode-aware parser combinator library with slicing and Clang-style colored diagnostics build-type:    Simple  +extra-source-files:+  examples/RFC2616.hs  source-repository head   type: git@@ -48,6 +50,7 @@     Text.Trifecta.Parser     Text.Trifecta.Parser.ByteString     Text.Trifecta.Parser.Char+    Text.Trifecta.Parser.Char8     Text.Trifecta.Parser.Class     Text.Trifecta.Parser.Combinators     Text.Trifecta.Parser.Expr