ribbit 1.0.0.1 → 1.1.0.0

raw patch · 10 files changed

+176/−175 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ribbit.cabal +2/−2
• src/Database/Ribbit.hs +23/−24
• src/Database/Ribbit/Args.hs +0/−114
• src/Database/Ribbit/Conditions.hs +47/−1
• src/Database/Ribbit/Delete.hs +8/−0
• src/Database/Ribbit/Insert.hs +5/−1
• src/Database/Ribbit/Params.hs +56/−0
• src/Database/Ribbit/PostgreSQL.hs +5/−5
• src/Database/Ribbit/Select.hs +17/−3
• src/Database/Ribbit/Update.hs +13/−25

@@ -1,6 +1,6 @@  name:                ribbit-version:             1.0.0.1+version:             1.1.0.0 synopsis:            Type-level Relational DB combinators. description:         Ribbit is yet another type safe relational database                      library for Haskell, heavily inspired by the@@ -25,10 +25,10 @@     Database.Ribbit     Database.Ribbit.PostgreSQL   other-modules:       -    Database.Ribbit.Args     Database.Ribbit.Conditions     Database.Ribbit.Delete     Database.Ribbit.Insert+    Database.Ribbit.Params     Database.Ribbit.Render     Database.Ribbit.Select     Database.Ribbit.Table

@@ -1,9 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -201,14 +199,15 @@     Produce the Haskell type corresponding to the query parameters for a select     statement: -    > ArgsType Query ~ Only Int -- Our statement has only one parameter, which is an int.+    > ParamsType Query ~ Only Int -- Our statement has only one parameter, which is an int.      Produce the Haskell type corresponding to the rows produced by the query:      > ResultType Query ~ Only Text -- Our query procudes only one column, a text.    -}-  ArgsType,+  ParamsType,+  ParamsTypeSchema,   ResultType,   Render,   -- ValidField,@@ -220,11 +219,11 @@ ) where  -import Database.Ribbit.Args (ArgsType, ResultType) import Database.Ribbit.Conditions (Where, Equals, NotEquals, Lt, Lte,   Gt, Gte, And, Or, Not, IsNull, NotNull, type (?)) import Database.Ribbit.Delete (DeleteFrom) import Database.Ribbit.Insert (InsertInto)+import Database.Ribbit.Params (ParamsType, ResultType, ParamsTypeSchema) import Database.Ribbit.Render (Render) import Database.Ribbit.Select (Select, From, As, On, LeftJoin) import Database.Ribbit.Table (Table(Name, DBSchema), Field, (:>)((:>)))@@ -307,42 +306,42 @@ -- >      forall m query. -- >      ( MonadIO m -- >      , KnownSymbol (Render query)--- >      , ToRow (ArgsType query)+-- >      , ToRow (ParamsType query) -- >      , FromRow (ResultType query) -- >      ) -- >   => Connection -- >   -> Proxy query--- >   -> ArgsType query+-- >   -> ParamsType query -- >   -> m [ResultType query] -- -- In particular, I want to point how how, in addition to the query--- itself, 'Database.Ribbit.PostgreSQL.query' accepts an @'ArgsType' query@+-- itself, 'Database.Ribbit.PostgreSQL.query' accepts an @'ParamsType' query@ -- as a parameter, and produces a list of @'ResultType' query@ items. ----- 'ArgsType' and 'ResultType' are where the type safety magic+-- 'ParamsType' and 'ResultType' are where the type safety magic -- happens. They are type families that, given a query type, produce the -- haskell type of the arguments to that query, and the rows produce by -- that query, respectively: ----- * 'ArgsType' - Given a query, produce the type of the embedded query+-- * 'ParamsType' - Given a query, produce the type of the embedded query --   parameters. -- * 'ResultType' - Given a query, produce the type of rows produced by --   that query. -- --- +-------------------------+------------------------------------------------+------------------------------------------------------------------------------+--- | Example                 | Resulting type                                 | Reason                                                                       |--- +=========================+================================================+==============================================================================+--- | @'ArgsType' MyQuery@    | @'Only' 'Text'@                                | Our query on only has one parameter, which is compared against the company   |--- |                         |                                                | "name" field, indicating it must be of type 'Text', because that is what     |--- |                         |                                                | we have defined the "name" column to be in our database schema using:        |--- |                         |                                                |                                                                              |--- |                         |                                                | @Field "name" Text@                                                          |--- |                         |                                                |                                                                              |--- +-------------------------+------------------------------------------------+------------------------------------------------------------------------------+--- | @'ResultType' MyQuery@  | @'Only' 'Text' ':>' 'Only' ('Maybe' 'Int')@    |  The Fields that 'MyQuery' is selecting are employee "name" and              |--- |                         |                                                |  "salary". Name is a non-null Text, and salary is a nullable integer.        |--- |                         |                                                |                                                                              |--- +-------------------------+------------------------------------------------+------------------------------------------------------------------------------++-- +-----------------------------+-----------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------++-- | Example                     | Resulting type                                                                                                  | Reason                                                                       |+-- +=============================+=================================================================================================================+==============================================================================++-- | @'ParamsType' MyQuery@ | @'Data.Tuple.Only.Only' 'Data.Text.Text'@                                                                  | Our query on only has one parameter, which is compared against the company   |+-- |                             |                                                                                                                 | "name" field, indicating it must be of type 'Text', because that is what     |+-- |                             |                                                                                                                 | we have defined the "name" column to be in our database schema using:        |+-- |                             |                                                                                                                 |                                                                              |+-- |                             |                                                                                                                 | @Field "name" Text@                                                          |+-- |                             |                                                                                                                 |                                                                              |+-- +-----------------------------+-----------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------++-- | @'ResultType' MyQuery@ | @'Data.Tuple.Only.Only' 'Data.Text.Text' ':>' 'Data.Tuple.Only.Only' ('Maybe' 'Int')@  | The Fields that 'MyQuery' is selecting are employee "name" and               |+-- |                             |                                                                                                                 | "salary". Name is a non-null Text, and salary is a nullable integer.         |+-- |                             |                                                                                                                 |                                                                              |+-- +-----------------------------+-----------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------+ -- -- Therefore, we can invoke the query thusly: -- 

@@ -1,114 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--{- | Translate statement parameters into Haskell types. -}-module Database.Ribbit.Args (-  ArgsType,-  ResultType,-) where---import Data.Tuple.Only (Only)-import Data.Type.Bool (If)-import Database.Ribbit.Conditions (Where, Equals, NotEquals, Lt, Lte,-  Gt, Gte, Not, And, Or, type (?))-import Database.Ribbit.Delete (DeleteFrom)-import Database.Ribbit.Insert (InsertInto)-import Database.Ribbit.Select (From, Select)-import Database.Ribbit.Table (DBSchema, Flatten, (:>), Field, ValidField,-  NotInSchema)-import Database.Ribbit.Update (Update)-import GHC.TypeLits (TypeError, ErrorMessage(ShowType, (:$$:)))-import qualified GHC.TypeLits as Lit---{- |-  Produce the type represeting the placeholder ("?") values in a-  paramaterized query.--}-type family ArgsType query where-  ArgsType (_ `From` relation `Where` conditions) =-    ArgsType (DBSchema relation, conditions)--  ArgsType (InsertInto relation fields) =-    ProjectionType fields (DBSchema relation)--  ArgsType (DeleteFrom relation `Where` conditions) =-    ArgsType (DBSchema relation, conditions)--  ArgsType (Update relation fields) =-    ProjectionType fields (DBSchema relation)-  ArgsType (Update relation fields `Where` conditions) =-    ProjectionType fields (DBSchema relation)-    :> ArgsType (DBSchema relation, conditions)--  ArgsType (schema, And a b) =-    StripUnit (Flatten (ArgsType (schema, a) :> ArgsType (schema, b)))-  ArgsType (schema, Or a b) =-    StripUnit (Flatten (ArgsType (schema, a) :> ArgsType (schema, b)))-  ArgsType (schema, Condition field (?)) =-    ProjectionType '[field] schema-  ArgsType (schema, Condition (?) field) =-    ProjectionType '[field] schema-  ArgsType (schema, Condition l r) =-    If-      (ValidField r schema)-      (If (ValidField l schema) () (NotInSchema l schema))-      (NotInSchema r schema)-  ArgsType (schema, Equals l r) = ArgsType (schema, Condition l r)-  ArgsType (schema, NotEquals l r) = ArgsType (schema, Condition l r)-  ArgsType (schema, Lt l r) = ArgsType (schema, Condition l r)-  ArgsType (schema, Lte l r) = ArgsType (schema, Condition l r)-  ArgsType (schema, Gt l r) = ArgsType (schema, Condition l r)-  ArgsType (schema, Gte l r) = ArgsType (schema, Condition l r)-  ArgsType (schema, Not a) = ArgsType (schema, a)-  ArgsType _ = ()---{- |-  Helper for 'ArgsType'. Reduces the number of equations required, because-  'ArgsType' doesn't actually care about which conditionl operator it-  is inspecting.--}-data Condition l r---{- |-  Strip redundant unit types out of a string of types. This is used-  mainly to help simplify the implementation of 'ArgsType'.--}-type family StripUnit a where-  StripUnit (() :> a) = StripUnit a-  StripUnit (a :> ()) = StripUnit a-  StripUnit (a :> b) = a :> StripUnit b-  StripUnit a = a---type family ProjectionType proj schema where-  ProjectionType '[name] schema =-    LookupType name schema schema-  ProjectionType (name:more) schema =-    LookupType name schema schema-    :> ProjectionType more schema---{- | Produce the type of rows return by a query. -}-type family ResultType query where-  ResultType (Select fields `From` relation) =-    ProjectionType fields (DBSchema relation)-  ResultType (query `Where` conditions) = ResultType query-  ResultType query =-    TypeError ('Lit.Text "Malformed Query" ':$$: 'ShowType query)---type family LookupType name schema context where-  LookupType name (Field name typ) _ = Only typ-  LookupType name (Field name typ :> _) _ = Only typ-  LookupType name (Field _ typ) context = NotInSchema name context-  LookupType name (_ :> more) context = LookupType name more context-  LookupType name a context = NotInSchema name context--

@@ -25,7 +25,11 @@ ) where  -import Database.Ribbit.Table (Validate)+import Data.Type.Bool (If)+import Database.Ribbit.Params (ParamsTypeSchema, ResultType,+  ProjectionType)+import Database.Ribbit.Table (Validate, Flatten, (:>), ValidField,+  NotInSchema) import GHC.TypeLits (Symbol, AppendSymbol, TypeError, ErrorMessage((:<>:),   ShowType)) import qualified GHC.TypeLits as Lit@@ -202,5 +206,47 @@  {- | "?" constructor, used to indicate the presence of a query parameter. -} data (?)+++type instance ParamsTypeSchema schema (And a b) =+  StripUnit (Flatten (ParamsTypeSchema schema a :> ParamsTypeSchema schema b))+type instance ParamsTypeSchema schema (Or a b) =+  StripUnit (Flatten (ParamsTypeSchema schema a :> ParamsTypeSchema schema b))+type instance ParamsTypeSchema schema (Equals l r) = CompParams schema (Comparison l r)+type instance ParamsTypeSchema schema (NotEquals l r) = CompParams schema (Comparison l r)+type instance ParamsTypeSchema schema (Lt l r) = CompParams schema (Comparison l r)+type instance ParamsTypeSchema schema (Lte l r) = CompParams schema (Comparison l r)+type instance ParamsTypeSchema schema (Gt l r) = CompParams schema (Comparison l r)+type instance ParamsTypeSchema schema (Gte l r) = CompParams schema (Comparison l r)+type instance ParamsTypeSchema schema (Not a) = ParamsTypeSchema schema a+++type instance ResultType (query `Where` conditions) = ResultType query+++{- | Produce the parameters for a comparison operator. -}+type family CompParams schema comp where+  CompParams schema (Comparison field (?)) = ProjectionType '[field] schema+  CompParams schema (Comparison (?) field) = ProjectionType '[field] schema+  CompParams schema (Comparison l r) =+    If+      (ValidField r schema)+      (If (ValidField l schema) () (NotInSchema l schema))+      (NotInSchema r schema)+++{- | Helper for 'CompParams'. -}+data Comparison l r+++{- |+  Strip redundant unit types out of a string of types. This is used+  mainly to help simplify the implementation of 'ParamsType'.+-}+type family StripUnit a where+  StripUnit (() :> a) = StripUnit a+  StripUnit (a :> ()) = StripUnit a+  StripUnit (a :> b) = a :> StripUnit b+  StripUnit a = a  

@@ -11,6 +11,7 @@   import Database.Ribbit.Conditions (RenderConditions, Where)+import Database.Ribbit.Params (ParamsType, ParamsTypeSchema) import Database.Ribbit.Render (Render) import Database.Ribbit.Table (Name, DBSchema) import GHC.TypeLits (AppendSymbol)@@ -28,5 +29,12 @@   Render (DeleteFrom table)   `AppendSymbol` " WHERE "   `AppendSymbol` RenderConditions conditions (DBSchema table)+++type instance ParamsType (DeleteFrom relation `Where` conditions) =+  ParamsTypeSchema (DBSchema relation) conditions+++type instance ParamsType (DeleteFrom relation) = ()  

@@ -11,8 +11,9 @@ ) where  +import Database.Ribbit.Params (ParamsType, ProjectionType) import Database.Ribbit.Render (Render)-import Database.Ribbit.Table (Name)+import Database.Ribbit.Table (Name, DBSchema) import GHC.TypeLits (AppendSymbol)  @@ -44,4 +45,7 @@     `AppendSymbol` ", "     `AppendSymbol` RendPlaceholderList (f2:more) ++type instance ParamsType (InsertInto relation fields) =+  ProjectionType fields (DBSchema relation) 

@@ -0,0 +1,56 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{- | Translate statement parameters into Haskell types. -}+module Database.Ribbit.Params (+  ParamsType,+  ResultType,+  ParamsTypeSchema,+  ProjectionType,+) where+++import Data.Tuple.Only (Only)+import Database.Ribbit.Table ((:>), Field, NotInSchema)+++{- |+  Produce the type represeting the placeholder ("?") values in a+  paramaterized query.++  This type family is open and extendable.+-}+type family ParamsType query+++{- | Produce the type of rows return by a query. -}+type family ResultType query+++{- |+  Produce the parameters type in relation to a particiular schema.++  This type family is open and extendable.+-}+type family ParamsTypeSchema schema a+++type family ProjectionType proj schema where+  ProjectionType '[name] schema =+    LookupType name schema schema+  ProjectionType (name:more) schema =+    LookupType name schema schema+    :> ProjectionType more schema+++type family LookupType name schema context where+  LookupType name (Field name typ) _ = Only typ+  LookupType name (Field name typ :> _) _ = Only typ+  LookupType name (Field _ typ) context = NotInSchema name context+  LookupType name (_ :> more) context = LookupType name more context+  LookupType name a context = NotInSchema name context++

@@ -51,7 +51,7 @@ import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple.FromField (FromField) import Database.PostgreSQL.Simple.ToField (Action, ToField)-import Database.Ribbit.Args (ArgsType, ResultType)+import Database.Ribbit.Params (ParamsType, ResultType) import Database.Ribbit.Render (Render) import Database.Ribbit.Table ((:>)((:>)), Name, DBSchema, Field,   ValidField)@@ -67,10 +67,10 @@ {- | Execute a statement. -} execute ::      forall m query.-     (MonadIO m, ToRow (ArgsType query), KnownSymbol (Render query))+     (MonadIO m, ToRow (ParamsType query), KnownSymbol (Render query))   => Connection   -> Proxy query-  -> ArgsType query+  -> ParamsType query   -> m Int64 execute conn _theQuery args =   liftIO $@@ -300,12 +300,12 @@      forall m query.      ( MonadIO m      , KnownSymbol (Render query)-     , ToRow (ArgsType query)+     , ToRow (ParamsType query)      , FromRow (ResultType query)      )   => Connection   -> Proxy query-  -> ArgsType query+  -> ParamsType query   -> m [ResultType query] query conn _theQuery args =   liftIO . (fmap . fmap) unWrap $

@@ -21,10 +21,13 @@ ) where  -import Database.Ribbit.Conditions (RenderJoinConditions, Where, RenderConditions)+import Database.Ribbit.Conditions (RenderJoinConditions, Where,+  RenderConditions)+import Database.Ribbit.Params (ParamsType, ResultType, ParamsTypeSchema,+  ProjectionType) import Database.Ribbit.Render (Render)-import Database.Ribbit.Table (Name, DBSchema, Field, (:>), Table, Flatten,-  Validate)+import Database.Ribbit.Table (Name, DBSchema, Field, (:>), Table,+  Flatten, Validate) import GHC.TypeLits (AppendSymbol, Symbol)  @@ -173,5 +176,16 @@   Render (proj `From` table)   `AppendSymbol` " WHERE "   `AppendSymbol` RenderConditions conditions (DBSchema table)+++type instance ParamsType (_ `From` relation `Where` conditions) =+  ParamsTypeSchema (DBSchema relation) conditions+++type instance ParamsType (Select proj `From` relation) = ()+++type instance ResultType (Select fields `From` relation) =+    ProjectionType fields (DBSchema relation)  

@@ -12,8 +12,10 @@   import Database.Ribbit.Conditions (RenderConditions, Where)+import Database.Ribbit.Params (ParamsType, ParamsTypeSchema,+  ProjectionType) import Database.Ribbit.Render (Render)-import Database.Ribbit.Table (Name, DBSchema)+import Database.Ribbit.Table (Name, DBSchema, (:>)) import GHC.TypeLits (AppendSymbol, Symbol)  @@ -41,27 +43,13 @@     `AppendSymbol` " = ?, "     `AppendSymbol` RenderUpdateFields more --- {- UPDATE -}--- instance (KnownSymbol (Name table), RenderUpdates updates)---   =>---     Render (Update table updates)---   where---     render _proxy =---       "UPDATE "---       <> symbolVal (Proxy @(Name table))---       <> " SET "---       <> renderUpdates (Proxy @updates)--- --- --- {- | Render the updates to a table. -}--- class RenderUpdates a where---   renderUpdates :: proxy a -> Text--- instance (KnownSymbol field) => RenderUpdates '[field] where---   renderUpdates _ = symbolVal (Proxy @field) <> " = ?"--- instance (KnownSymbol field, RenderUpdates (m:ore))---   =>---     RenderUpdates (field : (m:ore))---   where---     renderUpdates _ =---       symbolVal (Proxy @field) <> " = ?, "---       <> renderUpdates (Proxy @(m:ore))++type instance ParamsType (Update relation fields) =+  ProjectionType fields (DBSchema relation)+++type instance ParamsType (Update relation fields `Where` conditions) =+  ProjectionType fields (DBSchema relation)+  :> ParamsTypeSchema (DBSchema relation) conditions++