@@ -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,19 @@ 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 Generics.SOP (NP(..), hmap, SListI)
3239import GHC.TypeLits
3340
41+import Squeal.PostgreSQL.Alias
3442import Squeal.PostgreSQL.Expression
3543import Squeal.PostgreSQL.Expression.Type
44+import Squeal.PostgreSQL.Manipulation
3645import Squeal.PostgreSQL.Render
3746import Squeal.PostgreSQL.Schema
3847
@@ -78,3 +87,78 @@ param
7887 . (PGTyped schemas ty, HasParameter n params ty)
7988 => Expression outer commons grp schemas params from ty -- ^ param
8089param = parameter @n (pgtype @schemas)
90+
91+class Insertable
92+ (schemas :: SchemasType)
93+ (params :: [NullityType])
94+ (row :: RowType)
95+ (columns :: ColumnsType)
96+ | columns -> params
97+ , columns -> row where
98+ params ::
99+ NP (Aliased (Optional (
100+ Expression '[] commons 'Ungrouped schemas params '[]
101+ ) ) ) columns
102+instance Insertable schemas '[] '[] '[] where params = Nil
103+instance
104+ ( KnownSymbol col
105+ , PGTyped schemas ty
106+ , SListI columns
107+ , Insertable schemas params row columns ) =>
108+ Insertable schemas (ty ': params) (col ::: ty ': row)
109+ (col ::: 'NoDef :=> ty ': columns) where
110+ params =
111+ Set (param @1) `as` (Alias @col)
112+ :* hmap (overValue paramsPlus1) (params @schemas)
113+instance
114+ ( KnownSymbol col
115+ , PGTyped schemas ty
116+ , SListI columns
117+ , Insertable schemas params row columns ) =>
118+ Insertable schemas params row (col ::: 'Def :=> ty ': columns) where
119+ params = Default `as` (Alias @col) :* (params @schemas)
120+overValue
121+ :: ( forall o c g s f x
122+ . Expression o c g s p0 f x -> Expression o c g s p1 f x )
123+ -> Aliased (Optional (
124+ Expression '[] commons 'Ungrouped schemas p0 '[]
125+ ) ) column
126+ -> Aliased (Optional (
127+ Expression '[] commons 'Ungrouped schemas p1 '[]
128+ ) ) column
129+overValue f = \case
130+ Set expr `As` alias -> Set (f expr) `as` alias
131+ Default `As` alias -> Default `as` alias
132+
133+paramsPlus1
134+ :: Expression outer commons grp schemas params from ty
135+ -> Expression outer commons grp schemas (param ': params) from ty
136+paramsPlus1 = UnsafeExpression . paramsPlus1_ . renderSQL
137+ where
138+ paramsPlus1_ :: ByteString -> ByteString
139+ paramsPlus1_ = undefined -- replace $n with $n+1
140+
141+insertParamsInto
142+ :: ( Has sch schemas schema
143+ , Has tab schema ('Table table)
144+ , columns ~ TableToColumns table
145+ , row0 ~ TableToRow table
146+ , SListI columns
147+ , SListI returning
148+ , Insertable schemas params row columns )
149+ => QualifiedAlias sch tab
150+ -> ConflictClause tab commons schemas params table
151+ -> ReturningClause commons schemas params '[tab ::: row0] returning
152+ -> Manipulation commons schemas params returning
153+insertParamsInto tab = insertInto tab (Values_ params)
154+
155+insertParamsInto_
156+ :: ( Has sch schemas schema
157+ , Has tab schema ('Table table)
158+ , columns ~ TableToColumns table
159+ , row0 ~ TableToRow table
160+ , SListI columns
161+ , Insertable schemas params row columns )
162+ => QualifiedAlias sch tab
163+ -> Manipulation commons schemas params '[]
164+insertParamsInto_ tab = insertInto_ tab (Values_ params)