{-# LANGUAGE StandaloneDeriving, UndecidableInstances #-}
-- | Metadata about what a datatype looks like
--
-- In @generics-sop@, the metadata is completely independent of the main
-- universe. Many generic functions will use this metadata, but other don't,
-- and yet others might need completely different metadata.
--
-- This module defines a datatype to represent standard metadata, i.e., names
-- of the datatype, its constructors, and possibly its record selectors.
-- Metadata descriptions are in general GADTs indexed by the code of the
-- datatype they're associated with, so matching on the metadata will reveal
-- information about the shape of the datatype.
--
module Generics.SOP.Metadata
  ( module Generics.SOP.Metadata
    -- * re-exports
  , Associativity(..)
  , DecidedStrictness(..)
  , SourceStrictness(..)
  , SourceUnpackedness(..)
  ) where

import Data.Kind (Type)
import GHC.Generics
  ( Associativity(..)
  , DecidedStrictness(..)
  , SourceStrictness(..)
  , SourceUnpackedness(..)
  )

import Generics.SOP.Constraint
import Generics.SOP.NP

-- | Metadata for a datatype.
--
-- A value of type @'DatatypeInfo' c@ contains the information about a datatype
-- that is not contained in @'Code' c@. This information consists
-- primarily of the names of the datatype, its constructors, and possibly its
-- record selectors.
--
-- The constructor indicates whether the datatype has been declared using @newtype@
-- or not.
--
data DatatypeInfo :: [[Type]] -> Type where
  -- Standard algebraic datatype
  ADT     ::
       ModuleName
    -> DatatypeName
    -> NP ConstructorInfo xss
    -> POP StrictnessInfo xss
    -> DatatypeInfo xss
  -- Newtype
  Newtype ::
       ModuleName
    -> DatatypeName
    -> ConstructorInfo '[x]
    -> DatatypeInfo '[ '[x] ]

-- | The module name where a datatype is defined.
--
-- @since 0.2.3.0
--
moduleName :: DatatypeInfo xss -> ModuleName
moduleName :: DatatypeInfo xss -> ModuleName
moduleName (ADT name :: ModuleName
name _ _ _) = ModuleName
name
moduleName (Newtype name :: ModuleName
name _ _) = ModuleName
name

-- | The name of a datatype (or newtype).
--
-- @since 0.2.3.0
--
datatypeName :: DatatypeInfo xss -> DatatypeName
datatypeName :: DatatypeInfo xss -> ModuleName
datatypeName (ADT _ name :: ModuleName
name _ _) = ModuleName
name
datatypeName (Newtype _ name :: ModuleName
name _) = ModuleName
name

-- | The constructor info for a datatype (or newtype).
--
-- @since 0.2.3.0
--
constructorInfo :: DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo :: DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo (ADT _ _ cs :: NP ConstructorInfo xss
cs _) = NP ConstructorInfo xss
cs
constructorInfo (Newtype _ _ c :: ConstructorInfo '[x]
c) = ConstructorInfo '[x]
c ConstructorInfo '[x]
-> NP ConstructorInfo '[] -> NP ConstructorInfo '[ '[x]]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP ConstructorInfo '[]
forall k (a :: k -> *). NP a '[]
Nil

deriving instance
  ( All (Show `Compose` ConstructorInfo) xs
  , All (Show `Compose` NP StrictnessInfo) xs
  ) => Show (DatatypeInfo xs)
deriving instance
  ( All (Eq `Compose` ConstructorInfo) xs
  , All (Eq `Compose` NP StrictnessInfo) xs
  ) => Eq (DatatypeInfo xs)
deriving instance
  ( All (Eq `Compose` ConstructorInfo) xs
  , All (Ord `Compose` ConstructorInfo) xs
  , All (Eq `Compose` NP StrictnessInfo) xs
  , All (Ord `Compose` NP StrictnessInfo) xs
  ) => Ord (DatatypeInfo xs)

-- | Metadata for a single constructor.
--
-- This is indexed by the product structure of the constructor components.
--
data ConstructorInfo :: [Type] -> Type where
  -- Normal constructor
  Constructor :: SListI xs => ConstructorName -> ConstructorInfo xs
  -- Infix constructor
  Infix :: ConstructorName -> Associativity -> Fixity -> ConstructorInfo '[ x, y ]
  -- Record constructor
  Record :: SListI xs => ConstructorName -> NP FieldInfo xs -> ConstructorInfo xs

-- | The name of a constructor.
--
-- @since 0.2.3.0
--
constructorName :: ConstructorInfo xs -> ConstructorName
constructorName :: ConstructorInfo xs -> ModuleName
constructorName (Constructor name :: ModuleName
name) = ModuleName
name
constructorName (Infix name :: ModuleName
name _ _)   = ModuleName
name
constructorName (Record name :: ModuleName
name _)    = ModuleName
name

deriving instance All (Show `Compose` FieldInfo) xs => Show (ConstructorInfo xs)
deriving instance All (Eq   `Compose` FieldInfo) xs => Eq   (ConstructorInfo xs)
deriving instance (All (Eq `Compose` FieldInfo) xs, All (Ord `Compose` FieldInfo) xs) => Ord (ConstructorInfo xs)

-- | Metadata for strictness information of a field.
--
-- Indexed by the type of the field.
--
-- @since 0.4.0.0
--
data StrictnessInfo :: Type -> Type where
  StrictnessInfo ::
       SourceUnpackedness
    -> SourceStrictness
    -> DecidedStrictness
    -> StrictnessInfo a
  deriving (Int -> StrictnessInfo a -> ShowS
[StrictnessInfo a] -> ShowS
StrictnessInfo a -> ModuleName
(Int -> StrictnessInfo a -> ShowS)
-> (StrictnessInfo a -> ModuleName)
-> ([StrictnessInfo a] -> ShowS)
-> Show (StrictnessInfo a)
forall a. Int -> StrictnessInfo a -> ShowS
forall a. [StrictnessInfo a] -> ShowS
forall a. StrictnessInfo a -> ModuleName
forall a.
(Int -> a -> ShowS)
-> (a -> ModuleName) -> ([a] -> ShowS) -> Show a
showList :: [StrictnessInfo a] -> ShowS
$cshowList :: forall a. [StrictnessInfo a] -> ShowS
show :: StrictnessInfo a -> ModuleName
$cshow :: forall a. StrictnessInfo a -> ModuleName
showsPrec :: Int -> StrictnessInfo a -> ShowS
$cshowsPrec :: forall a. Int -> StrictnessInfo a -> ShowS
Show, StrictnessInfo a -> StrictnessInfo a -> Bool
(StrictnessInfo a -> StrictnessInfo a -> Bool)
-> (StrictnessInfo a -> StrictnessInfo a -> Bool)
-> Eq (StrictnessInfo a)
forall a. StrictnessInfo a -> StrictnessInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrictnessInfo a -> StrictnessInfo a -> Bool
$c/= :: forall a. StrictnessInfo a -> StrictnessInfo a -> Bool
== :: StrictnessInfo a -> StrictnessInfo a -> Bool
$c== :: forall a. StrictnessInfo a -> StrictnessInfo a -> Bool
Eq, Eq (StrictnessInfo a)
Eq (StrictnessInfo a) =>
(StrictnessInfo a -> StrictnessInfo a -> Ordering)
-> (StrictnessInfo a -> StrictnessInfo a -> Bool)
-> (StrictnessInfo a -> StrictnessInfo a -> Bool)
-> (StrictnessInfo a -> StrictnessInfo a -> Bool)
-> (StrictnessInfo a -> StrictnessInfo a -> Bool)
-> (StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a)
-> (StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a)
-> Ord (StrictnessInfo a)
StrictnessInfo a -> StrictnessInfo a -> Bool
StrictnessInfo a -> StrictnessInfo a -> Ordering
StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a
forall a. Eq (StrictnessInfo a)
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. StrictnessInfo a -> StrictnessInfo a -> Bool
forall a. StrictnessInfo a -> StrictnessInfo a -> Ordering
forall a. StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a
min :: StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a
$cmin :: forall a. StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a
max :: StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a
$cmax :: forall a. StrictnessInfo a -> StrictnessInfo a -> StrictnessInfo a
>= :: StrictnessInfo a -> StrictnessInfo a -> Bool
$c>= :: forall a. StrictnessInfo a -> StrictnessInfo a -> Bool
> :: StrictnessInfo a -> StrictnessInfo a -> Bool
$c> :: forall a. StrictnessInfo a -> StrictnessInfo a -> Bool
<= :: StrictnessInfo a -> StrictnessInfo a -> Bool
$c<= :: forall a. StrictnessInfo a -> StrictnessInfo a -> Bool
< :: StrictnessInfo a -> StrictnessInfo a -> Bool
$c< :: forall a. StrictnessInfo a -> StrictnessInfo a -> Bool
compare :: StrictnessInfo a -> StrictnessInfo a -> Ordering
$ccompare :: forall a. StrictnessInfo a -> StrictnessInfo a -> Ordering
$cp1Ord :: forall a. Eq (StrictnessInfo a)
Ord, (a -> b) -> StrictnessInfo a -> StrictnessInfo b
(forall a b. (a -> b) -> StrictnessInfo a -> StrictnessInfo b)
-> (forall a b. a -> StrictnessInfo b -> StrictnessInfo a)
-> Functor StrictnessInfo
forall a b. a -> StrictnessInfo b -> StrictnessInfo a
forall a b. (a -> b) -> StrictnessInfo a -> StrictnessInfo b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StrictnessInfo b -> StrictnessInfo a
$c<$ :: forall a b. a -> StrictnessInfo b -> StrictnessInfo a
fmap :: (a -> b) -> StrictnessInfo a -> StrictnessInfo b
$cfmap :: forall a b. (a -> b) -> StrictnessInfo a -> StrictnessInfo b
Functor)

-- | For records, this functor maps the component to its selector name.
data FieldInfo :: Type -> Type where
  FieldInfo :: FieldName -> FieldInfo a
  deriving (Int -> FieldInfo a -> ShowS
[FieldInfo a] -> ShowS
FieldInfo a -> ModuleName
(Int -> FieldInfo a -> ShowS)
-> (FieldInfo a -> ModuleName)
-> ([FieldInfo a] -> ShowS)
-> Show (FieldInfo a)
forall a. Int -> FieldInfo a -> ShowS
forall a. [FieldInfo a] -> ShowS
forall a. FieldInfo a -> ModuleName
forall a.
(Int -> a -> ShowS)
-> (a -> ModuleName) -> ([a] -> ShowS) -> Show a
showList :: [FieldInfo a] -> ShowS
$cshowList :: forall a. [FieldInfo a] -> ShowS
show :: FieldInfo a -> ModuleName
$cshow :: forall a. FieldInfo a -> ModuleName
showsPrec :: Int -> FieldInfo a -> ShowS
$cshowsPrec :: forall a. Int -> FieldInfo a -> ShowS
Show, FieldInfo a -> FieldInfo a -> Bool
(FieldInfo a -> FieldInfo a -> Bool)
-> (FieldInfo a -> FieldInfo a -> Bool) -> Eq (FieldInfo a)
forall a. FieldInfo a -> FieldInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldInfo a -> FieldInfo a -> Bool
$c/= :: forall a. FieldInfo a -> FieldInfo a -> Bool
== :: FieldInfo a -> FieldInfo a -> Bool
$c== :: forall a. FieldInfo a -> FieldInfo a -> Bool
Eq, Eq (FieldInfo a)
Eq (FieldInfo a) =>
(FieldInfo a -> FieldInfo a -> Ordering)
-> (FieldInfo a -> FieldInfo a -> Bool)
-> (FieldInfo a -> FieldInfo a -> Bool)
-> (FieldInfo a -> FieldInfo a -> Bool)
-> (FieldInfo a -> FieldInfo a -> Bool)
-> (FieldInfo a -> FieldInfo a -> FieldInfo a)
-> (FieldInfo a -> FieldInfo a -> FieldInfo a)
-> Ord (FieldInfo a)
FieldInfo a -> FieldInfo a -> Bool
FieldInfo a -> FieldInfo a -> Ordering
FieldInfo a -> FieldInfo a -> FieldInfo a
forall a. Eq (FieldInfo a)
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. FieldInfo a -> FieldInfo a -> Bool
forall a. FieldInfo a -> FieldInfo a -> Ordering
forall a. FieldInfo a -> FieldInfo a -> FieldInfo a
min :: FieldInfo a -> FieldInfo a -> FieldInfo a
$cmin :: forall a. FieldInfo a -> FieldInfo a -> FieldInfo a
max :: FieldInfo a -> FieldInfo a -> FieldInfo a
$cmax :: forall a. FieldInfo a -> FieldInfo a -> FieldInfo a
>= :: FieldInfo a -> FieldInfo a -> Bool
$c>= :: forall a. FieldInfo a -> FieldInfo a -> Bool
> :: FieldInfo a -> FieldInfo a -> Bool
$c> :: forall a. FieldInfo a -> FieldInfo a -> Bool
<= :: FieldInfo a -> FieldInfo a -> Bool
$c<= :: forall a. FieldInfo a -> FieldInfo a -> Bool
< :: FieldInfo a -> FieldInfo a -> Bool
$c< :: forall a. FieldInfo a -> FieldInfo a -> Bool
compare :: FieldInfo a -> FieldInfo a -> Ordering
$ccompare :: forall a. FieldInfo a -> FieldInfo a -> Ordering
$cp1Ord :: forall a. Eq (FieldInfo a)
Ord, (a -> b) -> FieldInfo a -> FieldInfo b
(forall a b. (a -> b) -> FieldInfo a -> FieldInfo b)
-> (forall a b. a -> FieldInfo b -> FieldInfo a)
-> Functor FieldInfo
forall a b. a -> FieldInfo b -> FieldInfo a
forall a b. (a -> b) -> FieldInfo a -> FieldInfo b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FieldInfo b -> FieldInfo a
$c<$ :: forall a b. a -> FieldInfo b -> FieldInfo a
fmap :: (a -> b) -> FieldInfo a -> FieldInfo b
$cfmap :: forall a b. (a -> b) -> FieldInfo a -> FieldInfo b
Functor)

-- | The name of a field.
--
-- @since 0.2.3.0
--
fieldName :: FieldInfo a -> FieldName
fieldName :: FieldInfo a -> ModuleName
fieldName (FieldInfo n :: ModuleName
n) = ModuleName
n

-- | The name of a datatype.
type DatatypeName    = String

-- | The name of a module.
type ModuleName      = String

-- | The name of a data constructor.
type ConstructorName = String

-- | The name of a field / record selector.
type FieldName       = String

-- | The fixity of an infix constructor.
type Fixity          = Int