{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Foreign.Storable.Generic.Tools.TypeFuns where
import Data.Proxy
import GHC.Generics
import GHC.TypeLits
type family SumArity (arg :: * -> *) where
SumArity (M1 C _ t) = 1
SumArity (M1 _ _ t) = SumArity t
SumArity (f :+: g) = (SumArity f) + (SumArity g)
SumArity (f :*: g) = (SumArity f) + (SumArity g)
SumArity _ = 0
type family NoFields (arg :: * -> *) where
NoFields (M1 _ _ t) = NoFields t
NoFields (f :+: g) = (NoFields f) + (NoFields g)
NoFields (f :*: g) = (NoFields f) + (NoFields g)
NoFields (K1 _ _) = 1
NoFields _ = 0
type IsSumType (arg :: * -> *) = IsSumType' (CmpNat (SumArity arg) (1))
type family IsSumType' (ret :: Ordering) :: Bool where
IsSumType' GT = True
IsSumType' _ = False
noFields :: (KnownNat (NoFields f)) => f p -> Int
noFields (a :: f p) = fromIntegral.natVal $ (Proxy :: Proxy (NoFields f))
sumArity :: (KnownNat (SumArity f)) => f p -> Int
sumArity (a :: f p) = fromIntegral.natVal $ (Proxy :: Proxy (SumArity f))