ribbit 0.2.2.0 → 0.3.0.0
raw patch · 3 files changed
+220/−25 lines, 3 files
Files
- ribbit.cabal +1/−1
- src/Database/Ribbit.hs +191/−16
- src/Database/Ribbit/PostgreSQL.hs +28/−8
ribbit.cabal view
@@ -1,6 +1,6 @@ name: ribbit-version: 0.2.2.0+version: 0.3.0.0 synopsis: ribbit -- description: homepage: https://github.com/owensmurray/ribbit
src/Database/Ribbit.hs view
@@ -11,10 +11,27 @@ {- | This module attepts to define a type-level language for describing- database shcemas (i.e. schemas "as a type"), and the queries- that operate on them in such a way that the meaning of a query is- immediately obvious to anyone who knows SQL, and that can be extended- and deconstructed by library users for their own purposes.+ database shcemas (i.e. schemas "as a type"), and the queries that+ operate on them in such a way that:+ + 1) The schema and/or query is completely defined at the type level+ (sans runtime arguments to query parameters).++ 2) The meaning of a schema and/or query is immediately obvious to+ anyone who knows SQL, and++ 3) The schema and/or query can be extended, deconstructed, or+ interpreted by third parties for their own purposes.++ To that end, each schema is a new type, defined by you, using the+ combinators provided by this library. The same goes for queries. Each+ query is a separate type defined with combinators from this library.++ We provide a PostgreSQL backend so that real work can be accomplished,+ but if the backend is missing something you need, then the idea is+ that you can use your own type families and type classes to extend+ the schema and query languages, or interpret them differently for your+ own needs including writing entirely new backends if need be. -} module Database.Ribbit ( -- * Quick Start@@ -27,6 +44,9 @@ -- ** Using a Query -- $usequery + -- ** Inserting values+ -- $insert+ -- * Schema Definition Types (:>)(..), Table(..),@@ -39,6 +59,9 @@ As, Where, + -- * Insert Combinators+ InsertInto,+ -- ** Condition Conbinators And, Or,@@ -57,6 +80,7 @@ ArgsType, ResultType, ValidField,+ ProjectionType, -- * Query Rendering Render(..)@@ -71,6 +95,7 @@ import Data.Type.Bool (If, type (||)) import GHC.TypeLits (KnownSymbol, TypeError, ErrorMessage((:<>:), (:$$:), ShowType), AppendSymbol, Symbol)+import qualified Data.Text as T import qualified GHC.TypeLits as Lit @@ -79,11 +104,11 @@ -- -- > data Company ----- (Note: It is not required that the type contain any data, but it can if--- you like. Unlike some db frameworks, columns stored in the table--- represented by this type is not directly tied to the Haskell record--- fields it contains. It is mainly used as a type-level symbol to--- reference your table.)+-- (Note: It is not required that the type contain any data, but it can+-- if you like. Unlike some db frameworks, the set of columns stored+-- in the table represented by this type is not directly tied to the+-- Haskell record fields it contains. It is mainly used as a type-level+-- symbol to reference your table.) -- -- And you need a type class instance 'Table': -- @@ -131,6 +156,7 @@ -- -- > -- Given a company name as a query parameter, return all the -- > -- employees that work at that company along with their salary.+-- > -- > type MyQuery = -- > Select '["e.name", "e.salary"] -- > `From`@@ -159,8 +185,81 @@ -- | 'ResultType' MyQuery | 'Only' 'Text' ':>' 'Only' ('Maybe' 'Int') | -- +----------------------+-------------------------------------------+ --+-- The "Database.Ribbit.PostgreSQL" module provides a+-- 'Database.Ribbit.PostgreSQL.query' function:+-- +-- > query :: (+-- > MonadIO m,+-- > Render query,+-- > ToRow (ArgsType query),+-- > FromRow (ResultType query)+-- > )+-- > => Connection+-- > -> Proxy query+-- > -> ArgsType query+-- > -> m [ResultType query]+-- +-- Notice that it accepts an @('ArgsType' query)@ argument, and returns a+-- list of @('ResultType' query)@ values.+-- +-- Therefore, we can invoke the query thusly:+-- +-- > results <- query conn (Proxy :: Proxy MyQuery) (Only "Some Company")+-- +-- The @('Only' "Some Company")@ argument fulfils the query parameters,+-- and the results will be a list of rows which can be deconstructed+-- using pattern matching. E.g.:+-- +-- > sequence_+-- > [+-- > putStrLn (show name <> " - " <> show sallary)+-- > | (Only name :> Only salary) <- results+-- > ] +-- $insert+-- To insert values into our example tables above, we need to write a+-- couple of insert statements:+-- +-- E.g.:+-- +-- > type InsertCompany = InsertInto Company '["id", "name", "address"]+-- > type InsertEmployee = InsertInto Employee '["company_id", "id", "name", "birth_date"]+--+-- That's it really. Insert statements are much simpler than select+-- queries. These statement will automatically be parameterized according+-- to the listed fields.+--+-- There is a little bit of important nuance here: Note that+-- 'InsertEmployee' omits the "salary" field. That field is nullable,+-- and so the database will insert a null value when this insert statement+-- is used.+--+-- This can be particularly useful for allowing the database to supply+-- default values, such as auto-incremented id fields. This library is+-- not (yet) sophisticated enough understand which fields can safely be+-- omitted, so it lets you omit any field. If you omit a field for which+-- the database cannot supply a default value then that will result in a+-- runtime error. This is a problem we plan to fix in a future version. On+-- the other hand if you try to include a field that is not part of the+-- schema, you will get a /compile time/ error like you are supposed to.+--+-- To execute these insert statements, use "Database.Ribbit.PostgreSQL"'s+-- 'Database.Ribbit.PostgreSQL.execute' function:+--+-- > do+-- > let+-- > myBirthday :: Day+-- > myBirthday = ...+-- > execute+-- > conn+-- > (Proxy :: Proxy InsertCompany)+-- > (Only 1 :> Only "Owens Murray" :> Only (Just "Austin, Tx"))+-- > execute+-- > conn+-- > (Proxy :: Proxy InsertEmployee)+-- > (Only 1 :> Only 1 :> Only "Rick" :> Only myBirthday) + {- | "SELECT" combinator, used for starting a @SELECT@ statement. -} data Select fields @@ -236,7 +335,20 @@ data (?) -{- | Define a field in a database schema. -}+{- |+ Define a field in a database schema, where:++ - @name@: is the name of the database column, expressed as a type-level+ string literal, and++ - @typ@: is the Haskell type whose values get stored in the column.++ E.g:++ - @'Field' "company_name" 'Text'@+ - @'Field' "expiration_date" ('Maybe' 'Data.Time.Day')@++-} data Field name typ @@ -244,6 +356,25 @@ String two types together. 'Int' ':>' 'Int' ':>' 'Int' is similar in principal to the nested tuple ('Int', ('Int', 'Int')), but looks a whole lot nicer when the number of elements becomes large.++ This is how you build up a schema from a collection of 'Field' types.++ E.g.:++ > Field "foo" Int+ > :> Field "bar" Text+ > :> Field "baz" (Maybe Text)++ It also the mechanism by which this library builds up the Haskell+ types for query parameters and resulting rows that get returned. So+ if you have a query that accepts three text query parameters, that+ type represented in Haskell is going to be @('Only' 'Text' ':>' 'Only'+ 'Text' ':>' 'Only' 'Text')@.++ If that query returns rows that contain a Text, an Int, and a Text,+ then the type of the rows will be @('Only' 'Text' ':>' 'Only' 'Int'+ ':>' 'Only' 'Text')@.+ -} data a :> b = a :> b deriving (Eq, Ord, Show)@@ -267,9 +398,27 @@ LookupType name (_ :> more) context = LookupType name more context LookupType name a context = NotInSchema name context +++{- |+ Type class for defining your own tables. The primary way for you to+ introduce a new schema is to instantiate this type class for one of+ your types.++ E.g.:++ > data MyTable+ > instance Table MyTable where+ > type Name MyTable = "my_table"+ > type DBSchema MyTable =+ > Field "id" Int+ > :> Field "my_non_nullable_text_field" Text+ > :> Field "my_nullable_int_field" (Maybe Int)+ +-} class Table relation where- type DBSchema relation type Name relation :: Symbol+ type DBSchema relation {- | Cross product -} instance (Table l, Table r, KnownSymbol lname, KnownSymbol rname) => Table (l `As` lname `X` r `As` rname) where@@ -320,6 +469,11 @@ type family ArgsType query where ArgsType (_ `From` relation `Where` conditions) = ArgsType (DBSchema relation, conditions)+ ArgsType (InsertInto relation '[]) =+ TypeError ('Lit.Text "Insert statement must specify at least one column.")+ ArgsType (InsertInto relation fields) =+ ProjectionType fields (DBSchema relation)+ ArgsType (schema, And a b) = StripUnit (Flatten (ArgsType (schema, a) :> ArgsType (schema, b))) ArgsType (schema, Or a b) =@@ -405,11 +559,8 @@ <> render (Proxy @fields) {- Field list -}-instance {-# OVERLAPS #-} (KnownSymbol field) => Render '[field] where- render _proxy = symbolVal (Proxy @field)-instance (KnownSymbol field, Render more) => Render (field:more) where- render _proxy =- symbolVal (Proxy @field) <> ", " <> render (Proxy @more)+instance (KnownSymbol field, ReflectFields (field:more)) => Render (field:more) where+ render _proxy = T.intercalate "," (reflectFields (Proxy @(field:more))) {- FROM -} instance (KnownSymbol (Name relation), Render proj, Table relation) => Render (From proj relation) where@@ -501,5 +652,29 @@ {- (?) -} instance Render (?) where render _proxy = "?"++{- INSERT -}+instance (ReflectFields fields, KnownSymbol (Name table)) => Render (InsertInto table fields) where+ render _proxy =+ let+ fields :: [Text]+ fields = reflectFields (Proxy @fields)+ in+ "insert into " <> symbolVal (Proxy @(Name table))+ <> " (" <> T.intercalate ", " fields <> ")"+ <> " values (" <> T.intercalate ", " (const "?" <$> fields) <> ");"+++{- | Insert statement. -}+data InsertInto table fields+++{- | Convert a type-level list of strings into a value. -}+class ReflectFields a where+ reflectFields :: proxy a -> [Text]+instance ReflectFields '[] where+ reflectFields _proxy = []+instance (KnownSymbol a, ReflectFields more) => ReflectFields (a:more) where+ reflectFields _proxy = symbolVal (Proxy @a) : reflectFields (Proxy @more)
src/Database/Ribbit/PostgreSQL.hs view
@@ -19,6 +19,7 @@ -- * Performing queries. query,+ execute, -- * Creating tables. createTable,@@ -32,7 +33,7 @@ HasFields, HasPsqlTypes, HasIsNullable,- ValidKey,+ IsSubset, FromRow, ToRow, ) where@@ -40,6 +41,7 @@ import Control.Monad (void) import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Int (Int64) import Data.Proxy (Proxy(Proxy)) import Data.String (fromString, IsString) import Data.Text (Text)@@ -79,6 +81,24 @@ (Wrap args) +{- | Execute a statement. -}+execute :: (+ MonadIO m,+ ToRow (ArgsType query),+ Render query+ )+ => Connection+ -> Proxy query+ -> ArgsType query+ -> m Int64+execute conn theQuery args =+ liftIO $+ PG.execute+ conn+ ((fromString . T.unpack . render) theQuery)+ (Wrap args)++ {- | Create the indicated table in the database. @@ -89,7 +109,7 @@ HasPsqlTypes (DBSchema table), HasFields (DBSchema table), HasFields key,- ValidKey key (DBSchema table) ~ 'True,+ IsSubset key (DBSchema table) ~ 'True, MonadIO m ) => Connection@@ -141,7 +161,7 @@ HasPsqlTypes (DBSchema table), HasFields (DBSchema table), HasFields key,- ValidKey key (DBSchema table) ~ 'True+ IsSubset key (DBSchema table) ~ 'True ) => proxy1 key -> proxy2 table@@ -275,13 +295,13 @@ 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 =+{- | Make sure the fields in the list are actually part of the schema. -}+type family IsSubset fields schema where+ IsSubset '[] schema = 'True+ IsSubset (field:more) schema = If (ValidField field schema)- (ValidKey more schema)+ (IsSubset more schema) ( TypeError ( 'Lit.Text "field "