Commits

Mario Blažević  committed c3841e1

Renamed Data/Attoparsec/Internal/Types.hs to Data/Attoparsec/Types/Internal.hs and exposed the module.

  • Participants
  • Parent commits dcb0517

Comments (0)

Files changed (12)

File Data/Attoparsec/ByteString.hs

 import qualified Data.Attoparsec.Internal as I
 import qualified Data.ByteString as B
 import Data.Attoparsec.ByteString.Internal (Result, parse)
-import qualified Data.Attoparsec.Internal.Types as T
+import qualified Data.Attoparsec.Types.Internal as T
 
 -- $parsec
 --

File Data/Attoparsec/ByteString/Internal.hs

 import Control.Monad (when)
 import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
 import Data.Attoparsec.Combinator
-import Data.Attoparsec.Internal.Types
+import Data.Attoparsec.Types.Internal
     hiding (Parser, Input, Added, Failure, Success)
 import Data.Monoid (Monoid(..))
 import Data.Word (Word8)
 import Foreign.Ptr (castPtr, minusPtr, plusPtr)
 import Foreign.Storable (Storable(peek, sizeOf))
 import Prelude hiding (getChar, take, takeWhile)
-import qualified Data.Attoparsec.Internal.Types as T
+import qualified Data.Attoparsec.Types.Internal as T
 import qualified Data.ByteString as B8
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Internal as B

File Data/Attoparsec/ByteString/Lazy.hs

 import Data.ByteString.Lazy.Internal (ByteString(..), chunk)
 import qualified Data.ByteString as B
 import qualified Data.Attoparsec.ByteString as A
-import qualified Data.Attoparsec.Internal.Types as T
+import qualified Data.Attoparsec.Types.Internal as T
 import Data.Attoparsec.ByteString
     hiding (IResult(..), Result, eitherResult, maybeResult,
             parse, parseWith, parseTest)

File Data/Attoparsec/Combinator.hs

 #endif
 
 #if __GLASGOW_HASKELL__ >= 700
-import Data.Attoparsec.Internal.Types (Parser)
+import Data.Attoparsec.Types.Internal (Parser)
 import qualified Data.Attoparsec.Zepto as Z
 import Data.ByteString (ByteString)
 import Data.Text (Text)

File Data/Attoparsec/Internal.hs

       compareResults
     ) where
 
-import Data.Attoparsec.Internal.Types (IResult(..))
+import Data.Attoparsec.Types.Internal (IResult(..))
 
 -- | Compare two 'IResult' values for equality.
 --

File Data/Attoparsec/Internal/Types.hs

-{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings,
-    Rank2Types, 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, loosely based on the Parsec
--- library.
-
-module Data.Attoparsec.Internal.Types
-    (
-      Parser(..)
-    , Failure
-    , Success
-    , IResult(..)
-    , Input(..)
-    , Added(..)
-    , More(..)
-    , addS
-    , (<>)
-    ) 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)
-
--- | The result of a parse.  This is parameterised over the type @t@
--- of string that was processed.
---
--- This type is an instance of 'Functor', where 'fmap' transforms the
--- value in a 'Done' result.
-data IResult t r = Fail t [String] String
-                 -- ^ The parse failed.  The 't' parameter 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 (t -> IResult t r)
-                 -- ^ Supply this continuation with more input so that
-                 -- the parser can resume.  To indicate that no more
-                 -- input is available, use an empty string.
-                 | Done t r
-                 -- ^ The parse succeeded.  The 't' parameter is the
-                 -- input that had not yet been consumed (if any) when
-                 -- the parse succeeded.
-
-instance (Show t, Show r) => Show (IResult t r) where
-    show (Fail t stk msg) =
-        "Fail " ++ show t ++ " " ++ show stk ++ " " ++ show msg
-    show (Partial _)      = "Partial _"
-    show (Done t r)       = "Done " ++ show t ++ " " ++ show r
-
-instance (NFData t, NFData r) => NFData (IResult t r) where
-    rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg
-    rnf (Partial _)  = ()
-    rnf (Done t r)   = rnf t `seq` rnf r
-    {-# INLINE rnf #-}
-
-fmapR :: (a -> b) -> IResult t a -> IResult t b
-fmapR _ (Fail t stk msg) = Fail t stk msg
-fmapR f (Partial k)       = Partial (fmapR f . k)
-fmapR f (Done t r)       = Done t (f r)
-
-instance Functor (IResult t) where
-    fmap = fmapR
-    {-# INLINE fmap #-}
-
-newtype Input t = I {unI :: t} deriving (Monoid)
-newtype Added t = A {unA :: t} deriving (Monoid)
-
--- | The core parser type.  This is parameterised over the type @t@ of
--- string being processed.
---
--- This type is an instance of the following classes:
---
--- * 'Monad', where 'fail' throws an exception (i.e. fails) with an
---   error message.
---
--- * 'Functor' and 'Applicative', which follow the usual definitions.
---
--- * 'MonadPlus', where 'mzero' fails (with no error message) and
---   'mplus' executes the right-hand parser if the left-hand one
---   fails.  When the parser on the right executes, the input is reset
---   to the same state as the parser on the left started with. (In
---   other words, Attoparsec is a backtracking parser that supports
---   arbitrary lookahead.)
---
--- * 'Alternative', which follows 'MonadPlus'.
-newtype Parser t a = Parser {
-      runParser :: forall r. Input t -> Added t -> More
-                -> Failure t   r
-                -> Success t a r
-                -> IResult t r
-    }
-
-type Failure t   r = Input t -> Added t -> More -> [String] -> String
-                   -> IResult t r
-type Success t a r = Input t -> Added t -> More -> a -> IResult t r
-
--- | Have we read all available input?
-data More = Complete | Incomplete
-            deriving (Eq, Show)
-
-instance Monoid More where
-    mappend c@Complete _ = c
-    mappend _ m          = m
-    mempty               = Incomplete
-
-addS :: (Monoid t) =>
-        Input t -> Added t -> More
-     -> Input t -> Added t -> More
-     -> (Input t -> Added t -> More -> r) -> r
-addS i0 a0 m0 _i1 a1 m1 f =
-    let !i = i0 <> I (unA a1)
-        a  = a0 <> a1
-        !m = m0 <> m1
-    in f i a m
-{-# INLINE addS #-}
-
-bindP :: Parser t a -> (a -> Parser t b) -> Parser t 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 t a
-returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
-{-# INLINE returnP #-}
-
-instance Monad (Parser t) where
-    return = returnP
-    (>>=)  = bindP
-    fail   = failDesc
-
-noAdds :: (Monoid t) =>
-          Input t -> Added t -> More
-       -> (Input t -> Added t -> More -> r) -> r
-noAdds i0 _a0 m0 f = f i0 mempty m0
-{-# INLINE noAdds #-}
-
-plus :: (Monoid t) => Parser t a -> Parser t a -> Parser t 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
-               ks' i1 a1 m1 = ks i1 (a0 <> a1) m1
-           in  noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks'
-{-# INLINE plus #-}
-
-instance (Monoid t) => MonadPlus (Parser t) where
-    mzero = failDesc "mzero"
-    {-# INLINE mzero #-}
-    mplus = plus
-
-fmapP :: (a -> b) -> Parser t a -> Parser t 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 t) where
-    fmap = fmapP
-    {-# INLINE fmap #-}
-
-apP :: Parser t (a -> b) -> Parser t a -> Parser t b
-apP d e = do
-  b <- d
-  a <- e
-  return (b a)
-{-# INLINE apP #-}
-
-instance Applicative (Parser t) where
-    pure   = returnP
-    {-# INLINE pure #-}
-    (<*>)  = apP
-    {-# INLINE (<*>) #-}
-
-#if MIN_VERSION_base(4,2,0)
-    -- These definitions are equal to the defaults, but this
-    -- way the optimizer doesn't have to work so hard to figure
-    -- that out.
-    (*>)   = (>>)
-    {-# INLINE (*>) #-}
-    x <* y = x >>= \a -> y >> return a
-    {-# INLINE (<*) #-}
-#endif
-
-instance (Monoid t) => Monoid (Parser t a) where
-    mempty  = failDesc "mempty"
-    {-# INLINE mempty #-}
-    mappend = plus
-    {-# INLINE mappend #-}
-
-instance (Monoid t) => Alternative (Parser t) where
-    empty = failDesc "empty"
-    {-# INLINE empty #-}
-
-    (<|>) = plus
-    {-# INLINE (<|>) #-}
-
-#if MIN_VERSION_base(4,2,0)
-    many v = many_v
-        where many_v = some_v <|> pure []
-              some_v = (:) <$> v <*> many_v
-    {-# INLINE many #-}
-
-    some v = some_v
-      where
-        many_v = some_v <|> pure []
-        some_v = (:) <$> v <*> many_v
-    {-# INLINE some #-}
-#endif
-
-failDesc :: String -> Parser t a
-failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
-    where msg = "Failed reading: " ++ err
-{-# INLINE failDesc #-}
-
-(<>) :: (Monoid m) => m -> m -> m
-(<>) = mappend
-{-# INLINE (<>) #-}

File Data/Attoparsec/Text.hs

 import Data.Text (Text)
 import Data.Word (Word8, Word16, Word32, Word64, Word)
 import qualified Data.Attoparsec.Internal as I
-import qualified Data.Attoparsec.Internal.Types as T
+import qualified Data.Attoparsec.Types.Internal as T
 import qualified Data.Attoparsec.Text.Internal as I
 import qualified Data.Text as T
 

File Data/Attoparsec/Text/Internal.hs

 import Control.Applicative ((<|>), (<$>))
 import Control.Monad (when)
 import Data.Attoparsec.Combinator
-import Data.Attoparsec.Internal.Types hiding (Parser, Input, Added, Failure, Success)
+import Data.Attoparsec.Types.Internal hiding (Parser, Input, Added, Failure, Success)
 import Data.Monoid (Monoid(..))
 import Data.String (IsString(..))
 import Data.Text (Text)
 import Prelude hiding (getChar, take, takeWhile)
 import Data.Char (chr, ord)
-import qualified Data.Attoparsec.Internal.Types as T
+import qualified Data.Attoparsec.Types.Internal as T
 import qualified Data.Attoparsec.Text.FastSet as Set
 import qualified Data.Text as T
 import qualified Data.Text.Internal as T

File Data/Attoparsec/Text/Lazy.hs

 
 import Control.DeepSeq (NFData(rnf))
 import Data.Text.Lazy.Internal (Text(..), chunk)
-import qualified Data.Attoparsec.Internal.Types as T
+import qualified Data.Attoparsec.Types.Internal as T
 import qualified Data.Attoparsec.Text as A
 import qualified Data.Text as T
 import Data.Attoparsec.Text hiding (IResult(..), Result, eitherResult,

File Data/Attoparsec/Types.hs

     , IResult(..)
     ) where
 
-import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))
+import Data.Attoparsec.Types.Internal (Parser(..), IResult(..))

File Data/Attoparsec/Types/Internal.hs

+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings,
+    Rank2Types, RecordWildCards #-}
+-- |
+-- Module      :  Data.Attoparsec.Types.Internal
+-- Copyright   :  Bryan O'Sullivan 2007-2011
+-- License     :  BSD3
+--
+-- Maintainer  :  bos@serpentine.com
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Simple, efficient parser combinators, loosely based on the Parsec
+-- library.
+
+module Data.Attoparsec.Types.Internal
+    (
+      Parser(..)
+    , Failure
+    , Success
+    , IResult(..)
+    , Input(..)
+    , Added(..)
+    , More(..)
+    , addS
+    , (<>)
+    ) 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)
+
+-- | The result of a parse.  This is parameterised over the type @t@
+-- of string that was processed.
+--
+-- This type is an instance of 'Functor', where 'fmap' transforms the
+-- value in a 'Done' result.
+data IResult t r = Fail t [String] String
+                 -- ^ The parse failed.  The 't' parameter 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 (t -> IResult t r)
+                 -- ^ Supply this continuation with more input so that
+                 -- the parser can resume.  To indicate that no more
+                 -- input is available, use an empty string.
+                 | Done t r
+                 -- ^ The parse succeeded.  The 't' parameter is the
+                 -- input that had not yet been consumed (if any) when
+                 -- the parse succeeded.
+
+instance (Show t, Show r) => Show (IResult t r) where
+    show (Fail t stk msg) =
+        "Fail " ++ show t ++ " " ++ show stk ++ " " ++ show msg
+    show (Partial _)      = "Partial _"
+    show (Done t r)       = "Done " ++ show t ++ " " ++ show r
+
+instance (NFData t, NFData r) => NFData (IResult t r) where
+    rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg
+    rnf (Partial _)  = ()
+    rnf (Done t r)   = rnf t `seq` rnf r
+    {-# INLINE rnf #-}
+
+fmapR :: (a -> b) -> IResult t a -> IResult t b
+fmapR _ (Fail t stk msg) = Fail t stk msg
+fmapR f (Partial k)       = Partial (fmapR f . k)
+fmapR f (Done t r)       = Done t (f r)
+
+instance Functor (IResult t) where
+    fmap = fmapR
+    {-# INLINE fmap #-}
+
+newtype Input t = I {unI :: t} deriving (Monoid)
+newtype Added t = A {unA :: t} deriving (Monoid)
+
+-- | The core parser type.  This is parameterised over the type @t@ of
+-- string being processed.
+--
+-- This type is an instance of the following classes:
+--
+-- * 'Monad', where 'fail' throws an exception (i.e. fails) with an
+--   error message.
+--
+-- * 'Functor' and 'Applicative', which follow the usual definitions.
+--
+-- * 'MonadPlus', where 'mzero' fails (with no error message) and
+--   'mplus' executes the right-hand parser if the left-hand one
+--   fails.  When the parser on the right executes, the input is reset
+--   to the same state as the parser on the left started with. (In
+--   other words, Attoparsec is a backtracking parser that supports
+--   arbitrary lookahead.)
+--
+-- * 'Alternative', which follows 'MonadPlus'.
+newtype Parser t a = Parser {
+      runParser :: forall r. Input t -> Added t -> More
+                -> Failure t   r
+                -> Success t a r
+                -> IResult t r
+    }
+
+type Failure t   r = Input t -> Added t -> More -> [String] -> String
+                   -> IResult t r
+type Success t a r = Input t -> Added t -> More -> a -> IResult t r
+
+-- | Have we read all available input?
+data More = Complete | Incomplete
+            deriving (Eq, Show)
+
+instance Monoid More where
+    mappend c@Complete _ = c
+    mappend _ m          = m
+    mempty               = Incomplete
+
+addS :: (Monoid t) =>
+        Input t -> Added t -> More
+     -> Input t -> Added t -> More
+     -> (Input t -> Added t -> More -> r) -> r
+addS i0 a0 m0 _i1 a1 m1 f =
+    let !i = i0 <> I (unA a1)
+        a  = a0 <> a1
+        !m = m0 <> m1
+    in f i a m
+{-# INLINE addS #-}
+
+bindP :: Parser t a -> (a -> Parser t b) -> Parser t 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 t a
+returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
+{-# INLINE returnP #-}
+
+instance Monad (Parser t) where
+    return = returnP
+    (>>=)  = bindP
+    fail   = failDesc
+
+noAdds :: (Monoid t) =>
+          Input t -> Added t -> More
+       -> (Input t -> Added t -> More -> r) -> r
+noAdds i0 _a0 m0 f = f i0 mempty m0
+{-# INLINE noAdds #-}
+
+plus :: (Monoid t) => Parser t a -> Parser t a -> Parser t 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
+               ks' i1 a1 m1 = ks i1 (a0 <> a1) m1
+           in  noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks'
+{-# INLINE plus #-}
+
+instance (Monoid t) => MonadPlus (Parser t) where
+    mzero = failDesc "mzero"
+    {-# INLINE mzero #-}
+    mplus = plus
+
+fmapP :: (a -> b) -> Parser t a -> Parser t 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 t) where
+    fmap = fmapP
+    {-# INLINE fmap #-}
+
+apP :: Parser t (a -> b) -> Parser t a -> Parser t b
+apP d e = do
+  b <- d
+  a <- e
+  return (b a)
+{-# INLINE apP #-}
+
+instance Applicative (Parser t) where
+    pure   = returnP
+    {-# INLINE pure #-}
+    (<*>)  = apP
+    {-# INLINE (<*>) #-}
+
+#if MIN_VERSION_base(4,2,0)
+    -- These definitions are equal to the defaults, but this
+    -- way the optimizer doesn't have to work so hard to figure
+    -- that out.
+    (*>)   = (>>)
+    {-# INLINE (*>) #-}
+    x <* y = x >>= \a -> y >> return a
+    {-# INLINE (<*) #-}
+#endif
+
+instance (Monoid t) => Monoid (Parser t a) where
+    mempty  = failDesc "mempty"
+    {-# INLINE mempty #-}
+    mappend = plus
+    {-# INLINE mappend #-}
+
+instance (Monoid t) => Alternative (Parser t) where
+    empty = failDesc "empty"
+    {-# INLINE empty #-}
+
+    (<|>) = plus
+    {-# INLINE (<|>) #-}
+
+#if MIN_VERSION_base(4,2,0)
+    many v = many_v
+        where many_v = some_v <|> pure []
+              some_v = (:) <$> v <*> many_v
+    {-# INLINE many #-}
+
+    some v = some_v
+      where
+        many_v = some_v <|> pure []
+        some_v = (:) <$> v <*> many_v
+    {-# INLINE some #-}
+#endif
+
+failDesc :: String -> Parser t a
+failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
+    where msg = "Failed reading: " ++ err
+{-# INLINE failDesc #-}
+
+(<>) :: (Monoid m) => m -> m -> m
+(<>) = mappend
+{-# INLINE (<>) #-}

File attoparsec.cabal

                    Data.Attoparsec.Text
                    Data.Attoparsec.Text.Lazy
                    Data.Attoparsec.Types
+                   Data.Attoparsec.Types.Internal
                    Data.Attoparsec.Zepto
   other-modules:   Data.Attoparsec.ByteString.FastSet
                    Data.Attoparsec.ByteString.Internal
                    Data.Attoparsec.Internal
-                   Data.Attoparsec.Internal.Types
                    Data.Attoparsec.Text.FastSet
                    Data.Attoparsec.Text.Internal
   ghc-options: -O2 -Wall