{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Generics.SOP.Type.Metadata
( module Generics.SOP.Type.Metadata
, Associativity(..)
) where
#if __GLASGOW_HASKELL__ <802
import Data.Kind (Type)
#endif
import Data.Proxy (Proxy (..))
import GHC.Generics
( Associativity(..)
, DecidedStrictness(..)
, SourceStrictness(..)
, SourceUnpackedness(..)
)
import GHC.Types
import GHC.TypeLits
import qualified Generics.SOP.Metadata as M
import Generics.SOP.NP
import Generics.SOP.Sing
data DatatypeInfo =
ADT ModuleName DatatypeName [ConstructorInfo] [[StrictnessInfo]]
| Newtype ModuleName DatatypeName ConstructorInfo
data ConstructorInfo =
Constructor ConstructorName
| Infix ConstructorName Associativity Fixity
| Record ConstructorName [FieldInfo]
data StrictnessInfo =
StrictnessInfo SourceUnpackedness SourceStrictness DecidedStrictness
data FieldInfo =
FieldInfo FieldName
type DatatypeName = Symbol
type ModuleName = Symbol
type ConstructorName = Symbol
type FieldName = Symbol
type Fixity = Nat
class DemoteDatatypeInfo (x :: DatatypeInfo) (xss :: [[Type]]) where
demoteDatatypeInfo :: proxy x -> M.DatatypeInfo xss
instance
( KnownSymbol m
, KnownSymbol d
, DemoteConstructorInfos cs xss
, DemoteStrictnessInfoss sss xss
)
=> DemoteDatatypeInfo ('ADT m d cs sss) xss where
demoteDatatypeInfo :: proxy ('ADT m d cs sss) -> DatatypeInfo xss
demoteDatatypeInfo proxy ('ADT m d cs sss)
_ =
ModuleName
-> ModuleName
-> NP ConstructorInfo xss
-> POP StrictnessInfo xss
-> DatatypeInfo xss
forall (xss :: [[*]]).
ModuleName
-> ModuleName
-> NP ConstructorInfo xss
-> POP StrictnessInfo xss
-> DatatypeInfo xss
M.ADT
(Proxy m -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy m
forall k (t :: k). Proxy t
Proxy :: Proxy m))
(Proxy d -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d))
(Proxy cs -> NP ConstructorInfo xss
forall (cs :: [ConstructorInfo]) (xss :: [[*]])
(proxy :: [ConstructorInfo] -> *).
DemoteConstructorInfos cs xss =>
proxy cs -> NP ConstructorInfo xss
demoteConstructorInfos (Proxy cs
forall k (t :: k). Proxy t
Proxy :: Proxy cs))
(NP (NP StrictnessInfo) xss -> POP StrictnessInfo xss
forall k (f :: k -> *) (xss :: [[k]]). NP (NP f) xss -> POP f xss
POP (Proxy sss -> NP (NP StrictnessInfo) xss
forall (sss :: [[StrictnessInfo]]) (xss :: [[*]])
(proxy :: [[StrictnessInfo]] -> *).
DemoteStrictnessInfoss sss xss =>
proxy sss -> NP (NP StrictnessInfo) xss
demoteStrictnessInfoss (Proxy sss
forall k (t :: k). Proxy t
Proxy :: Proxy sss)))
instance
(KnownSymbol m, KnownSymbol d, DemoteConstructorInfo c '[ x ])
=> DemoteDatatypeInfo ('Newtype m d c) '[ '[ x ] ] where
demoteDatatypeInfo :: proxy ('Newtype m d c) -> DatatypeInfo '[ '[x]]
demoteDatatypeInfo proxy ('Newtype m d c)
_ =
ModuleName
-> ModuleName -> ConstructorInfo '[x] -> DatatypeInfo '[ '[x]]
forall x.
ModuleName
-> ModuleName -> ConstructorInfo '[x] -> DatatypeInfo '[ '[x]]
M.Newtype
(Proxy m -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy m
forall k (t :: k). Proxy t
Proxy :: Proxy m))
(Proxy d -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d))
(Proxy c -> ConstructorInfo '[x]
forall (x :: ConstructorInfo) (xs :: [*])
(proxy :: ConstructorInfo -> *).
DemoteConstructorInfo x xs =>
proxy x -> ConstructorInfo xs
demoteConstructorInfo (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c))
class DemoteConstructorInfos (cs :: [ConstructorInfo]) (xss :: [[Type]]) where
demoteConstructorInfos :: proxy cs -> NP M.ConstructorInfo xss
instance DemoteConstructorInfos '[] '[] where
demoteConstructorInfos :: proxy '[] -> NP ConstructorInfo '[]
demoteConstructorInfos proxy '[]
_ = NP ConstructorInfo '[]
forall k (a :: k -> *). NP a '[]
Nil
instance
(DemoteConstructorInfo c xs, DemoteConstructorInfos cs xss)
=> DemoteConstructorInfos (c ': cs) (xs ': xss) where
demoteConstructorInfos :: proxy (c : cs) -> NP ConstructorInfo (xs : xss)
demoteConstructorInfos proxy (c : cs)
_ =
Proxy c -> ConstructorInfo xs
forall (x :: ConstructorInfo) (xs :: [*])
(proxy :: ConstructorInfo -> *).
DemoteConstructorInfo x xs =>
proxy x -> ConstructorInfo xs
demoteConstructorInfo (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c) ConstructorInfo xs
-> NP ConstructorInfo xss -> NP ConstructorInfo (xs : xss)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Proxy cs -> NP ConstructorInfo xss
forall (cs :: [ConstructorInfo]) (xss :: [[*]])
(proxy :: [ConstructorInfo] -> *).
DemoteConstructorInfos cs xss =>
proxy cs -> NP ConstructorInfo xss
demoteConstructorInfos (Proxy cs
forall k (t :: k). Proxy t
Proxy :: Proxy cs)
class DemoteConstructorInfo (x :: ConstructorInfo) (xs :: [Type]) where
demoteConstructorInfo :: proxy x -> M.ConstructorInfo xs
instance (KnownSymbol s, SListI xs) => DemoteConstructorInfo ('Constructor s) xs where
demoteConstructorInfo :: proxy ('Constructor s) -> ConstructorInfo xs
demoteConstructorInfo proxy ('Constructor s)
_ = ModuleName -> ConstructorInfo xs
forall (xs :: [*]). SListI xs => ModuleName -> ConstructorInfo xs
M.Constructor (Proxy s -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))
instance
(KnownSymbol s, DemoteAssociativity a, KnownNat f)
=> DemoteConstructorInfo ('Infix s a f) [y, z] where
demoteConstructorInfo :: proxy ('Infix s a f) -> ConstructorInfo '[y, z]
demoteConstructorInfo proxy ('Infix s a f)
_ =
ModuleName -> Associativity -> Fixity -> ConstructorInfo '[y, z]
forall x y.
ModuleName -> Associativity -> Fixity -> ConstructorInfo '[x, y]
M.Infix
(Proxy s -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))
(Proxy a -> Associativity
forall (a :: Associativity) (proxy :: Associativity -> *).
DemoteAssociativity a =>
proxy a -> Associativity
demoteAssociativity (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
(Integer -> Fixity
forall a. Num a => Integer -> a
fromInteger (Proxy f -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)))
instance (KnownSymbol s, DemoteFieldInfos fs xs) => DemoteConstructorInfo ('Record s fs) xs where
demoteConstructorInfo :: proxy ('Record s fs) -> ConstructorInfo xs
demoteConstructorInfo proxy ('Record s fs)
_ =
ModuleName -> NP FieldInfo xs -> ConstructorInfo xs
forall (xs :: [*]).
SListI xs =>
ModuleName -> NP FieldInfo xs -> ConstructorInfo xs
M.Record (Proxy s -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)) (Proxy fs -> NP FieldInfo xs
forall (fs :: [FieldInfo]) (xs :: [*]) (proxy :: [FieldInfo] -> *).
DemoteFieldInfos fs xs =>
proxy fs -> NP FieldInfo xs
demoteFieldInfos (Proxy fs
forall k (t :: k). Proxy t
Proxy :: Proxy fs))
class DemoteStrictnessInfoss (sss :: [[StrictnessInfo]]) (xss :: [[Type]]) where
demoteStrictnessInfoss :: proxy sss -> NP (NP M.StrictnessInfo) xss
instance DemoteStrictnessInfoss '[] '[] where
demoteStrictnessInfoss :: proxy '[] -> NP (NP StrictnessInfo) '[]
demoteStrictnessInfoss proxy '[]
_ = NP (NP StrictnessInfo) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance
(DemoteStrictnessInfos ss xs, DemoteStrictnessInfoss sss xss)
=> DemoteStrictnessInfoss (ss ': sss) (xs ': xss) where
demoteStrictnessInfoss :: proxy (ss : sss) -> NP (NP StrictnessInfo) (xs : xss)
demoteStrictnessInfoss proxy (ss : sss)
_ =
Proxy ss -> NP StrictnessInfo xs
forall (ss :: [StrictnessInfo]) (xs :: [*])
(proxy :: [StrictnessInfo] -> *).
DemoteStrictnessInfos ss xs =>
proxy ss -> NP StrictnessInfo xs
demoteStrictnessInfos (Proxy ss
forall k (t :: k). Proxy t
Proxy :: Proxy ss )
NP StrictnessInfo xs
-> NP (NP StrictnessInfo) xss -> NP (NP StrictnessInfo) (xs : xss)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Proxy sss -> NP (NP StrictnessInfo) xss
forall (sss :: [[StrictnessInfo]]) (xss :: [[*]])
(proxy :: [[StrictnessInfo]] -> *).
DemoteStrictnessInfoss sss xss =>
proxy sss -> NP (NP StrictnessInfo) xss
demoteStrictnessInfoss (Proxy sss
forall k (t :: k). Proxy t
Proxy :: Proxy sss)
class DemoteStrictnessInfos (ss :: [StrictnessInfo]) (xs :: [Type]) where
demoteStrictnessInfos :: proxy ss -> NP M.StrictnessInfo xs
instance DemoteStrictnessInfos '[] '[] where
demoteStrictnessInfos :: proxy '[] -> NP StrictnessInfo '[]
demoteStrictnessInfos proxy '[]
_ = NP StrictnessInfo '[]
forall k (a :: k -> *). NP a '[]
Nil
instance
(DemoteStrictnessInfo s x, DemoteStrictnessInfos ss xs)
=> DemoteStrictnessInfos (s ': ss) (x ': xs) where
demoteStrictnessInfos :: proxy (s : ss) -> NP StrictnessInfo (x : xs)
demoteStrictnessInfos proxy (s : ss)
_ =
Proxy s -> StrictnessInfo x
forall (s :: StrictnessInfo) x (proxy :: StrictnessInfo -> *).
DemoteStrictnessInfo s x =>
proxy s -> StrictnessInfo x
demoteStrictnessInfo (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s )
StrictnessInfo x
-> NP StrictnessInfo xs -> NP StrictnessInfo (x : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Proxy ss -> NP StrictnessInfo xs
forall (ss :: [StrictnessInfo]) (xs :: [*])
(proxy :: [StrictnessInfo] -> *).
DemoteStrictnessInfos ss xs =>
proxy ss -> NP StrictnessInfo xs
demoteStrictnessInfos (Proxy ss
forall k (t :: k). Proxy t
Proxy :: Proxy ss)
class DemoteStrictnessInfo (s :: StrictnessInfo) (x :: Type) where
demoteStrictnessInfo :: proxy s -> M.StrictnessInfo x
instance
( DemoteSourceUnpackedness su
, DemoteSourceStrictness ss
, DemoteDecidedStrictness ds
)
=> DemoteStrictnessInfo ('StrictnessInfo su ss ds) x where
demoteStrictnessInfo :: proxy ('StrictnessInfo su ss ds) -> StrictnessInfo x
demoteStrictnessInfo proxy ('StrictnessInfo su ss ds)
_ =
SourceUnpackedness
-> SourceStrictness -> DecidedStrictness -> StrictnessInfo x
forall a.
SourceUnpackedness
-> SourceStrictness -> DecidedStrictness -> StrictnessInfo a
M.StrictnessInfo
(Proxy su -> SourceUnpackedness
forall (a :: SourceUnpackedness)
(proxy :: SourceUnpackedness -> *).
DemoteSourceUnpackedness a =>
proxy a -> SourceUnpackedness
demoteSourceUnpackedness (Proxy su
forall k (t :: k). Proxy t
Proxy :: Proxy su))
(Proxy ss -> SourceStrictness
forall (a :: SourceStrictness) (proxy :: SourceStrictness -> *).
DemoteSourceStrictness a =>
proxy a -> SourceStrictness
demoteSourceStrictness (Proxy ss
forall k (t :: k). Proxy t
Proxy :: Proxy ss))
(Proxy ds -> DecidedStrictness
forall (a :: DecidedStrictness) (proxy :: DecidedStrictness -> *).
DemoteDecidedStrictness a =>
proxy a -> DecidedStrictness
demoteDecidedStrictness (Proxy ds
forall k (t :: k). Proxy t
Proxy :: Proxy ds))
class SListI xs => DemoteFieldInfos (fs :: [FieldInfo]) (xs :: [Type]) where
demoteFieldInfos :: proxy fs -> NP M.FieldInfo xs
instance DemoteFieldInfos '[] '[] where
demoteFieldInfos :: proxy '[] -> NP FieldInfo '[]
demoteFieldInfos proxy '[]
_ = NP FieldInfo '[]
forall k (a :: k -> *). NP a '[]
Nil
instance
(DemoteFieldInfo f x, DemoteFieldInfos fs xs)
=> DemoteFieldInfos (f ': fs) (x ': xs) where
demoteFieldInfos :: proxy (f : fs) -> NP FieldInfo (x : xs)
demoteFieldInfos proxy (f : fs)
_ = Proxy f -> FieldInfo x
forall (x :: FieldInfo) a (proxy :: FieldInfo -> *).
DemoteFieldInfo x a =>
proxy x -> FieldInfo a
demoteFieldInfo (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) FieldInfo x -> NP FieldInfo xs -> NP FieldInfo (x : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Proxy fs -> NP FieldInfo xs
forall (fs :: [FieldInfo]) (xs :: [*]) (proxy :: [FieldInfo] -> *).
DemoteFieldInfos fs xs =>
proxy fs -> NP FieldInfo xs
demoteFieldInfos (Proxy fs
forall k (t :: k). Proxy t
Proxy :: Proxy fs)
class DemoteFieldInfo (x :: FieldInfo) (a :: Type) where
demoteFieldInfo :: proxy x -> M.FieldInfo a
instance KnownSymbol s => DemoteFieldInfo ('FieldInfo s) a where
demoteFieldInfo :: proxy ('FieldInfo s) -> FieldInfo a
demoteFieldInfo proxy ('FieldInfo s)
_ = ModuleName -> FieldInfo a
forall a. ModuleName -> FieldInfo a
M.FieldInfo (Proxy s -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))
class DemoteAssociativity (a :: Associativity) where
demoteAssociativity :: proxy a -> M.Associativity
instance DemoteAssociativity 'LeftAssociative where
demoteAssociativity :: proxy 'LeftAssociative -> Associativity
demoteAssociativity proxy 'LeftAssociative
_ = Associativity
M.LeftAssociative
instance DemoteAssociativity 'RightAssociative where
demoteAssociativity :: proxy 'RightAssociative -> Associativity
demoteAssociativity proxy 'RightAssociative
_ = Associativity
M.RightAssociative
instance DemoteAssociativity 'NotAssociative where
demoteAssociativity :: proxy 'NotAssociative -> Associativity
demoteAssociativity proxy 'NotAssociative
_ = Associativity
M.NotAssociative
class DemoteSourceUnpackedness (a :: SourceUnpackedness) where
demoteSourceUnpackedness :: proxy a -> M.SourceUnpackedness
instance DemoteSourceUnpackedness 'NoSourceUnpackedness where
demoteSourceUnpackedness :: proxy 'NoSourceUnpackedness -> SourceUnpackedness
demoteSourceUnpackedness proxy 'NoSourceUnpackedness
_ = SourceUnpackedness
M.NoSourceUnpackedness
instance DemoteSourceUnpackedness 'SourceNoUnpack where
demoteSourceUnpackedness :: proxy 'SourceNoUnpack -> SourceUnpackedness
demoteSourceUnpackedness proxy 'SourceNoUnpack
_ = SourceUnpackedness
M.SourceNoUnpack
instance DemoteSourceUnpackedness 'SourceUnpack where
demoteSourceUnpackedness :: proxy 'SourceUnpack -> SourceUnpackedness
demoteSourceUnpackedness proxy 'SourceUnpack
_ = SourceUnpackedness
M.SourceUnpack
class DemoteSourceStrictness (a :: SourceStrictness) where
demoteSourceStrictness :: proxy a -> M.SourceStrictness
instance DemoteSourceStrictness 'NoSourceStrictness where
demoteSourceStrictness :: proxy 'NoSourceStrictness -> SourceStrictness
demoteSourceStrictness proxy 'NoSourceStrictness
_ = SourceStrictness
M.NoSourceStrictness
instance DemoteSourceStrictness 'SourceLazy where
demoteSourceStrictness :: proxy 'SourceLazy -> SourceStrictness
demoteSourceStrictness proxy 'SourceLazy
_ = SourceStrictness
M.SourceLazy
instance DemoteSourceStrictness 'SourceStrict where
demoteSourceStrictness :: proxy 'SourceStrict -> SourceStrictness
demoteSourceStrictness proxy 'SourceStrict
_ = SourceStrictness
M.SourceStrict
class DemoteDecidedStrictness (a :: DecidedStrictness) where
demoteDecidedStrictness :: proxy a -> M.DecidedStrictness
instance DemoteDecidedStrictness 'DecidedLazy where
demoteDecidedStrictness :: proxy 'DecidedLazy -> DecidedStrictness
demoteDecidedStrictness proxy 'DecidedLazy
_ = DecidedStrictness
M.DecidedLazy
instance DemoteDecidedStrictness 'DecidedStrict where
demoteDecidedStrictness :: proxy 'DecidedStrict -> DecidedStrictness
demoteDecidedStrictness proxy 'DecidedStrict
_ = DecidedStrictness
M.DecidedStrict
instance DemoteDecidedStrictness 'DecidedUnpack where
demoteDecidedStrictness :: proxy 'DecidedUnpack -> DecidedStrictness
demoteDecidedStrictness proxy 'DecidedUnpack
_ = DecidedStrictness
M.DecidedUnpack