-- |
-- Module      : Foundation.Tuple.Nat
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- a Generalized version of Fstable, Sndable, ..
--
-- Using this module is limited to GHC 7.10 and above.
--
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
module Foundation.Tuple.Nth (Nthable(..)) where

import GHC.TypeLits
import Foundation.Tuple

-- | A generalized version of indexed accessor allowing
-- access to tuples n'th element.
--
-- Indexing starts at 1, as 'fst' is used to get first element.
class KnownNat n => Nthable n a where
    type NthTy n a
    nth :: proxy n -> a -> NthTy n a

--------------------
-- 2 elements tuple
--------------------

instance Nthable 1 (a,b) where
    type NthTy 1 (a,b) = a
    nth :: proxy 1 -> (a, b) -> NthTy 1 (a, b)
nth proxy 1
_ (a
a,b
_) = a
NthTy 1 (a, b)
a
instance Nthable 2 (a,b) where
    type NthTy 2 (a,b) = b
    nth :: proxy 2 -> (a, b) -> NthTy 2 (a, b)
nth proxy 2
_ (a
_,b
b) = b
NthTy 2 (a, b)
b
instance Nthable 1 (Tuple2 a b) where
    type NthTy 1 (Tuple2 a b) = a
    nth :: proxy 1 -> Tuple2 a b -> NthTy 1 (Tuple2 a b)
nth proxy 1
_ (Tuple2 a
a b
_) = a
NthTy 1 (Tuple2 a b)
a
instance Nthable 2 (Tuple2 a b) where
    type NthTy 2 (Tuple2 a b) = b
    nth :: proxy 2 -> Tuple2 a b -> NthTy 2 (Tuple2 a b)
nth proxy 2
_ (Tuple2 a
_ b
b) = b
NthTy 2 (Tuple2 a b)
b

--------------------
-- 3 elements tuple
--------------------

instance Nthable 1 (a,b,c) where
    type NthTy 1 (a,b,c) = a
    nth :: proxy 1 -> (a, b, c) -> NthTy 1 (a, b, c)
nth proxy 1
_ (a
a,b
_,c
_) = a
NthTy 1 (a, b, c)
a
instance Nthable 2 (a,b,c) where
    type NthTy 2 (a,b,c) = b
    nth :: proxy 2 -> (a, b, c) -> NthTy 2 (a, b, c)
nth proxy 2
_ (a
_,b
b,c
_) = b
NthTy 2 (a, b, c)
b
instance Nthable 3 (a,b,c) where
    type NthTy 3 (a,b,c) = c
    nth :: proxy 3 -> (a, b, c) -> NthTy 3 (a, b, c)
nth proxy 3
_ (a
_,b
_,c
c) = c
NthTy 3 (a, b, c)
c

instance Nthable 1 (Tuple3 a b c) where
    type NthTy 1 (Tuple3 a b c) = a
    nth :: proxy 1 -> Tuple3 a b c -> NthTy 1 (Tuple3 a b c)
nth proxy 1
_ (Tuple3 a
a b
_ c
_) = a
NthTy 1 (Tuple3 a b c)
a
instance Nthable 2 (Tuple3 a b c) where
    type NthTy 2 (Tuple3 a b c) = b
    nth :: proxy 2 -> Tuple3 a b c -> NthTy 2 (Tuple3 a b c)
nth proxy 2
_ (Tuple3 a
_ b
b c
_) = b
NthTy 2 (Tuple3 a b c)
b
instance Nthable 3 (Tuple3 a b c) where
    type NthTy 3 (Tuple3 a b c) = c
    nth :: proxy 3 -> Tuple3 a b c -> NthTy 3 (Tuple3 a b c)
nth proxy 3
_ (Tuple3 a
_ b
_ c
c) = c
NthTy 3 (Tuple3 a b c)
c

--------------------
-- 4 elements tuple
--------------------

instance Nthable 1 (a,b,c,d) where
    type NthTy 1 (a,b,c,d) = a
    nth :: proxy 1 -> (a, b, c, d) -> NthTy 1 (a, b, c, d)
nth proxy 1
_ (a
a,b
_,c
_,d
_) = a
NthTy 1 (a, b, c, d)
a
instance Nthable 2 (a,b,c,d) where
    type NthTy 2 (a,b,c,d) = b
    nth :: proxy 2 -> (a, b, c, d) -> NthTy 2 (a, b, c, d)
nth proxy 2
_ (a
_,b
b,c
_,d
_) = b
NthTy 2 (a, b, c, d)
b
instance Nthable 3 (a,b,c,d) where
    type NthTy 3 (a,b,c,d) = c
    nth :: proxy 3 -> (a, b, c, d) -> NthTy 3 (a, b, c, d)
nth proxy 3
_ (a
_,b
_,c
c,d
_) = c
NthTy 3 (a, b, c, d)
c
instance Nthable 4 (a,b,c,d) where
    type NthTy 4 (a,b,c,d) = d
    nth :: proxy 4 -> (a, b, c, d) -> NthTy 4 (a, b, c, d)
nth proxy 4
_ (a
_,b
_,c
_,d
d) = d
NthTy 4 (a, b, c, d)
d

instance Nthable 1 (Tuple4 a b c d) where
    type NthTy 1 (Tuple4 a b c d) = a
    nth :: proxy 1 -> Tuple4 a b c d -> NthTy 1 (Tuple4 a b c d)
nth proxy 1
_ (Tuple4 a
a b
_ c
_ d
_) = a
NthTy 1 (Tuple4 a b c d)
a
instance Nthable 2 (Tuple4 a b c d) where
    type NthTy 2 (Tuple4 a b c d) = b
    nth :: proxy 2 -> Tuple4 a b c d -> NthTy 2 (Tuple4 a b c d)
nth proxy 2
_ (Tuple4 a
_ b
b c
_ d
_) = b
NthTy 2 (Tuple4 a b c d)
b
instance Nthable 3 (Tuple4 a b c d) where
    type NthTy 3 (Tuple4 a b c d) = c
    nth :: proxy 3 -> Tuple4 a b c d -> NthTy 3 (Tuple4 a b c d)
nth proxy 3
_ (Tuple4 a
_ b
_ c
c d
_) = c
NthTy 3 (Tuple4 a b c d)
c
instance Nthable 4 (Tuple4 a b c d) where
    type NthTy 4 (Tuple4 a b c d) = d
    nth :: proxy 4 -> Tuple4 a b c d -> NthTy 4 (Tuple4 a b c d)
nth proxy 4
_ (Tuple4 a
_ b
_ c
_ d
d) = d
NthTy 4 (Tuple4 a b c d)
d