{-# LANGUAGE CPP #-}
module Harp.Match (
Match
, runMatch
, baseMatch
, manyMatch
, gManyMatch
, foldComp
, unzip0, unzip1, unzip2, unzip3, unzip4, unzip5, unzip6, unzip7
, (+++)
) where
#if MIN_VERSION_base(4,8,0)
import Control.Monad (ap, liftM)
#endif
import Data.List (unzip3, unzip4, unzip5, unzip6, unzip7)
newtype Match e a = Match ([e] -> [(a, [e])])
(+++) :: Match e a -> Match e a -> Match e a
(Match [e] -> [(a, [e])]
f) +++ :: forall e a. Match e a -> Match e a -> Match e a
+++ (Match [e] -> [(a, [e])]
g) = forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (\[e]
es -> let aes1 :: [(a, [e])]
aes1 = [e] -> [(a, [e])]
f [e]
es
aes2 :: [(a, [e])]
aes2 = [e] -> [(a, [e])]
g [e]
es
in [(a, [e])]
aes1 forall a. [a] -> [a] -> [a]
++ [(a, [e])]
aes2)
#if MIN_VERSION_base(4,8,0)
instance Applicative (Match e) where
<*> :: forall a b. Match e (a -> b) -> Match e a -> Match e b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: forall a. a -> Match e a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Functor (Match e) where
fmap :: forall a b. (a -> b) -> Match e a -> Match e b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
#endif
instance Monad (Match e) where
return :: forall a. a -> Match e a
return a
x = forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (\[e]
es -> [(a
x, [e]
es)])
(Match [e] -> [(a, [e])]
f) >>= :: forall a b. Match e a -> (a -> Match e b) -> Match e b
>>= a -> Match e b
k = forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (\[e]
es -> let aes :: [(a, [e])]
aes = [e] -> [(a, [e])]
f [e]
es
in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [e]) -> [(b, [e])]
help [(a, [e])]
aes)
where help :: (a, [e]) -> [(b, [e])]
help (a
a, [e]
es) = let Match [e] -> [(b, [e])]
g = a -> Match e b
k a
a
in [e] -> [(b, [e])]
g [e]
es
mfail :: Match e a
mfail :: forall e a. Match e a
mfail = forall e a. ([e] -> [(a, [e])]) -> Match e a
Match forall a b. (a -> b) -> a -> b
$ \[e]
_ -> []
runM :: Match e a -> [e] -> [a]
runM :: forall e a. Match e a -> [e] -> [a]
runM (Match [e] -> [(a, [e])]
f) [e]
es = let aes :: [(a, [e])]
aes = [e] -> [(a, [e])]
f [e]
es
in forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, [e])]
aes
getElement :: Match e e
getElement :: forall e. Match e e
getElement = forall e a. ([e] -> [(a, [e])]) -> Match e a
Match forall a b. (a -> b) -> a -> b
$ \[e]
es -> case [e]
es of
[] -> []
(e
x:[e]
xs) -> [(e
x,e
xforall a. a -> [a] -> [a]
:[e]
xs)]
discard :: Match e ()
discard :: forall e. Match e ()
discard = forall e a. ([e] -> [(a, [e])]) -> Match e a
Match forall a b. (a -> b) -> a -> b
$ \[e]
es -> case [e]
es of
[] -> []
(e
_:[e]
xs) -> [((), [e]
xs)]
runMatch :: Match e a -> [e] -> Maybe a
runMatch :: forall e a. Match e a -> [e] -> Maybe a
runMatch Match e a
m [e]
es = case forall e a. Match e a -> [e] -> [a]
runM Match e a
m [e]
es of
[] -> forall a. Maybe a
Nothing
(a
a:[a]
_) -> forall a. a -> Maybe a
Just a
a
baseMatch :: (a -> Maybe b) -> Match a (a, b)
baseMatch :: forall a b. (a -> Maybe b) -> Match a (a, b)
baseMatch a -> Maybe b
f = do a
e <- forall e. Match e e
getElement
case a -> Maybe b
f a
e of
Maybe b
Nothing -> forall e a. Match e a
mfail
Just b
b -> do forall e. Match e ()
discard
forall (m :: * -> *) a. Monad m => a -> m a
return (a
e, b
b)
gManyMatch :: Match e a -> Match e [a]
gManyMatch :: forall e a. Match e a -> Match e [a]
gManyMatch Match e a
m = (do a
a <- Match e a
m
[a]
as <- forall e a. Match e a -> Match e [a]
gManyMatch Match e a
m
forall (m :: * -> *) a. Monad m => a -> m a
return (a
aforall a. a -> [a] -> [a]
:[a]
as))
forall e a. Match e a -> Match e a -> Match e a
+++ (forall (m :: * -> *) a. Monad m => a -> m a
return [])
manyMatch :: Match e a -> Match e [a]
manyMatch :: forall e a. Match e a -> Match e [a]
manyMatch Match e a
m = (forall (m :: * -> *) a. Monad m => a -> m a
return []) forall e a. Match e a -> Match e a -> Match e a
+++
(do a
a <- Match e a
m
[a]
as <- forall e a. Match e a -> Match e [a]
manyMatch Match e a
m
forall (m :: * -> *) a. Monad m => a -> m a
return (a
aforall a. a -> [a] -> [a]
:[a]
as))
foldComp :: [[a] -> [a]] -> ([a] -> [a])
foldComp :: forall a. [[a] -> [a]] -> [a] -> [a]
foldComp = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id
unzip0 :: [()] -> ()
unzip0 :: [()] -> ()
unzip0 = forall a b. a -> b -> a
const ()
unzip1 :: [a] -> [a]
unzip1 :: forall a. [a] -> [a]
unzip1 = forall a. a -> a
id
unzip2 :: [(a,b)] -> ([a],[b])
unzip2 :: forall a b. [(a, b)] -> ([a], [b])
unzip2 = forall a b. [(a, b)] -> ([a], [b])
unzip