{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Text.PariPari.Internal.ElementCombinators (
void
, (<|>)
, empty
, ON.some
, ON.endBy1
, ON.someTill
, ON.sepBy1
, ON.sepEndBy1
, O.optional
, O.many
, O.between
, O.choice
, O.count
, O.count'
, O.eitherP
, O.endBy
, O.manyTill
, O.option
, O.sepBy
, O.sepEndBy
, O.skipMany
, O.skipSome
, O.skipCount
, O.skipManyTill
, O.skipSomeTill
, (<?>)
, getLine
, getColumn
, withPos
, withSpan
, getRefColumn
, getRefLine
, withRefPos
, align
, indented
, line
, linefold
, notElement
, anyElement
, elementSatisfy
, takeElements
, skipElements
, skipElementsWhile
, takeElementsWhile
, skipElementsWhile1
, takeElementsWhile1
, scanElements
, scanElements1
) where
import Control.Applicative ((<|>), empty)
import Control.Monad (when)
import Control.Monad.Combinators (skipCount, skipMany)
import Data.Functor (void)
import Data.Semigroup ((<>))
import Prelude hiding (getLine)
import Text.PariPari.Internal.Chunk
import Text.PariPari.Internal.Class
import qualified Control.Monad.Combinators as O
import qualified Control.Monad.Combinators.NonEmpty as ON
type ChunkP k a = (forall p. ChunkParser k p => p a)
(<?>) :: ChunkParser k p => p a -> String -> p a
(<?>) = flip label
{-# INLINE (<?>) #-}
infix 0 <?>
getRefLine :: ChunkP k Int
getRefLine = _posLine <$> getRefPos
{-# INLINE getRefLine #-}
getRefColumn :: ChunkP k Int
getRefColumn = _posColumn <$> getRefPos
{-# INLINE getRefColumn #-}
getLine :: ChunkP k Int
getLine = _posLine <$> getPos
{-# INLINE getLine #-}
getColumn :: ChunkP k Int
getColumn = _posColumn <$> getPos
{-# INLINE getColumn #-}
withPos :: ChunkParser k p => p a -> p (Pos, a)
withPos p = do
pos <- getPos
ret <- p
pure (pos, ret)
{-# INLINE withPos #-}
type Span = (Pos, Pos)
withSpan :: ChunkParser k p => p a -> p (Span, a)
withSpan p = do
begin <- getPos
ret <- p
end <- getPos
pure ((begin, end), ret)
{-# INLINE withSpan #-}
line :: ChunkP k ()
line = do
l <- getLine
rl <- getRefLine
when (l /= rl) $ failWith $ EIndentOverLine rl l
{-# INLINE line #-}
align :: ChunkP k ()
align = do
c <- getColumn
rc <- getRefColumn
when (c /= rc) $ failWith $ EIndentNotAligned rc c
{-# INLINE align #-}
indented :: ChunkP k ()
indented = do
c <- getColumn
rc <- getRefColumn
when (c <= rc) $ failWith $ ENotEnoughIndent rc c
{-# INLINE indented #-}
linefold :: ChunkP k ()
linefold = line <|> indented
{-# INLINE linefold #-}
notElement :: forall k p. ChunkParser k p => Element k -> p (Element k)
notElement e = elementSatisfy @k (/= e) <?> "not " <> showElement @k e
{-# INLINE notElement #-}
anyElement :: ChunkP k (Element k)
anyElement = elementSatisfy (const True)
{-# INLINE anyElement #-}
skipElements :: ChunkParser k p => Int -> p ()
skipElements n = skipCount n anyElement
{-# INLINE skipElements #-}
takeElements :: ChunkParser k p => Int -> p k
takeElements n = asChunk (skipElements n) <?> show n <> " elements"
{-# INLINE takeElements #-}
skipElementsWhile :: ChunkParser k p => (Element k -> Bool) -> p ()
skipElementsWhile f = skipMany (elementSatisfy f)
{-# INLINE skipElementsWhile #-}
takeElementsWhile :: ChunkParser k p => (Element k -> Bool) -> p k
takeElementsWhile f = asChunk (skipElementsWhile f)
{-# INLINE takeElementsWhile #-}
skipElementsWhile1 :: ChunkParser k p => (Element k -> Bool) -> p ()
skipElementsWhile1 f = elementSatisfy f *> skipElementsWhile f
{-# INLINE skipElementsWhile1 #-}
takeElementsWhile1 :: ChunkParser k p => (Element k -> Bool) -> p k
takeElementsWhile1 f = asChunk (skipElementsWhile1 f)
{-# INLINE takeElementsWhile1 #-}
elementSatisfy :: ChunkParser k p => (Element k -> Bool) -> p (Element k)
elementSatisfy f = elementScan $ \e -> if f e then Just e else Nothing
{-# INLINE elementSatisfy #-}
scanElements :: ChunkParser k p => (s -> Element k -> Maybe s) -> s -> p s
scanElements f = go
where go s = (elementScan (f s) >>= go) <|> pure s
{-# INLINE scanElements #-}
scanElements1 :: ChunkParser k p => (s -> Element k -> Maybe s) -> s -> p s
scanElements1 f s = elementScan (f s) >>= scanElements f
{-# INLINE scanElements1 #-}