{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE KindSignatures     #-}
{-# LANGUAGE TypeFamilies       #-}

module Data.Record.Generic (
    -- * Types with a generic view
    Generic(..)
  , Rep(..) -- TODO: Make opaque?
    -- * Metadata
  , Metadata(..)
  , FieldStrictness(..)
  , recordFieldNames
  , FieldMetadata(..)
    -- * Working with type-level metadata
  , FieldName
  , FieldType
  , IsField
    -- * Re-exports
  , module SOP
  , Proxy(..)
  ) where

import Data.Kind
import Data.Proxy
import GHC.TypeLits

-- To reduce overlap between the two libraries and improve interoperability,
-- we import as much from sop-core as possible.
import Data.SOP.BasicFunctors as SOP
import Data.SOP.Classes       as SOP (type (-.->)(..))
import Data.SOP.Dict          as SOP (Dict(..))

import Data.Record.Generic.Rep.Internal (Rep(..))

import qualified Data.Record.Generic.Rep.Internal as Rep

{-------------------------------------------------------------------------------
  Generic type class
-------------------------------------------------------------------------------}

class Generic a where
  -- | @Constraints a c@ means "all fields of @a@ satisfy @c@"
  type Constraints a :: (Type -> Constraint) -> Constraint

  -- | Type-level metadata
  type MetadataOf a :: [(Symbol, Type)]

  -- | Translate to generic representation
  from :: a -> Rep I a

  -- | Translate from generic representation
  to :: Rep I a -> a

  -- | Construct vector of dictionaries, one for each field of the record
  dict :: Constraints a c => Proxy c -> Rep (Dict c) a

  -- | Metadata
  metadata :: proxy a -> Metadata a

{-------------------------------------------------------------------------------
  Metadata
-------------------------------------------------------------------------------}

data Metadata a = Metadata {
      Metadata a -> String
recordName          :: String
    , Metadata a -> String
recordConstructor   :: String
    , Metadata a -> Int
recordSize          :: Int
    , Metadata a -> Rep FieldMetadata a
recordFieldMetadata :: Rep FieldMetadata a
    }

data FieldStrictness = FieldStrict | FieldLazy

data FieldMetadata x where
  FieldMetadata ::
       KnownSymbol name
    => Proxy name
    -> FieldStrictness
    -> FieldMetadata x

recordFieldNames :: Metadata a -> Rep (K String) a
recordFieldNames :: Metadata a -> Rep (K String) a
recordFieldNames = (forall x. FieldMetadata x -> K String x)
-> Rep FieldMetadata a -> Rep (K String) a
forall (f :: Type -> Type) (g :: Type -> Type) a.
(forall x. f x -> g x) -> Rep f a -> Rep g a
Rep.map' forall x. FieldMetadata x -> K String x
aux (Rep FieldMetadata a -> Rep (K String) a)
-> (Metadata a -> Rep FieldMetadata a)
-> Metadata a
-> Rep (K String) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata a -> Rep FieldMetadata a
forall a. Metadata a -> Rep FieldMetadata a
recordFieldMetadata
  where
    aux :: FieldMetadata x -> K String x
    aux :: FieldMetadata x -> K String x
aux (FieldMetadata Proxy name
p FieldStrictness
_) = String -> K String x
forall k a (b :: k). a -> K a b
K (String -> K String x) -> String -> K String x
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy name
p

{-------------------------------------------------------------------------------
  Working with the type-level metadata
-------------------------------------------------------------------------------}

type family FieldName (field :: (Symbol, Type)) :: Symbol where
  FieldName '(name, _typ) = name

type family FieldType (field :: (Symbol, Type)) :: Type where
  FieldType '(_name, typ) = typ

class (field ~ '(FieldName field, FieldType field)) => IsField field
instance (field ~ '(FieldName field, FieldType field)) => IsField field