Mario Blažević avatar Mario Blažević committed 5cbf246

Added some TextualMonoid-specific functions and optimized 'string'.

Comments (0)

Files changed (2)

Data/Attoparsec/Cancellative.hs

     , I.try
     , module Data.Attoparsec.Combinator
 
-    -- * Parsing individual bytes
-    , I.word8
-    , I.anyWord8
-    , I.notWord8
-    , I.peekWord8
+    -- * Parsing individual atoms
+    , I.anyToken
+    , I.peekToken
     , I.satisfy
     , I.satisfyWith
     , I.skip
 
-    -- ** Byte classes
-    , I.inClass
-    , I.notInClass
+    -- * Parsing individual characters
+    , I.anyChar
+    , I.char
+    , I.takeCharsWhile
+    , I.takeCharsWhile1
+    , I.takeCharsTill
 
     -- * Efficient string handling
     , I.string
     , I.skipWhile
     , I.take
-    , I.scan
     , I.takeWhile
     , I.takeWhile1
     , I.takeTill
-
-    -- ** Consume all remaining input
-    , I.takeByteString
-    , I.takeLazyByteString
+    
+    -- * Text parsing
+    , I.endOfLine
 
     -- * State observation and manipulation functions
     , I.endOfInput
     , I.atEnd
     ) where
 
+import Data.Monoid (Monoid, (<>))
+
 import Data.Attoparsec.Combinator
-import qualified Data.Attoparsec.ByteString.Internal as I
+import qualified Data.Attoparsec.Cancellative.Internal as I
 import qualified Data.Attoparsec.Internal as I
-import qualified Data.ByteString as B
-import Data.Attoparsec.ByteString.Internal (Result, parse)
+import Data.Attoparsec.Cancellative.Internal (Result, parse)
 import qualified Data.Attoparsec.Internal.Types as T
 
 -- $parsec
 
 -- | If a parser has returned a 'T.Partial' result, supply it with more
 -- input.
-feed :: Result r -> B.ByteString -> Result r
+feed :: Monoid t => Result t r -> t -> Result t r
 feed f@(T.Fail _ _ _) _ = f
 feed (T.Partial k) d    = k d
-feed (T.Done bs r) d    = T.Done (B.append bs d) r
+feed (T.Done t r) d    = T.Done (t <> d) r
 {-# INLINE feed #-}
 
 -- | Run a parser and print its result to standard output.
-parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO ()
+parseTest :: (Monoid t, Show t, Show a) => I.Parser t a -> t -> IO ()
 parseTest p s = print (parse p s)
 
 -- | Run a parser with an initial input string, and a monadic action
 -- that can supply more input if needed.
-parseWith :: Monad m =>
-             (m B.ByteString)
+parseWith :: (Monoid t, Monad m) => m t
           -- ^ An action that will be executed to provide the parser
           -- with more input, if necessary.  The action must return an
-          -- 'B.empty' string when there is no more input available.
-          -> I.Parser a
-          -> B.ByteString
+          -- 'mempty' string when there is no more input available.
+          -> I.Parser t a
+          -> t
           -- ^ Initial input for the parser.
-          -> m (Result a)
+          -> m (Result t a)
 parseWith refill p s = step $ parse p s
   where step (T.Partial k) = (step . k) =<< refill
         step r             = return r
 
 -- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result
 -- is treated as failure.
-maybeResult :: Result r -> Maybe r
+maybeResult :: Result t r -> Maybe r
 maybeResult (T.Done _ r) = Just r
 maybeResult _            = Nothing
 
 -- | Convert a 'Result' value to an 'Either' value. A 'T.Partial'
 -- result is treated as failure.
-eitherResult :: Result r -> Either String r
+eitherResult :: Result t r -> Either String r
 eitherResult (T.Done _ r)     = Right r
 eitherResult (T.Fail _ _ msg) = Left msg
 eitherResult _                = Left "Result: incomplete input"

Data/Attoparsec/Cancellative/Internal.hs

     , anyToken
     , skip
     , peekToken
+    , anyChar
+    , char
 
     -- * Efficient string handling
     , skipWhile
     , takeWhile
     , takeWhile1
     , takeTill
+    , takeCharsWhile
+    , takeCharsWhile1
+    , takeCharsTill
 
     -- * State observation and manipulation functions
     , endOfInput
 import Data.Attoparsec.Combinator
 import Data.Attoparsec.Internal.Types
 import Data.Monoid (Monoid(..))
---import Data.Monoid.Cancellative (CancellativeMonoid(..))
+import Data.Monoid.Cancellative (LeftReductiveMonoid(..))
 import Data.Monoid.Null (MonoidNull(null))
 import qualified Data.Monoid.Factorial as Factorial
 import Data.Monoid.Factorial (FactorialMonoid)
---import Data.Monoid.Textual (TextualMonoid(..))
-import Data.String (IsString)
+import Data.Monoid.Textual (TextualMonoid)
+import qualified Data.Monoid.Textual as Textual
 import Prelude hiding (getChar, length, null, span, take, takeWhile)
 import qualified Data.Attoparsec.Internal.Types as T
 
 -- Non-recursive so the bounds check can be inlined:
 {-# INLINE ensure #-}
 
+-- | If at least @n@ bytes of input are available, return the current
+-- input, otherwise fail.
+ensureOne :: FactorialMonoid t => Parser t t
+ensureOne = T.Parser $ \i0 a0 m0 kf ks ->
+    if null (unI i0)
+    -- The uncommon case is kept out-of-line to reduce code size:
+    then ensure' 1 i0 a0 m0 kf ks
+    else ks i0 a0 m0 (unI i0)
+-- Non-recursive so the bounds check can be inlined:
+{-# INLINE ensureOne #-}
+
 -- | Ask for input.  If we receive any, pass it to a success
 -- continuation, otherwise to a failure continuation.
 prompt :: MonoidNull t => Input t -> Added t -> More
 -- >    where isDigit w = w >= 48 && w <= 57
 satisfy :: FactorialMonoid t => (t -> Bool) -> Parser t t
 satisfy p = do
-  s <- ensure 1
+  s <- ensureOne
   let Just (first, rest) = Factorial.splitPrimePrefix s
   if p first then put rest >> return first else fail "satisfy"
 {-# INLINE satisfy #-}
 
+satisfyChar :: TextualMonoid t => (Char -> Bool) -> Parser t Char
+satisfyChar p = do
+  s <- ensureOne
+  let Just (first, rest) = Textual.splitCharacterPrefix s
+  if p first then put rest >> return first else fail "satisfy"
+{-# INLINE satisfyChar #-}
+
 -- | The parser @skip p@ succeeds for any byte for which the predicate
 -- @p@ returns 'True'.
 --
 -- >    where isDigit w = w >= 48 && w <= 57
 skip :: FactorialMonoid t => (t -> Bool) -> Parser t ()
 skip p = do
-  s <- ensure 1
+  s <- ensureOne
   let Just (first, rest) = Factorial.splitPrimePrefix s
   if p first then put rest else fail "skip"
 
 -- parser returns the transformed byte that was parsed.
 satisfyWith :: FactorialMonoid t => (t -> a) -> (a -> Bool) -> Parser t a
 satisfyWith f p = do
-  s <- ensure 1
+  s <- ensureOne
   let Just (first, rest) = Factorial.splitPrimePrefix s
       c = f $! first
   if p c then put rest >> return c else fail "satisfyWith"
 -- partial match, and will consume the letters @\'f\'@ and @\'o\'@
 -- before failing.  In Attoparsec, the above parser will /succeed/ on
 -- that input, because the failed first branch will consume nothing.
-string :: (FactorialMonoid t, Eq t) => t -> Parser t t
-string s = takeWith (Factorial.length s) (==s)
-{-# INLINE string #-}
+string :: (LeftReductiveMonoid t, MonoidNull t) => t -> Parser t t
+string s | null s = return s
+string s = do
+   (`when` demandInput) =<< null <$> get
+   i <- get
+   case (stripPrefix s i, stripPrefix i s)
+      of (Just i', _) -> put i' >> return s
+         (Nothing, Nothing) -> fail "string"
+         (Nothing, Just s') -> string s' >> return s
 
 stringTransform :: (FactorialMonoid t, Eq t) => (t -> t) -> t
                 -> Parser t t
 takeTill p = takeWhile (not . p)
 {-# INLINE takeTill #-}
 
+takeCharsTill :: TextualMonoid t => (Char -> Bool) -> Parser t t
+takeCharsTill p = takeCharsWhile (not . p)
+
 -- | Consume input as long as the predicate returns 'True', and return
 -- the consumed input.
 --
 -- combinators such as 'many', because such parsers loop until a
 -- failure occurs.  Careless use will thus result in an infinite loop.
 takeWhile :: FactorialMonoid t => (t -> Bool) -> Parser t t
-takeWhile p = (mconcat . reverse) `fmap` go []
+takeWhile p = go id
  where
   go acc = do
     (h,t) <- Factorial.span p <$> get
       then do
         input <- wantInput
         if input
-          then go (h:acc)
-          else return (h:acc)
-      else return (h:acc)
+          then go (mappend h . acc)
+          else return (mappend h $ acc mempty)
+      else return (mappend h $ acc mempty)
 {-# INLINE takeWhile #-}
 
+takeCharsWhile :: TextualMonoid t => (Char -> Bool) -> Parser t t
+takeCharsWhile p = go id
+ where
+  go acc = do
+    (h,t) <- Textual.span (const False) p <$> get
+    put t
+    if null t
+      then do
+        input <- wantInput
+        if input
+          then go (mappend h . acc)
+          else return (mappend h $ acc mempty)
+      else return (mappend h $ acc mempty)
+{-# INLINE takeCharsWhile #-}
+
 takeRest :: MonoidNull t => Parser t t
 takeRest = go []
  where
     then (h<>) `fmap` takeWhile p
     else return h
 
+takeCharsWhile1 :: TextualMonoid t => (Char -> Bool) -> Parser t t
+takeCharsWhile1 p = do
+  (`when` demandInput) =<< null <$> get
+  (h,t) <- Textual.span (const False) p <$> get
+  when (null h) $ fail "takeWhile1"
+  put t
+  if null t
+    then (h<>) `fmap` takeCharsWhile p
+    else return h
+
 
 -- | Match any input atom.
 anyToken :: FactorialMonoid t => Parser t t
                  in ks i0 a0 m0 w
 {-# INLINE peekToken #-}
 
+-- | Match any character.
+anyChar :: TextualMonoid t => Parser t Char
+anyChar = satisfyChar $ const True
+{-# INLINE anyChar #-}
+
+-- | Match a specific character.
+char :: TextualMonoid t => Char -> Parser t Char
+char c = satisfyChar (== c) <?> show c
+{-# INLINE char #-}
+
 -- | Match only if all input has been consumed.
 endOfInput :: MonoidNull t => Parser t ()
 endOfInput = T.Parser $ \i0 a0 m0 kf ks ->
 
 -- | Match either a single newline character @\'\\n\'@, or a carriage
 -- return followed by a newline character @\"\\r\\n\"@.
-endOfLine :: (Eq t, FactorialMonoid t, IsString t) => Parser t ()
-endOfLine = (string "\n" >> return ()) <|> (string "\r\n" >> return ())
+endOfLine :: (Eq t, TextualMonoid t) => Parser t ()
+endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
 
 -- | Name the parser, in case failure occurs.
 (<?>) :: Parser t a
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.