on dev help sign in
profunctor
f2a2a49Eitan Chatav
squeal-postgresql/squeal-postgresql.cabal+1
@@ -50,6 +50,7 @@ library
50 , network-ip >= 0.3.0.2
50 , network-ip >= 0.3.0.2
51 , postgresql-binary >= 0.12.1
51 , postgresql-binary >= 0.12.1
52 , postgresql-libpq >= 0.9.4.1
52 , postgresql-libpq >= 0.9.4.1
53+ , profunctors >= 5.2.2
53 , resource-pool >= 0.2.3.2
54 , resource-pool >= 0.2.3.2
54 , scientific >= 0.3.5.3
55 , scientific >= 0.3.5.3
55 , text >= 1.2.3.0
56 , text >= 1.2.3.0
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+22
@@ -74,7 +74,9 @@ module Squeal.PostgreSQL.Query
74
74
75import Control.DeepSeq
75import Control.DeepSeq
76import Data.ByteString (ByteString)
76import Data.ByteString (ByteString)
77+import Data.Kind
77import Data.Monoid hiding (All)
78import Data.Monoid hiding (All)
79+import Data.Profunctor
78import Data.String
80import Data.String
79import Data.Word
81import Data.Word
80import Generics.SOP hiding (from)
82import Generics.SOP hiding (from)
@@ -82,6 +84,7 @@ import GHC.TypeLits
82
84
83import qualified GHC.Generics as GHC
85import qualified GHC.Generics as GHC
84
86
87+import Squeal.PostgreSQL.Binary
85import Squeal.PostgreSQL.Expression
88import Squeal.PostgreSQL.Expression
86import Squeal.PostgreSQL.Render
89import Squeal.PostgreSQL.Render
87import Squeal.PostgreSQL.Schema
90import Squeal.PostgreSQL.Schema
@@ -285,6 +288,25 @@ newtype Query
285 deriving (GHC.Generic,Show,Eq,Ord,NFData)
288 deriving (GHC.Generic,Show,Eq,Ord,NFData)
286instance RenderSQL (Query schema params columns) where renderSQL = renderQuery
289instance RenderSQL (Query schema params columns) where renderSQL = renderQuery
287
290
291+data QueryFrom
292+ (schema :: SchemaType)
293+ (x :: Type)
294+ (y :: Type)
295+ where
296+ QueryFrom
297+ :: (x -> NP (K (Maybe ByteString)) params)
298+ -> Query schema params result
299+ -> (NP (K (Maybe ByteString)) result -> y)
300+ -> QueryFrom schema x y
301+instance Profunctor (QueryFrom schema) where
302+ dimap f g (QueryFrom params q result) = QueryFrom (params.f) q (g.result)
303+
304+queryFrom
305+ :: (ToParams x (ParamsFrom x), FromRow (ResultFrom y) y)
306+ => Query schema (ParamsFrom x) (ResultFrom y)
307+ -> QueryFrom schema x y
308+queryFrom q = QueryFrom toParams q fromRow
309+
288type family Query' schema x y where
310type family Query' schema x y where
289 Query' schema x y = Query schema (ParamsFrom x) (ResultFrom y)
311 Query' schema x y = Query schema (ParamsFrom x) (ResultFrom y)
290
312