-- |
--
-- Module:      Control.Egison.Matcher.Pair
-- Description: Matchers for pairs
-- Stability:   experimental

module Control.Egison.Matcher.Pair
  ( tuple2
  , tuple2M
  )
where

import           Control.Monad                  ( MonadPlus(..) )
import           Control.Monad.Search
import           Control.Egison.Match
import           Control.Egison.Matcher
import           Control.Egison.QQ

instance (Matcher m1 t1, Matcher m2 t2) => Matcher (m1, m2) (t1, t2)

tuple2 :: Pattern (PP t1, PP t2) (m1, m2) (t1, t2) (t1, t2)
tuple2 :: forall t1 t2 m1 m2.
Pattern (PP t1, PP t2) (m1, m2) (t1, t2) (t1, t2)
tuple2 (PP t1, PP t2)
_ (m1
_, m2
_) (t1
t1, t2
t2) = (t1, t2) -> [(t1, t2)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t1
t1, t2
t2)

tuple2M :: (m1, m2) -> (t1, t2) -> (m1, m2)
tuple2M :: forall m1 m2 t1 t2. (m1, m2) -> (t1, t2) -> (m1, m2)
tuple2M (m1
m1, m2
m2) (t1, t2)
_ = (m1
m1, m2
m2)

instance (Eq a1, Matcher m1 a1, ValuePattern m1 a1, Eq a2, Matcher m2 a2, ValuePattern m2 a2) => ValuePattern (m1, m2) (a1, a2) where
  value :: (a1, a2) -> Pattern () (m1, m2) (a1, a2) ()
value (a1
e1, a2
e2) () (m1
m1, m2
m2) (a1
v1, a2
v2) =
    if m1 -> a1 -> a1 -> Bool
forall m t. (Matcher m t, ValuePattern m t) => m -> t -> t -> Bool
eqAs m1
m1 a1
e1 a1
v1 Bool -> Bool -> Bool
&& m2 -> a2 -> a2 -> Bool
forall m t. (Matcher m t, ValuePattern m t) => m -> t -> t -> Bool
eqAs m2
m2 a2
e2 a2
v2 then () -> [()]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else [()]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero

eqAs :: (Matcher m t, ValuePattern m t) => m -> t -> t -> Bool
eqAs :: forall m t. (Matcher m t, ValuePattern m t) => m -> t -> t -> Bool
eqAs m
m t
x t
y = ((m, t) -> DFS (m, t)) -> t -> m -> [(m, t) -> DFS Bool] -> Bool
forall m t (s :: * -> *) r.
(Matcher m t, MonadSearch s) =>
((m, t) -> s (m, t)) -> t -> m -> [(m, t) -> s r] -> r
match (m, t) -> DFS (m, t)
forall a. a -> DFS a
dfs t
y m
m [(m, t) -> DFS Bool
[mc| #x -> True |], (m, t) -> DFS Bool
[mc| _ -> False |]]