{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
#define USE_DEFAULT_SIGNATURES
#endif

#ifdef USE_DEFAULT_SIGNATURES
{-# LANGUAGE DefaultSignatures, TypeFamilies #-}
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Parser.LookAhead
-- Copyright   :  (c) Edward Kmett 2011-2013
-- License     :  BSD3
--
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Parsers that can 'lookAhead'.
-----------------------------------------------------------------------------
module Text.Parser.LookAhead
  (
  -- * Parsing Combinators
    LookAheadParsing(..)
  ) where

import Control.Monad (MonadPlus(..))
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Identity
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import qualified Text.ParserCombinators.ReadP as ReadP
import Text.Parser.Combinators

#ifdef MIN_VERSION_parsec
import qualified Text.Parsec as Parsec
#endif

#ifdef MIN_VERSION_attoparsec
import qualified Data.Attoparsec.Types as Att
import qualified Data.Attoparsec.Combinator as Att
#endif

#ifdef MIN_VERSION_binary
import qualified Data.Binary.Get as B
#endif

-- | Additional functionality needed to describe parsers independent of input type.
class Parsing m => LookAheadParsing m where
  -- | @lookAhead p@ parses @p@ without consuming any input.
  lookAhead :: m a -> m a

instance (LookAheadParsing m, MonadPlus m) => LookAheadParsing (Lazy.StateT s m) where
  lookAhead :: StateT s m a -> StateT s m a
lookAhead (Lazy.StateT s -> m (a, s)
m) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ m (a, s) -> m (a, s)
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
m
  {-# INLINE lookAhead #-}

instance (LookAheadParsing m, MonadPlus m) => LookAheadParsing (Strict.StateT s m) where
  lookAhead :: StateT s m a -> StateT s m a
lookAhead (Strict.StateT s -> m (a, s)
m) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ m (a, s) -> m (a, s)
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
m
  {-# INLINE lookAhead #-}

instance (LookAheadParsing m, MonadPlus m) => LookAheadParsing (ReaderT e m) where
  lookAhead :: ReaderT e m a -> ReaderT e m a
lookAhead (ReaderT e -> m a
m) = (e -> m a) -> ReaderT e m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m a) -> ReaderT e m a) -> (e -> m a) -> ReaderT e m a
forall a b. (a -> b) -> a -> b
$ m a -> m a
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead (m a -> m a) -> (e -> m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
m
  {-# INLINE lookAhead #-}

instance (LookAheadParsing m, MonadPlus m, Monoid w) => LookAheadParsing (Strict.WriterT w m) where
  lookAhead :: WriterT w m a -> WriterT w m a
lookAhead (Strict.WriterT m (a, w)
m) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead m (a, w)
m
  {-# INLINE lookAhead #-}

instance (LookAheadParsing m, MonadPlus m, Monoid w) => LookAheadParsing (Lazy.WriterT w m) where
  lookAhead :: WriterT w m a -> WriterT w m a
lookAhead (Lazy.WriterT m (a, w)
m) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead m (a, w)
m
  {-# INLINE lookAhead #-}

instance (LookAheadParsing m, MonadPlus m, Monoid w) => LookAheadParsing (Lazy.RWST r w s m) where
  lookAhead :: RWST r w s m a -> RWST r w s m a
lookAhead (Lazy.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead (r -> s -> m (a, s, w)
m r
r s
s)
  {-# INLINE lookAhead #-}

instance (LookAheadParsing m, MonadPlus m, Monoid w) => LookAheadParsing (Strict.RWST r w s m) where
  lookAhead :: RWST r w s m a -> RWST r w s m a
lookAhead (Strict.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead (r -> s -> m (a, s, w)
m r
r s
s)
  {-# INLINE lookAhead #-}

instance (LookAheadParsing m, Monad m) => LookAheadParsing (IdentityT m) where
  lookAhead :: IdentityT m a -> IdentityT m a
lookAhead = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a)
-> (IdentityT m a -> m a) -> IdentityT m a -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead (m a -> m a) -> (IdentityT m a -> m a) -> IdentityT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  {-# INLINE lookAhead #-}

#ifdef MIN_VERSION_parsec
instance (Parsec.Stream s m t, Show t) => LookAheadParsing (Parsec.ParsecT s u m) where
  lookAhead :: ParsecT s u m a -> ParsecT s u m a
lookAhead = ParsecT s u m a -> ParsecT s u m a
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
Parsec.lookAhead
#endif

#ifdef MIN_VERSION_attoparsec
instance Att.Chunk i => LookAheadParsing (Att.Parser i) where
  lookAhead :: Parser i a -> Parser i a
lookAhead = Parser i a -> Parser i a
forall i a. Parser i a -> Parser i a
Att.lookAhead
#endif

#ifdef MIN_VERSION_binary
instance LookAheadParsing B.Get where
  lookAhead :: Get a -> Get a
lookAhead = Get a -> Get a
forall a. Get a -> Get a
B.lookAhead
#endif

instance LookAheadParsing ReadP.ReadP where
  lookAhead :: ReadP a -> ReadP a
lookAhead ReadP a
p = ReadP String
ReadP.look ReadP String -> (String -> ReadP a) -> ReadP a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
s ->
                [ReadP a] -> ReadP a
forall a. [ReadP a] -> ReadP a
ReadP.choice ([ReadP a] -> ReadP a) -> [ReadP a] -> ReadP a
forall a b. (a -> b) -> a -> b
$ ((a, String) -> ReadP a) -> [(a, String)] -> [ReadP a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ReadP a) -> ((a, String) -> a) -> (a, String) -> ReadP a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> a
forall a b. (a, b) -> a
fst) ([(a, String)] -> [ReadP a]) -> [(a, String)] -> [ReadP a]
forall a b. (a -> b) -> a -> b
$ ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
ReadP.readP_to_S ReadP a
p String
s