module Text.Trifecta.Parser.Class
( MonadParser(..)
, satisfyAscii
, restOfLine
, (<?>)
, skipping
, slicedWith
, sliced
, rend
) where
import Control.Applicative
import Control.Monad (MonadPlus(..))
import Control.Monad.Trans.Class
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 Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Identity
import Data.Functor.Yoneda
import Data.Word
import Data.ByteString as Strict
import Data.ByteString.Internal (w2c)
import Data.Semigroup
import Text.Trifecta.Rope.Delta
import Text.Trifecta.Rope.Prim
import Text.Trifecta.Parser.It
import Text.Trifecta.Highlight.Prim
import Text.Trifecta.Diagnostic.Rendering.Prim
infix 0 <?>
class ( Alternative m, MonadPlus m) => MonadParser m where
try :: m a -> m a
labels :: m a -> [String] -> m a
skipMany :: m a -> m ()
skipMany p = () <$ many p
satisfy :: (Char -> Bool) -> m Char
satisfy8 :: (Word8 -> Bool) -> m Word8
highlight :: Highlight -> m a -> m a
highlight _ m = m
liftIt :: It Rope a -> m a
mark :: m Delta
unexpected :: MonadParser m => String -> m a
line :: m ByteString
release :: Delta -> m ()
instance MonadParser m => MonadParser (Lazy.StateT s m) where
try (Lazy.StateT m) = Lazy.StateT $ try . m
labels (Lazy.StateT m) ss = Lazy.StateT $ \s -> labels (m s) ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (Lazy.StateT m) = Lazy.StateT $ \e -> highlight t (m e)
instance MonadParser m => MonadParser (Strict.StateT s m) where
try (Strict.StateT m) = Strict.StateT $ try . m
labels (Strict.StateT m) ss = Strict.StateT $ \s -> labels (m s) ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (Strict.StateT m) = Strict.StateT $ \e -> highlight t (m e)
instance MonadParser m => MonadParser (ReaderT e m) where
try (ReaderT m) = ReaderT $ try . m
labels (ReaderT m) ss = ReaderT $ \s -> labels (m s) ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (ReaderT m) = ReaderT $ \e -> highlight t (m e)
instance (MonadParser m, Monoid w) => MonadParser (Strict.WriterT w m) where
try (Strict.WriterT m) = Strict.WriterT $ try m
labels (Strict.WriterT m) ss = Strict.WriterT $ labels m ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (Strict.WriterT m) = Strict.WriterT $ highlight t m
instance (MonadParser m, Monoid w) => MonadParser (Lazy.WriterT w m) where
try (Lazy.WriterT m) = Lazy.WriterT $ try m
labels (Lazy.WriterT m) ss = Lazy.WriterT $ labels m ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (Lazy.WriterT m) = Lazy.WriterT $ highlight t m
instance (MonadParser m, Monoid w) => MonadParser (Lazy.RWST r w s m) where
try (Lazy.RWST m) = Lazy.RWST $ \r s -> try (m r s)
labels (Lazy.RWST m) ss = Lazy.RWST $ \r s -> labels (m r s) ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (Lazy.RWST m) = Lazy.RWST $ \r s -> highlight t (m r s)
instance (MonadParser m, Monoid w) => MonadParser (Strict.RWST r w s m) where
try (Strict.RWST m) = Strict.RWST $ \r s -> try (m r s)
labels (Strict.RWST m) ss = Strict.RWST $ \r s -> labels (m r s) ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (Strict.RWST m) = Strict.RWST $ \r s -> highlight t (m r s)
instance MonadParser m => MonadParser (IdentityT m) where
try (IdentityT m) = IdentityT $ try m
labels (IdentityT m) = IdentityT . labels m
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (IdentityT m) = IdentityT $ highlight t m
instance MonadParser m => MonadParser (Yoneda m) where
try = lift . try . lowerYoneda
labels m ss = lift $ labels (lowerYoneda m) ss
line = lift line
liftIt = lift . liftIt
mark = lift mark
release = lift . release
unexpected = lift . unexpected
satisfy = lift . satisfy
satisfy8 = lift . satisfy8
highlight t (Yoneda m) = Yoneda $ \f -> highlight t (m f)
satisfyAscii :: MonadParser m => (Char -> Bool) -> m Char
satisfyAscii p = w2c <$> satisfy8 (\w -> w <= 0x7f && p (w2c w))
skipping :: MonadParser m => Delta -> m ()
skipping d = do
m <- mark
release (m <> d)
restOfLine :: MonadParser m => m ByteString
restOfLine = do
m <- mark
Strict.drop (fromIntegral (columnByte m)) <$> line
(<?>) :: MonadParser m => m a -> String -> m a
p <?> msg = labels p [msg]
slicedWith :: MonadParser m => (a -> Strict.ByteString -> r) -> m a -> m r
slicedWith f pa = do
m <- mark
a <- pa
r <- mark
liftIt $ f a <$> sliceIt m r
sliced :: MonadParser m => m a -> m ByteString
sliced = slicedWith (\_ bs -> bs)
rend :: MonadParser m => m Rendering
rend = rendering <$> mark <*> line