module Text.Trifecta.Literate.Combinators
( someLiterateSpace
, getLiterate
, putLiterate
) where
import Data.Char (isSpace)
import Control.Applicative
import Control.Monad
import Text.Trifecta.Rope.Delta
import qualified Text.Trifecta.Highlight.Prim as Highlight
import Text.Trifecta.Literate.Prim
import Text.Trifecta.Literate.Class
import Text.Trifecta.Parser.Char
import Text.Trifecta.Parser.Class
import Text.Trifecta.Parser.Combinators
getLiterate :: MonadLiterate m => m LiterateState
getLiterate = literateState $ \s -> (s, s)
putLiterate :: MonadLiterate m => LiterateState -> m ()
putLiterate s = literateState $ \_ -> ((), s)
skipLine :: MonadParser m => m ()
skipLine = do
r <- restOfLine
skipping (delta r)
someLiterateSpace :: MonadLiterate m => m ()
someLiterateSpace = do
s <- getLiterate
case s of
IlliterateStart -> skipSome $ satisfy isSpace
LiterateStart -> position >>= \m -> track m <|> begin m <|> blank m <|> other m
LiterateCode -> do
skipSome $ satisfy isSpace
option () $ position >>= \m -> when (column m == 0) $ do
highlight Highlight.LiterateSyntax (string "\\end{code}") *> skipLine
begin m <|> blank m <|> other m
LiterateTrack -> skipSome horizontalSpace >> skipOptional bird
<|> bird
where
bird = newline *> position >>= \m -> track m <|> blank m
horizontalSpace :: MonadLiterate m => m Char
horizontalSpace = satisfy $ \s -> s /= '\n' && isSpace s
track, begin, blank, other :: MonadLiterate m => Delta -> m ()
track s = do
e <- position
try $ highlight Highlight.LiterateSyntax (char '>')
*> highlightInterval Highlight.LiterateComment s e
*> skipSome horizontalSpace
tracks <|> putLiterate LiterateTrack where
tracks = do
s' <- newline *> position
track s' <|> blank s'
begin s = do
try $ highlight Highlight.LiterateSyntax (string "\begin{code}") *> skipLine
position >>= highlightInterval Highlight.LiterateComment s
putLiterate LiterateCode
whiteSpace
other s = do
notChar '>' *> skipLine
begin s <|> blank s <|> other s
blank s = do
k <- try $ do
skipMany horizontalSpace
True <$ newline <|> False <$ eof
when k $ track s <|> begin s <|> blank s <|> other s