module Data.Pattern.Common (
var, __, (/\), (\/), view, tryView,
is, cst,
elim,
mmatch,
mk0, mk1, mk2, mk3, mk4, mk5,
tup0, tup1, tup2, tup3, tup4, tup5,
left, right,
nil, cons,
) where
import Data.Pattern.Base
import Control.Applicative
import Control.Monad
var :: Pattern (a :*: Nil) a
var = Pattern (Just . one)
__ :: Pat0 a
__ = is (const True)
(/\) :: Pat2 a a a
(/\) = mk2 (\a -> Just (a,a))
(\/) :: Pattern as a -> Pattern as a -> Pattern as a
(Pattern l) \/ (Pattern r) = Pattern (\a -> l a `mplus` r a)
left :: Pat1 a (Either a b)
left = mk1 (either Just (const Nothing))
right :: Pat1 b (Either a b)
right = mk1 (either (const Nothing) Just)
view :: (a -> b) -> Pat1 b a
view f = mk1 (Just . f)
tryView :: (a -> Maybe b) -> Pat1 b a
tryView = mk1
elim :: Clause a r -> a -> r
elim = flip match
mmatch :: (Monad m) => m a -> Clause a (m b) -> m b
mmatch m p = m >>= elim p
is :: (a -> Bool) -> Pat0 a
is g = mk0 (\a -> if g a then Just () else Nothing)
cst :: (Eq a) => a -> Pat0 a
cst x = is (==x)
nil :: Pat0 [a]
nil = is null
cons :: Pat2 a [a] [a]
cons = mk2 (\l -> case l of { (x:xs) -> Just (x,xs); _ -> Nothing })
fail :: Pat0 a
fail = is (const False)
mk0 :: (a -> Maybe ()) -> Pat0 a
mk0 g = Pattern (fmap (const zero) . g)
mk1 :: (a -> Maybe b) -> Pat1 b a
mk1 g (Pattern p) = Pattern (\a -> g a >>= p)
mk2 :: (a -> Maybe (b,c)) -> Pat2 b c a
mk2 g b c = mk1 g (tup2 b c)
mk3 :: (a -> Maybe (b,c,d)) -> Pat3 b c d a
mk3 g b c d = mk1 g (tup3 b c d)
mk4 :: (a -> Maybe (b,c,d,e)) -> Pat4 b c d e a
mk4 g b c d e = mk1 g (tup4 b c d e)
mk5 :: (a -> Maybe (b,c,d,e,f)) -> Pat5 b c d e f a
mk5 g b c d e f = mk1 g (tup5 b c d e f)
tup0 :: Pat0 ()
tup0 = mk0 (\() -> Just ())
tup1 :: Pat1 a a
tup1 = mk1 Just
tup2 :: Pat2 a b (a,b)
tup2 (Pattern pa) (Pattern pb) = Pattern (\(a,b) -> (<>) <$> pa a <*> pb b)
tup3 :: Pat3 a b c (a,b,c)
tup3 (Pattern pa) (Pattern pb) (Pattern pc) =
Pattern (\(a,b,c) -> (<>) <$> pa a <*> ((<>) <$> pb b <*> pc c))
tup4 :: Pat4 a b c d (a,b,c,d)
tup4 (Pattern pa) (Pattern pb) (Pattern pc) (Pattern pd) =
Pattern (\(a,b,c,d) -> (<>) <$> pa a <*> ((<>) <$> pb b <*> ((<>) <$> pc c <*> pd d)))
tup5 :: Pat5 a b c d e (a,b,c,d,e)
tup5 (Pattern pa) (Pattern pb) (Pattern pc) (Pattern pd) (Pattern pe) =
Pattern (\(a,b,c,d,e) -> (<>) <$> pa a <*> ((<>) <$> pb b <*> ((<>) <$> pc c <*> ((<>) <$> pd d <*> pe e))))