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 = StateT [a] Maybe [a] -> Parser a
forall a. StateT [a] Maybe [a] -> Parser a
Parser (StateT [a] Maybe [a] -> Parser a)
-> StateT [a] Maybe [a] -> Parser a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a])
-> StateT [a] Maybe [a]
-> StateT [a] Maybe [a]
-> StateT [a] Maybe [a]
forall a b c.
(a -> b -> c)
-> StateT [a] Maybe a -> StateT [a] Maybe b -> StateT [a] Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) StateT [a] Maybe [a]
x StateT [a] Maybe [a]
y

instance Monoid (Parser a) where
    mempty :: Parser a
mempty = StateT [a] Maybe [a] -> Parser a
forall a. StateT [a] Maybe [a] -> Parser a
Parser (StateT [a] Maybe [a] -> Parser a)
-> StateT [a] Maybe [a] -> Parser a
forall a b. (a -> b) -> a -> b
$ [a] -> StateT [a] Maybe [a]
forall a. a -> StateT [a] Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    mappend :: Parser a -> Parser a -> Parser a
mappend = Parser a -> Parser a -> Parser a
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 = StateT [a] Maybe [a] -> Parser a
forall a. StateT [a] Maybe [a] -> Parser a
Parser (StateT [a] Maybe [a] -> Parser a)
-> StateT [a] Maybe [a] -> Parser a
forall a b. (a -> b) -> a -> b
$ StateT [a] Maybe [a]
x StateT [a] Maybe [a]
-> StateT [a] Maybe [a] -> StateT [a] Maybe [a]
forall a.
StateT [a] Maybe a -> StateT [a] Maybe a -> StateT [a] Maybe a
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 = StateT [a] Maybe [a] -> Parser a
forall a. StateT [a] Maybe [a] -> Parser a
Parser (StateT [a] Maybe [a] -> Parser a)
-> StateT [a] Maybe [a] -> Parser a
forall a b. (a -> b) -> a -> b
$ do
    a
c <- ([a] -> Maybe (a, [a])) -> StateT [a] Maybe a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
ListHT.viewL
    Bool -> StateT [a] Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> StateT [a] Maybe ()) -> Bool -> StateT [a] Maybe ()
forall a b. (a -> b) -> a -> b
$ a -> Bool
p a
c
    [a] -> StateT [a] Maybe [a]
forall a. a -> StateT [a] Maybe a
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) =
    ([a] -> ([a], [a])) -> StateT [a] Identity [a]
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state (([a] -> ([a], [a])) -> StateT [a] Identity [a])
-> ([a] -> ([a], [a])) -> StateT [a] Identity [a]
forall a b. (a -> b) -> a -> b
$ \[a]
str -> ([a], [a]) -> Maybe ([a], [a]) -> ([a], [a])
forall a. a -> Maybe a -> a
fromMaybe ([], [a]
str) (Maybe ([a], [a]) -> ([a], [a])) -> Maybe ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ StateT [a] Maybe [a] -> [a] -> Maybe ([a], [a])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT StateT [a] Maybe [a]
x [a]
str