Add Encodable class for specifying what lit should do for a given type

This means that users defining new `DBType`s will have to additionally derive `Encodable` (but a simple `deriving Encodable` will suffice).

It also opens up the possibility of users defining non-`DBType`s that are `lit`able (and `select`able). For example, the `HKDT` helper makes allows arbitrary products of `DBType`s to be `lit`ed via `higgled`'s `HKD`:

```haskell
data S3Object = S3Object
  { bucketName :: Text
  , objectKey :: Text
  }
  deriving stock Generic
  deriving Encodable via HKDT S3Object
```

With the above loaded into GHCi:

```
>>> :t lit (S3Object mempty mempty)
lit (S3Object mempty mempty)
  :: HKD S3Object Expr
```

The implementation is extensible, allowing for the possibility of other "strategies" (in addition to `DBType` and `HKD`) in the future.

rel8.cabal

@@ -130,6 +130,7 @@ library
     Rel8.Schema.Null
     Rel8.Schema.Reify
     Rel8.Schema.Result
+    Rel8.Schema.Serialize
     Rel8.Schema.Spec
     Rel8.Schema.Spec.ConstrainDBType
     Rel8.Schema.Spec.ConstrainType
@@ -179,6 +180,7 @@ library
     Rel8.Type.Ord
     Rel8.Type.ReadShow
     Rel8.Type.Semigroup
+    Rel8.Type.Serialize
     Rel8.Type.String
     Rel8.Type.Sum
     Rel8.Type.Tag

src/Rel8.hs

@@ -274,6 +274,7 @@ module Rel8
     -- TODO
     -- These need organizing, but are reachable from Rel8's documentation so we
     -- do need to export and document them.
+  , Encodable
   , Nullable
   , NotNull
   , HTable
@@ -332,6 +333,7 @@ import Rel8.Schema.HTable
 import Rel8.Schema.Name
 import Rel8.Schema.Null hiding ( nullable )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Serialize
 import Rel8.Schema.Table
 import Rel8.Statement.Delete
 import Rel8.Statement.Insert

src/Rel8/Generic/Rel8able/Test.hs

@@ -3,10 +3,6 @@
 {-# language DeriveGeneric #-}
 {-# language DerivingVia #-}
 {-# language DuplicateRecordFields #-}
-{-# language FlexibleInstances #-}
-{-# language MultiParamTypeClasses #-}
-{-# language StandaloneDeriving #-}
-{-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
 
 {-# options_ghc -O0 #-}
@@ -96,26 +92,12 @@ data S3Object = S3Object
   , objectKey :: Text
   }
   deriving stock Generic
-
+  deriving Encodable via HKDT S3Object
-
-deriving via HKDT S3Object
-  instance Table Result S3Object
-
-
-deriving via HKDT S3Object
-  instance x ~ HKD S3Object Expr => ToExprs x S3Object
 
 
 data HKDSum = HKDSumA Text | HKDSumB Bool Char | HKDSumC
   deriving stock Generic
-
+  deriving Encodable via HKDT HKDSum
-
-deriving via HKDT HKDSum
-  instance Table Result HKDSum
-
-
-deriving via HKDT HKDSum
-  instance x ~ HKD HKDSum Expr => ToExprs x HKDSum
 
 
 data HKDTest f = HKDTest

src/Rel8/Schema/HTable/Nullify.hs

@@ -10,6 +10,7 @@
 {-# language NamedFieldPuns #-}
 {-# language QuantifiedConstraints #-}
 {-# language RankNTypes #-}
+{-# language RecordWildCards #-}
 {-# language ScopedTypeVariables #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
@@ -56,14 +57,12 @@ type instance Eval (Nullify ('Spec labels necessity a)) =
 
 instance MapSpec Nullify where
   mapInfo = \case
-    SSpec{labels, necessity, info, nullity} -> SSpec
+    SSpec{labels, necessity, info, nullity, ..} -> SSpec
-      { labels
+      { nullity = case nullity of
-      , necessity
-      , info
-      , nullity = case nullity of
           Null    -> Null
           NotNull -> Null
-      } 
+      , ..
+      }
 
 
 hnulls :: HTable t

src/Rel8/Schema/HTable/Vectorize.hs

@@ -41,6 +41,7 @@ import Rel8.Schema.HTable
   , hfield, htabulate, htabulateA, hspecs
   )
 import Rel8.Schema.Null ( Unnullify, NotNull, Nullity( NotNull ) )
+import Rel8.Schema.Serialize ( Exprable )
 import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
 import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
 import Rel8.Type.Information ( TypeInformation )
@@ -53,6 +54,7 @@ import GHC.Generics (Generic)
 
 
 class Vector list where
+  listExprable :: proxy a -> Dict Exprable (list a)
   listNotNull :: proxy a -> Dict NotNull (list a)
   vectorTypeInformation :: ()
     => Nullity a
@@ -61,11 +63,13 @@ class Vector list where
 
 
 instance Vector [] where
+  listExprable _ = Dict
   listNotNull _ = Dict
   vectorTypeInformation = listTypeInformation
 
 
 instance Vector NonEmpty where
+  listExprable _ = Dict
   listNotNull _ = Dict
   vectorTypeInformation = nonEmptyTypeInformation
 
@@ -88,6 +92,7 @@ instance Vector list => MapSpec (Vectorize list) where
       Dict -> SSpec
         { necessity = SRequired
         , nullity = NotNull
+        , exprable = listExprable @list nullity
         , info = vectorTypeInformation nullity info
         , ..
         }

src/Rel8/Schema/Null.hs

@@ -24,6 +24,9 @@ where
 import Data.Kind ( Constraint, Type )
 import Prelude
 
+-- rel8
+import Rel8.Schema.Serialize ( Exprable )
+
 
 type IsMaybe :: Type -> Bool
 type family IsMaybe a where
@@ -106,5 +109,5 @@ nullable = nullable'
 -- supports equality, and @a@ can either be exactly an @a@, or it could also be
 -- @Maybe a@.
 type Sql :: (Type -> Constraint) -> Type -> Constraint
-class (constraint (Unnullify a), Nullable a) => Sql constraint a
+class (constraint (Unnullify a), Exprable a, Nullable a) => Sql constraint a
-instance (constraint (Unnullify a), Nullable a) => Sql constraint a
+instance (constraint (Unnullify a), Exprable a, Nullable a) => Sql constraint a

src/Rel8/Schema/Serialize.hs

@@ -0,0 +1,88 @@
+{-# language FlexibleInstances #-}
+{-# language StandaloneKindSignatures #-}
+{-# language TypeFamilies #-}
+{-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
+
+module Rel8.Schema.Serialize
+  ( Encodable( Encoding )
+  , Constraints
+  , Exprable
+  )
+where
+
+-- aeson
+import Data.Aeson ( Value )
+
+-- base
+import Data.Int ( Int16, Int32, Int64 )
+import Data.List.NonEmpty ( NonEmpty )
+import Data.Kind ( Constraint, Type )
+import Data.Proxy ( Proxy )
+import Prelude
+
+-- bytestring
+import Data.ByteString ( ByteString )
+import qualified Data.ByteString.Lazy as Lazy ( ByteString )
+
+-- case-insensitive
+import Data.CaseInsensitive ( CI )
+
+-- rel8
+import {-# SOURCE #-} Rel8.Expr ( Expr )
+
+-- scientific
+import Data.Scientific ( Scientific )
+
+-- text
+import Data.Text ( Text )
+import qualified Data.Text.Lazy as Lazy ( Text )
+
+-- time
+import Data.Time.Calendar ( Day )
+import Data.Time.Clock ( UTCTime )
+import Data.Time.LocalTime ( CalendarDiffTime, LocalTime, TimeOfDay )
+
+-- uuid
+import Data.UUID ( UUID )
+
+
+type Constraints :: Type -> Type -> Constraint
+type family Constraints encoding a
+type instance Constraints (Proxy Expr) _a = ()
+
+
+type Encodable :: Type -> Constraint
+class Constraints (Encoding a) a => Encodable a where
+  type Encoding a :: Type
+  type Encoding _a = Proxy (Expr :: Type -> Type)
+
+
+instance Encodable Bool
+instance Encodable Char
+instance Encodable Int16
+instance Encodable Int32
+instance Encodable Int64
+instance Encodable Float
+instance Encodable Double
+instance Encodable Scientific
+instance Encodable UTCTime
+instance Encodable Day
+instance Encodable LocalTime
+instance Encodable TimeOfDay
+instance Encodable CalendarDiffTime
+instance Encodable Text
+instance Encodable Lazy.Text
+instance Encodable (CI Text)
+instance Encodable (CI Lazy.Text)
+instance Encodable ByteString
+instance Encodable Lazy.ByteString
+instance Encodable UUID
+instance Encodable Value
+instance Encodable [a]
+instance Encodable (NonEmpty a)
+instance Encodable (Maybe a)
+
+
+class (Encodable a, Encoding a ~ Proxy (Expr :: Type -> Type)) => Exprable a
+instance (Encodable a, Encoding a ~ Proxy (Expr :: Type -> Type)) => Exprable a

src/Rel8/Schema/Spec.hs

@@ -6,7 +6,7 @@
 
 module Rel8.Schema.Spec
   ( Spec( Spec )
-  , SSpec( SSpec, labels, necessity, info, nullity )
+  , SSpec( SSpec, labels, necessity, info, nullity, exprable )
   , KnownSpec( specSing )
   )
 where
@@ -22,7 +22,9 @@ import Rel8.Kind.Necessity
   , SNecessity
   , KnownNecessity, necessitySing
   )
+import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.Null ( Nullity, Sql, Unnullify, nullable )
+import Rel8.Schema.Serialize ( Exprable )
 import Rel8.Type ( DBType, typeInformation )
 import Rel8.Type.Information ( TypeInformation )
 
@@ -38,6 +40,7 @@ data SSpec spec where
     , necessity :: SNecessity necessity
     , info :: TypeInformation (Unnullify a)
     , nullity :: Nullity a
+    , exprable :: Dict Exprable (Unnullify a)
     }
     -> SSpec ('Spec labels necessity a)
 
@@ -59,4 +62,5 @@ instance
     , necessity = necessitySing
     , info = typeInformation
     , nullity = nullable
+    , exprable = Dict
     }

src/Rel8/Schema/Spec/ConstrainDBType.hs

@@ -24,9 +24,10 @@ import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.Null
   ( Nullify, Unnullify
   , Nullity( Null, NotNull )
-  , Sql, nullable
+  , Nullable, Sql, nullable
   )
-import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec, nullity ) )
+import Rel8.Schema.Serialize ( Exprable )
+import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec, exprable, nullity ) )
 
 
 type ConstrainDBType :: (Type -> Constraint) -> Spec -> Constraint
@@ -44,13 +45,16 @@ instance
 
 
 dbTypeNullity :: Dict (ConstrainDBType c) ('Spec l n a) -> Nullity a
-dbTypeNullity = step2 . step1
+dbTypeNullity = step3 . step2 . step1
   where
     step1 :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict (Sql c) a
     step1 Dict = Dict
 
-    step2 :: Dict (Sql c) a -> Nullity a
+    step2 :: Dict (Sql c) a -> Dict Nullable a
-    step2 Dict = nullable
+    step2 Dict = Dict
+
+    step3 :: Dict Nullable a -> Nullity a
+    step3 Dict = nullable
 
 
 dbTypeDict :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict c (Unnullify a)
@@ -63,9 +67,9 @@ dbTypeDict = step2 . step1
     step2 Dict = Dict
 
 
-fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l n a)
+fromNullityDict :: Nullity a -> Dict Exprable (Unnullify a) -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l n a)
-fromNullityDict Null Dict = Dict
+fromNullityDict Null Dict Dict = Dict
-fromNullityDict NotNull Dict = Dict
+fromNullityDict NotNull Dict Dict = Dict
 
 
 nullifier :: ()
@@ -82,8 +86,8 @@ unnullifier :: ()
   => SSpec ('Spec labels necessity a)
   -> Dict (ConstrainDBType c) ('Spec labels necessity (Nullify a))
   -> Dict (ConstrainDBType c) ('Spec labels necessity a)
-unnullifier SSpec {nullity} dict = case dbTypeDict dict of
+unnullifier SSpec {exprable, nullity} dict = case dbTypeDict dict of
   Dict -> case nullity of
     Null -> Dict
     NotNull -> case dbTypeNullity dict of
-      Null -> fromNullityDict nullity Dict
+      Null -> fromNullityDict nullity exprable Dict

src/Rel8/Table/HKD.hs

@@ -1,7 +1,9 @@
 {-# language AllowAmbiguousTypes #-}
 {-# language DataKinds #-}
+{-# language DerivingStrategies #-}
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
+{-# language GeneralizedNewtypeDeriving #-}
 {-# language MultiParamTypeClasses #-}
 {-# language RankNTypes #-}
 {-# language ScopedTypeVariables #-}
@@ -70,12 +72,13 @@ import Rel8.Schema.Insert ( Insert )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify, notReify )
 import Rel8.Schema.Result ( Result )
+import Rel8.Schema.Serialize ( Encodable, Encoding, Constraints )
 import Rel8.Table
   ( Table, Columns, Context, Unreify
   , fromColumns, toColumns, reify, unreify
   , TTable, TColumns, TUnreify
   )
-import Rel8.Table.Serialize ( ToExprs, fromResult, toResult )
+import Rel8.Type.Serialize ( Strategy, ExprsFor, encode, decode )
 
 
 type GColumnsHKD :: Type -> K.HTable
@@ -142,6 +145,7 @@ type HKDT :: Type -> Type
 newtype HKDT a = HKDT
   { unHKDT :: a
   }
+  deriving newtype Generic
 
 
 instance HKDable a => Table Result (HKDT a) where
@@ -155,16 +159,18 @@ instance HKDable a => Table Result (HKDT a) where
   unreify = notReify
 
 
-instance
+instance HKDable (HKDT a) => Encodable (HKDT a) where
-  ( Table Expr (HKD a Expr)
+  type Encoding (HKDT a) = Proxy HKD
-  , Columns (HKD a Expr) ~ GColumns (HKD a)
+
-  , HKDable a
+
-  , x ~ HKD a Expr
+instance Strategy (Proxy HKD) where
-  )
+  type ExprsFor (Proxy HKD) a = HKD a Expr
-  => ToExprs x (HKDT a)
+
- where
+  encode = (\(HKD a) -> a) . toHKD
-  toResult = (\(HKD a) -> a) . toHKD . (\(HKDT a) -> a)
+  decode = fromHKD . HKD
-  fromResult = HKDT . fromHKD . HKD
+
+
+type instance Constraints (Proxy HKD) a = HKDable a
 
 
 fromHKD :: HKDable a => HKD a Result -> a
@@ -193,6 +199,8 @@ class
   , GMappable Top (Rep a)
   , GMappable (TTable (Reify Result)) (GMap (TColumn (Reify Result)) (Rep a))
   , GMap TUnreify (GMap (TColumn (Reify Result)) (Rep a)) ~ GMap (TColumn Result) (Rep a)
+  , Table Expr (HKD a Expr)
+  , Columns (HKD a Expr) ~ GColumns (HKD a)
   )
   => HKDable a
 instance
@@ -205,6 +213,8 @@ instance
   , GMappable Top (Rep a)
   , GMappable (TTable (Reify Result)) (GMap (TColumn (Reify Result)) (Rep a))
   , GMap TUnreify (GMap (TColumn (Reify Result)) (Rep a)) ~ GMap (TColumn Result) (Rep a)
+  , Table Expr (HKD a Expr)
+  , Columns (HKD a Expr) ~ GColumns (HKD a)
   )
   => HKDable a
 

src/Rel8/Table/Serialize.hs

@@ -41,11 +41,13 @@ import Rel8.Generic.Table
 import Rel8.Kind.Algebra ( KnownAlgebra )
 import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
-import Rel8.Schema.Null ( NotNull, Sql )
+import Rel8.Schema.Null ( Sql )
 import Rel8.Schema.Result ( Col( R ), Result )
+import Rel8.Schema.Serialize ( Encoding, Encodable )
 import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
 import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )
 import Rel8.Type ( DBType )
+import Rel8.Type.Serialize ( Strategy, ExprsFor, encode, decode )
 
 -- semigroupoids
 import Data.Functor.Apply ( WrappedApplicative(..) )
@@ -95,9 +97,17 @@ data TToExprs :: Type -> Type -> Exp Constraint
 type instance Eval (TToExprs exprs a) = ToExprs exprs a
 
 
-instance {-# OVERLAPPABLE #-} (Sql DBType a, x ~ Expr a) => ToExprs x a where
+instance {-# OVERLAPPABLE #-}
-  fromResult (HType (R a)) = a
+  ( Table Expr x
-  toResult = HType . R
+  , Encodable a
+  , encoding ~ Encoding a
+  , Strategy encoding
+  , x ~ ExprsFor encoding a
+  )
+  => ToExprs x a
+ where
+  fromResult = decode @encoding @a
+  toResult = encode @encoding @a
 
 
 instance (Sql DBType a, x ~ [a]) => ToExprs (Expr x) [a] where
@@ -105,14 +115,12 @@ instance (Sql DBType a, x ~ [a]) => ToExprs (Expr x) [a] where
   toResult = HType . R
 
 
-instance (Sql DBType a, NotNull a, x ~ Maybe a) => ToExprs (Expr x) (Maybe a)
+instance (DBType a, x ~ Maybe a) => ToExprs (Expr x) (Maybe a) where
- where
   fromResult (HType (R a)) = a
   toResult = HType . R
 
 
-instance (Sql DBType a, NotNull a, x ~ NonEmpty a) => ToExprs (Expr x) (NonEmpty a)
+instance (Sql DBType a, x ~ NonEmpty a) => ToExprs (Expr x) (NonEmpty a) where
- where
   fromResult (HType (R a)) = a
   toResult = HType . R
 

src/Rel8/Type.hs

@@ -1,8 +1,9 @@
 {-# language FlexibleInstances #-}
-{-# language MonoLocalBinds #-}
 {-# language MultiWayIf #-}
 {-# language StandaloneKindSignatures #-}
+{-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type
   ( DBType (typeInformation)
@@ -37,6 +38,7 @@ import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )
 
 -- rel8
 import Rel8.Schema.Null ( NotNull, Sql, nullable )
+import Rel8.Schema.Serialize ( Exprable )
 import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
 import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
 
@@ -74,7 +76,7 @@ import qualified Data.UUID as UUID
 -- types, such as types defined in PostgreSQL extensions, or custom domain
 -- types.
 type DBType :: Type -> Constraint
-class NotNull a => DBType a where
+class (NotNull a, Exprable a) => DBType a where
   typeInformation :: TypeInformation a
 
 

src/Rel8/Type/Composite.hs

@@ -36,6 +36,7 @@ import Rel8.Schema.HTable ( hfield, hspecs, htabulate, htabulateA )
 import Rel8.Schema.Name ( Col( N ), Name( Name ) )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
 import Rel8.Schema.Result ( Col( R ), Result )
+import Rel8.Schema.Serialize ( Encodable )
 import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
 import Rel8.Table ( Table, fromColumns, toColumns )
 import Rel8.Table.Eq ( EqTable )
@@ -65,6 +66,9 @@ newtype Composite a = Composite
   }
 
 
+instance Encodable (Composite a)
+
+
 instance DBComposite a => DBType (Composite a) where
   typeInformation = TypeInformation
     { decode = Hasql.composite (Composite . fromHKD <$> decoder)

src/Rel8/Type/Enum.hs

@@ -10,6 +10,7 @@
 {-# language TypeFamilies #-}
 {-# language TypeOperators #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.Enum
   ( Enum( Enum )
@@ -38,6 +39,7 @@ import qualified Hasql.Decoders as Hasql
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 
 -- rel8
+import Rel8.Schema.Serialize ( Encodable )
 import Rel8.Type ( DBType, typeInformation )
 import Rel8.Type.Eq ( DBEq )
 import Rel8.Type.Information ( TypeInformation(..) )
@@ -63,6 +65,9 @@ newtype Enum a = Enum
   }
 
 
+instance Encodable (Enum a)
+
+
 instance DBEnum a => DBType (Enum a) where
   typeInformation = TypeInformation
     { decode =

src/Rel8/Type/Eq.hs

@@ -4,6 +4,7 @@
 {-# language MultiParamTypeClasses #-}
 {-# language StandaloneKindSignatures #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.Eq
   ( DBEq

src/Rel8/Type/JSONBEncoded.hs

@@ -12,6 +12,7 @@ import Prelude
 import qualified Hasql.Decoders as Hasql
 
 -- rel8
+import Rel8.Schema.Serialize ( Encodable )
 import Rel8.Type ( DBType(..) )
 import Rel8.Type.Information ( TypeInformation(..) )
 
@@ -29,3 +30,6 @@ instance (FromJSON a, ToJSON a) => DBType (JSONBEncoded a) where
     , decode = Hasql.refine (first pack . fmap JSONBEncoded . parseEither parseJSON) Hasql.jsonb
     , typeName = "jsonb"
     }
+
+
+instance Encodable (JSONBEncoded a)

src/Rel8/Type/JSONEncoded.hs

@@ -8,6 +8,7 @@ import Data.Aeson.Types ( parseEither )
 import Prelude
 
 -- rel8
+import Rel8.Schema.Serialize ( Encodable )
 import Rel8.Type ( DBType(..) )
 import Rel8.Type.Information ( parseTypeInformation )
 
@@ -23,3 +24,6 @@ instance (FromJSON a, ToJSON a) => DBType (JSONEncoded a) where
     where
       f = fmap JSONEncoded . parseEither parseJSON
       g = toJSON . fromJSONEncoded
+
+
+instance Encodable (JSONEncoded a)

src/Rel8/Type/Monoid.hs

@@ -6,6 +6,7 @@
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.Monoid
   ( DBMonoid( memptyExpr )

src/Rel8/Type/Num.hs

@@ -5,6 +5,7 @@
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.Num
   ( DBNum, DBIntegral, DBFractional, DBFloating

src/Rel8/Type/Ord.hs

@@ -4,6 +4,7 @@
 {-# language MultiParamTypeClasses #-}
 {-# language StandaloneKindSignatures #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.Ord
   ( DBOrd

src/Rel8/Type/ReadShow.hs

@@ -11,6 +11,7 @@ import Prelude
 import Text.Read ( readMaybe )
 
 -- rel8
+import Rel8.Schema.Serialize ( Encodable )
 import Rel8.Type ( DBType( typeInformation ) )
 import Rel8.Type.Information ( parseTypeInformation )
 
@@ -30,3 +31,6 @@ instance (Read a, Show a, Typeable a) => DBType (ReadShow a) where
         Just ok -> Right $ ReadShow ok
         Nothing -> Left $ "Could not read " <> t <> " as a " <> show (typeRep (Proxy @a))
       printer = Text.pack . show . fromReadShow
+
+
+instance Encodable (ReadShow a)

src/Rel8/Type/Semigroup.hs

@@ -6,6 +6,7 @@
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.Semigroup
   ( DBSemigroup( (<>.))

src/Rel8/Type/Serialize.hs

@@ -0,0 +1,53 @@
+{-# language AllowAmbiguousTypes #-}
+{-# language DataKinds #-}
+{-# language DerivingVia #-}
+{-# language FlexibleContexts #-}
+{-# language FlexibleInstances #-}
+{-# language ScopedTypeVariables #-}
+{-# language StandaloneKindSignatures #-}
+{-# language TypeFamilyDependencies #-}
+{-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
+
+module Rel8.Type.Serialize
+  ( Strategy( ExprsFor, encode, decode )
+  )
+where
+
+-- base
+import Data.Kind ( Constraint, Type )
+import Data.Proxy ( Proxy )
+import Prelude
+
+-- rel8
+import Rel8.Expr ( Expr )
+import Rel8.Schema.HTable.Identity ( HIdentity(..) )
+import Rel8.Schema.Result ( Col( R ), Result )
+import Rel8.Schema.Serialize ( Constraints )
+import Rel8.Table ( Columns )
+
+
+type Strategy :: Type -> Constraint
+class Strategy strategy where
+  type ExprsFor strategy (a :: Type) = (expr :: Type) | expr -> a strategy
+
+  encode :: forall a expr result.
+    ( expr ~ ExprsFor strategy a
+    , result ~ Columns expr (Col Result)
+    , Constraints strategy a
+    )
+    => a -> result
+
+  decode :: forall a expr result.
+    ( expr ~ ExprsFor strategy a
+    , result ~ Columns expr (Col Result)
+    , Constraints strategy a
+    )
+    => result -> a
+
+
+instance Strategy (Proxy Expr) where
+  type ExprsFor (Proxy Expr) a = Expr a
+
+  decode (HType (R a)) = a
+  encode = HType . R

src/Rel8/Type/String.hs

@@ -3,6 +3,7 @@
 {-# language MultiParamTypeClasses #-}
 {-# language StandaloneKindSignatures #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.String
   ( DBString

src/Rel8/Type/Sum.hs

@@ -5,6 +5,7 @@
 {-# language TypeFamilies #-}
 {-# language StandaloneKindSignatures #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Type.Sum
   ( DBSum

src/Rel8/Type/Tag.hs

@@ -3,6 +3,7 @@
 {-# language DerivingVia #-}
 {-# language GeneralizedNewtypeDeriving #-}
 {-# language StandaloneKindSignatures #-}
+{-# language UndecidableInstances #-}
 
 module Rel8.Type.Tag
   ( EitherTag( IsLeft, IsRight ), isLeft, isRight
@@ -25,6 +26,7 @@ import {-# SOURCE #-} Rel8.Expr ( Expr )
 import Rel8.Expr.Eq ( (==.) )
 import Rel8.Expr.Opaleye ( zipPrimExprsWith )
 import Rel8.Expr.Serialize ( litExpr )
+import Rel8.Schema.Serialize ( Encodable )
 import Rel8.Type.Eq ( DBEq )
 import Rel8.Type ( DBType, typeInformation )
 import Rel8.Type.Information ( mapTypeInformation, parseTypeInformation )
@@ -40,7 +42,7 @@ type EitherTag :: Type
 data EitherTag = IsLeft | IsRight
   deriving stock (Eq, Ord, Read, Show, Enum, Bounded)
   deriving (Semigroup, Monoid) via (Min EitherTag)
-  deriving anyclass (DBEq, DBOrd)
+  deriving anyclass (DBEq, DBOrd, Encodable)
 
 
 instance DBType EitherTag where
@@ -71,7 +73,7 @@ type MaybeTag :: Type
 data MaybeTag = IsJust
   deriving stock (Eq, Ord, Read, Show, Enum, Bounded)
   deriving (Semigroup, Monoid) via (Min MaybeTag)
-  deriving anyclass (DBEq, DBOrd)
+  deriving anyclass (DBEq, DBOrd, Encodable)
 
 
 instance DBType MaybeTag where
@@ -93,5 +95,5 @@ instance DBMonoid MaybeTag where
 newtype Tag = Tag Text
   deriving newtype
     ( Eq, Ord, Read, Show
-    , DBType, DBEq, DBOrd
+    , DBType, DBEq, DBOrd, Encodable
     )