{-# language CPP                    #-}
{-# language FlexibleContexts       #-}
{-# language FlexibleInstances      #-}
{-# language FunctionalDependencies #-}
{-# language MultiParamTypeClasses  #-}
{-# language UndecidableInstances   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Trifecta.Combinators
-- Copyright   :  (c) Edward Kmett 2011-2019
-- License     :  BSD3
--
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Text.Trifecta.Combinators
  ( DeltaParsing(..)
  , sliced
  , careting, careted
  , spanning, spanned
  , fixiting
  , MarkParsing(..)
  ) where

import Control.Applicative
import Control.Monad                     (MonadPlus)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Reader
import Control.Monad.Trans.RWS.Lazy      as Lazy
import Control.Monad.Trans.RWS.Strict    as Strict
import Control.Monad.Trans.State.Lazy    as Lazy
import Control.Monad.Trans.State.Strict  as Strict
import Control.Monad.Trans.Writer.Lazy   as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Data.ByteString                   as Strict hiding (span)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Prelude                           hiding (span)

import Text.Parser.Token
import Text.Trifecta.Delta
import Text.Trifecta.Rendering

-- | This class provides parsers with easy access to:
--
-- 1) the current line contents.
-- 2) the current position as a 'Delta'.
-- 3) the ability to use 'sliced' on any parser.
class (MonadPlus m, TokenParsing m) => DeltaParsing m where
  -- | Retrieve the contents of the current line (from the beginning of the line)
  line :: m ByteString

  -- | Retrieve the current position as a 'Delta'.
  position :: m Delta

  -- | Run a parser, grabbing all of the text between its start and end points
  slicedWith :: (a -> Strict.ByteString -> r) -> m a -> m r

  -- | Retrieve a 'Rendering' of the current line noting this position, but not
  -- placing a 'Caret' there.
  rend :: m Rendering
  rend = Delta -> ByteString -> Rendering
forall s. Source s => Delta -> s -> Rendering
rendered (Delta -> ByteString -> Rendering)
-> m Delta -> m (ByteString -> Rendering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position m (ByteString -> Rendering) -> m ByteString -> m Rendering
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable rend #-}

  -- | Grab the remainder of the current line
  restOfLine :: m ByteString
  restOfLine = Int -> ByteString -> ByteString
Strict.drop (Int -> ByteString -> ByteString)
-> (Delta -> Int) -> Delta -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Delta -> Int64) -> Delta -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delta -> Int64
columnByte (Delta -> ByteString -> ByteString)
-> m Delta -> m (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position m (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m) => DeltaParsing (Lazy.StateT s m) where
  line :: StateT s m ByteString
line = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: StateT s m Delta
position = m Delta -> StateT s m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> StateT s m a -> StateT s m r
slicedWith a -> ByteString -> r
f (Lazy.StateT s -> m (a, s)
m) = (s -> m (r, s)) -> StateT s m r
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (r, s)) -> StateT s m r)
-> (s -> m (r, s)) -> StateT s m r
forall a b. (a -> b) -> a -> b
$ \s
s -> ((a, s) -> ByteString -> (r, s)) -> m (a, s) -> m (r, s)
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith (\(a
a,s
s') ByteString
b -> (a -> ByteString -> r
f a
a ByteString
b, s
s')) (m (a, s) -> m (r, s)) -> m (a, s) -> m (r, s)
forall a b. (a -> b) -> a -> b
$ s -> m (a, s)
m s
s
  {-# inlinable slicedWith #-}
  rend :: StateT s m Rendering
rend = m Rendering -> StateT s m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: StateT s m ByteString
restOfLine = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m) => DeltaParsing (Strict.StateT s m) where
  line :: StateT s m ByteString
line = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: StateT s m Delta
position = m Delta -> StateT s m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> StateT s m a -> StateT s m r
slicedWith a -> ByteString -> r
f (Strict.StateT s -> m (a, s)
m) = (s -> m (r, s)) -> StateT s m r
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (r, s)) -> StateT s m r)
-> (s -> m (r, s)) -> StateT s m r
forall a b. (a -> b) -> a -> b
$ \s
s -> ((a, s) -> ByteString -> (r, s)) -> m (a, s) -> m (r, s)
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith (\(a
a,s
s') ByteString
b -> (a -> ByteString -> r
f a
a ByteString
b, s
s')) (m (a, s) -> m (r, s)) -> m (a, s) -> m (r, s)
forall a b. (a -> b) -> a -> b
$ s -> m (a, s)
m s
s
  {-# inlinable slicedWith #-}
  rend :: StateT s m Rendering
rend = m Rendering -> StateT s m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: StateT s m ByteString
restOfLine = m ByteString -> StateT s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m) => DeltaParsing (ReaderT e m) where
  line :: ReaderT e m ByteString
line = m ByteString -> ReaderT e m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: ReaderT e m Delta
position = m Delta -> ReaderT e m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> ReaderT e m a -> ReaderT e m r
slicedWith a -> ByteString -> r
f (ReaderT e -> m a
m) = (e -> m r) -> ReaderT e m r
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m r) -> ReaderT e m r) -> (e -> m r) -> ReaderT e m r
forall a b. (a -> b) -> a -> b
$ (a -> ByteString -> r) -> m a -> m r
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith a -> ByteString -> r
f (m a -> m r) -> (e -> m a) -> e -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
m
  {-# inlinable slicedWith #-}
  rend :: ReaderT e m Rendering
rend = m Rendering -> ReaderT e m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: ReaderT e m ByteString
restOfLine = m ByteString -> ReaderT e m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Strict.WriterT w m) where
  line :: WriterT w m ByteString
line = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: WriterT w m Delta
position = m Delta -> WriterT w m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> WriterT w m a -> WriterT w m r
slicedWith a -> ByteString -> r
f (Strict.WriterT m (a, w)
m) = m (r, w) -> WriterT w m r
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (r, w) -> WriterT w m r) -> m (r, w) -> WriterT w m r
forall a b. (a -> b) -> a -> b
$ ((a, w) -> ByteString -> (r, w)) -> m (a, w) -> m (r, w)
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith (\(a
a,w
s') ByteString
b -> (a -> ByteString -> r
f a
a ByteString
b, w
s')) m (a, w)
m
  {-# inlinable slicedWith #-}
  rend :: WriterT w m Rendering
rend = m Rendering -> WriterT w m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: WriterT w m ByteString
restOfLine = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Lazy.WriterT w m) where
  line :: WriterT w m ByteString
line = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: WriterT w m Delta
position = m Delta -> WriterT w m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> WriterT w m a -> WriterT w m r
slicedWith a -> ByteString -> r
f (Lazy.WriterT m (a, w)
m) = m (r, w) -> WriterT w m r
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (r, w) -> WriterT w m r) -> m (r, w) -> WriterT w m r
forall a b. (a -> b) -> a -> b
$ ((a, w) -> ByteString -> (r, w)) -> m (a, w) -> m (r, w)
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith (\(a
a,w
s') ByteString
b -> (a -> ByteString -> r
f a
a ByteString
b, w
s')) m (a, w)
m
  {-# inlinable slicedWith #-}
  rend :: WriterT w m Rendering
rend = m Rendering -> WriterT w m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: WriterT w m ByteString
restOfLine = m ByteString -> WriterT w m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Lazy.RWST r w s m) where
  line :: RWST r w s m ByteString
line = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: RWST r w s m Delta
position = m Delta -> RWST r w s m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> RWST r w s m a -> RWST r w s m r
slicedWith a -> ByteString -> r
f (Lazy.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (r, s, w)) -> RWST r w s m r
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (r, s, w)) -> RWST r w s m r)
-> (r -> s -> m (r, s, w)) -> RWST r w s m r
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> ((a, s, w) -> ByteString -> (r, s, w))
-> m (a, s, w) -> m (r, s, w)
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith (\(a
a,s
s',w
w) ByteString
b -> (a -> ByteString -> r
f a
a ByteString
b, s
s',w
w)) (m (a, s, w) -> m (r, s, w)) -> m (a, s, w) -> m (r, s, w)
forall a b. (a -> b) -> a -> b
$ r -> s -> m (a, s, w)
m r
r s
s
  {-# inlinable slicedWith #-}
  rend :: RWST r w s m Rendering
rend = m Rendering -> RWST r w s m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: RWST r w s m ByteString
restOfLine = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m, Monoid w) => DeltaParsing (Strict.RWST r w s m) where
  line :: RWST r w s m ByteString
line = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: RWST r w s m Delta
position = m Delta -> RWST r w s m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> RWST r w s m a -> RWST r w s m r
slicedWith a -> ByteString -> r
f (Strict.RWST r -> s -> m (a, s, w)
m) = (r -> s -> m (r, s, w)) -> RWST r w s m r
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (r, s, w)) -> RWST r w s m r)
-> (r -> s -> m (r, s, w)) -> RWST r w s m r
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> ((a, s, w) -> ByteString -> (r, s, w))
-> m (a, s, w) -> m (r, s, w)
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith (\(a
a,s
s',w
w) ByteString
b -> (a -> ByteString -> r
f a
a ByteString
b, s
s',w
w)) (m (a, s, w) -> m (r, s, w)) -> m (a, s, w) -> m (r, s, w)
forall a b. (a -> b) -> a -> b
$ r -> s -> m (a, s, w)
m r
r s
s
  {-# inlinable slicedWith #-}
  rend :: RWST r w s m Rendering
rend = m Rendering -> RWST r w s m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: RWST r w s m ByteString
restOfLine = m ByteString -> RWST r w s m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

instance (MonadPlus m, DeltaParsing m) => DeltaParsing (IdentityT m) where
  line :: IdentityT m ByteString
line = m ByteString -> IdentityT m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
  {-# inlinable line #-}
  position :: IdentityT m Delta
position = m Delta -> IdentityT m Delta
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable position #-}
  slicedWith :: (a -> ByteString -> r) -> IdentityT m a -> IdentityT m r
slicedWith a -> ByteString -> r
f (IdentityT m a
m) = m r -> IdentityT m r
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m r -> IdentityT m r) -> m r -> IdentityT m r
forall a b. (a -> b) -> a -> b
$ (a -> ByteString -> r) -> m a -> m r
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith a -> ByteString -> r
f m a
m
  {-# inlinable slicedWith #-}
  rend :: IdentityT m Rendering
rend = m Rendering -> IdentityT m Rendering
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Rendering
forall (m :: * -> *). DeltaParsing m => m Rendering
rend
  {-# inlinable rend #-}
  restOfLine :: IdentityT m ByteString
restOfLine = m ByteString -> IdentityT m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
restOfLine
  {-# inlinable restOfLine #-}

-- | Run a parser, grabbing all of the text between its start and end points and
-- discarding the original result
sliced :: DeltaParsing m => m a -> m ByteString
sliced :: m a -> m ByteString
sliced = (a -> ByteString -> ByteString) -> m a -> m ByteString
forall (m :: * -> *) a r.
DeltaParsing m =>
(a -> ByteString -> r) -> m a -> m r
slicedWith (\a
_ ByteString
bs -> ByteString
bs)
{-# inlinable sliced #-}

-- | Grab a 'Caret' pointing to the current location.
careting :: DeltaParsing m => m Caret
careting :: m Caret
careting = Delta -> ByteString -> Caret
Caret (Delta -> ByteString -> Caret)
-> m Delta -> m (ByteString -> Caret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position m (ByteString -> Caret) -> m ByteString -> m Caret
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line
{-# inlinable careting #-}

-- | Parse a 'Careted' result. Pointing the 'Caret' to where you start.
careted :: DeltaParsing m => m a -> m (Careted a)
careted :: m a -> m (Careted a)
careted m a
p = (\Delta
m ByteString
l a
a -> a
a a -> Caret -> Careted a
forall a. a -> Caret -> Careted a
:^ Delta -> ByteString -> Caret
Caret Delta
m ByteString
l) (Delta -> ByteString -> a -> Careted a)
-> m Delta -> m (ByteString -> a -> Careted a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position m (ByteString -> a -> Careted a)
-> m ByteString -> m (a -> Careted a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line m (a -> Careted a) -> m a -> m (Careted a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
p
{-# inlinable careted #-}

-- | Discard the result of a parse, returning a 'Span' from where we start to
-- where it ended parsing.
spanning :: DeltaParsing m => m a -> m Span
spanning :: m a -> m Span
spanning m a
p = (\Delta
s ByteString
l Delta
e -> Delta -> Delta -> ByteString -> Span
Span Delta
s Delta
e ByteString
l) (Delta -> ByteString -> Delta -> Span)
-> m Delta -> m (ByteString -> Delta -> Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position m (ByteString -> Delta -> Span)
-> m ByteString -> m (Delta -> Span)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line m (Delta -> Span) -> m Delta -> m Span
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (m a
p m a -> m Delta -> m Delta
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position)
{-# inlinable spanning #-}

-- | Parse a 'Spanned' result. The 'Span' starts here and runs to the last
-- position parsed.
spanned :: DeltaParsing m => m a -> m (Spanned a)
spanned :: m a -> m (Spanned a)
spanned m a
p = (\Delta
s ByteString
l a
a Delta
e -> a
a a -> Span -> Spanned a
forall a. a -> Span -> Spanned a
:~ Delta -> Delta -> ByteString -> Span
Span Delta
s Delta
e ByteString
l) (Delta -> ByteString -> a -> Delta -> Spanned a)
-> m Delta -> m (ByteString -> a -> Delta -> Spanned a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position m (ByteString -> a -> Delta -> Spanned a)
-> m ByteString -> m (a -> Delta -> Spanned a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ByteString
forall (m :: * -> *). DeltaParsing m => m ByteString
line m (a -> Delta -> Spanned a) -> m a -> m (Delta -> Spanned a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
p m (Delta -> Spanned a) -> m Delta -> m (Spanned a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
{-# inlinable spanned #-}

-- | Grab a fixit.
fixiting :: DeltaParsing m => m Strict.ByteString -> m Fixit
fixiting :: m ByteString -> m Fixit
fixiting m ByteString
p = (\(ByteString
r :~ Span
s) -> Span -> ByteString -> Fixit
Fixit Span
s ByteString
r) (Spanned ByteString -> Fixit) -> m (Spanned ByteString) -> m Fixit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString -> m (Spanned ByteString)
forall (m :: * -> *) a. DeltaParsing m => m a -> m (Spanned a)
spanned m ByteString
p
{-# inlinable fixiting #-}

-- | This class is a refinement of 'DeltaParsing' that adds the ability to mark
-- your position in the input and return there for further parsing later.
class (DeltaParsing m, HasDelta d) => MarkParsing d m | m -> d where
  -- | mark the current location so it can be used in constructing a span, or
  -- for later seeking
  mark :: m d
  -- | Seek a previously marked location
  release :: d -> m ()

instance (MonadPlus m, MarkParsing d m) => MarkParsing d (Lazy.StateT s m) where
  mark :: StateT s m d
mark = m d -> StateT s m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> StateT s m ()
release = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> (d -> m ()) -> d -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}

instance (MonadPlus m, MarkParsing d m) => MarkParsing d (Strict.StateT s m) where
  mark :: StateT s m d
mark = m d -> StateT s m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> StateT s m ()
release = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> (d -> m ()) -> d -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}

instance (MonadPlus m, MarkParsing d m) => MarkParsing d (ReaderT e m) where
  mark :: ReaderT e m d
mark = m d -> ReaderT e m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> ReaderT e m ()
release = m () -> ReaderT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ()) -> (d -> m ()) -> d -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}

instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Strict.WriterT w m) where
  mark :: WriterT w m d
mark = m d -> WriterT w m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> WriterT w m ()
release = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> (d -> m ()) -> d -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}

instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Lazy.WriterT w m) where
  mark :: WriterT w m d
mark = m d -> WriterT w m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> WriterT w m ()
release = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> (d -> m ()) -> d -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}

instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Lazy.RWST r w s m) where
  mark :: RWST r w s m d
mark = m d -> RWST r w s m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> RWST r w s m ()
release = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ()) -> (d -> m ()) -> d -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}

instance (MonadPlus m, MarkParsing d m, Monoid w) => MarkParsing d (Strict.RWST r w s m) where
  mark :: RWST r w s m d
mark = m d -> RWST r w s m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> RWST r w s m ()
release = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ()) -> (d -> m ()) -> d -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}

instance (MonadPlus m, MarkParsing d m) => MarkParsing d (IdentityT m) where
  mark :: IdentityT m d
mark = m d -> IdentityT m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MarkParsing d m => m d
mark
  {-# inlinable mark #-}
  release :: d -> IdentityT m ()
release = m () -> IdentityT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> IdentityT m ()) -> (d -> m ()) -> d -> IdentityT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MarkParsing d m => d -> m ()
release
  {-# inlinable release #-}