{-# 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) +++ :: Match e a -> Match e a -> Match e a
+++ (Match [e] -> [(a, [e])]
g) = ([e] -> [(a, [e])]) -> Match e a
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 [(a, [e])] -> [(a, [e])] -> [(a, [e])]
forall a. [a] -> [a] -> [a]
++ [(a, [e])]
aes2)
#if MIN_VERSION_base(4,8,0)
instance Applicative (Match e) where
<*> :: Match e (a -> b) -> Match e a -> Match e 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 :: a -> Match e a
pure = a -> Match e a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Functor (Match e) where
fmap :: (a -> b) -> Match e a -> Match e b
fmap = (a -> b) -> Match e a -> Match e b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
#endif
instance Monad (Match e) where
return :: a -> Match e a
return a
x = ([e] -> [(a, [e])]) -> Match e a
forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (\[e]
es -> [(a
x, [e]
es)])
(Match [e] -> [(a, [e])]
f) >>= :: Match e a -> (a -> Match e b) -> Match e b
>>= a -> Match e b
k = ([e] -> [(b, [e])]) -> Match e b
forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (\[e]
es -> let aes :: [(a, [e])]
aes = [e] -> [(a, [e])]
f [e]
es
in ((a, [e]) -> [(b, [e])]) -> [(a, [e])] -> [(b, [e])]
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 :: Match e a
mfail = ([e] -> [(a, [e])]) -> Match e a
forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (([e] -> [(a, [e])]) -> Match e a)
-> ([e] -> [(a, [e])]) -> Match e a
forall a b. (a -> b) -> a -> b
$ \[e]
_ -> []
runM :: Match e a -> [e] -> [a]
runM :: 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 ((a, [e]) -> a) -> [(a, [e])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [e]) -> a
forall a b. (a, b) -> a
fst ([(a, [e])] -> [a]) -> [(a, [e])] -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, [e]) -> Bool) -> [(a, [e])] -> [(a, [e])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([e] -> Bool) -> ((a, [e]) -> [e]) -> (a, [e]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [e]) -> [e]
forall a b. (a, b) -> b
snd) [(a, [e])]
aes
getElement :: Match e e
getElement :: Match e e
getElement = ([e] -> [(e, [e])]) -> Match e e
forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (([e] -> [(e, [e])]) -> Match e e)
-> ([e] -> [(e, [e])]) -> Match e e
forall a b. (a -> b) -> a -> b
$ \[e]
es -> case [e]
es of
[] -> []
(e
x:[e]
xs) -> [(e
x,e
xe -> [e] -> [e]
forall a. a -> [a] -> [a]
:[e]
xs)]
discard :: Match e ()
discard :: Match e ()
discard = ([e] -> [((), [e])]) -> Match e ()
forall e a. ([e] -> [(a, [e])]) -> Match e a
Match (([e] -> [((), [e])]) -> Match e ())
-> ([e] -> [((), [e])]) -> Match e ()
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 :: Match e a -> [e] -> Maybe a
runMatch Match e a
m [e]
es = case Match e a -> [e] -> [a]
forall e a. Match e a -> [e] -> [a]
runM Match e a
m [e]
es of
[] -> Maybe a
forall a. Maybe a
Nothing
(a
a:[a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
baseMatch :: (a -> Maybe b) -> Match a (a, b)
baseMatch :: (a -> Maybe b) -> Match a (a, b)
baseMatch a -> Maybe b
f = do a
e <- Match a a
forall e. Match e e
getElement
case a -> Maybe b
f a
e of
Maybe b
Nothing -> Match a (a, b)
forall e a. Match e a
mfail
Just b
b -> do Match a ()
forall e. Match e ()
discard
(a, b) -> Match a (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
e, b
b)
gManyMatch :: Match e a -> Match e [a]
gManyMatch :: Match e a -> Match e [a]
gManyMatch Match e a
m = (do a
a <- Match e a
m
[a]
as <- Match e a -> Match e [a]
forall e a. Match e a -> Match e [a]
gManyMatch Match e a
m
[a] -> Match e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as))
Match e [a] -> Match e [a] -> Match e [a]
forall e a. Match e a -> Match e a -> Match e a
+++ ([a] -> Match e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
manyMatch :: Match e a -> Match e [a]
manyMatch :: Match e a -> Match e [a]
manyMatch Match e a
m = ([a] -> Match e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Match e [a] -> Match e [a] -> Match e [a]
forall e a. Match e a -> Match e a -> Match e a
+++
(do a
a <- Match e a
m
[a]
as <- Match e a -> Match e [a]
forall e a. Match e a -> Match e [a]
manyMatch Match e a
m
[a] -> Match e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as))
foldComp :: [[a] -> [a]] -> ([a] -> [a])
foldComp :: [[a] -> [a]] -> [a] -> [a]
foldComp = (([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> ([a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [a] -> [a]
forall a. a -> a
id
unzip0 :: [()] -> ()
unzip0 :: [()] -> ()
unzip0 = () -> [()] -> ()
forall a b. a -> b -> a
const ()
unzip1 :: [a] -> [a]
unzip1 :: [a] -> [a]
unzip1 = [a] -> [a]
forall a. a -> a
id
unzip2 :: [(a,b)] -> ([a],[b])
unzip2 :: [(a, b)] -> ([a], [b])
unzip2 = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip