{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Text.Parsec.Indent (
    -- $doc

    -- * Types
    IndentT, IndentParserT, IndentParser, runIndent,
    runIndentParserT, runIndentParser,
    -- * Blocks
    withBlock, withBlock', block,
    -- * Indentation Checking
    indented, same, sameOrIndented, checkIndent,
    topLevel, notTopLevel,
    withPos,
    -- * Paired characters
    indentBrackets, indentAngles, indentBraces, indentParens,
    -- * Line Fold Chaining
    -- | Any chain using these combinators must used with 'withPos'
    (<+/>), (<-/>), (<*/>), (<?/>), Optional(..)
    ) where

import           Control.Monad               (ap, liftM2)
import           Control.Monad.Identity      (Identity, runIdentity)
import           Control.Monad.Reader        (ReaderT, ask, local, runReaderT)
import           Text.Parsec
import qualified Text.Parsec.Indent.Explicit as Explicit
import           Text.Parsec.Indent.Internal
import           Text.Parsec.Token

-- $doc
-- A module to construct indentation aware parsers. Many programming
-- language have indentation based syntax rules e.g. python and Haskell.
-- This module exports combinators to create such parsers.
--
-- The input source can be thought of as a list of tokens. Abstractly
-- each token occurs at a line and a column and has a width. The column
-- number of a token measures is indentation. If t1 and t2 are two tokens
-- then we say that indentation of t1 is more than t2 if the column
-- number of occurrence of t1 is greater than that of t2.
--
-- Currently this module supports two kind of indentation based syntactic
-- structures which we now describe:
--
-- [Block] A block of indentation /c/ is a sequence of tokens with
-- indentation at least /c/.  Examples for a block is a where clause of
-- Haskell with no explicit braces.
--
-- [Line fold] A line fold starting at line /l/ and indentation /c/ is a
-- sequence of tokens that start at line /l/ and possibly continue to
-- subsequent lines as long as the indentation is greater than /c/. Such
-- a sequence of lines need to be /folded/ to a single line. An example
-- is MIME headers. Line folding based binding separation is used in
-- Haskell as well.

referenceIndentation :: Monad m => IndentParserT s u m Indentation
referenceIndentation :: forall (m :: * -> *) s u.
Monad m =>
IndentParserT s u m Indentation
referenceIndentation = forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Indentation transformer.
type IndentT m = ReaderT Indentation m

-- | Indentation sensitive parser type. Usually @m@ will be 'Identity' as with
-- any 'ParsecT'.  In that case you can use the simpler 'IndentParser' type.
type IndentParserT s u m a = ParsecT s u (IndentT m) a

-- | A simplified 'IndentParserT'.
type IndentParser s u a = IndentParserT s u Identity a

-- | @ 'withBlock' f a p @ parses @ a @
--   followed by an indented block of @ p @
--   combining them with @ f @
withBlock
    :: (Monad m, Stream s (IndentT m) z)
    => (a -> [b] -> c)
    -> IndentParserT s u m a
    -> IndentParserT s u m b
    -> IndentParserT s u m c
withBlock :: forall (m :: * -> *) s z a b c u.
(Monad m, Stream s (IndentT m) z) =>
(a -> [b] -> c)
-> IndentParserT s u m a
-> IndentParserT s u m b
-> IndentParserT s u m c
withBlock a -> [b] -> c
f IndentParserT s u m a
a IndentParserT s u m b
p = forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m a
withPos forall a b. (a -> b) -> a -> b
$ do
    a
r1 <- IndentParserT s u m a
a
    [b]
r2 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
indented forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m [a]
block IndentParserT s u m b
p)
    forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [b] -> c
f a
r1 [b]
r2)

-- | Like 'withBlock', but throws away initial parse result
withBlock'
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m a
    -> IndentParserT s u m b
    -> IndentParserT s u m [b]
withBlock' :: forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m [b]
withBlock' = forall (m :: * -> *) s z a b c u.
(Monad m, Stream s (IndentT m) z) =>
(a -> [b] -> c)
-> IndentParserT s u m a
-> IndentParserT s u m b
-> IndentParserT s u m c
withBlock (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const)

-- | Parses only when indented past the level of the reference
indented
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m ()
indented :: forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
indented = forall (m :: * -> *) s u.
Monad m =>
IndentParserT s u m Indentation
referenceIndentation forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) s z u.
(Monad m, Stream s m z) =>
Indentation -> ParsecT s u m ()
Explicit.indented

-- | Parses only when indented past the level of the reference or on the same line
sameOrIndented
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m ()
sameOrIndented :: forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
sameOrIndented = forall (m :: * -> *) s u.
Monad m =>
IndentParserT s u m Indentation
referenceIndentation forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) s z u.
(Monad m, Stream s m z) =>
Indentation -> ParsecT s u m ()
Explicit.sameOrIndented

-- | Parses only on the same line as the reference
same
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m ()
same :: forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
same = forall (m :: * -> *) s u.
Monad m =>
IndentParserT s u m Indentation
referenceIndentation forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) s z u.
(Monad m, Stream s m z) =>
Indentation -> ParsecT s u m ()
Explicit.same

-- | Parses a block of lines at the same indentation level
block
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m a
    -> IndentParserT s u m [a]
block :: forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m [a]
block = forall (m :: * -> *) s z u a.
(Monad m, Stream s m z) =>
ParsecT s u m a -> ParsecT s u m [a]
Explicit.block

-- | Parses using the current location for indentation reference
withPos
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m a
    -> IndentParserT s u m a
withPos :: forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m a
withPos IndentParserT s u m a
x = do
    Indentation
p <- forall (m :: * -> *) s u. Monad m => ParsecT s u m Indentation
Explicit.indentation
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall a b. a -> b -> a
const Indentation
p) IndentParserT s u m a
x

-- | Ensures the current indentation level matches that of the reference
checkIndent
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m ()
checkIndent :: forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
checkIndent = forall (m :: * -> *) s u.
Monad m =>
IndentParserT s u m Indentation
referenceIndentation forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) s z u.
(Monad m, Stream s m z) =>
Indentation -> ParsecT s u m ()
Explicit.checkIndent

-- | Ensures that there is no indentation.
topLevel
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m ()
topLevel :: forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
topLevel = forall (m :: * -> *) s z u.
(Monad m, Stream s m z) =>
ParsecT s u m ()
Explicit.topLevel

-- | Ensures that there is at least some indentation.
notTopLevel
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m ()
notTopLevel :: forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
notTopLevel = forall (m :: * -> *) s z u.
(Monad m, Stream s m z) =>
ParsecT s u m ()
Explicit.notTopLevel

-- | Run the result of an indentation sensitive parse
runIndentT :: Monad m => IndentT m a -> m a
runIndentT :: forall (m :: * -> *) a. Monad m => IndentT m a -> m a
runIndentT IndentT m a
i = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT IndentT m a
i (Int -> Int -> Indentation
Indentation Int
1 Int
1)

-- | Simplified version of 'runIndentT'.
runIndent :: IndentT Identity a -> a
runIndent :: forall a. IndentT Identity a -> a
runIndent = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => IndentT m a -> m a
runIndentT

-- | This is a convenience function which wraps 'runIndentT' and 'runParserT'.
runIndentParserT
    :: (Monad m, Stream s (IndentT m) t)
    => IndentParserT s u m a    -- ^ Parser to run
    -> u                        -- ^ User state
    -> SourceName               -- ^ Source name
    -> s                        -- ^ Input for the parser
    -> m (Either ParseError a)  -- ^ Result
runIndentParserT :: forall (m :: * -> *) s t u a.
(Monad m, Stream s (IndentT m) t) =>
IndentParserT s u m a
-> u -> SourceName -> s -> m (Either ParseError a)
runIndentParserT IndentParserT s u m a
parser u
u SourceName
source s
txt =
    forall (m :: * -> *) a. Monad m => IndentT m a -> m a
runIndentT (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT IndentParserT s u m a
parser u
u SourceName
source s
txt)

-- | This is another convenience function.  Use this instead of
-- 'runIndentParserT' if 'm' is 'Identity'.
runIndentParser
    :: Stream s (IndentT Identity) t
    => IndentParser s u a   -- ^ Parser to run
    -> u                    -- ^ User state
    -> SourceName           -- ^ Source name
    -> s                    -- ^ Input for the parser
    -> Either ParseError a  -- ^ Result
runIndentParser :: forall s t u a.
Stream s (IndentT Identity) t =>
IndentParser s u a -> u -> SourceName -> s -> Either ParseError a
runIndentParser IndentParser s u a
parser u
u SourceName
source s
txt =
    forall a. Identity a -> a
runIdentity (forall (m :: * -> *) s t u a.
(Monad m, Stream s (IndentT m) t) =>
IndentParserT s u m a
-> u -> SourceName -> s -> m (Either ParseError a)
runIndentParserT IndentParser s u a
parser u
u SourceName
source s
txt)

-- | '<+/>' is to indentation sensitive parsers what 'ap' is to monads
(<+/>)
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m (a -> b)
    -> IndentParserT s u m a
    -> IndentParserT s u m b
IndentParserT s u m (a -> b)
a <+/> :: forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m (a -> b)
-> IndentParserT s u m a -> IndentParserT s u m b
<+/> IndentParserT s u m a
b = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap IndentParserT s u m (a -> b)
a (forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
sameOrIndented forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndentParserT s u m a
b)

-- | '<-/>' is like '<+/>', but doesn't apply the function to the parsed value
(<-/>)
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m a
    -> IndentParserT s u m b
    -> IndentParserT s u m a
IndentParserT s u m a
a <-/> :: forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> IndentParserT s u m b
b = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a b. a -> b -> a
const IndentParserT s u m a
a (forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
sameOrIndented forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndentParserT s u m b
b)

-- | Like '<+/>' but applies the second parser many times
(<*/>)
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m ([a] -> b)
    -> IndentParserT s u m a
    -> IndentParserT s u m b
IndentParserT s u m ([a] -> b)
a <*/> :: forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ([a] -> b)
-> IndentParserT s u m a -> IndentParserT s u m b
<*/> IndentParserT s u m a
b = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap IndentParserT s u m ([a] -> b)
a (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
sameOrIndented forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndentParserT s u m a
b))

-- | Datatype used to optional parsing
data Optional s u m a = Opt a (IndentParserT s u m a)

-- | Like '<+/>' but applies the second parser optionally using the 'Optional' datatype
(<?/>)
    :: (Monad m, Stream s (IndentT m) z)
    => IndentParserT s u m (a -> b)
    -> (Optional s u m a)
    -> IndentParserT s u m b
<?/> :: forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m (a -> b)
-> Optional s u m a -> IndentParserT s u m b
(<?/>) IndentParserT s u m (a -> b)
a (Opt a
b IndentParserT s u m a
c) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap IndentParserT s u m (a -> b)
a (forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
b (forall (m :: * -> *) s z u.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m ()
sameOrIndented forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndentParserT s u m a
c))

-- | parses with surrounding brackets
indentBrackets
    :: (Monad m, Stream s (IndentT m) z)
    => GenTokenParser s u (IndentT m)
    -> IndentParserT s u m a
    -> IndentParserT s u m a
indentBrackets :: forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
GenTokenParser s u (IndentT m)
-> IndentParserT s u m a -> IndentParserT s u m a
indentBrackets GenTokenParser s u (IndentT m)
lexer IndentParserT s u m a
p = forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m a
withPos forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
"[" forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m (a -> b)
-> IndentParserT s u m a -> IndentParserT s u m b
<+/> IndentParserT s u m a
p forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
"]"

-- | parses with surrounding angle brackets
indentAngles
    :: (Monad m, Stream s (IndentT m) z)
    => GenTokenParser s u (IndentT m)
    -> IndentParserT s u m a
    -> IndentParserT s u m a
indentAngles :: forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
GenTokenParser s u (IndentT m)
-> IndentParserT s u m a -> IndentParserT s u m a
indentAngles GenTokenParser s u (IndentT m)
lexer IndentParserT s u m a
p = forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m a
withPos forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
"<" forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m (a -> b)
-> IndentParserT s u m a -> IndentParserT s u m b
<+/> IndentParserT s u m a
p forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
">"

-- | parses with surrounding braces
indentBraces
    :: (Monad m, Stream s (IndentT m) z)
    => GenTokenParser s u (IndentT m)
    -> IndentParserT s u m a
    -> IndentParserT s u m a
indentBraces :: forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
GenTokenParser s u (IndentT m)
-> IndentParserT s u m a -> IndentParserT s u m a
indentBraces GenTokenParser s u (IndentT m)
lexer IndentParserT s u m a
p = forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m a
withPos forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
"{" forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m (a -> b)
-> IndentParserT s u m a -> IndentParserT s u m b
<+/> IndentParserT s u m a
p forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
"}"

-- | parses with surrounding parentheses
indentParens
    :: (Monad m, Stream s (IndentT m) z)
    => GenTokenParser s u (IndentT m)
    -> IndentParserT s u m a
    -> IndentParserT s u m a
indentParens :: forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
GenTokenParser s u (IndentT m)
-> IndentParserT s u m a -> IndentParserT s u m a
indentParens GenTokenParser s u (IndentT m)
lexer IndentParserT s u m a
p = forall (m :: * -> *) s z u a.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a -> IndentParserT s u m a
withPos forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
"(" forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m (a -> b)
-> IndentParserT s u m a -> IndentParserT s u m b
<+/> IndentParserT s u m a
p forall (m :: * -> *) s z u a b.
(Monad m, Stream s (IndentT m) z) =>
IndentParserT s u m a
-> IndentParserT s u m b -> IndentParserT s u m a
<-/> forall s u (m :: * -> *).
GenTokenParser s u m -> SourceName -> ParsecT s u m SourceName
symbol GenTokenParser s u (IndentT m)
lexer SourceName
")"