module Network.Wai.RequestSpec.Internal.Parser (
Result(..),
P(..)
) where
import Control.Applicative
import Control.Monad
import Data.Monoid
import Network.Wai.RequestSpec.Error
data Result a
= Failure Error
| Success a
instance Functor Result where
fmap _ (Failure e) = Failure e
fmap f (Success x) = Success (f x)
instance Applicative Result where
pure = Success
(Failure e) <*> (Failure e') = Failure (e <> e')
(Failure e) <*> _ = Failure e
_ <*> (Failure e) = Failure e
(Success f) <*> (Success x) = Success (f x)
instance Monad Result where
return = pure
(Failure e) >>= _ = Failure e
(Success x) >>= f = f x
instance Show a => Show (Result a) where
show (Failure e) = show e
show (Success a) = show a
newtype P a =
P { runP :: forall r.
(Error -> Result r)
-> (a -> Error -> Result r)
-> Result r
}
instance Functor P where
fmap f (P p) = P $ \kf ks -> p kf (ks . f)
instance Monad P where
return a = P $ \_ ks -> ks a mempty
(P m) >>= k = P $ \kf ks ->
m kf
(\a e ->
runP (k a) (\e' -> kf (e <> e'))
ks
)
instance Applicative P where
pure = return
(P f) <*> (P p) = P $ \kf ks ->
p (\e ->
f (\e' -> kf (e <> e'))
(\_ e' -> kf (e <> e'))
)
(\a e ->
f (\e' -> kf (e <> e'))
(\f' e' -> ks (f' a) e')
)
instance MonadPlus P where
mzero = P $ \kf _ -> kf Clear
mplus (P m) (P n) = P $ \kf ks ->
m (\e ->
n (kf . Or e)
ks
) ks
instance Alternative P where
empty = mzero
(<|>) = mplus
instance Monoid a => Monoid (P a) where
mempty = P $ \_ ks -> ks mempty Clear
mappend = mplus