diff --git a/Database/Groundhog/Expression.hs b/Database/Groundhog/Expression.hs --- a/Database/Groundhog/Expression.hs +++ b/Database/Groundhog/Expression.hs @@ -36,10 +36,10 @@ instance (PersistEntity v, Constructor c, PersistField a, v ~ v', c ~ c') => Expression (SubField v c a) v' c' where wrap = ExprField -instance (PersistEntity v, Constructor c, FieldLike (AutoKeyField v c) (RestrictionHolder v c) a', v ~ v', c ~ c') => Expression (AutoKeyField v c) v' c' where +instance (PersistEntity v, Constructor c, PersistField (Key v' BackendSpecific), FieldLike (AutoKeyField v c) (RestrictionHolder v c) a', v ~ v', c ~ c') => Expression (AutoKeyField v c) v' c' where wrap = ExprField -instance (PersistEntity v, Constructor c, FieldLike (u (UniqueMarker v)) (RestrictionHolder v c) a', v ~ v', c ~ c') => Expression (u (UniqueMarker v)) v' c' where +instance (PersistEntity v, Constructor c, FieldLike (u (UniqueMarker v)) (RestrictionHolder v c) a', c' ~ UniqueConstr (Key v' (Unique u)), v ~ v', IsUniqueKey (Key v' (Unique u)), c ~ c') => Expression (u (UniqueMarker v)) v' c' where wrap = ExprField -- Let's call "plain type" the types that uniquely define type of a Field it is compared to. @@ -53,7 +53,7 @@ instance (ExtractValue t (isPlain, r), NormalizeValue counterpart isPlain r r') => Normalize counterpart t r' class ExtractValue t r | t -> r -instance r ~ (HTrue, a) => ExtractValue (Arith v c a) r +instance r ~ (HFalse, a) => ExtractValue (Arith v c a) r instance r ~ (HFalse, a) => ExtractValue (Field v c a) r instance r ~ (HFalse, a) => ExtractValue (SubField v c a) r instance r ~ (HFalse, Key v BackendSpecific) => ExtractValue (AutoKeyField v c) r diff --git a/examples/basic.hs b/examples/basic.hs new file mode 100644 --- /dev/null +++ b/examples/basic.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances #-} +import Control.Monad.IO.Class (liftIO) +import Database.Groundhog.TH +import Database.Groundhog.Sqlite + +data Customer a = Customer {customerName :: String, remark :: a} deriving Show +data Product = Product {productName :: String, quantity :: Int, customer :: Customer String} deriving Show + +-- Code generator will derive the necessary instances and generate other boilerplate code for the entities defined below. +-- It will also create function migrateAll that migrates schema for all non-polymorphic entities +mkPersist (defaultCodegenConfig {migrationFunction = Just "migrateAll"}) [groundhog| +- entity: Customer + constructors: + - name: Customer + uniques: + - name: NameConstraint + fields: [customerName] +- entity: Product +|] + +main = withSqliteConn ":memory:" $ runSqliteConn $ do + -- Customer is also migrated because Product references it. + -- It is possible to migrate schema for given type, e.g. migrate (undefined :: Customer String), or run migrateAll + runMigration defaultMigrationLogger migrateAll + let john = Customer "John Doe" "Phone: 01234567" + johnKey <- insert john + -- John is inserted only once because of the name constraint + insert $ Product "Apples" 5 john + insert $ Product "Melon" 2 john + -- Groundhog prevents SQL injections. Quotes and other special symbols are safe. + insert $ Product "Melon" 6 (Customer "Jack Smith" "Don't let him pay by check") + -- bonus melon for all large melon orders. The values used in expressions should have known type, so literal 5 is annotated. + update [QuantityField =. toArith QuantityField + 1] (ProductNameField ==. "Melon" &&. QuantityField >. (5 :: Int)) + productsForJohn <- select $ CustomerField ==. johnKey + liftIO $ putStrLn $ "Products for John: " ++ show productsForJohn + -- check bonus + melon <- select $ (ProductNameField ==. "Melon") `orderBy` [Desc QuantityField] + liftIO $ putStrLn $ "Melon orders: " ++ show melon diff --git a/examples/embedded.hs b/examples/embedded.hs new file mode 100644 --- /dev/null +++ b/examples/embedded.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances #-} +import Control.Monad.IO.Class (liftIO) +import Database.Groundhog.TH +import Database.Groundhog.Sqlite + +data Company = Company {name :: String, producedSkynetAndTerminator :: (Bool, Bool), headquarter :: Address, dataCentre :: Address, salesOffice :: Address} deriving (Eq, Show) +data Address = Address {city :: String, zipCode :: String, street :: String} deriving (Eq, Show) + +mkPersist defaultCodegenConfig [groundhog| +definitions: + - entity: Company + constructors: + - name: Company + fields: + - name: producedSkynetAndTerminator + embeddedType: + - name: val0 + dbName: producedSkynet + - name: val1 + dbName: producedTerminator + - name: headquarter + embeddedType: # If a field has an embedded type you can access its subfields. If you do it, the database columns will match with the embedded dbNames (no prefixing). + - name: city # Just a regular list of fields. However, note that you should use default dbNames of embedded + dbName: hq_city + - name: zip_code # Here we use embedded dbName (zip_code) which differs from the name used in Address definition (zipCode) for accessing the field. + dbName: hq_zipcode + - name: street + dbName: hq_street + - name: dataCentre + embeddedType: # Similar declaration, but using another syntax for YAML objects + - {name: city, dbName: dc_city} + - {name: zip_code, dbName: dc_zipcode} + - {name: street, dbName: dc_street} + # Property embeddedType of salesOffice field is not mentioned, so the corresponding table columns will have names prefixed with salesOffice (salesOffice#city, salesOffice#zip_code, salesOffice#street) + - embedded: Address + dbName: Address # This name is used only to set polymorphic part of name of its container. E.g, persistName (a :: SomeData Address) = "SomeData#Address" + fields: # The syntax is the same as for constructor fields. Nested embedded types are allowed. + - name: city # This line does nothing and can be omitted. Default settings for city are not changed. + - name: zipCode + dbName: zip_code # Change column name. + exprName: ZipCodeSelector # Set the default name explicitly + # Street is not mentioned so it will have default settings. + |] + +main = withSqliteConn ":memory:" $ runSqliteConn $ do + let address = Address "Sunnyvale" "18144" "El Camino Real" + let company = Company "Cyberdyne Systems" (False, False) address address address + runMigration defaultMigrationLogger $ migrate company + k <- insert company + -- compare embedded data fields as a whole and compare their subfields individually + select (DataCentreField ==. HeadquarterField &&. DataCentreField ~> ZipCodeSelector ==. HeadquarterField ~> ZipCodeSelector) >>= liftIO . print + -- after the Cyberdyne headquarter was destroyed by John Connor and T-800, the Skynet development was continued by Cyber Research Systems affiliated with Pentagon + let newAddress = Address "Washington" "20301" "1400 Defense Pentagon" + -- compare fields with an embedded value as a whole and update embedded field with a value + update [NameField =. "Cyber Research Systems", HeadquarterField =. newAddress] (NameField ==. "Cyberdyne Systems" &&. HeadquarterField ==. address) + -- update embedded field with another field as a whole. Separate subfields can be accessed individually for update via ~> as in the select above + update [DataCentreField =. HeadquarterField, SalesOfficeField =. HeadquarterField] (NameField ==. "Cyber Research Systems" &&. HeadquarterField ==. newAddress) + -- eventually the skynet was developed. To access the elements of tuple we use predefined selectors. In Tuple2_0Selector 2 is arity of the tuple, 0 is number of element in it + update [ProducedSkynetAndTerminatorField ~> Tuple2_0Selector =. True] (AutoKeyField ==. k) + select (HeadquarterField ~> ZipCodeSelector ==. "20301") >>= liftIO . print diff --git a/examples/keys.hs b/examples/keys.hs new file mode 100644 --- /dev/null +++ b/examples/keys.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances, StandaloneDeriving #-} +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Database.Groundhog.TH +import Database.Groundhog.Sqlite + +-- artistName is a unique key +data Artist = Artist { artistName :: String } deriving (Eq, Show) + +mkPersist defaultCodegenConfig [groundhog| +definitions: + - entity: Artist + autoKey: + constrName: AutoKey + default: false # Defines if this key is used when an entity is stored directly, for example, data Ref = Ref SomeEntity + keys: + - name: ArtistName + default: true + constructors: + - name: Artist + uniques: + - name: ArtistName + fields: [artistName] +|] + +data Album = Album { albumName :: String} deriving (Eq, Show) +-- many-to-many relation +data ArtistAlbum = ArtistAlbum {artist :: Key Artist (Unique ArtistName), album :: Key Album BackendSpecific } +deriving instance Eq ArtistAlbum +deriving instance Show ArtistAlbum +-- We cannot use regular deriving because when it works, the Key Eq and Show instances for (Key Album BackendSpecific) are not created yet +data Track = Track { albumTrack :: Key Album BackendSpecific, trackName :: String } +deriving instance Eq Track +deriving instance Show Track + +mkPersist defaultCodegenConfig [groundhog| +definitions: + - entity: Album + - entity: Track + # keys of many-to-many relation form a unique key + - entity: ArtistAlbum + autoKey: null + keys: + - name: ArtistAlbumKey + default: true + constructors: + - name: ArtistAlbum + uniques: + - name: ArtistAlbumKey + fields: [artist, album] +|] + +main :: IO () +main = withSqliteConn ":memory:" $ runSqliteConn $ do + let artists = [Artist "John Lennon", Artist "George Harrison"] + imagineAlbum = Album "Imagine" + runMigration defaultMigrationLogger $ do + migrate (undefined :: ArtistAlbum) + migrate (undefined :: Track) + mapM_ insert artists + + imagineKey <- insert imagineAlbum + let tracks = map (Track imagineKey) ["Imagine", "Crippled Inside", "Jealous Guy", "It's So Hard", "I Don't Want to Be a Soldier, Mama, I Don't Want to Die", "Gimme Some Truth", "Oh My Love", "How Do You Sleep?", "How?", "Oh Yoko!"] + mapM_ insert tracks + mapM_ (\artist -> insert $ ArtistAlbum (extractUnique artist) imagineKey) artists + -- print first 3 tracks from any album with John Lennon + [albumKey'] <- project AlbumField $ (ArtistField ==. ArtistNameKey "John Lennon") `limitTo` 1 + -- order by primary key + tracks' <- select $ (AlbumTrackField ==. albumKey') `orderBy` [Asc AutoKeyField] `limitTo` 3 + liftIO $ print tracks' + diff --git a/examples/projections.hs b/examples/projections.hs new file mode 100644 --- /dev/null +++ b/examples/projections.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances, OverloadedStrings #-} +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Data.ByteString +import Database.Groundhog.TH +import Database.Groundhog.Sqlite + +data User = User {name :: String, phoneNumber :: (String, String), bigAvatar :: ByteString} deriving (Eq, Show) + +mkPersist defaultCodegenConfig [groundhog| +definitions: + - entity: User + keys: + - name: unique_name + constructors: + - name: User + uniques: + - name: unique_name + fields: [name] +|] + +main :: IO () +main = withSqliteConn ":memory:" $ runSqliteConn $ do + let jack = User "Jack" ("+380", "12-345-67-89") "BMP" + jill = User "Jill" ("+1", "98-765-43-12") "BMP" + runMigration defaultMigrationLogger $ migrate jack + mapM_ insert [jack, jill] + -- get phones of the users. Only the required fields are fetched. Function project supports both regular and subfields + phones <- project (PhoneNumberField ~> Tuple2_1Selector) $ (() ==. ()) `orderBy` [Asc AutoKeyField] + liftIO $ print phones + -- we can also use 'project' as a replacement for 'select' with extended options. + -- the special datatype 'AutoKeyField' projects to the entity autokey, unique key phantoms project to keys, and the constructor phantoms project to the data itself + withIds <- project (AutoKeyField, Unique_name, UserConstructor) (() ==. ()) + liftIO $ print withIds diff --git a/examples/rawQueries.hs b/examples/rawQueries.hs new file mode 100644 --- /dev/null +++ b/examples/rawQueries.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances #-} +import Control.Monad (liftM, (>=>)) +import Control.Monad.IO.Class (liftIO) +import Database.Groundhog.Core (PersistValue, PersistField(..), PrimitivePersistField(..), RowPopper) +import Database.Groundhog.Generic (mapAllRows, phantomDb) +import Database.Groundhog.TH +import Database.Groundhog.Sqlite + +data SomeData = SomeData Int (Int, String) deriving Show + +mkPersist defaultCodegenConfig [groundhog| +- entity: SomeData +|] + +main = withSqliteConn ":memory:" $ runSqliteConn $ do + runMigration defaultMigrationLogger $ migrate (undefined :: SomeData) + k1 <- insert $ SomeData 1 (2, "abc") + k2 <- insert $ SomeData 10 (20, "def") + proxy <- phantomDb + + -- PersistField instance for PersistEntity expects to receive its id, not values contained in data. + -- So here we cannot use fromPersistValues to get data. + xs1 <- queryRaw False "SELECT \"SomeData0\", \"someData1#val0\", \"someData1#val1\" FROM \"SomeData\" WHERE \"id\" = ? OR \"id\" = ?" [toPrimitivePersistValue proxy k1, toPrimitivePersistValue proxy k2] $ mapAllRows (liftM fst . fromPersistValues) + liftIO $ print (xs1 :: [(Int, Int, String)]) + + -- it will run 1 + N select queries to get data by id. + xs2 <- queryRaw False "SELECT \"id\" FROM \"SomeData\" ORDER BY \"someData1#val0\" DESC" [] $ mapAllRows (liftM fst . fromPersistValues) + liftIO $ print (xs2 :: [SomeData]) + + -- function fromEntityPersistValues from PersistEntity expects constructor number (they start from 0) and the data contained in it. + xs3 <- queryRaw False "SELECT \"SomeData0\", \"someData1#val0\", \"someData1#val1\" FROM \"SomeData\" WHERE \"id\" = ? OR \"id\" = ?" [toPrimitivePersistValue proxy k1, toPrimitivePersistValue proxy k2] $ mapAllRows (liftM fst . fromEntityPersistValues . (toPrimitivePersistValue proxy (0 :: Int):)) + liftIO $ print (xs3 :: [SomeData]) + + -- the queries not supported by groundhog API may be run via raw SQL. If number of columns is too big (there are no instances PersistFields for tuples with more than 5 elements) you can nest tuples + xs4 <- queryRaw False "SELECT s1.\"id\", s1.\"someData1#val1\", s2.\"id\", s2.\"someData1#val1\" FROM \"SomeData\" s1 INNER JOIN \"SomeData\" s2 ON s1.\"id\" <= s2.\"id\"" [] $ mapAllRows (liftM fst . fromPersistValues) + liftIO $ print (xs4 :: [((String, String), (String, String))]) diff --git a/examples/sumTypes.hs b/examples/sumTypes.hs new file mode 100644 --- /dev/null +++ b/examples/sumTypes.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances #-} +import Control.Monad.IO.Class (liftIO) +import Database.Groundhog.TH +import Database.Groundhog.Sqlite + +data Shape = Circle { radius :: Double } + | Triangle { side1 :: Double, side2 :: Double, angle :: Double } deriving Show + +mkPersist defaultCodegenConfig [groundhog| +- entity: Shape + constructors: # Any constructors can be adjusted in this list. The order is not important. + - name: Triangle # This declaration just repeats some of the default values and can be removed. + exprName: TriangleConstructor # Just as default. + - name: Circle + fields: + - name: radius + exprName: CircleRadius # The default value defined by naming style was RadiusField +|] + +main = withSqliteConn ":memory:" $ runSqliteConn $ do + let circle = Circle 5 + -- Both table for Circle and for Triangle of the Shape datatype are migrated. + runMigration defaultMigrationLogger $ migrate circle + k <- insert circle + insert (Circle 10) + let triangle = Triangle 3 4 (pi / 2) + replace k triangle + count (CircleRadius <. (11 :: Double)) >>= \c -> liftIO (putStrLn $ "Small circles: " ++ show c) + shapes <- selectAll + liftIO $ print (shapes :: [(AutoKey Shape, Shape)]) diff --git a/examples/withoutQuasiQuotes.hs b/examples/withoutQuasiQuotes.hs new file mode 100644 --- /dev/null +++ b/examples/withoutQuasiQuotes.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, FlexibleInstances #-} +import Control.Monad.IO.Class (liftIO) +import Database.Groundhog.TH +import Database.Groundhog.TH.Settings +import Database.Groundhog.Sqlite + +data Table = Create {select :: String, update :: Int, fubar :: String} deriving (Eq, Show) + +mkPersist defaultCodegenConfig $ PersistDefinitions [ + Left $ PSEntityDef "Table" Nothing Nothing Nothing $ Just [ + PSConstructorDef "Create" Nothing Nothing Nothing (Just [ + PSFieldDef "select" (Just "SELECT") Nothing Nothing + , PSFieldDef "fubar" (Just "BEGIN COMMIT") Nothing Nothing + ]) + Nothing + ] + ] + +main = withSqliteConn ":memory:" $ runSqliteConn $ do + let table = Create "DROP" maxBound "DELETE" + runMigration defaultMigrationLogger $ migrate table + k <- insert table + get k >>= liftIO . print diff --git a/groundhog.cabal b/groundhog.cabal --- a/groundhog.cabal +++ b/groundhog.cabal @@ -1,5 +1,5 @@ name: groundhog -version: 0.1.0 +version: 0.1.0.1 license: BSD3 license-file: LICENSE author: Boris Lykah @@ -11,13 +11,15 @@ cabal-version: >= 1.6 build-type: Simple +extra-source-files: examples/*.hs + library build-depends: base >= 4 && < 5 , bytestring >= 0.9 && < 0.10 , transformers >= 0.2.1 && < 0.4 , time >= 1.1.4 , text >= 0.8 && < 0.12 - , containers >= 0.2 && < 0.5 + , containers >= 0.2 , monad-control >= 0.3 && < 0.4 , transformers-base exposed-modules: Database.Groundhog