Session construction demo

Author: VyacheslavHashov

src/Database/PostgreSQL/Query.hs

@@ -10,22 +10,11 @@ import qualified Data.HashSet as HS
 import Data.Word
 import Data.Proxy
 import Data.Monoid
+import Data.Coerce
 
 -- import Database.PostgreSQL.Session
 import Database.PostgreSQL.Other
 
----------------
--- Result Parser
----------------
-
-data ResultParser
-    = OneResurtParser
-    | MaybeResultParser
-    | ManyParser
-
-data ResultParserError
-    = ResultNoRows
-    | ResultToManyRows
 
 ---------------------
 -- Row parser
@@ -74,64 +63,90 @@ composite name xs = undefined
 class ToPostgres a where
     toPostgres :: Encoder a
 
--- Params
-
 class IsParams a where
     params :: a -> [QueryM EncodeResult]
 
 instance (ToPostgres a, ToPostgres b) => IsParams (a, b) where
     params (a, b) = [toPostgres a, toPostgres b]
 
-type Context = [QueryM EncodeResult]
+----------------------
+-- Results
+-------------------
 
-class ToParams a where
-    type ParamType a :: *
+data ResultParser a
+    = OneRowParser
+    | MaybeRowParser
+    | ManyRowsParser
 
-    derive :: Proxy a -> Context -> ParamType a
+data ResultParserError
+    = ResultNoRows
+    | ResultToManyRows
 
-instance IsParams a => ToParams a where
-    type ParamType a = a -> [QueryM EncodeResult]
+data SingleRow a
+data MaybeRow a
+data ManyRows a
 
-    derive p ctx = ctx <> params
+class FromResult a where
+    type Result a :: *
 
-instance (ToPostgres x, ToParams xs) => ToParams (x ': xs) where
-    type ParamType (x ': xs) = x -> ParamType xs
+    resultParser :: ResultParser (Result a)
 
-    derive p ctx v = derive (Proxy :: Proxy xs) (toPostgres v : ctx)
+instance FromPostgres a => FromResult (SingleRow a) where
+    type Result (SingleRow a) = a
 
-instance ToParams '[] where
-    type ParamType a = [QueryM EncodeResult]
+    resultParser = OneRowParser
 
-    derive p ctx = ctx
+instance FromPostgres a => FromResult (MaybeRow a) where
+    type Result (MaybeRow a) = Maybe a
 
-getParams :: ToParams a => SessionQuery a b -> ParamType a
-getParams _ = derive (Proxy :: Proxy a) []
+    resultParser = MaybeRowParser
 
+instance FromPostgres a => FromResult (ManyRows a) where
+    type Result (ManyRows a) = V.Vector a
 
-buildSession :: SessionQuery a b -> [QueryM EncoderResult] -> Session b
-buildSession = undefined
- -- makeQuery . runEncodeResult <$> sequence params
- --   where
- --     makeQuery values = Query
+    resultParser = ManyRowsParser
 
-----------------------
--- Results
--------------------
-data ResultType a
-    = SingleRow a
-    | MaybeRow a
-    | ManyRows a
+------------------------
+-- Session
+-----------------------
 
-data SessionQuery a (b :: ResultType *) = SessionQuery { sqStatement :: B.ByteString }
+data SessionQuery a b = SessionQuery { sqStatement :: B.ByteString }
     deriving (Show)
 
-type family Result a where
-    Result (SingleRow a) = a
-    Result (MaybeRow a) = Maybe a
-    Result (ManyRows a) = V.Vector a
+type Context = [QueryM EncodeResult]
+
+class ToSession a where
+    type SessionType a :: *
+
+    derive :: a -> Context -> SessionType a
+
+instance (IsParams a, FromResult b) => ToSession (SessionQuery a b) where
+    type SessionType a = a -> Session (Result b)
+
+    derive q ctx = buildSession s $ ctx <> params
+
+instance (ToPostgres x, ToSession xs, FromResult b)
+      => ToSession (SessionQuery (x ': xs) b) where
+
+    type SessionType (x ': xs) = x -> SessionType xs
 
-query :: (ToParams a, FromRows b) => SessionQuery a b -> a -> Session (Result b)
-query = undefined
+    derive q ctx v = derive (coerce q :: SessionQuery xs b) (toPostgres v : ctx)
+
+instance FromResult b => ToSession (SessionQuery '[] b) where
+    type SessionType a = Session (Result b)
+
+    derive = buildSession
+
+query :: ToSession q => q -> SessionType q
+query q = derive q []
+
+buildSession
+    :: FromResult b
+    => SessionQuery a b -> [QueryM EncoderResult] -> Session (Result b)
+buildSession = undefined
+ -- makeQuery . runEncodeResult <$> sequence params
+ --   where
+ --     makeQuery values = Query
 
 
 tq :: SessionQuery '[Int, Char, Word] b