groundhog 0.1.0 → 0.1.0.1

raw patch · 9 files changed

+299/−5 lines, 9 filesdep ~basedep ~containers

Dependency ranges changed: base, containers

Files

Database/Groundhog/Expression.hs +3/−3
examples/basic.hs +38/−0
examples/embedded.hs +60/−0
examples/keys.hs +71/−0
examples/projections.hs +34/−0
examples/rawQueries.hs +36/−0
examples/sumTypes.hs +30/−0
examples/withoutQuasiQuotes.hs +23/−0
groundhog.cabal +4/−2

Database/Groundhog/Expression.hs view

@@ -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

+ examples/basic.hs view

@@ -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

+ examples/embedded.hs view

@@ -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

+ examples/keys.hs view

@@ -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'
+

+ examples/projections.hs view

@@ -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

+ examples/rawQueries.hs view

@@ -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))])

+ examples/sumTypes.hs view

@@ -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)])

+ examples/withoutQuasiQuotes.hs view

@@ -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

groundhog.cabal view

@@ -1,5 +1,5 @@ name:            groundhog-version:         0.1.0+version:         0.1.0.1 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -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