{-# LANGUAGE FlexibleContexts #-}

-- | Parsers and parser combinators for handling indented text.
--
--   They generally expect to be run at the start of an input line, after any
--   indentation (ASCII spaces; usually after 'nli').
--   (Compare how typical lexeme parser combinators are expected to be run
--   after any whitespace.)
module Language.Ltml.Parser.Common.Indent
    ( nli
    , someIndented
    , checkIndentGT
    )
where

import Control.Applicative ((<|>))
import Control.Monad (guard, void)
import Data.Text (Text)
import qualified Data.Text as Text (singleton)
import Language.Ltml.Parser (MonadParser)
import Language.Ltml.Parser.Common.Lexeme (lineCommentP)
import Text.Megaparsec
    ( Pos
    , sepBy1
    , takeWhileP
    )
import Text.Megaparsec.Char (char)
import qualified Text.Megaparsec.Char.Lexer as L
    ( incorrectIndent
    , indentLevel
    )

-- | Parse a newline character, any number of comment lines, and any
--   subsequent indentation (ASCII spaces).
--
--   Comment lines are lines that only contain indentation followed by a
--   line comment.
--
--   Always returns a single newline character.
nli :: (MonadParser m) => m Text
nli :: forall (m :: * -> *). MonadParser m => m Text
nli = Char -> Text
Text.singleton (Char -> Text) -> m Char -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\n' m Text -> m () -> m Text
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). MonadParser m => m ()
indentationP

-- | Parse indentation, dropping any full line comments.
indentationP :: (MonadParser m) => m ()
indentationP :: forall (m :: * -> *). MonadParser m => m ()
indentationP = m [Tokens Text] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Tokens Text] -> m ()) -> m [Tokens Text] -> m ()
forall a b. (a -> b) -> a -> b
$ m (Tokens Text) -> m Char -> m [Tokens Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 m (Tokens Text)
indP (m ()
forall (m :: * -> *). MonadParser m => m ()
lineCommentP m () -> m Char -> m Char
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\n')
  where
    indP :: m (Tokens Text)
indP = Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"indentation") (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token Text
' ')

-- | Parse some (>= 1) items, all indented further than the provided reference
--   indentation level, but not necessarily the same amount.
--   For the first item, the indentation is not checked, and should thus be
--   checked by the caller.
--
--   The argument parser must not accept the empty input and must only succeed
--   after a final newline plus any trailing indentation.
someIndented :: (MonadParser m) => Maybe Pos -> m a -> m [a]
someIndented :: forall (m :: * -> *) a. MonadParser m => Maybe Pos -> m a -> m [a]
someIndented Maybe Pos
lvl m a
p = m a
p m a -> m () -> m [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` Maybe Pos -> m ()
forall (m :: * -> *). MonadParser m => Maybe Pos -> m ()
checkIndentGT Maybe Pos
lvl

-- | Check whether the current actual indentation is greater than the supplied
--   reference indentation level.
checkIndentGT :: (MonadParser m) => Maybe Pos -> m ()
checkIndentGT :: forall (m :: * -> *). MonadParser m => Maybe Pos -> m ()
checkIndentGT Maybe Pos
Nothing = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkIndentGT (Just Pos
lvl) = do
    Pos
pos <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
    Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
lvl) m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Ordering -> Pos -> Pos -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Ordering -> Pos -> Pos -> m a
L.incorrectIndent Ordering
GT Pos
lvl Pos
pos