{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Schema.Name
  ( Name(..)
  , Selects
  , ppColumn
  )
where

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

-- opaleye
import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye

-- pretty
import Text.PrettyPrint ( Doc )

-- rel8
import Rel8.Expr ( Expr )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import Rel8.Schema.Null ( Sql )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  , FromExprs, fromResult, toResult
  , Transpose
  )
import Rel8.Table.Transpose ( Transposes )
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.Context
newtype Name a = Name String
  deriving stock Int -> Name a -> ShowS
[Name a] -> ShowS
Name a -> String
(Int -> Name a -> ShowS)
-> (Name a -> String) -> ([Name a] -> ShowS) -> Show (Name a)
forall a. Int -> Name a -> ShowS
forall a. [Name a] -> ShowS
forall a. Name a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name a] -> ShowS
$cshowList :: forall a. [Name a] -> ShowS
show :: Name a -> String
$cshow :: forall a. Name a -> String
showsPrec :: Int -> Name a -> ShowS
$cshowsPrec :: forall a. Int -> Name a -> ShowS
Show
  deriving newtype String -> Name a
(String -> Name a) -> IsString (Name a)
forall a. String -> Name a
forall a. (String -> a) -> IsString a
fromString :: String -> Name a
$cfromString :: forall a. String -> Name a
IsString


instance Sql DBType a => Table Name (Name a) where
  type Columns (Name a) = HIdentity a
  type Context (Name a) = Name
  type FromExprs (Name a) = a
  type Transpose to (Name a) = to a

  toColumns :: Name a -> Columns (Name a) Name
toColumns Name a
a = Name a -> HIdentity a Name
forall a (context :: Context). context a -> HIdentity a context
HIdentity Name a
a
  fromColumns :: Columns (Name a) Name -> Name a
fromColumns (HIdentity a) = Name a
a
  toResult :: FromExprs (Name a) -> Columns (Name a) Result
toResult FromExprs (Name a)
a = Identity a -> HIdentity a Result
forall a (context :: Context). context a -> HIdentity a context
HIdentity (a -> Identity a
forall a. a -> Identity a
Identity a
FromExprs (Name a)
a)
  fromResult :: Columns (Name a) Result -> FromExprs (Name a)
fromResult (HIdentity (Identity a)) = a
FromExprs (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 Transposes Name Expr names exprs => Selects names exprs
instance Transposes Name Expr names exprs => Selects names exprs


ppColumn :: String -> Doc
ppColumn :: String -> Doc
ppColumn = SqlExpr -> Doc
Opaleye.ppSqlExpr (SqlExpr -> Doc) -> (String -> SqlExpr) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlColumn -> SqlExpr
Opaleye.ColumnSqlExpr (SqlColumn -> SqlExpr)
-> (String -> SqlColumn) -> String -> SqlExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SqlColumn
Opaleye.SqlColumn