Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

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.
commit e22d19512c9f606e4ea83f62b009c5d6cb608559 1 parent b018c63
@bos authored
View
2  Data/Attoparsec/ByteString/Internal.hs
@@ -86,7 +86,7 @@ import qualified Data.ByteString.Internal as B
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
View
60 Data/Attoparsec/Combinator.hs
@@ -47,14 +47,14 @@ import Prelude hiding (succ)
--
-- 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
@@ -66,9 +66,9 @@ infix 0 <?>
-- 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
@@ -78,8 +78,8 @@ choice = foldr (<|>) empty
-- > 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
@@ -125,9 +125,9 @@ many1' p = liftM2' (:) p (many' p)
-- > 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
@@ -138,9 +138,9 @@ sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure []
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
@@ -150,9 +150,9 @@ sepBy' p s = scan `mplus` return []
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
@@ -163,9 +163,9 @@ sepBy1 p s = scan
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
@@ -180,9 +180,9 @@ sepBy1' p s = scan
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
@@ -199,24 +199,24 @@ manyTill p end = scan
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.
View
39 Data/Attoparsec/Internal/Types.hs
@@ -15,6 +15,7 @@
module Data.Attoparsec.Internal.Types
(
Parser(..)
+ , Input(..)
, Failure
, Success
, Pos(..)
@@ -26,8 +27,12 @@ module Data.Attoparsec.Internal.Types
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)
@@ -90,13 +95,23 @@ instance Functor (IResult i) where
-- 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
@@ -110,7 +125,7 @@ instance Monoid More where
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 #-}
@@ -123,30 +138,30 @@ instance Monad (Parser i t) where
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
@@ -160,13 +175,13 @@ instance Applicative (Parser i t) where
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 #-}
View
2  Data/Attoparsec/Text/Internal.hs
@@ -81,7 +81,7 @@ import qualified Data.Text as T
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
Please sign in to comment.
Something went wrong with that request. Please try again.