Explicit Inserts

This commit is contained in:
Shane O'Brien 2021-06-13 17:24:58 +01:00
parent a9f500eb9e
commit 99d0021032
No known key found for this signature in database
GPG Key ID: 35A00ED1B695C1A1
4 changed files with 26 additions and 33 deletions

View File

@ -251,6 +251,9 @@ module Rel8
, Insert(..) , Insert(..)
, OnConflict(..) , OnConflict(..)
, insert , insert
, Create( Default, Value )
, unValue
, toInsert , toInsert
, toInsertDefaults , toInsertDefaults
@ -327,6 +330,7 @@ import Rel8.Query.These
import Rel8.Query.Values import Rel8.Query.Values
import Rel8.Schema.Context.Label import Rel8.Schema.Context.Label
import Rel8.Schema.HTable import Rel8.Schema.HTable
import Rel8.Schema.Insert
import Rel8.Schema.Name import Rel8.Schema.Name
import Rel8.Schema.Null hiding ( nullable ) import Rel8.Schema.Null hiding ( nullable )
import Rel8.Schema.Result ( Result ) import Rel8.Schema.Result ( Result )

View File

@ -18,11 +18,7 @@ import Prelude
import Rel8.Aggregate ( Aggregate, Col( A ) ) import Rel8.Aggregate ( Aggregate, Col( A ) )
import Rel8.Expr ( Expr, Col( E ) ) import Rel8.Expr ( Expr, Col( E ) )
import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) ) import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
import Rel8.Kind.Necessity import Rel8.Kind.Necessity ( Necessity, KnownNecessity )
( Necessity( Required, Optional )
, SNecessity( SRequired, SOptional )
, KnownNecessity, necessitySing
)
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) ) import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import Rel8.Schema.Insert ( Col( I ), Create(..), Insert ) import Rel8.Schema.Insert ( Col( I ), Create(..), Insert )
import qualified Rel8.Schema.Kind as K import qualified Rel8.Schema.Kind as K
@ -44,8 +40,7 @@ type family Field context necessity a where
Field (Reify context) necessity a = AField context necessity a Field (Reify context) necessity a = AField context necessity a
Field Aggregate _necessity a = Aggregate a Field Aggregate _necessity a = Aggregate a
Field Expr _necessity a = Expr a Field Expr _necessity a = Expr a
Field Insert 'Required a = Expr a Field Insert necessity a = Create necessity a
Field Insert 'Optional a = Maybe (Expr a)
Field Name _necessity a = Name a Field Name _necessity a = Name a
Field Result _necessity a = a Field Result _necessity a = a
@ -61,8 +56,8 @@ instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>
type Columns (AField context necessity a) = HIdentity ('Spec '[] necessity a) type Columns (AField context necessity a) = HIdentity ('Spec '[] necessity a)
type Unreify (AField context necessity a) = Field context necessity a type Unreify (AField context necessity a) = Field context necessity a
fromColumns (HIdentity (Reify a)) = sfromColumn contextSing necessitySing a fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
toColumns = HIdentity . Reify . stoColumn contextSing necessitySing toColumns = HIdentity . Reify . stoColumn contextSing
reify _ = AField reify _ = AField
unreify _ (AField a) = a unreify _ (AField a) = a
@ -80,36 +75,25 @@ instance
sfromColumn :: () sfromColumn :: ()
=> SContext context => SContext context
-> SNecessity necessity
-> Col context ('Spec labels necessity a) -> Col context ('Spec labels necessity a)
-> AField context necessity a -> AField context necessity a
sfromColumn = \case sfromColumn = \case
SAggregate -> \_ (A a) -> AField a SAggregate -> \(A a) -> AField a
SExpr -> \_ (E a) -> AField a SExpr -> \(E a) -> AField a
SInsert -> \case SInsert -> \(I a) -> AField a
SRequired -> \case SName -> \(N a) -> AField a
I (Value a) -> AField a SResult -> \(R a) -> AField a
SOptional -> \case SReify context -> \(Reify a) -> AField (sfromColumn context a)
I Default -> AField Nothing
I (Value a) -> AField (Just a)
SName -> \_ (N a) -> AField a
SResult -> \_ (R a) -> AField a
SReify context ->
\necessity (Reify a) -> AField (sfromColumn context necessity a)
stoColumn :: () stoColumn :: ()
=> SContext context => SContext context
-> SNecessity necessity
-> AField context necessity a -> AField context necessity a
-> Col context ('Spec labels necessity a) -> Col context ('Spec labels necessity a)
stoColumn = \case stoColumn = \case
SAggregate -> \_ (AField a) -> A a SAggregate -> \(AField a) -> A a
SExpr -> \_ (AField a) -> E a SExpr -> \(AField a) -> E a
SInsert -> \case SInsert -> \(AField a) -> I a
SRequired -> \(AField a) -> I (Value a) SName -> \(AField a) -> N a
SOptional -> \(AField ma) -> I $ maybe Default Value ma SResult -> \(AField a) -> R a
SName -> \_ (AField a) -> N a SReify context -> \(AField a) -> Reify (stoColumn context a)
SResult -> \_ (AField a) -> R a
SReify context ->
\necessity (AField a) -> Reify (stoColumn context necessity a)

View File

@ -151,7 +151,7 @@ data TableSum f
data TableProduct f = TableProduct data TableProduct f = TableProduct
{ sum :: HADT f TableSum { sum :: HADT f TableSum
, list :: TableList f , list :: TableList f
, foos :: HList f (HADT f TableSum, Lift f HKDSum, HKDTest f) , foos :: HList f (HADT f TableSum, Lift f HKDSum, HKDTest f, Column f Bool)
} }
deriving stock Generic deriving stock Generic
deriving anyclass Rel8able deriving anyclass Rel8able

View File

@ -18,6 +18,7 @@ module Rel8.Schema.Insert
, Col( I, unI ) , Col( I, unI )
, Inserts , Inserts
, Create(..) , Create(..)
, unValue
) )
where where
@ -88,6 +89,10 @@ data Create necessity a where
Value :: Expr a -> Create necessity a Value :: Expr a -> Create necessity a
unValue :: Create 'Required a -> Expr a
unValue (Value a) = a
instance (KnownNecessity necessity, Sql DBType a) => instance (KnownNecessity necessity, Sql DBType a) =>
Table Insert (Create necessity a) Table Insert (Create necessity a)
where where