From 99d00210320624d876aee2ae132d50bdaa6a38bc Mon Sep 17 00:00:00 2001
From: Shane O'Brien <shane.obrien@circuithub.com>
Date: Sun, 13 Jun 2021 17:24:58 +0100
Subject: [PATCH] Explicit Inserts

---
 src/Rel8.hs                       |  4 +++
 src/Rel8/Column/Field.hs          | 48 +++++++++++--------------------
 src/Rel8/Generic/Rel8able/Test.hs |  2 +-
 src/Rel8/Schema/Insert.hs         |  5 ++++
 4 files changed, 26 insertions(+), 33 deletions(-)

diff --git a/src/Rel8.hs b/src/Rel8.hs
index 1f4ef6b..9275b0b 100644
--- a/src/Rel8.hs
+++ b/src/Rel8.hs
@@ -251,6 +251,9 @@ module Rel8
   , Insert(..)
   , OnConflict(..)
   , insert
+
+  , Create( Default, Value )
+  , unValue
   , toInsert
   , toInsertDefaults
 
@@ -327,6 +330,7 @@ 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 )
diff --git a/src/Rel8/Column/Field.hs b/src/Rel8/Column/Field.hs
index 319db44..cddec8c 100644
--- a/src/Rel8/Column/Field.hs
+++ b/src/Rel8/Column/Field.hs
@@ -18,11 +18,7 @@ import Prelude
 import Rel8.Aggregate ( Aggregate, Col( A ) )
 import Rel8.Expr ( Expr, Col( E ) )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
-import Rel8.Kind.Necessity
-  ( Necessity( Required, Optional )
-  , SNecessity( SRequired, SOptional )
-  , KnownNecessity, necessitySing
-  )
+import Rel8.Kind.Necessity ( Necessity, KnownNecessity )
 import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
 import Rel8.Schema.Insert ( Col( I ), Create(..), Insert )
 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 Aggregate       _necessity a = Aggregate a
   Field Expr            _necessity a = Expr a
-  Field Insert          'Required  a = Expr a
-  Field Insert          'Optional  a = Maybe (Expr a)
+  Field Insert          necessity  a = Create necessity a
   Field Name            _necessity a = Name 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 Unreify (AField context necessity a) = Field context necessity a
 
-  fromColumns (HIdentity (Reify a)) = sfromColumn contextSing necessitySing a
-  toColumns = HIdentity . Reify . stoColumn contextSing necessitySing
+  fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
+  toColumns = HIdentity . Reify . stoColumn contextSing
   reify _ = AField
   unreify _ (AField a) = a
 
@@ -80,36 +75,25 @@ instance
 
 sfromColumn :: ()
   => SContext context
-  -> SNecessity necessity
   -> Col context ('Spec labels necessity a)
   -> AField context necessity a
 sfromColumn = \case
-  SAggregate -> \_ (A a) -> AField a
-  SExpr -> \_ (E a) -> AField a
-  SInsert -> \case
-    SRequired -> \case
-      I (Value a) -> AField a
-    SOptional -> \case
-      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)
+  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
+  SReify context -> \(Reify a) -> AField (sfromColumn context a)
 
 
 stoColumn :: ()
   => SContext context
-  -> SNecessity necessity
   -> AField context necessity a
   -> Col context ('Spec labels necessity a)
 stoColumn = \case
-  SAggregate -> \_ (AField a) -> A a
-  SExpr -> \_ (AField a) -> E a
-  SInsert -> \case
-    SRequired -> \(AField a) -> I (Value a)
-    SOptional -> \(AField ma) -> I $ maybe Default Value ma
-  SName -> \_ (AField a) -> N a
-  SResult -> \_ (AField a) -> R a
-  SReify context ->
-    \necessity (AField a) -> Reify (stoColumn context necessity a)
+  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
+  SReify context -> \(AField a) -> Reify (stoColumn context a)
diff --git a/src/Rel8/Generic/Rel8able/Test.hs b/src/Rel8/Generic/Rel8able/Test.hs
index 1ad3750..a7920d3 100644
--- a/src/Rel8/Generic/Rel8able/Test.hs
+++ b/src/Rel8/Generic/Rel8able/Test.hs
@@ -151,7 +151,7 @@ data TableSum f
 data TableProduct f = TableProduct
   { sum :: HADT f TableSum
   , 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 anyclass Rel8able
diff --git a/src/Rel8/Schema/Insert.hs b/src/Rel8/Schema/Insert.hs
index f697b3b..0e96789 100644
--- a/src/Rel8/Schema/Insert.hs
+++ b/src/Rel8/Schema/Insert.hs
@@ -18,6 +18,7 @@ module Rel8.Schema.Insert
   , Col( I, unI )
   , Inserts
   , Create(..)
+  , unValue
   )
 where
 
@@ -88,6 +89,10 @@ data Create necessity a where
   Value :: Expr a -> Create necessity a
 
 
+unValue :: Create 'Required a -> Expr a
+unValue (Value a) = a
+
+
 instance (KnownNecessity necessity, Sql DBType a) =>
   Table Insert (Create necessity a)
  where