module System.Path.RegularExpression where import qualified Control.Monad.Trans.State as MS import Control.Monad (guard) import Control.Applicative (liftA2, (<|>)) import qualified Data.List.HT as ListHT import Data.Monoid (Monoid, mempty, mappend) import Data.Semigroup (Semigroup, (<>)) import Data.Maybe (fromMaybe) newtype Parser a = Parser (MS.StateT [a] Maybe [a]) instance Semigroup (Parser a) where Parser StateT [a] Maybe [a] x <> :: Parser a -> Parser a -> Parser a <> Parser StateT [a] Maybe [a] y = forall a. StateT [a] Maybe [a] -> Parser a Parser forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 forall a. [a] -> [a] -> [a] (++) StateT [a] Maybe [a] x StateT [a] Maybe [a] y instance Monoid (Parser a) where mempty :: Parser a mempty = forall a. StateT [a] Maybe [a] -> Parser a Parser forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. Monad m => a -> m a return [] mappend :: Parser a -> Parser a -> Parser a mappend = forall a. Semigroup a => a -> a -> a (<>) infixr 5 -|- (-|-) :: Parser a -> Parser a -> Parser a Parser StateT [a] Maybe [a] x -|- :: forall a. Parser a -> Parser a -> Parser a -|- Parser StateT [a] Maybe [a] y = forall a. StateT [a] Maybe [a] -> Parser a Parser forall a b. (a -> b) -> a -> b $ StateT [a] Maybe [a] x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> StateT [a] Maybe [a] y single :: (a -> Bool) -> Parser a single :: forall a. (a -> Bool) -> Parser a single a -> Bool p = forall a. StateT [a] Maybe [a] -> Parser a Parser forall a b. (a -> b) -> a -> b $ do a c <- forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a MS.StateT forall a. [a] -> Maybe (a, [a]) ListHT.viewL forall (f :: * -> *). Alternative f => Bool -> f () guard forall a b. (a -> b) -> a -> b $ a -> Bool p a c forall (m :: * -> *) a. Monad m => a -> m a return [a c] run :: Parser a -> MS.State [a] [a] run :: forall a. Parser a -> State [a] [a] run (Parser StateT [a] Maybe [a] x) = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a MS.state forall a b. (a -> b) -> a -> b $ \[a] str -> forall a. a -> Maybe a -> a fromMaybe ([], [a] str) forall a b. (a -> b) -> a -> b $ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) MS.runStateT StateT [a] Maybe [a] x [a] str