{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances, TupleSections #-}
{-# OPTIONS -Wall #-}
module Text.Parsec.Indentation (module Text.Parsec.Indentation, I.IndentationRel(..), Indentation, infIndentation) where
import Control.Monad
import Text.Parsec.Prim (ParsecT, mkPT, runParsecT,
Stream(..), Consumed(..), Reply(..),
State(..), getInput, setInput)
import Text.Parsec.Error (Message (Message), addErrorMessage)
import Text.Parser.Indentation.Implementation as I
data IndentStream s = IndentStream { IndentStream s -> IndentationState
indentationState :: !IndentationState, IndentStream s -> s
tokenStream :: !s } deriving (Int -> IndentStream s -> ShowS
[IndentStream s] -> ShowS
IndentStream s -> String
(Int -> IndentStream s -> ShowS)
-> (IndentStream s -> String)
-> ([IndentStream s] -> ShowS)
-> Show (IndentStream s)
forall s. Show s => Int -> IndentStream s -> ShowS
forall s. Show s => [IndentStream s] -> ShowS
forall s. Show s => IndentStream s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndentStream s] -> ShowS
$cshowList :: forall s. Show s => [IndentStream s] -> ShowS
show :: IndentStream s -> String
$cshow :: forall s. Show s => IndentStream s -> String
showsPrec :: Int -> IndentStream s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> IndentStream s -> ShowS
Show)
type IndentationToken t = t
{-# INLINE mkIndentStream #-}
mkIndentStream :: Indentation -> Indentation -> Bool -> IndentationRel -> s -> IndentStream s
mkIndentStream :: Int -> Int -> Bool -> IndentationRel -> s -> IndentStream s
mkIndentStream Int
lo Int
hi Bool
mode IndentationRel
rel s
s = IndentationState -> s -> IndentStream s
forall s. IndentationState -> s -> IndentStream s
IndentStream (Int -> Int -> Bool -> IndentationRel -> IndentationState
mkIndentationState Int
lo Int
hi Bool
mode IndentationRel
rel) s
s
instance (Monad m, Stream s m (t, Indentation)) => Stream (IndentStream s) m (IndentationToken t) where
uncons :: IndentStream s -> m (Maybe (IndentationToken t, IndentStream s))
uncons (IndentStream IndentationState
is s
s) = do
Maybe ((IndentationToken t, Int), s)
x <- s -> m (Maybe ((IndentationToken t, Int), s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
s
case Maybe ((IndentationToken t, Int), s)
x of
Maybe ((IndentationToken t, Int), s)
Nothing -> Maybe (IndentationToken t, IndentStream s)
-> m (Maybe (IndentationToken t, IndentStream s))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IndentationToken t, IndentStream s)
forall a. Maybe a
Nothing
Just ((IndentationToken t
t, Int
i), s
s') -> Maybe (IndentationToken t, IndentStream s)
-> m (Maybe (IndentationToken t, IndentStream s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IndentationToken t, IndentStream s)
-> m (Maybe (IndentationToken t, IndentStream s)))
-> Maybe (IndentationToken t, IndentStream s)
-> m (Maybe (IndentationToken t, IndentStream s))
forall a b. (a -> b) -> a -> b
$ IndentationState
-> Int
-> (IndentationState -> Maybe (IndentationToken t, IndentStream s))
-> (String -> Maybe (IndentationToken t, IndentStream s))
-> Maybe (IndentationToken t, IndentStream s)
forall a.
IndentationState
-> Int -> (IndentationState -> a) -> (String -> a) -> a
updateIndentation IndentationState
is Int
i IndentationState -> Maybe (IndentationToken t, IndentStream s)
ok String -> Maybe (IndentationToken t, IndentStream s)
forall p a. p -> Maybe a
err where
ok :: IndentationState -> Maybe (IndentationToken t, IndentStream s)
ok IndentationState
is' = (IndentationToken t, IndentStream s)
-> Maybe (IndentationToken t, IndentStream s)
forall a. a -> Maybe a
Just ( IndentationToken t
t, IndentationState -> s -> IndentStream s
forall s. IndentationState -> s -> IndentStream s
IndentStream IndentationState
is' s
s')
err :: p -> Maybe a
err p
_ = Maybe a
forall a. Maybe a
Nothing
{-# INLINE localState #-}
localState :: (Monad m) => LocalState (ParsecT (IndentStream s) u m a)
localState :: LocalState (ParsecT (IndentStream s) u m a)
localState IndentationState -> IndentationState
pre IndentationState -> IndentationState -> IndentationState
post ParsecT (IndentStream s) u m a
m = do
IndentStream IndentationState
is s
s <- ParsecT (IndentStream s) u m (IndentStream s)
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
IndentStream s -> ParsecT (IndentStream s) u m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (IndentationState -> s -> IndentStream s
forall s. IndentationState -> s -> IndentStream s
IndentStream (IndentationState -> IndentationState
pre IndentationState
is) s
s)
a
x <- ParsecT (IndentStream s) u m a
m
IndentStream IndentationState
is' s
s' <- ParsecT (IndentStream s) u m (IndentStream s)
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
IndentStream s -> ParsecT (IndentStream s) u m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (IndentationState -> s -> IndentStream s
forall s. IndentationState -> s -> IndentStream s
IndentStream (IndentationState -> IndentationState -> IndentationState
post IndentationState
is IndentationState
is') s
s')
a -> ParsecT (IndentStream s) u m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
{-# INLINE localStateUnlessAbsMode #-}
localStateUnlessAbsMode :: (Monad m) => LocalState (ParsecT (IndentStream s) u m a)
localStateUnlessAbsMode :: LocalState (ParsecT (IndentStream s) u m a)
localStateUnlessAbsMode IndentationState -> IndentationState
pre IndentationState -> IndentationState -> IndentationState
post ParsecT (IndentStream s) u m a
m = do
Bool
a <- (IndentStream s -> Bool)
-> ParsecT (IndentStream s) u m (IndentStream s)
-> ParsecT (IndentStream s) u m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (IndentationState -> Bool
indentationStateAbsMode (IndentationState -> Bool)
-> (IndentStream s -> IndentationState) -> IndentStream s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndentStream s -> IndentationState
forall s. IndentStream s -> IndentationState
indentationState) ParsecT (IndentStream s) u m (IndentStream s)
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
if Bool
a then ParsecT (IndentStream s) u m a
m else LocalState (ParsecT (IndentStream s) u m a)
forall (m :: * -> *) s u a.
Monad m =>
LocalState (ParsecT (IndentStream s) u m a)
localState IndentationState -> IndentationState
pre IndentationState -> IndentationState -> IndentationState
post ParsecT (IndentStream s) u m a
m
{-# INLINE localTokenMode #-}
localTokenMode :: (Monad m) => (IndentationRel -> IndentationRel) -> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localTokenMode :: (IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localTokenMode = LocalState (ParsecT (IndentStream s) u m a)
-> (IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m a
forall a.
LocalState a -> (IndentationRel -> IndentationRel) -> a -> a
I.localTokenMode LocalState (ParsecT (IndentStream s) u m a)
forall (m :: * -> *) s u a.
Monad m =>
LocalState (ParsecT (IndentStream s) u m a)
localState
{-# INLINE localIndentation #-}
localIndentation :: (Monad m) => IndentationRel -> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localIndentation :: IndentationRel
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localIndentation = LocalState (ParsecT (IndentStream s) u m a)
-> IndentationRel
-> ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m a
forall a. LocalState a -> IndentationRel -> a -> a
I.localIndentation LocalState (ParsecT (IndentStream s) u m a)
forall (m :: * -> *) s u a.
Monad m =>
LocalState (ParsecT (IndentStream s) u m a)
localStateUnlessAbsMode
{-# INLINE absoluteIndentation #-}
absoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
absoluteIndentation :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
absoluteIndentation = LocalState (ParsecT (IndentStream s) u m a)
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall a. LocalState a -> a -> a
I.absoluteIndentation LocalState (ParsecT (IndentStream s) u m a)
forall (m :: * -> *) s u a.
Monad m =>
LocalState (ParsecT (IndentStream s) u m a)
localState
{-# INLINE ignoreAbsoluteIndentation #-}
ignoreAbsoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
ignoreAbsoluteIndentation :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
ignoreAbsoluteIndentation = LocalState (ParsecT (IndentStream s) u m a)
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall a. LocalState a -> a -> a
I.ignoreAbsoluteIndentation LocalState (ParsecT (IndentStream s) u m a)
forall (m :: * -> *) s u a.
Monad m =>
LocalState (ParsecT (IndentStream s) u m a)
localState
{-# INLINE localAbsoluteIndentation #-}
localAbsoluteIndentation :: (Monad m) => ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localAbsoluteIndentation :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localAbsoluteIndentation = LocalState (ParsecT (IndentStream s) u m a)
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall a. LocalState a -> a -> a
I.localAbsoluteIndentation LocalState (ParsecT (IndentStream s) u m a)
forall (m :: * -> *) s u a.
Monad m =>
LocalState (ParsecT (IndentStream s) u m a)
localState
streamToList :: (Monad m, Stream s m t) => s -> m [t]
streamToList :: s -> m [t]
streamToList s
s = do
Maybe (t, s)
x <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
s
case Maybe (t, s)
x of
Maybe (t, s)
Nothing -> [t] -> m [t]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (t
c, s
s') -> do [t]
s'' <- s -> m [t]
forall (m :: * -> *) s t. (Monad m, Stream s m t) => s -> m [t]
streamToList s
s'
[t] -> m [t]
forall (m :: * -> *) a. Monad m => a -> m a
return (t
c t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
s'')
{-# INLINE indentStreamParser #-}
indentStreamParser :: (Monad m) => ParsecT s u m (t, Indentation) -> ParsecT (IndentStream s) u m (IndentationToken t)
indentStreamParser :: ParsecT s u m (t, Int) -> ParsecT (IndentStream s) u m t
indentStreamParser ParsecT s u m (t, Int)
p = (State (IndentStream s) u
-> m (Consumed (m (Reply (IndentStream s) u t))))
-> ParsecT (IndentStream s) u m t
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT ((State (IndentStream s) u
-> m (Consumed (m (Reply (IndentStream s) u t))))
-> ParsecT (IndentStream s) u m t)
-> (State (IndentStream s) u
-> m (Consumed (m (Reply (IndentStream s) u t))))
-> ParsecT (IndentStream s) u m t
forall a b. (a -> b) -> a -> b
$ \State (IndentStream s) u
state ->
let IndentStream IndentationState
is s
s = State (IndentStream s) u -> IndentStream s
forall s u. State s u -> s
stateInput State (IndentStream s) u
state
go :: (m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a)))
-> Reply s u (a, Int) -> m (Consumed (m (Reply s u a)))
go m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a))
f (Ok (a
a, Int
i) State s u
state' ParseError
e) = IndentationState
-> Int
-> (IndentationState -> m (Consumed (m (Reply s u a))))
-> (String -> m (Consumed (m (Reply s u a))))
-> m (Consumed (m (Reply s u a)))
forall a.
IndentationState
-> Int -> (IndentationState -> a) -> (String -> a) -> a
updateIndentation IndentationState
is Int
i IndentationState -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *).
Monad m =>
IndentationState -> m (Consumed (m (Reply s u a)))
ok String -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) (m :: * -> *) s u a.
(Monad m, Monad m) =>
String -> m (Consumed (m (Reply s u a)))
err where
ok :: IndentationState -> m (Consumed (m (Reply s u a)))
ok IndentationState
is' = Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a))))
-> Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a))
f (m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a)))
-> m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a))
forall a b. (a -> b) -> a -> b
$ Reply (IndentStream s) u a -> m (Reply (IndentStream s) u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
-> State (IndentStream s) u
-> ParseError
-> Reply (IndentStream s) u a
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok ( a
a) (State s u
state' {stateInput :: IndentStream s
stateInput = IndentationState -> s -> IndentStream s
forall s. IndentationState -> s -> IndentStream s
IndentStream IndentationState
is' (State s u -> s
forall s u. State s u -> s
stateInput State s u
state') }) ParseError
e)
err :: String -> m (Consumed (m (Reply s u a)))
err String
msg = Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a))))
-> Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ m (Reply s u a) -> Consumed (m (Reply s u a))
forall a. a -> Consumed a
Empty (m (Reply s u a) -> Consumed (m (Reply s u a)))
-> m (Reply s u a) -> Consumed (m (Reply s u a))
forall a b. (a -> b) -> a -> b
$ Reply s u a -> m (Reply s u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply s u a -> m (Reply s u a)) -> Reply s u a -> m (Reply s u a)
forall a b. (a -> b) -> a -> b
$ ParseError -> Reply s u a
forall s u a. ParseError -> Reply s u a
Error (String -> Message
Message (String
"Invalid indentation. "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msgString -> ShowS
forall a. [a] -> [a] -> [a]
++IndentStream String -> String
forall a. Show a => a -> String
show ((State (IndentStream s) u -> IndentStream s
forall s u. State s u -> s
stateInput State (IndentStream s) u
state) { tokenStream :: String
tokenStream = String
""})) Message -> ParseError -> ParseError
`addErrorMessage` ParseError
e)
go m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a))
f (Error ParseError
e) = Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a))))
-> Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a))
f (m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a)))
-> m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a))
forall a b. (a -> b) -> a -> b
$ Reply (IndentStream s) u a -> m (Reply (IndentStream s) u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Reply (IndentStream s) u a
forall s u a. ParseError -> Reply s u a
Error ParseError
e)
in ParsecT s u m (t, Int)
-> State s u -> m (Consumed (m (Reply s u (t, Int))))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ParsecT s u m (t, Int)
p (State (IndentStream s) u
state { stateInput :: s
stateInput = s
s }) m (Consumed (m (Reply s u (t, Int))))
-> (Consumed (m (Reply s u (t, Int)))
-> m (Consumed (m (Reply (IndentStream s) u t))))
-> m (Consumed (m (Reply (IndentStream s) u t)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Reply s u (t, Int)
-> m (Consumed (m (Reply (IndentStream s) u t))))
-> (Reply s u (t, Int)
-> m (Consumed (m (Reply (IndentStream s) u t))))
-> Consumed (m (Reply s u (t, Int)))
-> m (Consumed (m (Reply (IndentStream s) u t)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a -> m b) -> Consumed (m a) -> m b
consumed ((m (Reply (IndentStream s) u t)
-> Consumed (m (Reply (IndentStream s) u t)))
-> Reply s u (t, Int)
-> m (Consumed (m (Reply (IndentStream s) u t)))
forall (m :: * -> *) (m :: * -> *) (m :: * -> *) s u a s u a.
(Monad m, Monad m, Monad m) =>
(m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a)))
-> Reply s u (a, Int) -> m (Consumed (m (Reply s u a)))
go m (Reply (IndentStream s) u t)
-> Consumed (m (Reply (IndentStream s) u t))
forall a. a -> Consumed a
Consumed) ((m (Reply (IndentStream s) u t)
-> Consumed (m (Reply (IndentStream s) u t)))
-> Reply s u (t, Int)
-> m (Consumed (m (Reply (IndentStream s) u t)))
forall (m :: * -> *) (m :: * -> *) (m :: * -> *) s u a s u a.
(Monad m, Monad m, Monad m) =>
(m (Reply (IndentStream s) u a) -> Consumed (m (Reply s u a)))
-> Reply s u (a, Int) -> m (Consumed (m (Reply s u a)))
go m (Reply (IndentStream s) u t)
-> Consumed (m (Reply (IndentStream s) u t))
forall a. a -> Consumed a
Empty)
{-# INLINE consumed #-}
consumed :: (Monad m) => (a -> m b) -> (a -> m b) -> Consumed (m a) -> m b
consumed :: (a -> m b) -> (a -> m b) -> Consumed (m a) -> m b
consumed a -> m b
c a -> m b
_ (Consumed m a
m) = m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
c
consumed a -> m b
_ a -> m b
e (Empty m a
m) = m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
e