{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE OverloadedStrings #-}

module Codec.Candid.Tuples ( Unary(..), Tuplable, AsTuple, asTuple, fromTuple ) where

import Data.Type.Bool

-- | A newtype to stand in for the unary tuple
newtype Unary a = Unary {forall a. Unary a -> a
unUnary :: a} deriving (Unary a -> Unary a -> Bool
forall a. Eq a => Unary a -> Unary a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unary a -> Unary a -> Bool
$c/= :: forall a. Eq a => Unary a -> Unary a -> Bool
== :: Unary a -> Unary a -> Bool
$c== :: forall a. Eq a => Unary a -> Unary a -> Bool
Eq, Int -> Unary a -> ShowS
forall a. Show a => Int -> Unary a -> ShowS
forall a. Show a => [Unary a] -> ShowS
forall a. Show a => Unary a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unary a] -> ShowS
$cshowList :: forall a. Show a => [Unary a] -> ShowS
show :: Unary a -> String
$cshow :: forall a. Show a => Unary a -> String
showsPrec :: Int -> Unary a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Unary a -> ShowS
Show)

type family IsTuple a :: Bool where
    IsTuple () = 'True
    IsTuple (Unary t) = 'True
    IsTuple (_,_) = 'True
    IsTuple (_,_,_) = 'True
    IsTuple (_,_,_,_) = 'True
    IsTuple (_,_,_,_,_) = 'True
    IsTuple (_,_,_,_,_,_) = 'True
    IsTuple (_,_,_,_,_,_,_) = 'True
    IsTuple (_,_,_,_,_,_,_,_) = 'True
    IsTuple (_,_,_,_,_,_,_,_,_) = 'True
    IsTuple (_,_,_,_,_,_,_,_,_,_) = 'True
    IsTuple t = 'False

type AsTuple a = If (IsTuple a) a (Unary a)

class IsTuple a ~ b => AsTuple_ a b where
    asTuple :: a -> AsTuple a
    fromTuple :: AsTuple a -> a
instance IsTuple a ~ 'True => AsTuple_ a 'True where
    asTuple :: a -> AsTuple a
asTuple = forall a. a -> a
id
    fromTuple :: AsTuple a -> a
fromTuple = forall a. a -> a
id
instance IsTuple a ~ 'False => AsTuple_ a 'False where
    asTuple :: a -> AsTuple a
asTuple = forall a. a -> Unary a
Unary
    fromTuple :: AsTuple a -> a
fromTuple = forall a. Unary a -> a
unUnary

type Tuplable a = (AsTuple_ a (IsTuple a))