Bryan O'Sullivan avatar Bryan O'Sullivan committed 9bb4d8a

Factor internal types out into their own module.

Comments (0)

Files changed (4)

Data/Attoparsec.hs

 -- |
 -- Module      :  Data.Attoparsec
--- Copyright   :  Bryan O'Sullivan 2007-2010
+-- Copyright   :  Bryan O'Sullivan 2007-2011
 -- License     :  BSD3
 -- 
 -- Maintainer  :  bos@serpentine.com

Data/Attoparsec/Internal.hs

 {-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards #-}
 -- |
 -- Module      :  Data.Attoparsec.Internal
--- Copyright   :  Bryan O'Sullivan 2007-2010
+-- Copyright   :  Bryan O'Sullivan 2007-2011
 -- License     :  BSD3
 --
 -- Maintainer  :  bos@serpentine.com
     , endOfLine
     ) where
 
-import Control.Applicative (Alternative(..), Applicative(..), (<$>))
-import Control.DeepSeq (NFData(rnf))
-import Control.Monad (MonadPlus(..), when)
+import Control.Applicative ((<|>), (<$>))
+import Control.Monad (when)
 import Data.Attoparsec.Combinator
 import Data.Attoparsec.FastSet (charClass, memberWord8)
-import Data.Monoid (Monoid(..))
+import Data.Attoparsec.Internal.Types
 import Data.Word (Word8)
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Ptr (castPtr, minusPtr, plusPtr)
 import qualified Data.ByteString as B8
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Internal as B
+import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Unsafe as B
-import qualified Data.ByteString.Lazy as L
-
--- | The result of a parse.
-data Result r = Fail B.ByteString [String] String
-              -- ^ The parse failed.  The 'B.ByteString' is the input
-              -- that had not yet been consumed when the failure
-              -- occurred.  The @[@'String'@]@ is a list of contexts
-              -- in which the error occurred.  The 'String' is the
-              -- message describing the error, if any.
-              | Partial (B.ByteString -> Result r)
-              -- ^ Supply this continuation with more input so that
-              -- the parser can resume.  To indicate that no more
-              -- input is available, use an 'B.empty' string.
-              | Done B.ByteString r
-              -- ^ The parse succeeded.  The 'B.ByteString' is the
-              -- input that had not yet been consumed (if any) when
-              -- the parse succeeded.
-
-instance Show r => Show (Result r) where
-    show (Fail bs stk msg) =
-        "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg
-    show (Partial _)       = "Partial _"
-    show (Done bs r)       = "Done " ++ show bs ++ " " ++ show r
-
-instance (NFData r) => NFData (Result r) where
-    rnf (Fail _ _ _) = ()
-    rnf (Partial _)  = ()
-    rnf (Done _ r)   = rnf r
-    {-# INLINE rnf #-}
-
-fmapR :: (a -> b) -> Result a -> Result b
-fmapR _ (Fail st stk msg) = Fail st stk msg
-fmapR f (Partial k)       = Partial (fmapR f . k)
-fmapR f (Done bs r)       = Done bs (f r)
-
-instance Functor Result where
-    fmap = fmapR
-
-newtype Input = I {unI :: B.ByteString}
-newtype Added = A {unA :: B.ByteString}
-
--- | The 'Parser' type is a monad.
-newtype Parser a = Parser {
-      runParser :: forall r. Input -> Added -> More
-                -> Failure   r
-                -> Success a r
-                -> Result r
-    }
-
-type Failure   r = Input -> Added -> More -> [String] -> String -> Result r
-type Success a r = Input -> Added -> More -> a -> Result r
-
--- | Have we read all available input?
-data More = Complete | Incomplete
-            deriving (Eq, Show)
-
-addS :: Input -> Added -> More
-     -> Input -> Added -> More
-     -> (Input -> Added -> More -> r) -> r
-addS i0 a0 m0 _i1 a1 m1 f =
-    let !i = I (unI i0 +++ unA a1)
-        a  = A (unA a0 +++ unA a1)
-        !m = m0 <> m1
-    in f i a m
-  where
-    Complete <> _ = Complete
-    _ <> Complete = Complete
-    _ <> _        = Incomplete
-{-# INLINE addS #-}
-
-bindP :: Parser a -> (a -> Parser b) -> Parser b
-bindP m g =
-    Parser $ \i0 a0 m0 kf ks -> runParser m i0 a0 m0 kf $
-                                \i1 a1 m1 a -> runParser (g a) i1 a1 m1 kf ks
-{-# INLINE bindP #-}
-
-returnP :: a -> Parser a
-returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
-{-# INLINE returnP #-}
-
-instance Monad Parser where
-    return = returnP
-    (>>=)  = bindP
-    fail   = failDesc
-
-noAdds :: Input -> Added -> More
-       -> (Input -> Added -> More -> r) -> r
-noAdds i0 _a0 m0 f = f i0 (A B.empty) m0
-{-# INLINE noAdds #-}
-
-plus :: Parser a -> Parser a -> Parser a
-plus a b = Parser $ \i0 a0 m0 kf ks ->
-           let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
-                                  \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
-           in  noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks
-{-# INLINE plus #-}
-
-instance MonadPlus Parser where
-    mzero = failDesc "mzero"
-    {-# INLINE mzero #-}
-    mplus = plus
-
-fmapP :: (a -> b) -> Parser a -> Parser b
-fmapP p m = Parser $ \i0 a0 m0 f k ->
-            runParser m i0 a0 m0 f $ \i1 a1 s1 a -> k i1 a1 s1 (p a)
-{-# INLINE fmapP #-}
-
-instance Functor Parser where
-    fmap = fmapP
-
-apP :: Parser (a -> b) -> Parser a -> Parser b
-apP d e = do
-  b <- d
-  a <- e
-  return (b a)
-{-# INLINE apP #-}
-
-instance Applicative Parser where
-    pure   = returnP
-    (<*>)  = apP
-
-    -- These definitions are equal to the defaults, but this
-    -- way the optimizer doesn't have to work so hard to figure
-    -- that out.
-    (*>)   = (>>)
-    x <* y = x >>= \a -> y >> return a
-
-instance Monoid (Parser a) where
-    mempty  = failDesc "mempty"
-    {-# INLINE mempty #-}
-    mappend = plus
-
-instance Alternative Parser where
-    empty = failDesc "empty"
-    {-# INLINE empty #-}
-    (<|>) = plus
-
-failDesc :: String -> Parser a
-failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
-    where msg = "Failed reading: " ++ err
-{-# INLINE failDesc #-}
 
 -- | If at least @n@ bytes of input are available, return the current
 -- input, otherwise fail.
 put :: B.ByteString -> Parser ()
 put s = Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 ()
 
-(+++) :: B.ByteString -> B.ByteString -> B.ByteString
-(+++) = B.append
-{-# INLINE (+++) #-}
-
 -- | Attempt a parse, and if it fails, rewind the input so that no
 -- input appears to have been consumed.
 --
  where
   hack :: Storable b => b -> Parser b
   hack dummy = do
-    (fp,o,_) <- B.toForeignPtr `fmapP` take (sizeOf dummy)
+    (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
     return . B.inlinePerformIO . withForeignPtr fp $ \p ->
         peek (castPtr $ p `plusPtr` o)
 
       t = B.unsafeDrop n s
   if p h
     then put t >> return h
-    else failDesc "takeWith"
+    else fail "takeWith"
 
 -- | Consume exactly @n@ bytes of input.
 take :: Int -> Parser B.ByteString
 takeWhile1 p = do
   (`when` demandInput) =<< B.null <$> get
   (h,t) <- B8.span p <$> get
-  when (B.null h) $ failDesc "takeWhile1"
+  when (B.null h) $ fail "takeWhile1"
   put t
   if B.null t
-    then (h+++) `fmapP` takeWhile p
+    then (h+++) `fmap` takeWhile p
     else return h
 
 -- | Match any byte in a set.

Data/Attoparsec/Internal/Types.hs

+{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards #-}
+-- |
+-- Module      :  Data.Attoparsec.Internal.Types
+-- Copyright   :  Bryan O'Sullivan 2007-2011
+-- License     :  BSD3
+--
+-- Maintainer  :  bos@serpentine.com
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Simple, efficient parser combinators for 'B.ByteString' strings,
+-- loosely based on the Parsec library.
+
+module Data.Attoparsec.Internal.Types
+    (
+      Parser(..)
+    , Failure
+    , Success
+    , Result(..)
+    , Input(..)
+    , Added(..)
+    , More(..)
+    , addS
+    , noAdds
+    , (+++)
+    ) where
+
+import Control.Applicative (Alternative(..), Applicative(..))
+import Control.DeepSeq (NFData(rnf))
+import Control.Monad (MonadPlus(..))
+import Data.Monoid (Monoid(..))
+import Prelude hiding (getChar, take, takeWhile)
+import qualified Data.ByteString.Char8 as B
+
+-- | The result of a parse.
+data Result r = Fail B.ByteString [String] String
+              -- ^ The parse failed.  The 'B.ByteString' is the input
+              -- that had not yet been consumed when the failure
+              -- occurred.  The @[@'String'@]@ is a list of contexts
+              -- in which the error occurred.  The 'String' is the
+              -- message describing the error, if any.
+              | Partial (B.ByteString -> Result r)
+              -- ^ Supply this continuation with more input so that
+              -- the parser can resume.  To indicate that no more
+              -- input is available, use an 'B.empty' string.
+              | Done B.ByteString r
+              -- ^ The parse succeeded.  The 'B.ByteString' is the
+              -- input that had not yet been consumed (if any) when
+              -- the parse succeeded.
+
+instance Show r => Show (Result r) where
+    show (Fail bs stk msg) =
+        "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg
+    show (Partial _)       = "Partial _"
+    show (Done bs r)       = "Done " ++ show bs ++ " " ++ show r
+
+instance (NFData r) => NFData (Result r) where
+    rnf (Fail _ _ _) = ()
+    rnf (Partial _)  = ()
+    rnf (Done _ r)   = rnf r
+    {-# INLINE rnf #-}
+
+fmapR :: (a -> b) -> Result a -> Result b
+fmapR _ (Fail st stk msg) = Fail st stk msg
+fmapR f (Partial k)       = Partial (fmapR f . k)
+fmapR f (Done bs r)       = Done bs (f r)
+
+instance Functor Result where
+    fmap = fmapR
+
+newtype Input = I {unI :: B.ByteString}
+newtype Added = A {unA :: B.ByteString}
+
+-- | The 'Parser' type is a monad.
+newtype Parser a = Parser {
+      runParser :: forall r. Input -> Added -> More
+                -> Failure   r
+                -> Success a r
+                -> Result r
+    }
+
+type Failure   r = Input -> Added -> More -> [String] -> String -> Result r
+type Success a r = Input -> Added -> More -> a -> Result r
+
+-- | Have we read all available input?
+data More = Complete | Incomplete
+            deriving (Eq, Show)
+
+addS :: Input -> Added -> More
+     -> Input -> Added -> More
+     -> (Input -> Added -> More -> r) -> r
+addS i0 a0 m0 _i1 a1 m1 f =
+    let !i = I (unI i0 +++ unA a1)
+        a  = A (unA a0 +++ unA a1)
+        !m = m0 <> m1
+    in f i a m
+  where
+    Complete <> _ = Complete
+    _ <> Complete = Complete
+    _ <> _        = Incomplete
+{-# INLINE addS #-}
+
+bindP :: Parser a -> (a -> Parser b) -> Parser b
+bindP m g =
+    Parser $ \i0 a0 m0 kf ks -> runParser m i0 a0 m0 kf $
+                                \i1 a1 m1 a -> runParser (g a) i1 a1 m1 kf ks
+{-# INLINE bindP #-}
+
+returnP :: a -> Parser a
+returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
+{-# INLINE returnP #-}
+
+instance Monad Parser where
+    return = returnP
+    (>>=)  = bindP
+    fail   = failDesc
+
+noAdds :: Input -> Added -> More
+       -> (Input -> Added -> More -> r) -> r
+noAdds i0 _a0 m0 f = f i0 (A B.empty) m0
+{-# INLINE noAdds #-}
+
+plus :: Parser a -> Parser a -> Parser a
+plus a b = Parser $ \i0 a0 m0 kf ks ->
+           let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
+                                  \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
+           in  noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks
+{-# INLINE plus #-}
+
+instance MonadPlus Parser where
+    mzero = failDesc "mzero"
+    {-# INLINE mzero #-}
+    mplus = plus
+
+fmapP :: (a -> b) -> Parser a -> Parser b
+fmapP p m = Parser $ \i0 a0 m0 f k ->
+            runParser m i0 a0 m0 f $ \i1 a1 s1 a -> k i1 a1 s1 (p a)
+{-# INLINE fmapP #-}
+
+instance Functor Parser where
+    fmap = fmapP
+
+apP :: Parser (a -> b) -> Parser a -> Parser b
+apP d e = do
+  b <- d
+  a <- e
+  return (b a)
+{-# INLINE apP #-}
+
+instance Applicative Parser where
+    pure   = returnP
+    (<*>)  = apP
+
+    -- These definitions are equal to the defaults, but this
+    -- way the optimizer doesn't have to work so hard to figure
+    -- that out.
+    (*>)   = (>>)
+    x <* y = x >>= \a -> y >> return a
+
+instance Monoid (Parser a) where
+    mempty  = failDesc "mempty"
+    {-# INLINE mempty #-}
+    mappend = plus
+
+instance Alternative Parser where
+    empty = failDesc "empty"
+    {-# INLINE empty #-}
+    (<|>) = plus
+
+failDesc :: String -> Parser a
+failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
+    where msg = "Failed reading: " ++ err
+{-# INLINE failDesc #-}
+
+(+++) :: B.ByteString -> B.ByteString -> B.ByteString
+(+++) = B.append
+{-# INLINE (+++) #-}
                    Data.Attoparsec.Number
                    Data.Attoparsec.Zepto
   other-modules:   Data.Attoparsec.Internal
+                   Data.Attoparsec.Internal.Types
   ghc-options:     -Wall
 
   if flag(developer)
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.