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