{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}

module Rel8.Schema.Context.Label
  ( Labelable( labeler, unlabeler )
  , HLabelable( hlabeler, hunlabeler )
  )
where

-- base
import Data.Kind ( Constraint )
import Prelude hiding ( null )

-- rel8
import Rel8.Schema.Context ( Interpretation )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.Kind ( Context, HContext )
import Rel8.Schema.Spec ( Spec( Spec ) )
import Rel8.Schema.Result ( Col( R ), Result )
import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )


-- | The @Labelable@ class is an internal implementation detail of Rel8, and
-- indicates that we can successfully "name" all columns in a type.
type Labelable :: Context -> Constraint
class Interpretation context => Labelable context where
  labeler :: ()
    => Col context ('Spec labels a)
    -> Col context ('Spec (label ': labels) a)

  unlabeler :: ()
    => Col context ('Spec (label ': labels) a)
    -> Col context ('Spec labels a)


instance Labelable Result where
  labeler :: Col Result ('Spec labels a)
-> Col Result ('Spec (label : labels) a)
labeler (R a) = a -> Col Result ('Spec (label : labels) a)
forall a (labels :: Labels). a -> Col Result ('Spec labels a)
R a
a
  unlabeler :: Col Result ('Spec (label : labels) a)
-> Col Result ('Spec labels a)
unlabeler (R a) = a -> Col Result ('Spec labels a)
forall a (labels :: Labels). a -> Col Result ('Spec labels a)
R a
a


type HLabelable :: HContext -> Constraint
class HLabelable context where
  hlabeler :: ()
    => context ('Spec labels a)
    -> context ('Spec (label ': labels) a)

  hunlabeler :: ()
    => context ('Spec (label ': labels) a)
    -> context ('Spec labels a)


instance Labelable context => HLabelable (Col context) where
  hlabeler :: Col context ('Spec labels a)
-> Col context ('Spec (label : labels) a)
hlabeler = Col context ('Spec labels a)
-> Col context ('Spec (label : labels) a)
forall (context :: Context) (labels :: Labels) a (label :: Symbol).
Labelable context =>
Col context ('Spec labels a)
-> Col context ('Spec (label : labels) a)
labeler
  hunlabeler :: Col context ('Spec (label : labels) a)
-> Col context ('Spec labels a)
hunlabeler = Col context ('Spec (label : labels) a)
-> Col context ('Spec labels a)
forall (context :: Context) (label :: Symbol) (labels :: Labels) a.
Labelable context =>
Col context ('Spec (label : labels) a)
-> Col context ('Spec labels a)
unlabeler


instance HLabelable (Dict (ConstrainDBType constraint)) where
  hlabeler :: Dict (ConstrainDBType constraint) ('Spec labels a)
-> Dict (ConstrainDBType constraint) ('Spec (label : labels) a)
hlabeler Dict (ConstrainDBType constraint) ('Spec labels a)
Dict = Dict (ConstrainDBType constraint) ('Spec (label : labels) a)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
  hunlabeler :: Dict (ConstrainDBType constraint) ('Spec (label : labels) a)
-> Dict (ConstrainDBType constraint) ('Spec labels a)
hunlabeler Dict (ConstrainDBType constraint) ('Spec (label : labels) a)
Dict = Dict (ConstrainDBType constraint) ('Spec labels a)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict