git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Schema/Name.hs
112 lines 3.4 kB history raw
1{-# language DataKinds #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language GeneralizedNewtypeDeriving #-}
6{-# language MultiParamTypeClasses #-}
7{-# language RankNTypes #-}
8{-# language ScopedTypeVariables #-}
9{-# language StandaloneKindSignatures #-}
10{-# language TypeApplications #-}
11{-# language TypeFamilies #-}
12{-# language UndecidableInstances #-}
13{-# language UndecidableSuperClasses #-}
15module Rel8.Schema.Name
16 ( Name(..)
17 , Col( NameCol )
18 , Selects
19 )
20where
22-- base
23import Data.Functor.Identity ( Identity )
24import qualified Data.List.NonEmpty as NonEmpty
25import Data.Kind ( Constraint, Type )
26import Data.String ( IsString )
27import Prelude
29-- rel8
30import Rel8.Expr ( Expr )
31import Rel8.Kind.Labels ( KnownLabels, labelsSing, renderLabels )
32import Rel8.Opaque ( Opaque )
33import Rel8.Schema.Context ( Interpretation, Col )
34import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
35import Rel8.Schema.Context.Nullify
36 ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
37 )
38import Rel8.Schema.HTable.Type ( HType( HType ) )
39import qualified Rel8.Schema.Kind as K
40import Rel8.Schema.Nullability ( Sql )
41import Rel8.Schema.Spec ( Spec( Spec ) )
42import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
43import Rel8.Table.Recontextualize ( Recontextualize )
44import Rel8.Type ( DBType )
47-- | A @Name@ is the name of a column, as it would be defined in a table's
48-- schema definition. You can construct names by using the @OverloadedStrings@
49-- extension and writing string literals. This is typically done when providing
50-- a 'TableSchema' value.
51type Name :: K.Context
52newtype Name a = Name String
53 deriving stock Show
54 deriving newtype (IsString, Monoid, Semigroup)
57instance Sql DBType a => Table Name (Name a) where
58 type Columns (Name a) = HType a
59 type Context (Name a) = Name
61 toColumns (Name a) = HType (NameCol a)
62 fromColumns (HType (NameCol a)) = Name a
65instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)
68instance Sql DBType a => Recontextualize Identity Name (Identity a) (Name a)
71instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)
74instance Sql DBType a => Recontextualize Name Identity (Name a) (Identity a)
77instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)
80instance Interpretation Name where
81 newtype Col Name _spec = NameCol String
84instance Labelable Name where
85 labeler (NameCol a) = NameCol a
86 unlabeler (NameCol a) = NameCol a
89instance Nullifiable Name where
90 encodeTag _ = nameFromLabel
91 decodeTag _ = mempty
92 nullifier _ _ (NameCol name) = NameCol name
93 unnullifier _ _ (NameCol name) = NameCol name
95 {-# INLINABLE encodeTag #-}
96 {-# INLINABLE decodeTag #-}
97 {-# INLINABLE nullifier #-}
98 {-# INLINABLE unnullifier #-}
101nameFromLabel :: forall labels necessity a.
102 KnownLabels labels => Col Name ('Spec labels necessity a)
103nameFromLabel = case labelsSing @labels of
104 labels -> NameCol (NonEmpty.last (renderLabels labels))
107-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
108-- the 'Expr' columns in @b@.
109type Selects :: Type -> Type -> Constraint
110class Recontextualize Name Expr names exprs => Selects names exprs
111instance Recontextualize Name Expr names exprs => Selects names exprs
112instance {-# OVERLAPPING #-} Selects (Opaque Name Opaque) (Opaque Expr Opaque)