ribbit 0.2.1.0 → 0.2.2.0

raw patch · 4 files changed

+273/−26 lines, 4 filesdep +timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: time

API changes (from Hackage documentation)

Files

• README.md +45/−18
• ribbit.cabal +3/−2
• src/Database/Ribbit.hs +5/−3
• src/Database/Ribbit/PostgreSQL.hs +220/−3

@@ -6,10 +6,10 @@             - [Basic @Select .. From ..](#basic-select--from-)             - [Cross product](#cross-product)             - [Conditionals](#conditionals)+            - [Limited `CREATE TABLE` support.](#limited-create-table-support)     - [Roadmap](#roadmap)-        - [More conditional operatores.](#more-conditional-operatores)-        - [`CREATE TABLE` support.](#create-table-support)         - [`INSERT INTO` support.](#insert-into-support)+        - [Flesh out Haskell to PostgreSQL type mapping.](#flesh-out-haskell-to-postgresql-type-mapping)     - [How it compares with other libraries.](#how-it-compares-with-other-libraries)     - [The name: Ribbit](#the-name-ribbit) @@ -44,9 +44,11 @@  ## Status -The status of Ribbit "Very Incomplete". My goal is to take a "depth first"-approach, where every feature added is production ready before moving on to the-next feature. Featured back-ends include `postgres-simple` at this time.+The status of Ribbit "Very Incomplete". My goal is to take a "depth+first" approach, where every feature added is production ready+before moving on to the next feature. Featured back-ends include+[postgresql-simple](https://hackage.haskell.org/package/postgresql-simple)+at this time.  ### Current Features @@ -56,19 +58,25 @@  We support queries of the form: -> type MyQuery = Select '["field1", "field2"] `From` MyTable+```haskell+type MyQuery = Select '["field1", "field2"] `From` MyTable+```  #### Cross product  We support queries of the form: +```haskell type MyQuery = Select '["t1.field1", "t2.field2"] `From` MyTable1 `As` "t1" `X` MyTable2 `As` "t2"+```  #### Conditionals  We support queries of the form: -> type MyQuery = Select '["field1", "field2"] `From` MyTable `Where` \<condition\>+```haskell+type MyQuery = Select '["field1", "field2"] `From` MyTable `Where` <condition>+```  Where ```<condition>``` can include: @@ -84,24 +92,43 @@ - ```"field" `NotEquals` (?)```: Test for inequality against a query parameter. - ```"field1" `NotEquals` "field2"```: Test for inequality between two fields. -## Roadmap+#### Limited `CREATE TABLE` support. -This is what I plan to work on next:+The postgresql-simple backend supports creating tables in the+database. This support is "limited" because it misses the following+features: -### `CREATE TABLE` support.+- PostgreSQL column types are know for only a small number of Haskell types.+  This is extensible by the user (by implementing a type class), but it would+  be nice to have a more comprehensive set of mappings out of the box. -One source of programming bugs is when the schema in the database and the-schema described by your schema types get out of sync. It is never possible to-always ensure at compile time that your database will match your program when-actually run, but the addition of `CREATE TABLE` support will at least make it-possible for the database schema to have one source of truth in your codebase-(as opposed to having to maintain Ribbit schemas and also a corresponding-schema embedded in some database initialization script somewhere).+- Foreign key constraints are not yet supported. +- Arbitrary non-primary-key indexes are not yet supported.++What *IS* supported already is:++- Determining whether a field is nullable, based on whether the corresponding+  Haskell type is wrapped in a `Maybe`.++- Compound primary keys. I.e. primary keys consisting of more than one+  component.+++## Roadmap++This is what I plan to work on next:+ ### `INSERT INTO` support.  Obviously, we want to do more with our DB than just read from it. +### Flesh out Haskell to PostgreSQL type mapping.++As mentioned above, only a small number of Haskell types are mapped+to PostgreSQL types out of the box. We would like to make this a more+comprehensive mapping out of the box.+ ## How it compares with other libraries.  The short answer is there are a lot of other libraries and I'm not sure.@@ -137,7 +164,7 @@   Then you would be free to deconstruct this type (using type families),   transform it into another schema, generate customized `CREATE TABLE`   statements if the (forthcoming) ones provided aren't good enough for your-  back-end or use case... that sort of thing. As a somewhat contrived example,+  back-end or use case... that sort of thing. As a somewhat contrived example:   maybe, for who knows what reason, you never want to allow null values in your   database. You can write a type family that can inspect every field in an   arbitrary schema, replacing all the `Maybe a` with just `a`, like:

@@ -1,6 +1,6 @@  name:                ribbit-version:             0.2.1.0+version:             0.2.2.0 synopsis:            ribbit -- description:          homepage:            https://github.com/owensmurray/ribbit@@ -24,7 +24,8 @@     Only              >= 0.1     && < 0.2,     base              >= 4.12    && < 4.13,     postgresql-simple >= 0.6.2   && < 0.7,-    text              >= 1.2.3.1 && < 1.3+    text              >= 1.2.3.1 && < 1.3,+    time              >= 1.8.0.2 && < 1.9   hs-source-dirs:      src   default-language:    Haskell2010 

@@ -56,7 +56,8 @@   -- * Transformations on Query Types   ArgsType,   ResultType,-  +  ValidField,+   -- * Query Rendering   Render(..) @@ -344,7 +345,8 @@  {- |   Helper for 'ArgsType'. Reduces the number of equations required, because-  'ArgsType' doesn't actually care about which condition it is inspecting.+  'ArgsType' doesn't actually care about which conditionl operator it+  is inspecting. -} data Condition l r @@ -359,7 +361,7 @@     )  -{- | Produce a type error if the field is not contained within the schema. -}+{- | Type level check to see if the field is actually contained in the schema -} type family ValidField field schema where   ValidField name (Field name typ) = 'True   ValidField name (Field _ typ) = 'False

@@ -1,26 +1,63 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  {- | "postgresql-simple"-backed query ribbit implementation. -} module Database.Ribbit.PostgreSQL (+  -- * Integrating your types.+  HasPsqlType(..),+  PsqlType(..),++  -- * Performing queries.   query,++  -- * Creating tables.+  createTable,+  createTableStatement,++  -- * Other types.+  -- | These type classes/families are not meant to be used directly. They+  -- are exported primarily because they appear in the type signatures+  -- of some of the above functions and documenting them can be helpful+  -- when trying to figure out how to use those functions.+  HasFields,+  HasPsqlTypes,+  HasIsNullable,+  ValidKey,   FromRow,   ToRow, ) where  +import Control.Monad (void) import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Proxy (Proxy)-import Data.String (fromString)+import Data.Proxy (Proxy(Proxy))+import Data.String (fromString, IsString)+import Data.Text (Text)+import Data.Time (Day) import Data.Tuple.Only (Only(Only))+import Data.Type.Bool (If) import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple.FromField (FromField) import Database.PostgreSQL.Simple.ToField (Action, ToField)-import Database.Ribbit (Render, render, ArgsType, ResultType, (:>)((:>)))+import Database.Ribbit (Render, render, ArgsType, ResultType, (:>)((:>)),+  Name, Field, DBSchema, ValidField)+import GHC.TypeLits (KnownSymbol, TypeError, ErrorMessage((:<>:),+  ShowType)) import qualified Data.Text as T import qualified Database.PostgreSQL.Simple as PG import qualified Database.PostgreSQL.Simple.FromRow as PGF import qualified Database.PostgreSQL.Simple.ToRow as PGT+import qualified GHC.TypeLits as Lit   {- | Execute a query against a PostgreSQL database connection. -}@@ -42,6 +79,163 @@       (Wrap args)  +{- |+  Create the indicated table in the database.++  See 'createTableStatement' for details.+-}+createTable :: forall proxy1 proxy2 key table m. (+    KnownSymbol (Name table),+    HasPsqlTypes (DBSchema table),+    HasFields (DBSchema table),+    HasFields key,+    ValidKey key (DBSchema table) ~ 'True,+    MonadIO m+  )+  => Connection+  -> proxy1 key+  -> proxy2 table+  -> m ()+createTable conn key table =+  let+    stmt :: Text+    stmt = createTableStatement key table+  in+    liftIO . void $+      PG.execute_+        conn+        (fromString . T.unpack $ stmt)+++{- |+  Produce the statement used to create a table.++  In this example, we create an employee table with a multi-part primary+  key, one nullable field, and a few non-nullable fields.++  > data Employee+  > instance Table Employee where+  >   type Name = "employees"+  >   type DBSchema =+  >     Field "company_id" Int+  >     :> Field "id" Int+  >     :> Field "name" Text+  >     :> Field "quit_date" (Maybe Day)+  >+  > let+  >   primaryKey :: Proxy '["company_id", "id"]+  >   primaryKey = Proxy+  >   +  >   table :: Proxy Employee+  >   table = Proxy+  >+  > in+  >   createTableStatement primaryKey table++  This will produce the statement:++  > "create table employees (company_id integer not null, id integer not null, name text not null, quit_date date, primary key (company_id, id));"+-}+createTableStatement :: forall proxy1 proxy2 table key. (+    KnownSymbol (Name table),+    HasPsqlTypes (DBSchema table),+    HasFields (DBSchema table),+    HasFields key,+    ValidKey key (DBSchema table) ~ 'True+  )+  => proxy1 key+  -> proxy2 table+  -> Text+createTableStatement key _table =+    "create table " <> symbolVal tableName+    <> " (" <> T.intercalate ", " [+      field+      <> " "+      <> typ+      | (field, typ) <- zip (fields schema) (psqlTypes schema)+    ]+    <> (+      case fields key of+        [] -> ""+        fs -> ", primary key (" <> T.intercalate ", " fs <> ")"+      )+    <> ");"+  where+    schema :: Proxy (DBSchema table)+    schema = Proxy++    tableName :: Proxy (Name table)+    tableName = Proxy+++class HasFields a where+  fields :: proxy a -> [Text]+instance (KnownSymbol name) => HasFields (Field name typ) where+  fields _proxy = [symbolVal (Proxy @name)]+instance (KnownSymbol name, HasFields more) =>+    HasFields (Field name typ :> more)+  where+    fields _proxy = symbolVal (Proxy @name) : fields (Proxy @more)+instance HasFields '[] where+  fields _proxy = []+instance (KnownSymbol name, HasFields more) => HasFields (name:more) where+  fields _proxy = symbolVal (Proxy @name) : fields (Proxy @more)+++class HasPsqlTypes a where+  psqlTypes :: proxy a -> [Text]+instance (HasIsNullable typ, HasPsqlType typ) => HasPsqlTypes (Field name typ) where+  psqlTypes _proxy =+    [+      unPsqlType (psqlType (Proxy @typ))+      <> if isNullable (Proxy @typ) then "" else " not null"+    ]+instance (HasIsNullable typ, HasPsqlType typ, HasPsqlTypes more) =>+    HasPsqlTypes (Field name typ :> more)+  where+    psqlTypes _proxy =+      psqlTypes (Proxy @(Field name typ)) ++ psqlTypes (Proxy @more)+++{- |+  Given a Haskell type, produce the PostgreSQL type of columns that+  store values of that haskell type.+-}+class HasPsqlType a where+  psqlType :: proxy a -> PsqlType+instance (HasPsqlType a) => HasPsqlType (Maybe a) where+  psqlType _proxy = psqlType (Proxy @a)+instance HasPsqlType Text where+  psqlType _proxy = "text"+instance HasPsqlType Int where+  psqlType _proxy = "integer"+instance HasPsqlType Day where+  psqlType _proxy = "date"+++class HasIsNullable a where+  isNullable :: proxy a -> Bool+instance HasIsNullable (Maybe a) where+  isNullable _proxy = True+instance {-# OVERLAPPABLE #-} HasIsNullable a where+  isNullable _proxy = False+++{- |+  Represents the "base" PostgreSQL type. We say "base" type because+  whether the type is nullable is handle automatically.++  e.g.++  * @PsqlType "integer"@+  * @PsqlType "timestamp with time zone"@+-}+newtype PsqlType = PsqlType {+    unPsqlType :: Text+  }+  deriving newtype (IsString)++ {- | Like 'PGF.FromRow', but defined here so we can avoid orphaned instances. -} class FromRow a where   fromRow :: PGF.RowParser a@@ -74,5 +268,28 @@   fromRow = Wrap <$> fromRow instance (ToRow a) => PGT.ToRow (Wrap a) where   toRow = toRow . unWrap+++{- | Like 'Lit.symbolVal', but produce any kind of string-like thing. -}+symbolVal :: (KnownSymbol n, IsString a) => proxy n -> a+symbolVal = fromString . Lit.symbolVal+++{- | Make sure the proposed primary key is legit. -}+type family ValidKey fields schema where+  ValidKey '[] schema = 'True+  ValidKey (field:more) schema =+    If+      (ValidField field schema)+      (ValidKey more schema)+      (+        TypeError (+          'Lit.Text "field "+          ':<>: 'ShowType field+          ':<>: 'Lit.Text " is not part of the schema, so it cannot be\+                          \ used as a component of the primary key."+        )+      )+