@@ -14,7 +14,9 @@ Parameters, out-of-line data values
1414 , FlexibleContexts
1515 , FlexibleInstances
1616 , FunctionalDependencies
17+ , GADTs
1718 , KindSignatures
19+ , LambdaCase
1820 , MultiParamTypeClasses
1921 , OverloadedStrings
2022 , RankNTypes
@@ -27,12 +29,22 @@ Parameters, out-of-line data values
2729module Squeal.PostgreSQL.Expression.Parameter
2830 ( HasParameter (parameter)
2931 , param
32+ , params
33+ , insertParamsInto
34+ , insertParamsInto_
3035 ) where
3136
37+import Data.ByteString (ByteString)
38+import qualified Data.ByteString as ByteString
39+import qualified Data.ByteString.Char8 as Char8
40+import Data.Int (Int32)
41+import Generics.SOP (NP(..), hmap, SListI)
3242import GHC.TypeLits
3343
44+import Squeal.PostgreSQL.Alias
3445import Squeal.PostgreSQL.Expression
3546import Squeal.PostgreSQL.Expression.Type
47+import Squeal.PostgreSQL.Manipulation
3648import Squeal.PostgreSQL.Render
3749import Squeal.PostgreSQL.Schema
3850
@@ -78,3 +90,86 @@ param
7890 . (PGTyped schemas ty, HasParameter n params ty)
7991 => Expression outer commons grp schemas params from ty -- ^ param
8092param = parameter @n (pgtype @schemas)
93+
94+class Insertable
95+ (schemas :: SchemasType)
96+ (params :: [NullityType])
97+ (row :: RowType)
98+ (columns :: ColumnsType)
99+ | columns -> params
100+ , columns -> row where
101+ params ::
102+ NP (Aliased (Optional (
103+ Expression '[] commons 'Ungrouped schemas params '[]
104+ ) ) ) columns
105+instance Insertable schemas '[] '[] '[] where params = Nil
106+instance
107+ ( KnownSymbol col
108+ , PGTyped schemas ty
109+ , SListI columns
110+ , Insertable schemas params row columns ) =>
111+ Insertable schemas params row (col ::: 'Def :=> ty ': columns) where
112+ params = Default `as` (Alias @col) :* (params @schemas)
113+instance
114+ ( KnownSymbol col
115+ , PGTyped schemas ty
116+ , SListI columns
117+ , Insertable schemas params row columns ) =>
118+ Insertable schemas (ty ': params) (col ::: ty ': row)
119+ (col ::: 'NoDef :=> ty ': columns) where
120+ params =
121+ Set (param @1) `as` (Alias @col)
122+ :* hmap (overValue paramPlus1) (params @schemas)
123+
124+overValue
125+ :: ( forall o c g s f x
126+ . Expression o c g s p0 f x -> Expression o c g s p1 f x )
127+ -> Aliased (Optional (
128+ Expression '[] commons 'Ungrouped schemas p0 '[]
129+ ) ) column
130+ -> Aliased (Optional (
131+ Expression '[] commons 'Ungrouped schemas p1 '[]
132+ ) ) column
133+overValue f = \case
134+ Set expr `As` alias -> Set (f expr) `as` alias
135+ Default `As` alias -> Default `as` alias
136+
137+paramPlus1
138+ :: Expression outer commons grp schemas params from ty
139+ -> Expression outer commons grp schemas (param ': params) from ty
140+paramPlus1 = UnsafeExpression . paramsPlus1_ . renderSQL
141+ where
142+ paramsPlus1_ :: ByteString -> ByteString
143+ paramsPlus1_ p =
144+ let
145+ (left_n, right) = ByteString.breakSubstring "::" p
146+ isDigit w = w - 48 <= 9
147+ (left, n) = ByteString.break isDigit left_n
148+ add1 = Char8.pack . show . (+ 1) . read @Int32 . Char8.unpack
149+ in
150+ left <> add1 n <> right
151+
152+insertParamsInto
153+ :: ( Has sch schemas schema
154+ , Has tab schema ('Table table)
155+ , columns ~ TableToColumns table
156+ , row0 ~ TableToRow table
157+ , SListI columns
158+ , SListI returning
159+ , Insertable schemas params row columns )
160+ => QualifiedAlias sch tab
161+ -> ConflictClause tab commons schemas params table
162+ -> ReturningClause commons schemas params '[tab ::: row0] returning
163+ -> Manipulation commons schemas params returning
164+insertParamsInto tab = insertInto tab (Values_ params)
165+
166+insertParamsInto_
167+ :: ( Has sch schemas schema
168+ , Has tab schema ('Table table)
169+ , columns ~ TableToColumns table
170+ , row0 ~ TableToRow table
171+ , SListI columns
172+ , Insertable schemas params row columns )
173+ => QualifiedAlias sch tab
174+ -> Manipulation commons schemas params '[]
175+insertParamsInto_ tab = insertInto_ tab (Values_ params)