ribbit 0.2.0.0 → 0.2.0.1
raw patch · 4 files changed
+104/−20 lines, 4 filesdep −om-show
Dependencies removed: om-show
Files
- README.md +67/−3
- ribbit.cabal +1/−2
- src/Database/Ribbit.hs +33/−15
- src/Database/Ribbit/PostgreSQL.hs +3/−0
README.md view
@@ -1,5 +1,18 @@ # Ribbit +- [Ribbit](#ribbit)+ - [Status](#status)+ - [Current Features](#current-features)+ - [Basic @Select .. From ..](#basic-select--from-)+ - [Cross product](#cross-product)+ - [Limited Conditionals](#limited-conditionals)+ - [Roadmap](#roadmap)+ - [More conditional operatores.](#more-conditional-operatores)+ - [`CREATE TABLE` support.](#create-table-support)+ - [`INSERT INTO` support.](#insert-into-support)+ - [How it compares with other libraries.](#how-it-compares-with-other-libraries)+ - [The name: Ribbit](#the-name-ribbit)+ Ribbit is yet another type safe relational database library for Haskell, heavily inspired by the amazing [Servant](http://hackage.haskell.org/package/servant) library. The goal@@ -31,9 +44,60 @@ ## Status -The status of Ribbit is non-functional pre-alpha. My goal though is to-make sure it is absolutely production ready for the operations it ends-up supporting, but we are a long way from that at the moment.+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.++### Current Features++These are the features that are currently implemented.++#### Basic @Select .. From ..++We support queries of the form:++> type MyQuery = Select '["field1", "field2"] `From` MyTable++#### Cross product++We support queries of the form:++type MyQuery = Select '["t1.field1", "t2.field2"] `From` MyTable1 `As` "t1" `X` MyTable2 `As` "t2"++#### Limited Conditionals++We support queries of the form:++> type MyQuery = Select '["field1", "field2"] `From` MyTable `Where` <condition>++Where <condition> can include:++- a `And` b: Basic intersection.+- a `Or` b: Basic union.+- "field" `Equals` (?): Test for equality. This introduces a query parameter that must be supplied at runtime.+- "field1" `Equals` "field2": Test the equality of two fields (that both must exist in the schema)++## Roadmap++This is what I plan to work on next:++### More conditional operatores.++I want to fill in the conditional operators with the usual suspects (`<`, `<=`, `>`, `>=`, `!=`, etc.).++### `CREATE TABLE` support.++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).++### `INSERT INTO` support.++Obviously, we want to do more with our DB than just read from it. ## How it compares with other libraries.
ribbit.cabal view
@@ -1,6 +1,6 @@ name: ribbit-version: 0.2.0.0+version: 0.2.0.1 synopsis: ribbit -- description: homepage: https://github.com/owensmurray/ribbit@@ -23,7 +23,6 @@ build-depends: Only >= 0.1 && < 0.2, base >= 4.12 && < 4.13,- om-show >= 0.1.1.0 && < 0.2, postgresql-simple >= 0.6.2 && < 0.7, text >= 1.2.3.1 && < 1.3 hs-source-dirs: src
src/Database/Ribbit.hs view
@@ -61,6 +61,7 @@ import Data.String (IsString, fromString) import Data.Text (Text) import Data.Tuple.Only (Only)+import Data.Type.Bool (If, type (||)) import GHC.TypeLits (KnownSymbol, TypeError, ErrorMessage((:<>:), (:$$:), ShowType), AppendSymbol, Symbol) import qualified GHC.TypeLits as Lit@@ -153,13 +154,10 @@ -- -- {- | "SELECT" combinator, used for starting a @SELECT@ statement. -} data Select fields - {- | "FROM" combinator, used for attaching a SELECT projection to a relation in the database.@@ -173,7 +171,6 @@ infixl 6 `Where` - {- | "=" combinator for conditions. -} data Equals l r infix 9 `Equals`@@ -220,18 +217,18 @@ data Expr a type family ProjectionType proj schema where- ProjectionType '[name] (Field name typ) = Only typ- ProjectionType '[name] (Field name2 typ) =- TypeError (- 'Lit.Text "name ("- ':<>: 'ShowType name- ':<>: 'Lit.Text ") not found in relation."- )- ProjectionType '[name] (Field name typ :> _) = Only typ- ProjectionType '[name] (_ :> more) = ProjectionType '[name] more+ ProjectionType '[name] schema =+ LookupType name schema schema+ ProjectionType (name:more) schema =+ LookupType name schema schema+ :> ProjectionType more schema - ProjectionType (name:more) relation =- ProjectionType '[name] relation :> ProjectionType more relation+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 class Table relation where type DBSchema relation@@ -292,7 +289,28 @@ StripUnit (Flatten (ArgsType (schema, a) :> ArgsType (schema, b))) ArgsType (schema, Equals field (?)) = ProjectionType '[field] schema+ ArgsType (schema, Equals field expr) =+ If+ (ValidField expr schema)+ (If (ValidField field schema) () (NotInSchema field schema))+ (NotInSchema expr schema) ArgsType _ = ()++type family NotInSchema field schema where+ NotInSchema field schema =+ TypeError (+ 'Lit.Text "name ("+ ':<>: 'ShowType field+ ':<>: 'Lit.Text ") not found in schema: "+ ':<>: 'ShowType schema+ )+++{- | Produce a type error if the field is not contained within the schema. -}+type family ValidField field schema where+ ValidField name (Field name typ) = 'True+ ValidField name (Field _ typ) = 'False+ ValidField name (a :> b) = ValidField name a || ValidField name b {- |
src/Database/Ribbit/PostgreSQL.hs view
@@ -61,6 +61,9 @@ toRow (a :> b) = toRow a ++ toRow b instance (ToField a) => ToRow (Only a) where toRow = PGT.toRow+instance ToRow () where+ toRow = PGT.toRow+ {- | Wrapper that helps us avoid orphan instances. -}