Use Write as context for both Inserts and Updates (replaces Create and Insert context)

rel8.cabal

@@ -121,7 +121,6 @@ library
     Rel8.Schema.HTable.Product
     Rel8.Schema.HTable.These
     Rel8.Schema.HTable.Vectorize
-    Rel8.Schema.Insert
     Rel8.Schema.Kind
     Rel8.Schema.Name
     Rel8.Schema.Null
@@ -131,6 +130,7 @@ library
     Rel8.Schema.Spec.ConstrainDBType
     Rel8.Schema.Spec.ConstrainType
     Rel8.Schema.Table
+    Rel8.Schema.Write
 
     Rel8.Statement.Delete
     Rel8.Statement.Insert
@@ -147,7 +147,6 @@ library
     Rel8.Table.Either
     Rel8.Table.Eq
     Rel8.Table.HKD
-    Rel8.Table.Insert
     Rel8.Table.List
     Rel8.Table.Maybe
     Rel8.Table.Name
@@ -162,6 +161,7 @@ library
     Rel8.Table.These
     Rel8.Table.Undefined
     Rel8.Table.Unreify
+    Rel8.Table.Write
 
     Rel8.Type
     Rel8.Type.Array

src/Rel8.hs

@@ -59,7 +59,7 @@ module Rel8
   , catMaybeTable
   , bindMaybeTable
   , traverseMaybeTable
-  , insertMaybeTable
+  , writeMaybeTable
   , nameMaybeTable
 
     -- ** @EitherTable@
@@ -70,7 +70,7 @@ module Rel8
   , keepRightTable
   , bindEitherTable
   , bitraverseEitherTable
-  , insertEitherTable
+  , writeEitherTable
   , nameEitherTable
 
     -- ** @TheseTable@
@@ -87,13 +87,13 @@ module Rel8
   , keepThoseTable, loseThoseTable
   , bindTheseTable
   , bitraverseTheseTable
-  , insertTheseTable
+  , writeTheseTable
   , nameTheseTable
 
     -- ** @ListTable@
   , ListTable
   , listTable
-  , insertListTable
+  , writeListTable
   , nameListTable
   , many
   , manyExpr
@@ -103,7 +103,7 @@ module Rel8
     -- ** @NonEmptyTable@
   , NonEmptyTable
   , nonEmptyTable
-  , insertNonEmptyTable
+  , writeNonEmptyTable
   , nameNonEmptyTable
   , some
   , someExpr
@@ -115,7 +115,7 @@ module Rel8
   , BuildADT, buildADT
   , ConstructADT, constructADT
   , DeconstructADT, deconstructADT
-  , InsertADT, insertADT
+  , WriteADT, writeADT
   , NameADT, nameADT
   , AggregateADT, aggregateADT
 
@@ -124,7 +124,7 @@ module Rel8
   , BuildHKD, buildHKD
   , ConstructHKD, constructHKD
   , DeconstructHKD, deconstructHKD
-  , InsertHKD, insertHKD
+  , WriteHKD, writeHKD
   , NameHKD, nameHKD
   , AggregateHKD, aggregateHKD
 
@@ -252,11 +252,6 @@ module Rel8
   , OnConflict(..)
   , insert
 
-  , Create( Default, Value )
-  , unValue
-  , toInsert
-  , toInsertDefaults
-
     -- ** @DELETE@
   , Delete(..)
   , delete
@@ -271,10 +266,23 @@ module Rel8
     -- ** @CREATE VIEW@
   , createView
 
+    -- ** Write
+  , Writable( Default, Value )
+  , Write
+  , Writes
+  , defaultValue
+  , override
+  , write
+  , reset
+
+  , fromWrite
+  , unwrite
+
     -- * TODO
     -- TODO
     -- These need organizing, but are reachable from Rel8's documentation so we
     -- do need to export and document them.
+  , Recontextualize
   , Nullable
   , NotNull
   , HTable
@@ -330,11 +338,11 @@ import Rel8.Query.These
 import Rel8.Query.Values
 import Rel8.Schema.Context.Label
 import Rel8.Schema.HTable
-import Rel8.Schema.Insert
 import Rel8.Schema.Name
 import Rel8.Schema.Null hiding ( nullable )
 import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Table
+import Rel8.Schema.Write
 import Rel8.Statement.Delete
 import Rel8.Statement.Insert
 import Rel8.Statement.Returning
@@ -349,16 +357,17 @@ import Rel8.Table.Bool
 import Rel8.Table.Either
 import Rel8.Table.Eq
 import Rel8.Table.HKD
-import Rel8.Table.Insert
 import Rel8.Table.List
 import Rel8.Table.Maybe
 import Rel8.Table.Name
 import Rel8.Table.NonEmpty
 import Rel8.Table.Ord
 import Rel8.Table.Order
+import Rel8.Table.Recontextualize
 import Rel8.Table.Rel8able ()
 import Rel8.Table.Serialize
 import Rel8.Table.These
+import Rel8.Table.Write
 import Rel8.Type
 import Rel8.Type.Composite
 import Rel8.Type.Eq

src/Rel8/Column/ADT.hs

@@ -71,9 +71,9 @@ sfromColumnsADT :: ADTable t
 sfromColumnsADT = \case
   SAggregate -> AHADT . ADT . hunreify
   SExpr -> AHADT . ADT . hunreify
-  SInsert -> AHADT . ADT . hunreify
   SName -> AHADT . ADT . hunreify
   SResult -> AHADT . fromADT . ADT . hunreify
+  SWrite -> AHADT . ADT . hunreify
   SReify context -> AHADT . sfromColumnsADT context . hunreify
 
 
@@ -84,7 +84,7 @@ stoColumnsADT :: ADTable t
 stoColumnsADT = \case
   SAggregate -> hreify . (\(AHADT (ADT a)) -> a)
   SExpr -> hreify . (\(AHADT (ADT a)) -> a)
-  SInsert -> hreify . (\(AHADT (ADT a)) -> a)
   SName -> hreify . (\(AHADT (ADT a)) -> a)
   SResult -> hreify . (\(ADT a) -> a) . toADT . (\(AHADT a) -> a)
+  SWrite -> hreify . (\(AHADT (ADT a)) -> a)
   SReify context -> hreify . stoColumnsADT context . (\(AHADT a) -> a)

src/Rel8/Column/Either.hs

@@ -23,11 +23,11 @@ import Rel8.Expr ( Expr )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
 import Rel8.Schema.Context ( Col )
 import Rel8.Schema.HTable.Either ( HEitherTable )
-import Rel8.Schema.Insert ( Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name(..) )
 import Rel8.Schema.Reify ( Reify, hreify, hunreify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , Unreify, reify, unreify
@@ -41,7 +41,7 @@ type family HEither context where
   HEither (Reify context) = AHEither context
   HEither Aggregate = EitherTable
   HEither Expr = EitherTable
-  HEither Insert = EitherTable
+  HEither Write = EitherTable
   HEither Name = EitherTable
   HEither Result = Either
 
@@ -92,9 +92,9 @@ sbimapEither :: ()
 sbimapEither = \case
   SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)
   SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)
-  SResult -> \f g (AHEither a) -> AHEither (bimap f g a)
-  SInsert -> \f g (AHEither a) -> AHEither (bimap f g a)
   SName -> \f g (AHEither a) -> AHEither (bimap f g a)
+  SResult -> \f g (AHEither a) -> AHEither (bimap f g a)
+  SWrite -> \f g (AHEither a) -> AHEither (bimap f g a)
   SReify context -> \f g (AHEither a) -> AHEither (sbimapEither context f g a)
 
 
@@ -113,17 +113,17 @@ sfromColumnsEither = \case
     bimap (fromColumns . hreify) (fromColumns . hreify) .
     fromColumns .
     hunreify
+  SName ->
+    AHEither .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
   SResult ->
     AHEither .
     bimap (fromColumns . hreify) (fromColumns . hreify) .
     fromColumns .
     hunreify
-  SInsert ->
+  SWrite ->
-    AHEither .
-    bimap (fromColumns . hreify) (fromColumns . hreify) .
-    fromColumns .
-    hunreify
-  SName ->
     AHEither .
     bimap (fromColumns . hreify) (fromColumns . hreify) .
     fromColumns .
@@ -150,17 +150,17 @@ stoColumnsEither = \case
     toColumns .
     bimap (hunreify . toColumns) (hunreify . toColumns) .
     (\(AHEither a) -> a)
+  SName ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHEither a) -> a)
   SResult ->
     hreify .
     toColumns .
     bimap (hunreify . toColumns) (hunreify . toColumns) .
     (\(AHEither a) -> a)
-  SInsert ->
+  SWrite ->
-    hreify .
-    toColumns .
-    bimap (hunreify . toColumns) (hunreify . toColumns) .
-    (\(AHEither a) -> a)
-  SName ->
     hreify .
     toColumns .
     bimap (hunreify . toColumns) (hunreify . toColumns) .

src/Rel8/Column/Field.hs

@@ -20,13 +20,13 @@ import Rel8.Expr ( Expr, Col( E ) )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
 import Rel8.Kind.Defaulting ( Defaulting, KnownDefaulting )
 import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
-import Rel8.Schema.Insert ( Col( I ), Create(..), Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name(..), Col( N ) )
 import Rel8.Schema.Null ( Sql )
 import Rel8.Schema.Reify ( Reify, Col(..) )
 import Rel8.Schema.Result ( Col( R ), Result )
 import Rel8.Schema.Spec ( Spec( Spec ) )
+import Rel8.Schema.Write ( Col( W ), Write, Writable(..) )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , Unreify, reify, unreify
@@ -40,7 +40,7 @@ type family Field context defaulting a where
   Field (Reify context) defaulting  a = AField context defaulting a
   Field Aggregate       _defaulting a = Aggregate a
   Field Expr            _defaulting a = Expr a
-  Field Insert          defaulting  a = Create defaulting a
+  Field Write           defaulting  a = Writable defaulting a
   Field Name            _defaulting a = Name a
   Field Result          _defaulting a = a
 
@@ -80,9 +80,9 @@ sfromColumn :: ()
 sfromColumn = \case
   SAggregate -> \(A a) -> AField a
   SExpr -> \(E a) -> AField a
-  SInsert -> \(I a) -> AField a
   SName -> \(N a) -> AField a
   SResult -> \(R a) -> AField a
+  SWrite -> \(W a) -> AField a
   SReify context -> \(Reify a) -> AField (sfromColumn context a)
 
 
@@ -93,7 +93,7 @@ stoColumn :: ()
 stoColumn = \case
   SAggregate -> \(AField a) -> A a
   SExpr -> \(AField a) -> E a
-  SInsert -> \(AField a) -> I a
   SName -> \(AField a) -> N a
   SResult -> \(AField a) -> R a
+  SWrite -> \(AField a) -> W a
   SReify context -> \(AField a) -> Reify (stoColumn context a)

src/Rel8/Column/Lift.hs

@@ -70,9 +70,9 @@ sfromColumnsLift :: HKDable a
 sfromColumnsLift = \case
   SAggregate -> ALift . fromColumns . hunreify
   SExpr -> ALift . fromColumns . hunreify
-  SInsert -> ALift . fromColumns . hunreify
   SName -> ALift . fromColumns . hunreify
   SResult -> ALift . fromHKD . HKD . hunreify
+  SWrite -> ALift . fromColumns . hunreify
   SReify context -> ALift . sfromColumnsLift context . hunreify
 
 
@@ -83,7 +83,7 @@ stoColumnsLift :: HKDable a
 stoColumnsLift = \case
   SAggregate -> hreify . toColumns . unALift
   SExpr -> hreify . toColumns . unALift
-  SInsert -> hreify . toColumns . unALift
   SName -> hreify . toColumns . unALift
   SResult -> hreify . (\(HKD a) -> a) . toHKD . unALift
+  SWrite -> hreify . toColumns . unALift
   SReify context -> hreify . stoColumnsLift context . unALift

src/Rel8/Column/List.hs

@@ -22,11 +22,11 @@ import Rel8.Expr ( Expr )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
 import Rel8.Schema.Context ( Col )
 import Rel8.Schema.HTable.List ( HListTable )
-import Rel8.Schema.Insert ( Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Reify, hreify, hunreify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table
   ( Table, Columns, Congruent, Context, fromColumns, toColumns
   , Unreify, reify, unreify
@@ -41,7 +41,7 @@ type family HList context where
   HList (Reify context) = AHList context
   HList Aggregate = ListTable
   HList Expr = ListTable
-  HList Insert = ListTable
+  HList Write = ListTable
   HList Name = ListTable
   HList Result = []
 
@@ -85,9 +85,9 @@ smapList :: Congruent a b
 smapList = \case
   SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
   SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
-  SResult -> \f _ (AHList as) -> AHList (fmap f as)
-  SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
   SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
+  SResult -> \f _ (AHList as) -> AHList (fmap f as)
+  SWrite -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
   SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
 
 
@@ -98,9 +98,9 @@ sfromColumnsList :: Table (Reify context) a
 sfromColumnsList = \case
   SAggregate -> AHList . ListTable
   SExpr -> AHList . ListTable
-  SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
-  SInsert -> AHList . ListTable
   SName -> AHList . ListTable
+  SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SWrite -> AHList . ListTable
   SReify context ->
     AHList .
     smapList context (fromColumns . hreify) hreify .
@@ -115,10 +115,10 @@ stoColumnsList :: Table (Reify context) a
 stoColumnsList = \case
   SAggregate -> \(AHList (ListTable a)) -> a
   SExpr -> \(AHList (ListTable a)) -> a
+  SName -> \(AHList (ListTable a)) -> a
   SResult ->
     hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
-  SInsert -> \(AHList (ListTable a)) -> a
+  SWrite -> \(AHList (ListTable a)) -> a
-  SName -> \(AHList (ListTable a)) -> a
   SReify context ->
     hreify .
     stoColumnsList context .

src/Rel8/Column/Maybe.hs

@@ -22,11 +22,11 @@ import Rel8.Expr ( Expr )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
 import Rel8.Schema.Context ( Col )
 import Rel8.Schema.HTable.Maybe ( HMaybeTable )
-import Rel8.Schema.Insert ( Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Reify, hreify, hunreify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , Unreify, reify, unreify
@@ -40,9 +40,9 @@ type family HMaybe context where
   HMaybe (Reify context) = AHMaybe context
   HMaybe Aggregate = MaybeTable
   HMaybe Expr = MaybeTable
-  HMaybe Insert = MaybeTable
   HMaybe Name = MaybeTable
   HMaybe Result = Maybe
+  HMaybe Write = MaybeTable
 
 
 type AHMaybe :: K.Context -> Type -> Type
@@ -85,9 +85,9 @@ smapMaybe :: ()
 smapMaybe = \case
   SAggregate -> \f (AHMaybe a) -> AHMaybe (fmap f a)
   SExpr -> \f (AHMaybe a) -> AHMaybe (fmap f a)
-  SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)
-  SInsert -> \f (AHMaybe a) -> AHMaybe (fmap f a)
   SName -> \f (AHMaybe a) -> AHMaybe (fmap f a)
+  SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)
+  SWrite -> \f (AHMaybe a) -> AHMaybe (fmap f a)
   SReify context -> \f (AHMaybe a) -> AHMaybe (smapMaybe context f a)
 
 
@@ -98,9 +98,9 @@ sfromColumnsMaybe :: Table (Reify context) a
 sfromColumnsMaybe = \case
   SAggregate -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
   SExpr -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
-  SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
-  SInsert -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
   SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SWrite -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
   SReify context ->
     AHMaybe .
     smapMaybe context (fromColumns . hreify) .
@@ -117,11 +117,11 @@ stoColumnsMaybe = \case
     hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
   SExpr ->
     hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
+  SName ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
   SResult ->
     hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
-  SInsert ->
+  SWrite ->
-    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
-  SName ->
     hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
   SReify context ->
     hreify .

src/Rel8/Column/NonEmpty.hs

@@ -23,11 +23,11 @@ import Rel8.Expr ( Expr )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
 import Rel8.Schema.Context ( Col )
 import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
-import Rel8.Schema.Insert ( Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Reify, hreify, hunreify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table
   ( Table, Columns, Congruent, Context, fromColumns, toColumns
   , Unreify, reify, unreify
@@ -42,9 +42,9 @@ type family HNonEmpty context where
   HNonEmpty (Reify context) = AHNonEmpty context
   HNonEmpty Aggregate = NonEmptyTable
   HNonEmpty Expr = NonEmptyTable
-  HNonEmpty Insert = NonEmptyTable
   HNonEmpty Name = NonEmptyTable
   HNonEmpty Result = NonEmpty
+  HNonEmpty Write = NonEmptyTable
 
 
 type AHNonEmpty :: K.Context -> Type -> Type
@@ -86,9 +86,9 @@ smapNonEmpty :: Congruent a b
 smapNonEmpty = \case
   SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
   SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
-  SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
-  SInsert -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
   SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
+  SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
+  SWrite -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
   SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)
 
 
@@ -99,10 +99,10 @@ sfromColumnsNonEmpty :: Table (Reify context) a
 sfromColumnsNonEmpty = \case
   SAggregate -> AHNonEmpty . NonEmptyTable
   SExpr -> AHNonEmpty . NonEmptyTable
+  SName -> AHNonEmpty . NonEmptyTable
   SResult ->
     AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify
-  SInsert -> AHNonEmpty . NonEmptyTable
+  SWrite -> AHNonEmpty . NonEmptyTable
-  SName -> AHNonEmpty . NonEmptyTable
   SReify context ->
     AHNonEmpty .
     smapNonEmpty context (fromColumns . hreify) hreify .
@@ -117,10 +117,10 @@ stoColumnsNonEmpty :: Table (Reify context) a
 stoColumnsNonEmpty = \case
   SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
   SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
+  SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
   SResult ->
     hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
-  SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a
+  SWrite -> \(AHNonEmpty (NonEmptyTable a)) -> a
-  SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
   SReify context ->
     hreify .
     stoColumnsNonEmpty context .

src/Rel8/Column/These.hs

@@ -24,11 +24,11 @@ import Rel8.Expr ( Expr )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
 import Rel8.Schema.Context ( Col )
 import Rel8.Schema.HTable.These ( HTheseTable )
-import Rel8.Schema.Insert ( Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Reify, hreify, hunreify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , Unreify, reify, unreify
@@ -45,7 +45,7 @@ type family HThese context where
   HThese (Reify context) = AHThese context
   HThese Aggregate = TheseTable
   HThese Expr = TheseTable
-  HThese Insert = TheseTable
+  HThese Write = TheseTable
   HThese Name = TheseTable
   HThese Result = These
 
@@ -97,7 +97,7 @@ sbimapThese = \case
   SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)
   SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)
   SResult -> \f g (AHThese a) -> AHThese (bimap f g a)
-  SInsert -> \f g (AHThese a) -> AHThese (bimap f g a)
+  SWrite -> \f g (AHThese a) -> AHThese (bimap f g a)
   SName -> \f g (AHThese a) -> AHThese (bimap f g a)
   SReify context -> \f g (AHThese a) -> AHThese (sbimapThese context f g a)
 
@@ -117,17 +117,17 @@ sfromColumnsThese = \case
     bimap (fromColumns . hreify) (fromColumns . hreify) .
     fromColumns .
     hunreify
+  SName ->
+    AHThese .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
   SResult ->
     AHThese .
     bimap (fromColumns . hreify) (fromColumns . hreify) .
     fromColumns .
     hunreify
-  SInsert ->
+  SWrite ->
-    AHThese .
-    bimap (fromColumns . hreify) (fromColumns . hreify) .
-    fromColumns .
-    hunreify
-  SName ->
     AHThese .
     bimap (fromColumns . hreify) (fromColumns . hreify) .
     fromColumns .
@@ -154,17 +154,17 @@ stoColumnsThese = \case
     toColumns .
     bimap (hunreify . toColumns) (hunreify . toColumns) .
     (\(AHThese a) -> a)
+  SName ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHThese a) -> a)
   SResult ->
     hreify .
     toColumns .
     bimap (hunreify . toColumns) (hunreify . toColumns) .
     (\(AHThese a) -> a)
-  SInsert ->
+  SWrite ->
-    hreify .
-    toColumns .
-    bimap (hunreify . toColumns) (hunreify . toColumns) .
-    (\(AHThese a) -> a)
-  SName ->
     hreify .
     toColumns .
     bimap (hunreify . toColumns) (hunreify . toColumns) .

src/Rel8/Expr.hs

@@ -106,7 +106,7 @@ instance Sql DBFractional a => Fractional (Expr a) where
 
 
 instance Sql DBFloating a => Floating (Expr a) where
-  pi = nullaryFunction "PI"
+  pi = nullaryFunction "pi"
   exp = function "exp"
   log = function "ln"
   sqrt = function "sqrt"

src/Rel8/Generic/Construction.hs

@@ -16,7 +16,7 @@
 module Rel8.Generic.Construction
   ( GGBuildable
   , GGBuild, ggbuild
-  , GGInsert, gginsert
+  , GGWrite, ggwrite
   , GGConstructable
   , GGConstruct, ggconstruct
   , GGDeconstruct, ggdeconstruct
@@ -63,13 +63,13 @@ import qualified Rel8.Kind.Algebra as K
 import Rel8.Schema.Context.Nullify ( runTag )
 import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
-import Rel8.Schema.Insert ( Col( I ), Create(..), Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Col( N ), Name( Name ) )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
 import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
 import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Col( W ), Write, Writable(..) )
 import Rel8.Table
   ( TTable, TColumns, TUnreify
   , Table, fromColumns, toColumns, reify, unreify
@@ -83,7 +83,7 @@ type GGBuildable algebra name rep =
   ( KnownAlgebra algebra
   , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
   , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
-  , Eval (GGColumns algebra TColumns (Eval (rep (Reify Insert)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
+  , Eval (GGColumns algebra TColumns (Eval (rep (Reify Write)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
   , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
   , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))
   , GGBuildable' algebra name rep
@@ -94,17 +94,17 @@ type GGBuildable' :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) ->
 type family GGBuildable' algebra name rep where
   GGBuildable' 'K.Product name rep =
     ( name ~ GConstructor (Eval (rep (Reify Expr)))
-    , name ~ GConstructor (Eval (rep (Reify Insert)))
+    , name ~ GConstructor (Eval (rep (Reify Write)))
     , Representable TUnreify (Eval (rep (Reify Expr)))
-    , Representable TUnreify (Eval (rep (Reify Insert)))
+    , Representable TUnreify (Eval (rep (Reify Write)))
     , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))
-    , GConstructable (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))
+    , GConstructable (TTable (Reify Write)) TColumns TUnreify (Col (Reify Write)) (Eval (rep (Reify Write)))
     )
   GGBuildable' 'K.Sum name rep =
     ( Representable TUnreify (GConstructorADT name (Eval (rep (Reify Expr))))
-    , Representable TUnreify (GConstructorADT name (Eval (rep (Reify Insert))))
+    , Representable TUnreify (GConstructorADT name (Eval (rep (Reify Write))))
     , GMakeableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) name (Eval (rep (Reify Expr)))
-    , GMakeableADT (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) name (Eval (rep (Reify Insert)))
+    , GMakeableADT (TTable (Reify Write)) TColumns TUnreify (Col (Reify Write)) name (Eval (rep (Reify Write)))
     )
 
 
@@ -150,48 +150,48 @@ ggbuild gfromColumns = case algebraSing @algebra of
       (HType . Reify . E . litExpr)
 
 
-type GGInsert :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
+type GGWrite :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
-type family GGInsert algebra name rep r where
+type family GGWrite algebra name rep r where
-  GGInsert 'K.Product _name rep r =
+  GGWrite 'K.Product _name rep r =
-    GConstruct TUnreify (Eval (rep (Reify Insert))) r
+    GConstruct TUnreify (Eval (rep (Reify Write))) r
-  GGInsert 'K.Sum name rep r =
+  GGWrite 'K.Sum name rep r =
-    GConstruct TUnreify (GConstructorADT name (Eval (rep (Reify Insert)))) r
+    GConstruct TUnreify (GConstructorADT name (Eval (rep (Reify Write)))) r
 
 
-gginsert :: forall algebra name rep a. GGBuildable algebra name rep
+ggwrite :: forall algebra name rep a. GGBuildable algebra name rep
-  => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Insert) -> a)
+  => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Write) -> a)
-  -> GGInsert algebra name rep a
+  -> GGWrite algebra name rep a
-gginsert gfromColumns = case algebraSing @algebra of
+ggwrite gfromColumns = case algebraSing @algebra of
   SProduct ->
-    gtabulate @TUnreify @(Eval (rep (Reify Insert))) @a $
+    gtabulate @TUnreify @(Eval (rep (Reify Write))) @a $
     gfromColumns .
     hunreify .
     gconstruct
-      @(TTable (Reify Insert))
+      @(TTable (Reify Write))
       @TColumns
       @TUnreify
-      @(Col (Reify Insert))
+      @(Col (Reify Write))
-      @(Eval (rep (Reify Insert)))
+      @(Eval (rep (Reify Write)))
       (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
   SSum ->
-    gtabulate @TUnreify @(GConstructorADT name (Eval (rep (Reify Insert)))) @a $
+    gtabulate @TUnreify @(GConstructorADT name (Eval (rep (Reify Write)))) @a $
     gfromColumns .
     hunreify .
     gmakeADT
-      @(TTable (Reify Insert))
+      @(TTable (Reify Write))
       @TColumns
       @TUnreify
-      @(Col (Reify Insert))
+      @(Col (Reify Write))
       @name
-      @(Eval (rep (Reify Insert)))
+      @(Eval (rep (Reify Write)))
       (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
-      (\SSpec {info} -> Reify $ I (Value (snull info)))
+      (\SSpec {info} -> Reify $ W (Value (snull info)))
       (\SSpec {nullity} -> case nullity of
         Null -> id
         NotNull -> \case
-          Reify (I Default) -> Reify (I Default)
+          Reify (W Default) -> Reify (W Default)
-          Reify (I (Value a)) -> Reify (I (Value (nullify a))))
+          Reify (W (Value a)) -> Reify (W (Value (nullify a))))
-      (HType . Reify . I . Value . litExpr)
+      (HType . Reify . W . Value . litExpr)
 
 
 type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
@@ -199,7 +199,7 @@ type GGConstructable algebra rep =
   ( KnownAlgebra algebra
   , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
   , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
-  , Eval (GGColumns algebra TColumns (Eval (rep (Reify Insert)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
+  , Eval (GGColumns algebra TColumns (Eval (rep (Reify Write)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
   , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
   , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))
   , GGConstructable' algebra rep
@@ -211,24 +211,24 @@ type family GGConstructable' algebra rep where
   GGConstructable' 'K.Product rep =
     ( Representable TUnreify (Eval (rep (Reify Aggregate)))
     , Representable TUnreify (Eval (rep (Reify Expr)))
-    , Representable TUnreify (Eval (rep (Reify Insert)))
+    , Representable TUnreify (Eval (rep (Reify Write)))
     , Representable TUnreify (Eval (rep (Reify Name)))
     , GConstructable (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))
     , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))
-    , GConstructable (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))
+    , GConstructable (TTable (Reify Write)) TColumns TUnreify (Col (Reify Write)) (Eval (rep (Reify Write)))
     , GConstructable (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))
     )
   GGConstructable' 'K.Sum rep =
     ( RepresentableConstructors TUnreify (Eval (rep (Reify Expr)))
-    , RepresentableConstructors TUnreify (Eval (rep (Reify Insert)))
+    , RepresentableConstructors TUnreify (Eval (rep (Reify Write)))
     , RepresentableFields TUnreify (Eval (rep (Reify Aggregate)))
     , RepresentableFields TUnreify (Eval (rep (Reify Expr)))
     , RepresentableFields TUnreify (Eval (rep (Reify Name)))
     , Functor (GConstructors TUnreify (Eval (rep (Reify Expr))))
-    , Functor (GConstructors TUnreify (Eval (rep (Reify Insert))))
+    , Functor (GConstructors TUnreify (Eval (rep (Reify Write))))
     , GConstructableADT (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))
     , GConstructableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))
-    , GConstructableADT (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))
+    , GConstructableADT (TTable (Reify Write)) TColumns TUnreify (Col (Reify Write)) (Eval (rep (Reify Write)))
     , GConstructableADT (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))
     )
 

src/Rel8/Kind/Context.hs

@@ -1,4 +1,5 @@
 {-# language DataKinds #-}
+{-# language FlexibleInstances #-}
 {-# language GADTs #-}
 {-# language LambdaCase #-}
 {-# language StandaloneKindSignatures #-}
@@ -21,20 +22,20 @@ import Rel8.Expr ( Expr )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.Context ( Interpretation )
 import Rel8.Schema.Context.Label ( Labelable )
-import Rel8.Schema.Insert ( Insert )
 import Rel8.Schema.Kind ( Context )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Reify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Write )
 
 
 type SContext :: Context -> Type
 data SContext context where
   SAggregate :: SContext Aggregate
   SExpr :: SContext Expr
-  SInsert :: SContext Insert
   SName :: SContext Name
   SResult :: SContext Result
+  SWrite :: SContext Write
   SReify :: SContext context -> SContext (Reify context)
 
 
@@ -51,16 +52,16 @@ instance Reifiable Expr where
   contextSing = SExpr
 
 
+instance Reifiable Name where
+  contextSing = SName
+
+
 instance Reifiable Result where
   contextSing = SResult
 
 
-instance Reifiable Insert where
+instance Reifiable Write where
-  contextSing = SInsert
+  contextSing = SWrite
-
-
-instance Reifiable Name where
-  contextSing = SName
 
 
 instance Reifiable context => Reifiable (Reify context) where
@@ -71,9 +72,9 @@ sReifiable :: SContext context -> Dict Reifiable context
 sReifiable = \case
   SAggregate -> Dict
   SExpr -> Dict
-  SInsert -> Dict
   SName -> Dict
   SResult -> Dict
+  SWrite -> Dict
   SReify context -> case sReifiable context of
     Dict -> Dict
 
@@ -82,8 +83,8 @@ sLabelable :: SContext context -> Dict Labelable context
 sLabelable = \case
   SAggregate -> Dict
   SExpr -> Dict
-  SInsert -> Dict
   SName -> Dict
   SResult -> Dict
+  SWrite -> Dict
   SReify context -> case sLabelable context of
     Dict -> Dict

src/Rel8/Schema/Insert.hs

@@ -1,169 +0,0 @@
-{-# language DataKinds #-}
-{-# language DuplicateRecordFields #-}
-{-# language FlexibleContexts #-}
-{-# language FlexibleInstances #-}
-{-# language GADTs #-}
-{-# language LambdaCase #-}
-{-# language MultiParamTypeClasses #-}
-{-# language NamedFieldPuns #-}
-{-# language PolyKinds #-}
-{-# language StandaloneKindSignatures #-}
-{-# language TypeFamilies #-}
-{-# language UndecidableInstances #-}
-{-# language UndecidableSuperClasses #-}
-
-module Rel8.Schema.Insert
-  ( Insert(..)
-  , OnConflict(..)
-  , Col( I, unI )
-  , Inserts
-  , Create(..)
-  , unValue
-  )
-where
-
--- base
-import Data.Functor.Identity ( Identity )
-import Data.Kind ( Constraint, Type )
-import Prelude
-
--- rel8
-import Rel8.Aggregate ( Aggregate )
-import Rel8.Expr ( Expr )
-import Rel8.Kind.Defaulting ( Defaulting(HasDefault, NoDefault), KnownDefaulting )
-import Rel8.Schema.Context ( Interpretation(..) )
-import Rel8.Schema.Context.Label ( Labelable(..) )
-import Rel8.Schema.Context.Nullify
-  ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
-  , runTag, unnull
-  )
-import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
-import Rel8.Schema.Name ( Name, Selects )
-import Rel8.Schema.Null ( Sql )
-import Rel8.Schema.Reify ( notReify )
-import Rel8.Schema.Result ( Result )
-import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
-import Rel8.Schema.Table ( TableSchema )
-import Rel8.Statement.Returning ( Returning )
-import Rel8.Table
-  ( Table, Context, Columns, fromColumns, toColumns
-  , reify, unreify
-  )
-import Rel8.Table.Recontextualize ( Recontextualize )
-import Rel8.Table.Tag ( Tag(..), fromExpr )
-import Rel8.Type ( DBType )
-
-
--- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
--- statement.
-data OnConflict
-  = Abort     -- ^ @ON CONFLICT ABORT@
-  | DoNothing -- ^ @ON CONFLICT DO NOTHING@
-
-
--- | The constituent parts of a SQL @INSERT@ statement.
-type Insert :: k -> Type
-data Insert a where
-  Insert :: (Selects names exprs, Inserts exprs inserts) =>
-    { into :: TableSchema names
-      -- ^ Which table to insert into.
-    , rows :: [inserts]
-      -- ^ The rows to insert.
-    , onConflict :: OnConflict
-      -- ^ What to do if the inserted rows conflict with data already in the
-      -- table.
-    , returning :: Returning names a
-      -- ^ What information to return on completion.
-    }
-    -> Insert a
-
-
-instance Interpretation Insert where
-  data Col Insert _spec where
-    I :: {unI :: !(Create defaulting a)} -> Col Insert ('Spec labels defaulting a)
-
-
-type Create :: Defaulting -> Type -> Type
-data Create defaulting a where
-  Default :: Create 'HasDefault a
-  Value :: Expr a -> Create defaulting a
-
-
-unValue :: Create 'NoDefault a -> Expr a
-unValue (Value a) = a
-
-
-instance (KnownDefaulting defaulting, Sql DBType a) =>
-  Table Insert (Create defaulting a)
- where
-  type Columns (Create defaulting a) = HIdentity ('Spec '[] defaulting a)
-  type Context (Create defaulting a) = Insert
-
-  toColumns = HIdentity . I
-  fromColumns (HIdentity (I a)) = a
-  reify = notReify
-  unreify = notReify
-
-
-instance Sql DBType a =>
-  Recontextualize Aggregate Insert (Aggregate a) (Create 'NoDefault a)
-
-
-instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Create 'NoDefault a)
-
-
-instance Sql DBType a =>
-  Recontextualize Result Insert (Identity a) (Create 'NoDefault a)
-
-
-instance Sql DBType a =>
-  Recontextualize Insert Aggregate (Create 'NoDefault a) (Aggregate a)
-
-
-instance Sql DBType a => Recontextualize Insert Expr (Create 'NoDefault a) (Expr a)
-
-
-instance Sql DBType a =>
-  Recontextualize Insert Result (Create 'NoDefault a) (Identity a)
-
-
-instance Sql DBType a => Recontextualize Insert Insert (Create 'NoDefault a) (Create 'NoDefault a)
-
-
-instance Sql DBType a => Recontextualize Insert Name (Create 'NoDefault a) (Name a)
-
-
-instance Sql DBType a => Recontextualize Name Insert (Name a) (Create 'NoDefault a)
-
-
-instance Labelable Insert where
-  labeler (I a) = I a
-  unlabeler (I a) = I a
-
-
-instance Nullifiable Insert where
-  encodeTag = I . Value . expr
-
-  decodeTag (I (Value a)) = fromExpr a
-
-  nullifier Tag {expr} test SSpec {nullity} = \case
-    I Default -> I Default
-    I (Value a) -> I $ Value $ runTag nullity condition a
-    where
-      condition = test expr
-
-  unnullifier SSpec {nullity} = \case
-    I Default -> I Default
-    I (Value a) -> I $ Value $ unnull nullity a
-
-  {-# INLINABLE encodeTag #-}
-  {-# INLINABLE decodeTag #-}
-  {-# INLINABLE nullifier #-}
-  {-# INLINABLE unnullifier #-}
-
-
--- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
--- with the table @b@.
-type Inserts :: Type -> Type -> Constraint
-class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
-instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts

src/Rel8/Schema/Spec.hs

@@ -16,12 +16,12 @@ import Data.Kind ( Constraint, Type )
 import Prelude ()
 
 -- rel8
-import Rel8.Kind.Labels ( Labels, SLabels, KnownLabels, labelsSing )
 import Rel8.Kind.Defaulting
   ( Defaulting
   , SDefaulting
   , KnownDefaulting, defaultingSing
   )
+import Rel8.Kind.Labels ( Labels, SLabels, KnownLabels, labelsSing )
 import Rel8.Schema.Null ( Nullity, Sql, Unnullify, nullable )
 import Rel8.Type ( DBType, typeInformation )
 import Rel8.Type.Information ( TypeInformation )

src/Rel8/Schema/Write.hs

@@ -0,0 +1,214 @@
+{-# language DataKinds #-}
+{-# language FlexibleContexts #-}
+{-# language FlexibleInstances #-}
+{-# language GADTs #-}
+{-# language LambdaCase #-}
+{-# language MultiParamTypeClasses #-}
+{-# language NamedFieldPuns #-}
+{-# language PolyKinds #-}
+{-# language StandaloneKindSignatures #-}
+{-# language TypeFamilies #-}
+{-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
+
+module Rel8.Schema.Write
+  ( Writable( Default, Value )
+  , Write, fromWrite, unwrite
+  , Writes
+  , Col( W, unW )
+  ) where
+
+-- base
+import Data.Functor.Identity ( Identity )
+import Data.Kind ( Constraint, Type )
+import Data.String ( IsString, fromString )
+import Prelude
+
+-- rel8
+import Rel8.Aggregate ( Aggregate )
+import Rel8.Expr ( Expr )
+import Rel8.Kind.Defaulting
+  ( Defaulting( HasDefault, NoDefault )
+  , KnownDefaulting
+  )
+import Rel8.Schema.Context ( Interpretation( Col ) )
+import Rel8.Schema.Context.Label ( Labelable( labeler, unlabeler) )
+import Rel8.Schema.Context.Nullify
+  ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
+  , runTag, unnull
+  )
+import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
+import Rel8.Schema.Name ( Name )
+import Rel8.Schema.Null ( Sql )
+import Rel8.Schema.Reify ( notReify )
+import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec, nullity ) )
+import Rel8.Table
+  ( Table, Columns, Context, fromColumns, toColumns
+  , reify, unreify
+  )
+import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.Tag ( Tag( Tag, expr ), fromExpr )
+import Rel8.Type ( DBType )
+import Rel8.Type.Monoid ( DBMonoid )
+import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )
+import Rel8.Type.Semigroup ( DBSemigroup )
+
+
+type Writable :: Defaulting -> k -> Type
+data Writable defaulting a where
+  Default :: k ~ Type => Writable 'HasDefault (a :: k)
+  Value :: k ~ Type => Expr a -> Writable defaulting (a :: k)
+
+
+fromWrite :: Writable defaulting a -> Maybe (Expr a)
+fromWrite Default = Nothing
+fromWrite (Value a) = Just a
+
+
+unwrite :: Write a -> Expr a
+unwrite (Value a) = a
+
+
+instance Sql DBSemigroup a => Semigroup (Writable defaulting a) where
+  (<>) = zipWrites (<>)
+
+
+instance Sql DBMonoid a => Monoid (Writable defaulting a) where
+  mempty = Value mempty
+
+
+instance (Sql IsString a, Sql DBType a) => IsString (Writable defaulting a) where
+  fromString = Value . fromString
+
+
+instance Sql DBNum a => Num (Writable defaulting a) where
+  (+) = zipWrites (+)
+  (*) = zipWrites (*)
+  (-) = zipWrites (-)
+  abs = mapWrite abs
+  negate = mapWrite negate
+  signum = mapWrite signum
+  fromInteger = Value . fromInteger
+
+
+instance Sql DBFractional a => Fractional (Writable defaulting a) where
+  (/) = zipWrites (/)
+  fromRational = Value . fromRational
+
+
+instance Sql DBFloating a => Floating (Writable defaulting a) where
+  pi = Value pi
+  exp = mapWrite exp
+  log = mapWrite log
+  sqrt = mapWrite sqrt
+  (**) = zipWrites (**)
+  logBase = zipWrites logBase
+  sin = mapWrite sin
+  cos = mapWrite cos
+  tan = mapWrite tan
+  asin = mapWrite asin
+  acos = mapWrite acos
+  atan = mapWrite atan
+  sinh = mapWrite sinh
+  cosh = mapWrite cosh
+  tanh = mapWrite tanh
+  asinh = mapWrite atanh
+  acosh = mapWrite acosh
+  atanh = mapWrite atanh
+
+
+mapWrite :: ()
+  => (Expr (a :: Type) -> Expr (b :: Type))
+  -> Writable defaulting a -> Writable defaulting b
+mapWrite _ Default = Default
+mapWrite f (Value a) = Value (f a)
+
+
+zipWrites :: ()
+  => (Expr (a :: Type) -> Expr (b :: Type) -> Expr (c :: Type))
+  -> Writable defaulting a -> Writable defaulting b -> Writable defaulting c
+zipWrites _ Default _ = Default
+zipWrites _ _ Default = Default
+zipWrites f (Value a) (Value b) = Value (f a b)
+
+
+type Write :: k -> Type
+type Write = Writable 'NoDefault
+
+
+instance (KnownDefaulting defaulting, Sql DBType a) =>
+  Table Write (Writable defaulting a)
+ where
+  type Columns (Writable defaulting a) = HIdentity ('Spec '[] defaulting a)
+  type Context (Writable defaulting a) = Write
+
+  toColumns = HIdentity . W
+  fromColumns (HIdentity (W a)) = a
+  reify = notReify
+  unreify = notReify
+
+
+instance Interpretation Write where
+  data Col Write _spec where
+    W :: {unW :: !(Writable defaulting a)} -> Col Write ('Spec labels defaulting a)
+
+
+instance Sql DBType a => Recontextualize Aggregate Write (Aggregate a) (Write a)
+
+
+instance Sql DBType a => Recontextualize Expr Write (Expr a) (Write a)
+
+
+instance Sql DBType a => Recontextualize Result Write (Identity a) (Write a)
+
+
+instance Sql DBType a => Recontextualize Write Aggregate (Write a) (Aggregate a)
+
+
+instance Sql DBType a => Recontextualize Write Expr (Write a) (Expr a)
+
+
+instance Sql DBType a => Recontextualize Write Result (Write a) (Identity a)
+
+
+instance Sql DBType a => Recontextualize Write Write (Write a) (Write a)
+
+
+instance Sql DBType a => Recontextualize Write Name (Write a) (Name a)
+
+
+instance Sql DBType a => Recontextualize Name Write (Name a) (Write a)
+
+
+instance Labelable Write where
+  labeler (W a) = W a
+  unlabeler (W a) = W a
+
+
+instance Nullifiable Write where
+  encodeTag = W . Value . expr
+
+  decodeTag (W (Value a)) = fromExpr a
+
+  nullifier Tag {expr} test SSpec {nullity} = \case
+    W Default -> W Default
+    W (Value a) -> W $ Value $ runTag nullity condition a
+    where
+      condition = test expr
+
+  unnullifier SSpec {nullity} = \case
+    W Default -> W Default
+    W (Value a) -> W $ Value $ unnull nullity a
+
+  {-# INLINABLE encodeTag #-}
+  {-# INLINABLE decodeTag #-}
+  {-# INLINABLE nullifier #-}
+  {-# INLINABLE unnullifier #-}
+
+
+-- | @Writes a b@ means that the columns in @a@ are compatible for inserting
+-- with the table @b@.
+type Writes :: Type -> Type -> Constraint
+class Recontextualize Expr Write exprs writes => Writes exprs writes
+instance Recontextualize Expr Write exprs writes => Writes exprs writes

src/Rel8/Statement/Insert.hs

@@ -1,6 +1,8 @@
+{-# language DuplicateRecordFields #-}
 {-# language GADTs #-}
 {-# language NamedFieldPuns #-}
 {-# language ScopedTypeVariables #-}
+{-# language StandaloneKindSignatures #-}
 {-# language TypeApplications #-}
 
 module Rel8.Statement.Insert
@@ -13,6 +15,7 @@ where
 -- base
 import Control.Exception ( throwIO )
 import Data.List.NonEmpty ( NonEmpty( (:|) ) )
+import Data.Kind ( Type )
 import Prelude
 
 -- hasql
@@ -27,7 +30,9 @@ import qualified Opaleye.Internal.Manipulation as Opaleye
 import qualified Opaleye.Manipulation as Opaleye
 
 -- rel8
-import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )
+import Rel8.Schema.Name ( Selects )
+import Rel8.Schema.Table ( TableSchema )
+import Rel8.Schema.Write ( Writes )
 import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
 import Rel8.Table ( fromColumns, toColumns )
 import Rel8.Table.Opaleye ( castTable, table, unpackspec )
@@ -38,6 +43,31 @@ import qualified Data.Text as Text ( pack )
 import Data.Text.Encoding ( encodeUtf8 )
 
 
+-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
+-- statement.
+type OnConflict :: Type
+data OnConflict
+  = Abort     -- ^ @ON CONFLICT ABORT@
+  | DoNothing -- ^ @ON CONFLICT DO NOTHING@
+
+
+-- | The constituent parts of a SQL @INSERT@ statement.
+type Insert :: Type -> Type
+data Insert a where
+  Insert :: (Selects names exprs, Writes exprs writes) =>
+    { into :: TableSchema names
+      -- ^ Which table to insert into.
+    , rows :: [writes]
+      -- ^ The rows to insert.
+    , onConflict :: OnConflict
+      -- ^ What to do if the inserted rows conflict with data already in the
+      -- table.
+    , returning :: Returning names a
+      -- ^ What information to return on completion.
+    }
+    -> Insert a
+
+
 -- | Run an @INSERT@ statement
 insert :: Connection -> Insert a -> IO a
 insert c Insert {into, rows, onConflict, returning} =

src/Rel8/Statement/Update.hs

@@ -25,17 +25,14 @@ import qualified Hasql.Statement as Hasql
 -- opaleye
 import qualified Opaleye.Internal.Manipulation as Opaleye
 
--- profunctors
-import Data.Profunctor ( lmap )
-
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
 import Rel8.Schema.Name ( Selects )
 import Rel8.Schema.Table ( TableSchema )
+import Rel8.Schema.Write ( Writes )
 import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
 import Rel8.Table ( fromColumns, toColumns )
-import Rel8.Table.Insert ( toInsert )
 import Rel8.Table.Opaleye ( castTable, table, unpackspec )
 import Rel8.Table.Serialize ( Serializable, parse )
 
@@ -47,10 +44,10 @@ import Data.Text.Encoding ( encodeUtf8 )
 -- | The constituent parts of an @UPDATE@ statement.
 type Update :: Type -> Type
 data Update a where
-  Update :: Selects names exprs =>
+  Update :: (Selects names exprs, Writes exprs writes) =>
     { target :: TableSchema names
       -- ^ Which table to update.
-    , set :: exprs -> exprs
+    , set :: exprs -> writes
       -- ^ How to update each selected row.
     , updateWhere :: exprs -> Expr Bool
       -- ^ Which rows to select for update.
@@ -74,7 +71,7 @@ update c Update {target, set, updateWhere, returning} =
         prepare = False
         sql = Opaleye.arrangeUpdateSql target' set' where'
           where
-            target' = lmap toInsert $ table $ toColumns <$> target
+            target' = table $ toColumns <$> target
             set' = toColumns . set . fromColumns
             where' = toColumn . toPrimExpr . updateWhere . fromColumns
 
@@ -94,7 +91,7 @@ update c Update {target, set, updateWhere, returning} =
             where'
             project'
           where
-            target' = lmap toInsert $ table $ toColumns <$> target
+            target' = table $ toColumns <$> target
             set' = toColumns . set . fromColumns
             where' = toColumn . toPrimExpr . updateWhere . fromColumns
             project' = castTable . toColumns . project . fromColumns

src/Rel8/Table/ADT.hs

@@ -16,7 +16,7 @@ module Rel8.Table.ADT
   , ADTable, fromADT, toADT
   , BuildableADT
   , BuildADT, buildADT
-  , InsertADT, insertADT
+  , WriteADT, writeADT
   , ConstructableADT
   , ConstructADT, constructADT
   , DeconstructADT, deconstructADT
@@ -41,7 +41,7 @@ import Rel8.FCF ( Eval, Exp )
 import Rel8.Generic.Construction
   ( GGBuildable
   , GGBuild, ggbuild
-  , GGInsert, gginsert
+  , GGWrite, ggwrite
   , GGConstructable
   , GGConstruct, ggconstruct
   , GGDeconstruct, ggdeconstruct
@@ -59,7 +59,7 @@ import qualified Rel8.Generic.Table.ADT as G
 import qualified Rel8.Kind.Algebra as K
 import Rel8.Schema.Context ( Col )
 import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.Insert ( Insert )
+import Rel8.Schema.Write ( Write )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )
@@ -156,13 +156,13 @@ buildADT =
   ggbuild @'K.Sum @name @(ADTRep t) @(ADT t Expr) ADT
 
 
-type InsertADT :: K.Rel8able -> Symbol -> Type
+type WriteADT :: K.Rel8able -> Symbol -> Type
-type InsertADT t name = GGInsert 'K.Sum name (ADTRep t) (ADT t Insert)
+type WriteADT t name = GGWrite 'K.Sum name (ADTRep t) (ADT t Write)
 
 
-insertADT :: forall t name. BuildableADT t name => InsertADT t name
+writeADT :: forall t name. BuildableADT t name => WriteADT t name
-insertADT =
+writeADT =
-  gginsert @'K.Sum @name @(ADTRep t) @(ADT t Insert) ADT
+  ggwrite @'K.Sum @name @(ADTRep t) @(ADT t Write) ADT
 
 
 type ConstructableADT :: K.Rel8able -> Constraint

src/Rel8/Table/Either.hs

@@ -18,7 +18,7 @@ module Rel8.Table.Either
   ( EitherTable(..)
   , eitherTable, leftTable, rightTable
   , isLeftTable, isRightTable
-  , insertEitherTable, nameEitherTable
+  , nameEitherTable, writeEitherTable
   )
 where
 
@@ -47,7 +47,7 @@ import Rel8.Schema.HTable.Either ( HEitherTable(..) )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
-import Rel8.Schema.Insert ( Insert )
+import Rel8.Schema.Write ( Write )
 import Rel8.Schema.Name ( Name )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
@@ -55,12 +55,12 @@ import Rel8.Table
   )
 import Rel8.Table.Bool ( bool )
 import Rel8.Table.Eq ( EqTable, eqTable )
-import Rel8.Table.Insert ( toInsert )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
 import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
 import Rel8.Table.Undefined ( undefined )
+import Rel8.Table.Write ( write )
 import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )
 
 -- semigroupoids
@@ -177,17 +177,17 @@ rightTableWith :: a -> b -> EitherTable a b
 rightTableWith = EitherTable (fromExpr (litExpr IsRight))
 
 
-insertEitherTable :: (Table Insert a, Table Insert b)
-  => Either a b -> EitherTable a b
-insertEitherTable = \case
-  Left a -> EitherTable (fromExpr (litExpr IsLeft)) a (fromColumns (toInsert undefined))
-  Right b -> EitherTable (fromExpr (litExpr IsRight)) (fromColumns (toInsert undefined)) b
-
-
 nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b
 nameEitherTable = EitherTable . fromName
 
 
+writeEitherTable :: (Table Write a, Table Write b)
+  => Either a b -> EitherTable a b
+writeEitherTable = \case
+  Left a -> EitherTable (fromExpr (litExpr IsLeft)) a (fromColumns (write undefined))
+  Right b -> EitherTable (fromExpr (litExpr IsRight)) (fromColumns (write undefined)) b
+
+
 toColumns2 ::
   ( HTable t
   , HTable u

src/Rel8/Table/HKD.hs

@@ -16,7 +16,7 @@ module Rel8.Table.HKD
   , HKDable, fromHKD, toHKD, HKDT(..)
   , BuildableHKD
   , BuildHKD, buildHKD
-  , InsertHKD, insertHKD
+  , WriteHKD, writeHKD
   , ConstructableHKD
   , ConstructHKD, constructHKD
   , DeconstructHKD, deconstructHKD
@@ -44,7 +44,7 @@ import Rel8.Kind.Algebra ( KnownAlgebra )
 import Rel8.Generic.Construction
   ( GGBuildable
   , GGBuild, ggbuild
-  , GGInsert, gginsert
+  , GGWrite, ggwrite
   , GGConstructable
   , GGConstruct, ggconstruct
   , GGDeconstruct, ggdeconstruct
@@ -66,7 +66,7 @@ import Rel8.Generic.Table
 import Rel8.Schema.Context ( Col )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.Insert ( Insert )
+import Rel8.Schema.Write ( Write )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify, notReify )
 import Rel8.Schema.Result ( Result )
@@ -223,13 +223,13 @@ buildHKD =
   ggbuild @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Expr) HKD
 
 
-type InsertHKD :: Type -> Symbol -> Type
+type WriteHKD :: Type -> Symbol -> Type
-type InsertHKD a name = GGInsert (GAlgebra (Rep a)) name (HKDRep a) (HKD a Insert)
+type WriteHKD a name = GGWrite (GAlgebra (Rep a)) name (HKDRep a) (HKD a Write)
 
 
-insertHKD :: forall a name. BuildableHKD a name => InsertHKD a name
+writeHKD :: forall a name. BuildableHKD a name => WriteHKD a name
-insertHKD =
+writeHKD =
-  gginsert @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Insert) HKD
+  ggwrite @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Write) HKD
 
 
 type ConstructableHKD :: Type -> Constraint

src/Rel8/Table/Insert.hs

@@ -1,49 +0,0 @@
-{-# language FlexibleContexts #-}
-{-# language NamedFieldPuns #-}
-{-# language TypeFamilies #-}
-{-# language ViewPatterns #-}
-
-module Rel8.Table.Insert
-  ( toInsert
-  , toInsertDefaults
-  )
-where
-
--- base
-import Prelude
-
--- rel8
-import Rel8.Expr ( Col( E ) )
-import Rel8.Kind.Defaulting ( SDefaulting( SHasDefault, SNoDefault ) )
-import Rel8.Schema.HTable ( hfield, htabulate, hspecs )
-import Rel8.Schema.Insert ( Inserts, Col( I ), Create(..) )
-import Rel8.Schema.Spec ( SSpec(..) )
-import Rel8.Table ( fromColumns, toColumns )
-
-
--- | @toInsert@ converts a 'Table' of 'Expr's into a 'Table' that can be used
--- with 'Rel8.insert'. This will override any columns that have default values
--- to use exactly what is given. If you want to use default values, you can
--- either override the result of @toInsert@, or use 'toInsertDefaults'.
-toInsert :: Inserts exprs inserts => exprs -> inserts
-toInsert (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
-  case hfield hspecs field of
-    SSpec {} -> I $ case hfield exprs field of
-      E expr -> Value expr
-
-
--- | @toInsertDefaults@ converts a 'Table' of 'Expr's into a 'Table' that can
--- be used with 'Rel8.insert'. Any columns that have a default value will
--- override whatever is in the input expression. 
---
--- One example where this is useful is for any table that has a special @id@
--- column, which has a default value to draw a new value from a sequence. If we
--- use 'toInsertDefaults', we can provide a dummy value that will be replaced
--- with a call to @DEFAULT@.
-toInsertDefaults :: Inserts exprs inserts => exprs -> inserts
-toInsertDefaults (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
-  case hfield hspecs field of
-    SSpec {defaulting} -> case hfield exprs field of
-      E expr -> I $ case defaulting of
-        SNoDefault -> Value expr
-        SHasDefault -> Default

src/Rel8/Table/List.hs

@@ -10,7 +10,7 @@
 
 module Rel8.Table.List
   ( ListTable(..)
-  , listTable, insertListTable, nameListTable
+  , listTable, nameListTable, writeListTable
   )
 where
 
@@ -26,12 +26,12 @@ import Rel8.Expr.Array ( sappend, sempty, slistOf )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.HTable.List ( HListTable )
 import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
-import Rel8.Schema.Insert ( Inserts )
 import Rel8.Schema.Name ( Col( N ), Name( Name ) )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
 import Rel8.Schema.Spec ( SSpec(..) )
 import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
 import Rel8.Schema.Reify ( hreify, hunreify )
+import Rel8.Schema.Write ( Writes )
 import Rel8.Table
   ( Table, Context, Columns, fromColumns, toColumns
   , reify, unreify
@@ -41,11 +41,11 @@ import Rel8.Table.Alternative
   , AlternativeTable, emptyTable
   )
 import Rel8.Table.Eq ( EqTable, eqTable )
-import Rel8.Table.Insert ( toInsert )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
 import Rel8.Table.Unreify ( Unreifies )
+import Rel8.Table.Write ( write )
 
 
 -- | A @ListTable@ value contains zero or more instances of @a@. You construct
@@ -126,13 +126,13 @@ listTable =
   fmap toColumns
 
 
-insertListTable :: Inserts exprs inserts => [exprs] -> ListTable inserts
-insertListTable = toInsert . listTable
-
-
 nameListTable :: Table Name a => a -> ListTable a
 nameListTable =
   ListTable .
   hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
   pure .
   toColumns
+
+
+writeListTable :: Writes exprs writes => [exprs] -> ListTable writes
+writeListTable = write . listTable

src/Rel8/Table/Maybe.hs

@@ -17,7 +17,8 @@ module Rel8.Table.Maybe
   , maybeTable, nothingTable, justTable
   , isNothingTable, isJustTable
   , ($?)
-  , insertMaybeTable, nameMaybeTable
+  , nameMaybeTable
+  , writeMaybeTable
   )
 where
 
@@ -44,9 +45,9 @@ import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
 import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
-import Rel8.Schema.Insert ( Insert )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql, nullable )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , reify, unreify
@@ -57,7 +58,7 @@ import Rel8.Table.Alternative
   )
 import Rel8.Table.Bool ( bool )
 import Rel8.Table.Eq ( EqTable, eqTable )
-import Rel8.Table.Insert ( toInsert )
+import Rel8.Table.Write ( write )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
@@ -209,16 +210,16 @@ f $? ma@(MaybeTable _ a) = case nullable @b of
 infixl 4 $?
 
 
-insertMaybeTable :: Table Insert a => Maybe a -> MaybeTable a
-insertMaybeTable = \case
-  Nothing -> MaybeTable (fromExpr null) (fromColumns (toInsert undefined))
-  Just a -> justTable a
-
-
 nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable a
 nameMaybeTable = MaybeTable . fromName
 
 
+writeMaybeTable :: Table Write a => Maybe a -> MaybeTable a
+writeMaybeTable = \case
+  Nothing -> MaybeTable (fromExpr null) (fromColumns (write undefined))
+  Just a -> justTable a
+
+
 toColumns1 ::
   ( HTable t
   , HConstrainTag context MaybeTag

src/Rel8/Table/NonEmpty.hs

@@ -10,7 +10,7 @@
 
 module Rel8.Table.NonEmpty
   ( NonEmptyTable(..)
-  , nonEmptyTable, insertNonEmptyTable, nameNonEmptyTable
+  , nonEmptyTable, nameNonEmptyTable, writeNonEmptyTable
   )
 where
 
@@ -27,23 +27,23 @@ import Rel8.Expr.Array ( sappend1, snonEmptyOf )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
 import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
-import Rel8.Schema.Insert ( Inserts )
 import Rel8.Schema.Name ( Col( N ), Name( Name ) )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
 import Rel8.Schema.Reify ( hreify, hunreify )
 import Rel8.Schema.Spec ( SSpec(..) )
 import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
+import Rel8.Schema.Write ( Writes )
 import Rel8.Table
   ( Table, Context, Columns, fromColumns, toColumns
   , reify, unreify
   )
 import Rel8.Table.Alternative ( AltTable, (<|>:) )
 import Rel8.Table.Eq ( EqTable, eqTable )
-import Rel8.Table.Insert ( toInsert )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
 import Rel8.Table.Unreify ( Unreifies )
+import Rel8.Table.Write ( write )
 
 
 -- | A @NonEmptyTable@ value contains one or more instances of @a@. You
@@ -118,14 +118,14 @@ nonEmptyTable =
   fmap toColumns
 
 
-insertNonEmptyTable :: Inserts exprs inserts
-  => NonEmpty exprs -> NonEmptyTable inserts
-insertNonEmptyTable = toInsert . nonEmptyTable
-
-
 nameNonEmptyTable :: Table Name a => a -> NonEmptyTable a
 nameNonEmptyTable =
   NonEmptyTable .
   hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
   pure .
   toColumns
+
+
+writeNonEmptyTable :: Writes exprs writes
+  => NonEmpty exprs -> NonEmptyTable writes
+writeNonEmptyTable = write . nonEmptyTable

src/Rel8/Table/Opaleye.hs

@@ -1,7 +1,7 @@
 {-# language BlockArguments #-}
+{-# language DataKinds #-}
 {-# language DisambiguateRecordFields #-}
 {-# language FlexibleContexts #-}
-{-# language LambdaCase #-}
 {-# language NamedFieldPuns #-}
 {-# language TypeFamilies #-}
 {-# language ViewPatterns #-}
@@ -45,10 +45,10 @@ import Rel8.Expr.Opaleye
   )
 import Rel8.Kind.Defaulting ( SDefaulting( SNoDefault, SHasDefault ) )
 import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )
-import Rel8.Schema.Insert ( Col( I ), Create(..), Insert, Inserts )
 import Rel8.Schema.Name ( Col( N ), Name( Name ), Selects )
 import Rel8.Schema.Spec ( SSpec(..) )
 import Rel8.Schema.Table ( TableSchema(..) )
+import Rel8.Schema.Write ( Col( W ), Write, Writes, Writable(..), fromWrite )
 import Rel8.Table ( Table, fromColumns, toColumns )
 import Rel8.Table.Undefined ( undefined )
 
@@ -83,36 +83,32 @@ distinctspec =
     toColumns
 
 
-table ::(Selects names exprs, Inserts exprs inserts)
+table ::(Selects names exprs, Writes exprs writes)
-  => TableSchema names -> Opaleye.Table inserts exprs
+  => TableSchema names -> Opaleye.Table writes exprs
 table (TableSchema name schema columns) =
   case schema of
     Nothing -> Opaleye.Table name (tableFields columns)
     Just schemaName -> Opaleye.TableWithSchema schemaName name (tableFields columns)
 
 
-tableFields :: (Selects names exprs, Inserts exprs inserts)
+tableFields :: (Selects names exprs, Writes exprs writes)
-  => names -> Opaleye.TableFields inserts exprs
+  => names -> Opaleye.TableFields writes exprs
 tableFields (toColumns -> names) = dimap toColumns fromColumns $
   unwrapApplicative $ htabulateA $ \field -> WrapApplicative $
     case hfield hspecs field of
       specs -> case hfield names field of
         name -> lmap (`hfield` field) (go specs name)
   where
-    go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)
+    go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Write spec) (Col Expr spec)
     go SSpec {defaulting} (N (Name name)) = case defaulting of
       SNoDefault ->
-        lmap (\(I (Value a)) -> toColumn $ toPrimExpr a) $
+        lmap (\(W (Value a)) -> toColumn $ toPrimExpr a) $
         E . fromPrimExpr . fromColumn <$>
           Opaleye.requiredTableField name
       SHasDefault ->
-        lmap (\(I ma) -> toColumn . toPrimExpr <$> fromInsert ma) $
+        lmap (\(W ma) -> toColumn . toPrimExpr <$> fromWrite ma) $
         E . fromPrimExpr . fromColumn <$>
           Opaleye.optionalTableField name
-      where
-        fromInsert = \case
-          Default -> Nothing
-          Value a -> Just a
 
 
 unpackspec :: Table Expr a => Opaleye.Unpackspec a a

src/Rel8/Table/These.hs

@@ -21,7 +21,7 @@ module Rel8.Table.These
   , isThisTable, isThatTable, isThoseTable
   , hasHereTable, hasThereTable
   , justHereTable, justThereTable
-  , insertTheseTable, nameTheseTable
+  , nameTheseTable, writeTheseTable
   )
 where
 
@@ -51,8 +51,8 @@ import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
 import Rel8.Schema.HTable.These ( HTheseTable(..) )
-import Rel8.Schema.Insert ( Insert )
 import Rel8.Schema.Name ( Name )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , reify, unreify
@@ -62,7 +62,7 @@ import Rel8.Table.Maybe
   ( MaybeTable(..)
   , maybeTable, justTable, nothingTable
   , isJustTable
-  , insertMaybeTable, nameMaybeTable
+  , nameMaybeTable, writeMaybeTable
   )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
@@ -231,12 +231,6 @@ theseTable f g h TheseTable {here, there} =
     there
 
 
-insertTheseTable :: (Table Insert a, Table Insert b)
-  => These a b -> TheseTable a b
-insertTheseTable =
-  TheseTable <$> insertMaybeTable . justHere <*> insertMaybeTable . justThere
-
-
 nameTheseTable :: ()
   => Name (Maybe MaybeTag)
   -> Name (Maybe MaybeTag)
@@ -250,6 +244,12 @@ nameTheseTable here there a b =
     }
 
 
+writeTheseTable :: (Table Write a, Table Write b)
+  => These a b -> TheseTable a b
+writeTheseTable =
+  TheseTable <$> writeMaybeTable . justHere <*> writeMaybeTable . justThere
+
+
 toColumns2 ::
   ( HTable t
   , HTable u

src/Rel8/Table/Unreify.hs

@@ -41,11 +41,11 @@ import Rel8.Aggregate ( Aggregate )
 import Rel8.Expr ( Expr )
 import Rel8.Kind.Context ( SContext(..), Reifiable, sReifiable )
 import Rel8.Schema.Dict ( Dict( Dict ) )
-import Rel8.Schema.Insert ( Insert )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Reify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Write ( Write )
 import Rel8.Table ( Table, Context, Congruent, Unreify )
 
 
@@ -59,16 +59,16 @@ type Unreifiable :: Type -> Constraint
 class
   ( Context a ~ Reify Aggregate => Unreifier Aggregate a
   , Context a ~ Reify Expr => Unreifier Expr a
-  , Context a ~ Reify Insert => Unreifier Insert a
   , Context a ~ Reify Name => Unreifier Name a
+  , Context a ~ Reify Write => Unreifier Write a
   , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)
   )
   => Unreifiable a
 instance
   ( Context a ~ Reify Aggregate => Unreifier Aggregate a
   , Context a ~ Reify Expr => Unreifier Expr a
-  , Context a ~ Reify Insert => Unreifier Insert a
   , Context a ~ Reify Name => Unreifier Name a
+  , Context a ~ Reify Write => Unreifier Write a
   , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)
   )
   => Unreifiable a
@@ -99,8 +99,8 @@ unreifiability :: (Context a ~ Reify context, Unreifiable a)
 unreifiability = \case
   SAggregate -> Unreifiability SAggregate
   SExpr -> Unreifiability SExpr
-  SInsert -> Unreifiability SInsert
   SName -> Unreifiability SName
   SResult -> UResult
+  SWrite -> Unreifiability SWrite
   SReify context -> case sReifiable context of
     Dict -> Unreifiability (SReify context)

src/Rel8/Table/Write.hs

@@ -0,0 +1,61 @@
+{-# language FlexibleContexts #-}
+{-# language NamedFieldPuns #-}
+{-# language TypeFamilies #-}
+{-# language ViewPatterns #-}
+
+module Rel8.Table.Write
+  ( defaultValue
+  , override
+  , write
+  , reset
+  )
+where
+
+-- base
+import Prelude
+
+-- rel8
+import Rel8.Column ( Default )
+import Rel8.Expr ( Col( E ), Expr )
+import Rel8.Kind.Defaulting ( SDefaulting( SHasDefault, SNoDefault ) )
+import Rel8.Schema.HTable ( hfield, hspecs, htabulate )
+import Rel8.Schema.Spec ( SSpec(..) )
+import Rel8.Schema.Write ( Col( W ), Write, Writes, Writable(..) )
+import Rel8.Table ( Table, fromColumns, toColumns )
+
+
+defaultValue :: Default Write a
+defaultValue = Default
+
+
+override :: Expr a -> Default Write a
+override = Value
+
+
+-- | @write@ converts a 'Table' of 'Expr's into a 'Table' that can be used
+-- with 'Rel8.insert'. This will override any columns that have default values
+-- to use exactly what is given. If you want to use default values, you can
+-- override the result of @write@ either manually, or using automatically using
+-- 'reset'.
+write :: Writes exprs inserts => exprs -> inserts
+write (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
+  case hfield hspecs field of
+    SSpec {} -> W $ case hfield exprs field of
+      E expr -> Value expr
+
+
+-- | @reset@ takes a 'Table' of 'Write's and, for each column which has a
+-- default value, resets the value of that column to its default.
+--
+-- One example where this is useful is for any table that has a special @id@
+-- column, which has a default value to draw a new value from a sequence. If
+-- we want to make a copy of an existing row, but with a new @id@, we can run
+-- the existing row through 'write', and then feed that to 'reset' to reset
+-- the @id@ column.
+reset :: Table Write a => a -> a
+reset (toColumns -> as) = fromColumns $ htabulate $ \field ->
+  case hfield hspecs field of
+    SSpec {defaulting} -> case hfield as field of
+      W a -> W $ case defaulting of
+        SNoDefault -> a
+        SHasDefault -> Default