Commits

Bryan O'Sullivan committed 68203a4

Hide the internal state type parameter

I'm finally making a tiny bit of progress in my understanding of
type families. This makes me happy.

  • Participants
  • Parent commits 1398632
  • Tags 0.12.0.0

Comments (0)

Files changed (4)

File Data/Attoparsec/ByteString/Internal.hs

 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Unsafe as B
 
-type Parser = T.Parser ByteString Buffer
+type Parser = T.Parser ByteString
 type Result = IResult ByteString
 type Failure r = T.Failure ByteString Buffer r
 type Success a r = T.Success ByteString Buffer a r

File Data/Attoparsec/Combinator.hs

 --
 -- This combinator is provided for compatibility with Parsec.
 -- attoparsec parsers always backtrack on failure.
-try :: Parser i t a -> Parser i t a
+try :: Parser i a -> Parser i a
 try p = p
 {-# INLINE try #-}
 
 -- | Name the parser, in case failure occurs.
-(<?>) :: Parser i t a
+(<?>) :: Parser i a
       -> String                 -- ^ the name to use if parsing fails
-      -> Parser i t a
+      -> Parser i a
 p <?> msg0 = Parser $ \t pos more lose succ ->
              let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg
              in runParser p t pos more lose' succ
 -- action.
 choice :: Alternative f => [f a] -> f a
 choice = foldr (<|>) empty
-{-# SPECIALIZE choice :: [Parser ByteString ByteString a]
-                      -> Parser ByteString ByteString a #-}
-{-# SPECIALIZE choice :: [Parser Text Text a] -> Parser Text Text a #-}
+{-# SPECIALIZE choice :: [Parser ByteString a]
+                      -> Parser ByteString a #-}
+{-# SPECIALIZE choice :: [Parser Text a] -> Parser Text a #-}
 {-# SPECIALIZE choice :: [Z.Parser a] -> Z.Parser a #-}
 
 -- | @option x p@ tries to apply action @p@. If @p@ fails without
 -- > priority  = option 0 (digitToInt <$> digit)
 option :: Alternative f => a -> f a -> f a
 option x p = p <|> pure x
-{-# SPECIALIZE option :: a -> Parser ByteString ByteString a -> Parser ByteString ByteString a #-}
-{-# SPECIALIZE option :: a -> Parser Text Text a -> Parser Text Text a #-}
+{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-}
+{-# SPECIALIZE option :: a -> Parser Text a -> Parser Text a #-}
 {-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-}
 
 -- | A version of 'liftM2' that is strict in the result of its first
 -- > commaSep p  = p `sepBy` (symbol ",")
 sepBy :: Alternative f => f a -> f s -> f [a]
 sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure []
-{-# SPECIALIZE sepBy :: Parser ByteString ByteString a -> Parser ByteString ByteString s
-                     -> Parser ByteString ByteString [a] #-}
-{-# SPECIALIZE sepBy :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}
+{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s
+                     -> Parser ByteString [a] #-}
+{-# SPECIALIZE sepBy :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
 {-# SPECIALIZE sepBy :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
 
 -- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated
 sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
 sepBy' p s = scan `mplus` return []
   where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return [])
-{-# SPECIALIZE sepBy' :: Parser ByteString ByteString a -> Parser ByteString ByteString s
-                      -> Parser ByteString ByteString [a] #-}
-{-# SPECIALIZE sepBy' :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}
+{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s
+                      -> Parser ByteString [a] #-}
+{-# SPECIALIZE sepBy' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
 {-# SPECIALIZE sepBy' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
 
 -- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated
 sepBy1 :: Alternative f => f a -> f s -> f [a]
 sepBy1 p s = scan
     where scan = liftA2 (:) p ((s *> scan) <|> pure [])
-{-# SPECIALIZE sepBy1 :: Parser ByteString ByteString a -> Parser ByteString ByteString s
-                      -> Parser ByteString ByteString [a] #-}
-{-# SPECIALIZE sepBy1 :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}
+{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s
+                      -> Parser ByteString [a] #-}
+{-# SPECIALIZE sepBy1 :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
 {-# SPECIALIZE sepBy1 :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
 
 -- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated
 sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
 sepBy1' p s = scan
     where scan = liftM2' (:) p ((s >> scan) `mplus` return [])
-{-# SPECIALIZE sepBy1' :: Parser ByteString ByteString a -> Parser ByteString ByteString s
-                       -> Parser ByteString ByteString [a] #-}
-{-# SPECIALIZE sepBy1' :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}
+{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s
+                       -> Parser ByteString [a] #-}
+{-# SPECIALIZE sepBy1' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
 {-# SPECIALIZE sepBy1' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
 
 -- | @manyTill p end@ applies action @p@ /zero/ or more times until
 manyTill :: Alternative f => f a -> f b -> f [a]
 manyTill p end = scan
     where scan = (end *> pure []) <|> liftA2 (:) p scan
-{-# SPECIALIZE manyTill :: Parser ByteString ByteString a -> Parser ByteString ByteString b
-                        -> Parser ByteString ByteString [a] #-}
-{-# SPECIALIZE manyTill :: Parser Text Text a -> Parser Text Text b -> Parser Text Text [a] #-}
+{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b
+                        -> Parser ByteString [a] #-}
+{-# SPECIALIZE manyTill :: Parser Text a -> Parser Text b -> Parser Text [a] #-}
 {-# SPECIALIZE manyTill :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}
 
 -- | @manyTill' p end@ applies action @p@ /zero/ or more times until
 manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
 manyTill' p end = scan
     where scan = (end >> return []) `mplus` liftM2' (:) p scan
-{-# SPECIALIZE manyTill' :: Parser ByteString ByteString a -> Parser ByteString ByteString b
-                         -> Parser ByteString ByteString [a] #-}
-{-# SPECIALIZE manyTill' :: Parser Text Text a -> Parser Text Text b -> Parser Text Text [a] #-}
+{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b
+                         -> Parser ByteString [a] #-}
+{-# SPECIALIZE manyTill' :: Parser Text a -> Parser Text b -> Parser Text [a] #-}
 {-# SPECIALIZE manyTill' :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}
 
 -- | Skip zero or more instances of an action.
 skipMany :: Alternative f => f a -> f ()
 skipMany p = scan
     where scan = (p *> scan) <|> pure ()
-{-# SPECIALIZE skipMany :: Parser ByteString ByteString a -> Parser ByteString ByteString () #-}
-{-# SPECIALIZE skipMany :: Parser Text Text a -> Parser Text Text () #-}
+{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-}
+{-# SPECIALIZE skipMany :: Parser Text a -> Parser Text () #-}
 {-# SPECIALIZE skipMany :: Z.Parser a -> Z.Parser () #-}
 
 -- | Skip one or more instances of an action.
 skipMany1 :: Alternative f => f a -> f ()
 skipMany1 p = p *> skipMany p
-{-# SPECIALIZE skipMany1 :: Parser ByteString ByteString a -> Parser ByteString ByteString () #-}
-{-# SPECIALIZE skipMany1 :: Parser Text Text a -> Parser Text Text () #-}
+{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-}
+{-# SPECIALIZE skipMany1 :: Parser Text a -> Parser Text () #-}
 {-# SPECIALIZE skipMany1 :: Z.Parser a -> Z.Parser () #-}
 
 -- | Apply the given action repeatedly, returning every result.

File Data/Attoparsec/Internal/Types.hs

 module Data.Attoparsec.Internal.Types
     (
       Parser(..)
+    , Input(..)
     , Failure
     , Success
     , Pos(..)
 import Control.Applicative (Alternative(..), Applicative(..), (<$>))
 import Control.DeepSeq (NFData(rnf))
 import Control.Monad (MonadPlus(..))
+import Data.ByteString (ByteString)
 import Data.Monoid (Monoid(..))
+import Data.Text (Text)
 import Prelude hiding (getChar, succ)
+import qualified Data.Attoparsec.ByteString.Buffer as B
+import qualified Data.Attoparsec.Text.Buffer as T
 
 newtype Pos = Pos { fromPos :: Int }
             deriving (Eq, Ord, Show, Num)
 --   arbitrary lookahead.)
 --
 -- * 'Alternative', which follows 'MonadPlus'.
-newtype Parser i t a = Parser {
-      runParser :: forall r. t -> Pos -> More
-                -> Failure i t   r
-                -> Success i t a r
+newtype Parser i a = Parser {
+      runParser :: forall r. Input i =>
+                   State i -> Pos -> More
+                -> Failure i (State i)   r
+                -> Success i (State i) a r
                 -> IResult i r
     }
 
+class Input i where
+    type State i :: *
+
+instance Input ByteString where
+    type State ByteString = B.Buffer
+
+instance Input Text where
+    type State Text = T.Buffer
+
 type Failure i t   r = t -> Pos -> More -> [String] -> String
                        -> IResult i r
 type Success i t a r = t -> Pos -> More -> a -> IResult i r
     mappend _ m          = m
     mempty               = Incomplete
 
-instance Monad (Parser i t) where
+instance Monad (Parser i) where
     fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
       where msg = "Failed reading: " ++ err
     {-# INLINE fail #-}
         in runParser m t pos more lose succ'
     {-# INLINE (>>=) #-}
 
-plus :: Parser i t a -> Parser i t a -> Parser i t a
+plus :: Parser i a -> Parser i a -> Parser i a
 plus f g = Parser $ \t pos more lose succ ->
   let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ
   in runParser f t pos more lose' succ
 
-instance MonadPlus (Parser i t) where
+instance MonadPlus (Parser i) where
     mzero = fail "mzero"
     {-# INLINE mzero #-}
     mplus = plus
 
-instance Functor (Parser i t) where
+instance Functor (Parser i) where
     fmap f p = Parser $ \t pos more lose succ ->
       let succ' t' pos' more' a = succ t' pos' more' (f a)
       in runParser p t pos more lose succ'
     {-# INLINE fmap #-}
 
-apP :: Parser i t (a -> b) -> Parser i t a -> Parser i t b
+apP :: Parser i (a -> b) -> Parser i a -> Parser i b
 apP d e = do
   b <- d
   a <- e
   return (b a)
 {-# INLINE apP #-}
 
-instance Applicative (Parser i t) where
+instance Applicative (Parser i) where
     pure   = return
     {-# INLINE pure #-}
     (<*>)  = apP
     x <* y = x >>= \a -> y >> return a
     {-# INLINE (<*) #-}
 
-instance Monoid (Parser i t a) where
+instance Monoid (Parser i a) where
     mempty  = fail "mempty"
     {-# INLINE mempty #-}
     mappend = plus
     {-# INLINE mappend #-}
 
-instance Alternative (Parser i t) where
+instance Alternative (Parser i) where
     empty = fail "empty"
     {-# INLINE empty #-}
 

File Data/Attoparsec/Text/Internal.hs

 import qualified Data.Text.Lazy as L
 import qualified Data.Text.Unsafe as T
 
-type Parser = T.Parser Text Buffer
+type Parser = T.Parser Text
 type Result = IResult Text
 type Failure r = T.Failure Text Buffer r
 type Success a r = T.Success Text Buffer a r