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