Source

attoparsec / Data / Attoparsec / Internal / Types.hs

Full commit
Bryan O'Sullivan 87a37ff 

Bryan O'Sullivan 9bb4d8a 








Bryan O'Sullivan 1abf418 

Bryan O'Sullivan 9bb4d8a 





Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 


Bryan O'Sullivan 0364dfc 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 




Bryan O'Sullivan 1abf418 

Bryan O'Sullivan e3bc107 



Bryan O'Sullivan 1abf418 





Bryan O'Sullivan e3bc107 




Bryan O'Sullivan 1abf418 


Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 




Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 1abf418 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 

Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan b7c99b2 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan 87a37ff 

Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan 1abf418 

Bryan O'Sullivan e3bc107 









Bryan O'Sullivan 1abf418 



Bryan O'Sullivan e3bc107 






Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 


Bryan O'Sullivan 9bb4d8a 




Bryan O'Sullivan 87a37ff 




Bryan O'Sullivan e3bc107 



Bryan O'Sullivan 0364dfc 
Bryan O'Sullivan 87a37ff 


Bryan O'Sullivan 0364dfc 

Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 7de1ded 


Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 7de1ded 
Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 



Bryan O'Sullivan e3bc107 



Bryan O'Sullivan 0364dfc 

Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 7de1ded 
Bryan O'Sullivan 0364dfc 

Bryan O'Sullivan 87a37ff 
Max Bolingbroke b163037 
Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 



Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 7de1ded 

Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan b7c99b2 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 





Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan b7c99b2 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan b7c99b2 
Bryan O'Sullivan 9bb4d8a 
John Millikin 390da6b 
Bryan O'Sullivan 9bb4d8a 



Bryan O'Sullivan b7c99b2 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan b7c99b2 
John Millikin 390da6b 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 


Bryan O'Sullivan b7c99b2 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 

Bryan O'Sullivan e3bc107 
Bryan O'Sullivan 9bb4d8a 
Bryan O'Sullivan b7c99b2 
Bryan O'Sullivan 9bb4d8a 
John Millikin 9bd3ade 
Bryan O'Sullivan e3bc107 









John Millikin 9bd3ade 
Bryan O'Sullivan e3bc107 

Bryan O'Sullivan 7de1ded 
Bryan O'Sullivan 9bb4d8a 


Bryan O'Sullivan e3bc107 

{-# 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 (A 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 (<>) #-}