{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language StandaloneDeriving #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language UndecidableSuperClasses #-}

module Rel8.Schema.Name
  ( Name(..)
  , Col( N, unN )
  , Selects
  )
where

-- base
import Data.Functor.Identity ( Identity )
import Data.Kind ( Constraint, Type )
import Data.String ( IsString, fromString )
import Prelude

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Schema.Context ( Interpretation, Col )
import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
import Rel8.Schema.Null ( Sql )
import Rel8.Schema.Reify ( notReify )
import Rel8.Schema.Result ( Result )
import Rel8.Schema.Spec ( Spec( Spec ) )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns, reify, unreify
  )
import Rel8.Table.Recontextualize ( Recontextualize )
import Rel8.Type ( DBType )


-- | A @Name@ is the name of a column, as it would be defined in a table's
-- schema definition. You can construct names by using the @OverloadedStrings@
-- extension and writing string literals. This is typically done when providing
-- a 'TableSchema' value.
type Name :: k -> Type
data Name a where
  Name :: k ~ Type => !String -> Name (a :: k)


deriving stock instance Show (Name a)


instance k ~ Type => IsString (Name (a :: k)) where
  fromString :: String -> Name a
fromString = String -> Name a
forall k (a :: k). (k ~ *) => String -> Name a
Name


instance Sql DBType a => Table Name (Name a) where
  type Columns (Name a) = HType a
  type Context (Name a) = Name

  toColumns :: Name a -> Columns (Name a) (Col Name)
toColumns Name a
a = Col Name ('Spec '[] 'Required a) -> HType a (Col Name)
forall (context :: Spec -> *) a.
context ('Spec '[] 'Required a) -> HType a context
HType (Name a -> Col Name ('Spec '[] 'Required a)
forall a (labels :: Labels) (necessity :: Necessity).
Name a -> Col Name ('Spec labels necessity a)
N Name a
a)
  fromColumns :: Columns (Name a) (Col Name) -> Name a
fromColumns (HType (N a)) = Name a
Name a
a
  reify :: (Name :~: Reify ctx) -> Unreify (Name a) -> Name a
reify = (Name :~: Reify ctx) -> Unreify (Name a) -> Name a
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify
  unreify :: (Name :~: Reify ctx) -> Name a -> Unreify (Name a)
unreify = (Name :~: Reify ctx) -> Name a -> Unreify (Name a)
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify


instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)


instance Sql DBType a => Recontextualize Result Name (Identity a) (Name a)


instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)


instance Sql DBType a => Recontextualize Name Result (Name a) (Identity a)


instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)


instance Interpretation Name where
  data Col Name _spec where
    N :: {Col Name ('Spec labels necessity a) -> Name a
unN :: !(Name a)} -> Col Name ('Spec labels necessity a)


instance Labelable Name where
  labeler :: Col Name ('Spec labels necessity a)
-> Col Name ('Spec (label : labels) necessity a)
labeler (N a) = Name a -> Col Name ('Spec (label : labels) necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Name a -> Col Name ('Spec labels necessity a)
N Name a
a
  unlabeler :: Col Name ('Spec (label : labels) necessity a)
-> Col Name ('Spec labels necessity a)
unlabeler (N a) = Name a -> Col Name ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Name a -> Col Name ('Spec labels necessity a)
N Name a
a


-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
-- the 'Expr' columns in @b@.
type Selects :: Type -> Type -> Constraint
class Recontextualize Name Expr names exprs => Selects names exprs
instance Recontextualize Name Expr names exprs => Selects names exprs