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

-- |
-- Module : Control.Method.Internal
-- License: BSD-3
-- Maintainer: autotaker@gmail.com
-- Stability: experimental
module Control.Method.Internal
  ( TupleLike (..),
    Nil (Nil),
    (:*) ((:*)),
  )
where

import GHC.Generics (Generic)

class TupleLike a where
  type AsTuple a
  fromTuple :: AsTuple a -> a
  toTuple :: a -> AsTuple a

instance TupleLike Nil where
  type AsTuple Nil = ()
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple Nil -> Nil
fromTuple AsTuple Nil
_ = Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: Nil -> AsTuple Nil
toTuple Nil
_ = ()

instance TupleLike (a :* Nil) where
  type AsTuple (a :* Nil) = a
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple (a :* Nil) -> a :* Nil
fromTuple AsTuple (a :* Nil)
a = a
AsTuple (a :* Nil)
a a -> Nil -> a :* Nil
forall a b. a -> b -> a :* b
:* Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: (a :* Nil) -> AsTuple (a :* Nil)
toTuple (a
a :* Nil
Nil) = a
AsTuple (a :* Nil)
a

instance TupleLike (a :* b :* Nil) where
  type AsTuple (a :* b :* Nil) = (a, b)
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple (a :* (b :* Nil)) -> a :* (b :* Nil)
fromTuple (a, b) = a
a a -> (b :* Nil) -> a :* (b :* Nil)
forall a b. a -> b -> a :* b
:* b
b b -> Nil -> b :* Nil
forall a b. a -> b -> a :* b
:* Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: (a :* (b :* Nil)) -> AsTuple (a :* (b :* Nil))
toTuple (a
a :* b
b :* Nil
Nil) = (a
a, b
b)

instance TupleLike (a :* b :* c :* Nil) where
  type AsTuple (a :* b :* c :* Nil) = (a, b, c)
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple (a :* (b :* (c :* Nil))) -> a :* (b :* (c :* Nil))
fromTuple (a, b, c) = a
a a -> (b :* (c :* Nil)) -> a :* (b :* (c :* Nil))
forall a b. a -> b -> a :* b
:* b
b b -> (c :* Nil) -> b :* (c :* Nil)
forall a b. a -> b -> a :* b
:* c
c c -> Nil -> c :* Nil
forall a b. a -> b -> a :* b
:* Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: (a :* (b :* (c :* Nil))) -> AsTuple (a :* (b :* (c :* Nil)))
toTuple (a
a :* b
b :* c
c :* Nil
Nil) = (a
a, b
b, c
c)

instance TupleLike (a :* b :* c :* d :* Nil) where
  type AsTuple (a :* b :* c :* d :* Nil) = (a, b, c, d)
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple (a :* (b :* (c :* (d :* Nil))))
-> a :* (b :* (c :* (d :* Nil)))
fromTuple (a, b, c, d) = a
a a -> (b :* (c :* (d :* Nil))) -> a :* (b :* (c :* (d :* Nil)))
forall a b. a -> b -> a :* b
:* b
b b -> (c :* (d :* Nil)) -> b :* (c :* (d :* Nil))
forall a b. a -> b -> a :* b
:* c
c c -> (d :* Nil) -> c :* (d :* Nil)
forall a b. a -> b -> a :* b
:* d
d d -> Nil -> d :* Nil
forall a b. a -> b -> a :* b
:* Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: (a :* (b :* (c :* (d :* Nil))))
-> AsTuple (a :* (b :* (c :* (d :* Nil))))
toTuple (a
a :* b
b :* c
c :* d
d :* Nil
Nil) = (a
a, b
b, c
c, d
d)

instance TupleLike (a :* b :* c :* d :* e :* Nil) where
  type AsTuple (a :* b :* c :* d :* e :* Nil) = (a, b, c, d, e)
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple (a :* (b :* (c :* (d :* (e :* Nil)))))
-> a :* (b :* (c :* (d :* (e :* Nil))))
fromTuple (a, b, c, d, e) = a
a a
-> (b :* (c :* (d :* (e :* Nil))))
-> a :* (b :* (c :* (d :* (e :* Nil))))
forall a b. a -> b -> a :* b
:* b
b b -> (c :* (d :* (e :* Nil))) -> b :* (c :* (d :* (e :* Nil)))
forall a b. a -> b -> a :* b
:* c
c c -> (d :* (e :* Nil)) -> c :* (d :* (e :* Nil))
forall a b. a -> b -> a :* b
:* d
d d -> (e :* Nil) -> d :* (e :* Nil)
forall a b. a -> b -> a :* b
:* e
e e -> Nil -> e :* Nil
forall a b. a -> b -> a :* b
:* Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: (a :* (b :* (c :* (d :* (e :* Nil)))))
-> AsTuple (a :* (b :* (c :* (d :* (e :* Nil)))))
toTuple (a
a :* b
b :* c
c :* d
d :* e
e :* Nil
Nil) = (a
a, b
b, c
c, d
d, e
e)

instance TupleLike (a :* b :* c :* d :* e :* f :* Nil) where
  type AsTuple (a :* b :* c :* d :* e :* f :* Nil) = (a, b, c, d, e, f)
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple (a :* (b :* (c :* (d :* (e :* (f :* Nil))))))
-> a :* (b :* (c :* (d :* (e :* (f :* Nil)))))
fromTuple (a, b, c, d, e, f) = a
a a
-> (b :* (c :* (d :* (e :* (f :* Nil)))))
-> a :* (b :* (c :* (d :* (e :* (f :* Nil)))))
forall a b. a -> b -> a :* b
:* b
b b
-> (c :* (d :* (e :* (f :* Nil))))
-> b :* (c :* (d :* (e :* (f :* Nil))))
forall a b. a -> b -> a :* b
:* c
c c -> (d :* (e :* (f :* Nil))) -> c :* (d :* (e :* (f :* Nil)))
forall a b. a -> b -> a :* b
:* d
d d -> (e :* (f :* Nil)) -> d :* (e :* (f :* Nil))
forall a b. a -> b -> a :* b
:* e
e e -> (f :* Nil) -> e :* (f :* Nil)
forall a b. a -> b -> a :* b
:* f
f f -> Nil -> f :* Nil
forall a b. a -> b -> a :* b
:* Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: (a :* (b :* (c :* (d :* (e :* (f :* Nil))))))
-> AsTuple (a :* (b :* (c :* (d :* (e :* (f :* Nil))))))
toTuple (a
a :* b
b :* c
c :* d
d :* e
e :* f
f :* Nil
Nil) = (a
a, b
b, c
c, d
d, e
e, f
f)

instance TupleLike (a :* b :* c :* d :* e :* f :* g :* Nil) where
  type AsTuple (a :* b :* c :* d :* e :* f :* g :* Nil) = (a, b, c, d, e, f, g)
  {-# INLINE fromTuple #-}
  fromTuple :: AsTuple (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil)))))))
-> a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))
fromTuple (a, b, c, d, e, f, g) = a
a a
-> (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))
-> a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))
forall a b. a -> b -> a :* b
:* b
b b
-> (c :* (d :* (e :* (f :* (g :* Nil)))))
-> b :* (c :* (d :* (e :* (f :* (g :* Nil)))))
forall a b. a -> b -> a :* b
:* c
c c
-> (d :* (e :* (f :* (g :* Nil))))
-> c :* (d :* (e :* (f :* (g :* Nil))))
forall a b. a -> b -> a :* b
:* d
d d -> (e :* (f :* (g :* Nil))) -> d :* (e :* (f :* (g :* Nil)))
forall a b. a -> b -> a :* b
:* e
e e -> (f :* (g :* Nil)) -> e :* (f :* (g :* Nil))
forall a b. a -> b -> a :* b
:* f
f f -> (g :* Nil) -> f :* (g :* Nil)
forall a b. a -> b -> a :* b
:* g
g g -> Nil -> g :* Nil
forall a b. a -> b -> a :* b
:* Nil
Nil
  {-# INLINE toTuple #-}
  toTuple :: (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil)))))))
-> AsTuple (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil)))))))
toTuple (a
a :* b
b :* c
c :* d
d :* e
e :* f
f :* g
g :* Nil
Nil) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g)

-- | Nullary tuple
data Nil = Nil
  deriving (Nil -> Nil -> Bool
(Nil -> Nil -> Bool) -> (Nil -> Nil -> Bool) -> Eq Nil
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nil -> Nil -> Bool
$c/= :: Nil -> Nil -> Bool
== :: Nil -> Nil -> Bool
$c== :: Nil -> Nil -> Bool
Eq, Eq Nil
Eq Nil
-> (Nil -> Nil -> Ordering)
-> (Nil -> Nil -> Bool)
-> (Nil -> Nil -> Bool)
-> (Nil -> Nil -> Bool)
-> (Nil -> Nil -> Bool)
-> (Nil -> Nil -> Nil)
-> (Nil -> Nil -> Nil)
-> Ord Nil
Nil -> Nil -> Bool
Nil -> Nil -> Ordering
Nil -> Nil -> Nil
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nil -> Nil -> Nil
$cmin :: Nil -> Nil -> Nil
max :: Nil -> Nil -> Nil
$cmax :: Nil -> Nil -> Nil
>= :: Nil -> Nil -> Bool
$c>= :: Nil -> Nil -> Bool
> :: Nil -> Nil -> Bool
$c> :: Nil -> Nil -> Bool
<= :: Nil -> Nil -> Bool
$c<= :: Nil -> Nil -> Bool
< :: Nil -> Nil -> Bool
$c< :: Nil -> Nil -> Bool
compare :: Nil -> Nil -> Ordering
$ccompare :: Nil -> Nil -> Ordering
$cp1Ord :: Eq Nil
Ord)

-- | Tuple constructor
data a :* b = a :* !b
  deriving ((a :* b) -> (a :* b) -> Bool
((a :* b) -> (a :* b) -> Bool)
-> ((a :* b) -> (a :* b) -> Bool) -> Eq (a :* b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :* b) -> (a :* b) -> Bool
/= :: (a :* b) -> (a :* b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :* b) -> (a :* b) -> Bool
== :: (a :* b) -> (a :* b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :* b) -> (a :* b) -> Bool
Eq, Eq (a :* b)
Eq (a :* b)
-> ((a :* b) -> (a :* b) -> Ordering)
-> ((a :* b) -> (a :* b) -> Bool)
-> ((a :* b) -> (a :* b) -> Bool)
-> ((a :* b) -> (a :* b) -> Bool)
-> ((a :* b) -> (a :* b) -> Bool)
-> ((a :* b) -> (a :* b) -> a :* b)
-> ((a :* b) -> (a :* b) -> a :* b)
-> Ord (a :* b)
(a :* b) -> (a :* b) -> Bool
(a :* b) -> (a :* b) -> Ordering
(a :* b) -> (a :* b) -> a :* b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (a :* b)
forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> Bool
forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> Ordering
forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> a :* b
min :: (a :* b) -> (a :* b) -> a :* b
$cmin :: forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> a :* b
max :: (a :* b) -> (a :* b) -> a :* b
$cmax :: forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> a :* b
>= :: (a :* b) -> (a :* b) -> Bool
$c>= :: forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> Bool
> :: (a :* b) -> (a :* b) -> Bool
$c> :: forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> Bool
<= :: (a :* b) -> (a :* b) -> Bool
$c<= :: forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> Bool
< :: (a :* b) -> (a :* b) -> Bool
$c< :: forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> Bool
compare :: (a :* b) -> (a :* b) -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => (a :* b) -> (a :* b) -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (a :* b)
Ord, (forall x. (a :* b) -> Rep (a :* b) x)
-> (forall x. Rep (a :* b) x -> a :* b) -> Generic (a :* b)
forall x. Rep (a :* b) x -> a :* b
forall x. (a :* b) -> Rep (a :* b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (a :* b) x -> a :* b
forall a b x. (a :* b) -> Rep (a :* b) x
$cto :: forall a b x. Rep (a :* b) x -> a :* b
$cfrom :: forall a b x. (a :* b) -> Rep (a :* b) x
Generic)

instance Show Nil where
  showsPrec :: Int -> Nil -> ShowS
showsPrec Int
_ Nil
Nil = String -> ShowS
showString String
"()"

instance (Show a, ShowTuple b) => Show (a :* b) where
  showsPrec :: Int -> (a :* b) -> ShowS
showsPrec Int
_ (a
a :* b
b) = ShowS -> b -> ShowS
forall a. ShowTuple a => ShowS -> a -> ShowS
showsTuple (a -> ShowS
forall a. Show a => a -> ShowS
shows a
a) b
b

class ShowTuple a where
  showsTuple :: ShowS -> a -> ShowS

instance ShowTuple Nil where
  showsTuple :: ShowS -> Nil -> ShowS
showsTuple ShowS
acc Nil
Nil = Bool -> ShowS -> ShowS
showParen Bool
True ShowS
acc

instance (Show a, ShowTuple b) => ShowTuple (a :* b) where
  showsTuple :: ShowS -> (a :* b) -> ShowS
showsTuple ShowS
acc (a
a :* b
b) = ShowS -> b -> ShowS
forall a. ShowTuple a => ShowS -> a -> ShowS
showsTuple (ShowS
acc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
a) b
b

infixr 1 :*