{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Module : Test.Method.Matcher
-- License: BSD-3
-- Maintainer: autotaker@gmail.com
-- Stability: experimental
module Test.Method.Matcher
  ( anything,
    when,
    Matcher,
    TupleLike (..),
    ArgsMatcher (..),
    args',
  )
where

import Control.Method.Internal (Nil (Nil), TupleLike (AsTuple, fromTuple, toTuple), (:*) ((:*)))

type Matcher a = a -> Bool

-- | Matcher that matches anything
anything :: Matcher a
anything :: Matcher a
anything = Bool -> Matcher a
forall a b. a -> b -> a
const Bool
True

-- | synonym of 'id' function.
-- Use this function for improving readability
when :: Matcher a -> Matcher a
when :: Matcher a -> Matcher a
when = Matcher a -> Matcher a
forall a. a -> a
id

-- | Matcher for 'Control.Method.Args'
--
-- >>> args ((==2), (>3)) (2 :* 4 :* Nil)
-- True
-- >>> args even (1 :* Nil)
-- False
-- >>> args () Nil
-- True
class TupleLike a => ArgsMatcher a where
  type EachMatcher a

  -- | Convert a tuple of matchers to a matcher of tuples
  args :: EachMatcher a -> Matcher a

-- | Convert a tuple matcher to a tuple-like matcher.
--
-- >>> args' (\(a, b) -> a * b == 10) (2 :* 5 :* Nil)
-- True
-- >>> args' (\(a, b) -> a * b == 10) (2 :* 4 :* Nil)
-- False
{-# INLINE args' #-}
args' :: TupleLike a => Matcher (AsTuple a) -> Matcher a
args' :: Matcher (AsTuple a) -> Matcher a
args' Matcher (AsTuple a)
m a
a = Matcher (AsTuple a)
m (a -> AsTuple a
forall a. TupleLike a => a -> AsTuple a
toTuple a
a)

instance ArgsMatcher Nil where
  type EachMatcher Nil = ()
  {-# INLINE args #-}
  args :: EachMatcher Nil -> Matcher Nil
args EachMatcher Nil
_ = Matcher Nil
forall a. Matcher a
anything

instance ArgsMatcher (a :* Nil) where
  type EachMatcher (a :* Nil) = Matcher a
  {-# INLINE args #-}
  args :: EachMatcher (a :* Nil) -> Matcher (a :* Nil)
args EachMatcher (a :* Nil)
matcher (a
a :* Nil
Nil) = EachMatcher (a :* Nil)
Matcher a
matcher a
a

instance ArgsMatcher (a :* b :* Nil) where
  type EachMatcher (a :* b :* Nil) = (Matcher a, Matcher b)
  {-# INLINE args #-}
  args :: EachMatcher (a :* (b :* Nil)) -> Matcher (a :* (b :* Nil))
args (ma, mb) (a
a :* b
b :* Nil
Nil) = a -> Bool
ma a
a Bool -> Bool -> Bool
&& b -> Bool
mb b
b

instance ArgsMatcher (a :* b :* c :* Nil) where
  type EachMatcher (a :* b :* c :* Nil) = (Matcher a, Matcher b, Matcher c)
  {-# INLINE args #-}
  args :: EachMatcher (a :* (b :* (c :* Nil)))
-> Matcher (a :* (b :* (c :* Nil)))
args (ma, mb, mc) (a
a :* b
b :* c
c :* Nil
Nil) = a -> Bool
ma a
a Bool -> Bool -> Bool
&& b -> Bool
mb b
b Bool -> Bool -> Bool
&& c -> Bool
mc c
c

instance ArgsMatcher (a :* b :* c :* d :* Nil) where
  type EachMatcher (a :* b :* c :* d :* Nil) = (Matcher a, Matcher b, Matcher c, Matcher d)
  {-# INLINE args #-}
  args :: EachMatcher (a :* (b :* (c :* (d :* Nil))))
-> Matcher (a :* (b :* (c :* (d :* Nil))))
args (ma, mb, mc, md) (a
a :* b
b :* c
c :* d
d :* Nil
Nil) = a -> Bool
ma a
a Bool -> Bool -> Bool
&& b -> Bool
mb b
b Bool -> Bool -> Bool
&& c -> Bool
mc c
c Bool -> Bool -> Bool
&& d -> Bool
md d
d

instance ArgsMatcher (a :* b :* c :* d :* e :* Nil) where
  type EachMatcher (a :* b :* c :* d :* e :* Nil) = (Matcher a, Matcher b, Matcher c, Matcher d, Matcher e)
  {-# INLINE args #-}
  args :: EachMatcher (a :* (b :* (c :* (d :* (e :* Nil)))))
-> Matcher (a :* (b :* (c :* (d :* (e :* Nil)))))
args (ma, mb, mc, md, me) (a
a :* b
b :* c
c :* d
d :* e
e :* Nil
Nil) = a -> Bool
ma a
a Bool -> Bool -> Bool
&& b -> Bool
mb b
b Bool -> Bool -> Bool
&& c -> Bool
mc c
c Bool -> Bool -> Bool
&& d -> Bool
md d
d Bool -> Bool -> Bool
&& e -> Bool
me e
e

instance ArgsMatcher (a :* b :* c :* d :* e :* f :* Nil) where
  type EachMatcher (a :* b :* c :* d :* e :* f :* Nil) = (Matcher a, Matcher b, Matcher c, Matcher d, Matcher e, Matcher f)
  {-# INLINE args #-}
  args :: EachMatcher (a :* (b :* (c :* (d :* (e :* (f :* Nil))))))
-> Matcher (a :* (b :* (c :* (d :* (e :* (f :* Nil))))))
args (ma, mb, mc, md, me, mf) (a
a :* b
b :* c
c :* d
d :* e
e :* f
f :* Nil
Nil) = a -> Bool
ma a
a Bool -> Bool -> Bool
&& b -> Bool
mb b
b Bool -> Bool -> Bool
&& c -> Bool
mc c
c Bool -> Bool -> Bool
&& d -> Bool
md d
d Bool -> Bool -> Bool
&& e -> Bool
me e
e Bool -> Bool -> Bool
&& f -> Bool
mf f
f

instance ArgsMatcher (a :* b :* c :* d :* e :* f :* g :* Nil) where
  type EachMatcher (a :* b :* c :* d :* e :* f :* g :* Nil) = (Matcher a, Matcher b, Matcher c, Matcher d, Matcher e, Matcher f, Matcher g)
  {-# INLINE args #-}
  args :: EachMatcher (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil)))))))
-> Matcher (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil)))))))
args (ma, mb, mc, md, me, mf, mg) (a
a :* b
b :* c
c :* d
d :* e
e :* f
f :* g
g :* Nil
Nil) = a -> Bool
ma a
a Bool -> Bool -> Bool
&& b -> Bool
mb b
b Bool -> Bool -> Bool
&& c -> Bool
mc c
c Bool -> Bool -> Bool
&& d -> Bool
md d
d Bool -> Bool -> Bool
&& e -> Bool
me e
e Bool -> Bool -> Bool
&& f -> Bool
mf f
f Bool -> Bool -> Bool
&& g -> Bool
mg g
g