diff --git a/README.md b/README.md index 9ebfc0f..519cfaa 100644 --- a/README.md +++ b/README.md @@ -5,11 +5,12 @@ Database-agnostic interface to generically persisted data. ## Introduction Explanation of the above: -- Database-agnostic interface: the interface is called `MonadDb`, and you must - specify how it can communicate with your database (e.g. PostgreSQL server). -- Generically persisted data: you can derive the necessary instances for your - data types via `Generics`. This will enable `MonadDb` to read/write instances - of your data types to/from your database. +- Database-agnostic: the typeclass is called `MonadDb`, and you must specify how + an instance can communicate with your database. We provide an example for + connecting to Postgres in the [runnable tutorial](tutorial/tutorial/main.hs). +- Generically persisted data: you can derive the necessary instances in one line + via `Generics`, to enable `MonadDb` to read/write instances of your data types + to/from your database. A key intended feature of this library is that the typeclass `MonadDb` can be used either server-side or client-side. Allowing your client application (e.g. @@ -22,7 +23,8 @@ to your database without having to write the usual server boilerplate. ## Quick Start -A tutorial as code exists [here](tutorial/tutorial/Main.hs). +The [runnable tutorial](tutorial/tutorial/Main.hs) is the recommended way of +becoming familiar with `database-generic`. To run the tutorial on your machine: 1. Clone this repo. diff --git a/database-generic/src/Database/Generic/Entity/DbTypes.hs b/database-generic/src/Database/Generic/Entity/DbTypes.hs index 2da3655..3e947f9 100644 --- a/database-generic/src/Database/Generic/Entity/DbTypes.hs +++ b/database-generic/src/Database/Generic/Entity/DbTypes.hs @@ -5,12 +5,12 @@ module Database.Generic.Entity.DbTypes where import Data.Aeson qualified as Aeson import Data.ByteString (ByteString) import Data.ByteString.Char8 qualified as BS -import Database.Generic.Entity.FromDb (FromDbValues(..)) import Database.Generic.Prelude import Database.HDBC qualified as HDBC data DbT f - = DbBytes !(F f Bytes) + = DbBool !(F f Bool) + | DbBytes !(F f Bytes) | DbInt64 !(F f Int64) | DbInteger !(F f Integer) | DbString !(F f String) @@ -32,6 +32,9 @@ deriving instance Show (DbT Unit) class HasDbType a where dbType :: DbType +instance HasDbType Bool where + dbType = DbBool Unit + instance HasDbType Int64 where dbType = DbInt64 Unit @@ -46,20 +49,12 @@ deriving instance Aeson.ToJSON (DbT Id) deriving instance Eq (DbT Id) deriving instance Show (DbT Id) -instance From Int64 DbValue where from = DbInt64 +instance From Bool DbValue where from = DbBool +instance From Int64 DbValue where from = DbInt64 instance From String DbValue where from = DbString -instance FromDbValues DbValue Int64 where - fromDbValues [DbInt64 i] = i - fromDbValues [DbInteger i] = unsafeFrom i - fromDbValues x = error $ "Error constructing Int64 from " <> show x - -instance FromDbValues DbValue String where - fromDbValues [DbBytes b] = from b - fromDbValues [DbString s] = s - fromDbValues x = error $ "Error constructing Int64 from " <> show x - instance From HDBC.SqlValue DbValue where + from (HDBC.SqlBool b) = DbBool b from (HDBC.SqlString s) = DbString s from (HDBC.SqlByteString b) = DbBytes $ Bytes b from (HDBC.SqlInt64 i) = DbInt64 i diff --git a/database-generic/src/Database/Generic/Entity/FromDb.hs b/database-generic/src/Database/Generic/Entity/FromDb.hs index 4d7b389..468ae1a 100644 --- a/database-generic/src/Database/Generic/Entity/FromDb.hs +++ b/database-generic/src/Database/Generic/Entity/FromDb.hs @@ -2,6 +2,8 @@ module Database.Generic.Entity.FromDb where +import Database.Generic.Entity.DbColumns (HasDbColumns) +import Database.Generic.Entity.DbTypes (DbT(..), DbValue) import Database.Generic.Prelude import Generics.Eot qualified as G @@ -17,7 +19,26 @@ instance (Show dbv, Typeable dbv) => Exception (FromDbError dbv) class FromDbValues dbv a where fromDbValues :: [dbv] -> a -instance {-# OVERLAPPABLE #-} (G.HasEot a, GFromDbValues dbv (G.Eot a)) => FromDbValues dbv a where +instance FromDbValues DbValue Bool where + fromDbValues [DbBool b] = b + fromDbValues x = error $ "Error constructing Bool from " <> show x + +instance FromDbValues DbValue Int64 where + fromDbValues [DbInt64 i] = i + fromDbValues [DbInteger i] = unsafeFrom i + fromDbValues x = error $ "Error constructing Int64 from " <> show x + +instance FromDbValues DbValue String where + fromDbValues [DbBytes b] = from b + fromDbValues [DbString s] = s + fromDbValues x = error $ "Error constructing Int64 from " <> show x + +instance {-# OVERLAPPABLE #-} + ( G.HasEot a + , GFromDbValues dbv (G.Eot a) + , HasDbColumns a -- Only included to ensure that 'FromDbValues' instances aren't + -- derived for simple datatypes such as 'Bool'. + ) => FromDbValues dbv a where fromDbValues = G.fromEot . gFromDbValues -- | Typeclass for generic implementation of 'FromDbValues'. diff --git a/database-generic/src/Database/Generic/Entity/ToDb.hs b/database-generic/src/Database/Generic/Entity/ToDb.hs index c543610..43730de 100644 --- a/database-generic/src/Database/Generic/Entity/ToDb.hs +++ b/database-generic/src/Database/Generic/Entity/ToDb.hs @@ -2,6 +2,7 @@ module Database.Generic.Entity.ToDb where +import Database.Generic.Entity.DbColumns (HasDbColumns) import Database.Generic.Entity.DbTypes (DbValue) import Database.Generic.Prelude import Generics.Eot qualified as G @@ -21,7 +22,12 @@ instance {-# OVERLAPPABLE #-} From a DbValue => ToDbValue a where class ToDbValues a where toDbValues :: a -> [DbValue] -instance {-# OVERLAPPABLE #-} (G.HasEot a, GToDbValues (G.Eot a)) => ToDbValues a where +instance {-# OVERLAPPABLE #-} + ( G.HasEot a + , GToDbValues (G.Eot a) + , HasDbColumns a -- Only included to ensure that 'ToDbValues' instances aren't + -- derived for simple datatypes such as 'Bool'. + ) => ToDbValues a where toDbValues = gToDbValues . G.toEot -- | Typeclass for generic implementation of 'ToDbValues'. diff --git a/database-generic/src/Database/Generic/Serialize.hs b/database-generic/src/Database/Generic/Serialize.hs index 7edd056..969dfe2 100644 --- a/database-generic/src/Database/Generic/Serialize.hs +++ b/database-generic/src/Database/Generic/Serialize.hs @@ -11,12 +11,14 @@ class Serialize a db where serialize :: a -> String instance Serialize DbType PostgreSQL where + serialize (DbBool Unit) = "BOOLEAN" serialize (DbBytes Unit) = "BINARY" serialize (DbInt64 Unit) = "BIGINT" serialize (DbInteger Unit) = "BIGINT" serialize (DbString Unit) = "VARCHAR" instance Serialize DbValue PostgreSQL where + serialize (DbBool b) = show b serialize (DbBytes b) = show b serialize (DbInt64 i) = show i serialize (DbInteger i) = show i diff --git a/tutorial/tutorial/Main.hs b/tutorial/tutorial/Main.hs index 200a89c..afa7369 100644 --- a/tutorial/tutorial/Main.hs +++ b/tutorial/tutorial/Main.hs @@ -25,7 +25,7 @@ import GHC.Generics (Generic) import Witch (from) -- | Data type we want to persist. -data Person = Person { age :: !Int64, name :: !String } +data Person = Person { age :: !Int64, name :: !String, ownsDog :: !Bool } deriving (Generic, PrimaryKey "name", Show) -- | Connection string to access our PostgreSQL DB. @@ -68,7 +68,7 @@ instance MonadDbNewConn AppM PSQL.Connection where main :: IO () main = do let c = connStr "127.0.0.1" 5432 "postgres" "demo" "demo" - let john = Person 70 "John" + let john = Person 70 "John" False let info m s = do putStrLn $ "\n" <> m print =<< runAppM c (tx $ execute s) @@ -76,16 +76,16 @@ main = do info "Create table if not exists" $ createTable @Person True info "Delete all" $ deleteAll @Person -- Clear table before tutorial. - info "Insert one" $ returning $ insertOne $ john + info "Insert one" $ insertOne john info "Insert many" $ - insertMany [Person 25 "Alice", Person 25 "Bob"] + insertMany [Person 25 "Alice" True, Person 25 "Bob" False] info "Insert many, returning" $ - returning $ insertMany [Person 26 "Charlie", Person 26 "Dee"] + returning $ insertMany [Person 26 "Charlie" False, Person 26 "Dee" True] info "Insert many, returning age" $ - insertMany [Person 27 "Enid", Person 27 "Flavio"] ==> field @"age" + insertMany [Person 27 "Enid" False, Person 27 "Flavio" True] ==> field @"age" info "Select all" $ selectAll @Person