groundhog-0.1.0.2: examples/compositeKeys.hs

{-# 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, artistSurname :: 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: ArtistFullName
        default: true
    constructors:
      - name: Artist
        uniques:
          - name: ArtistFullName
            fields: [artistName, artistSurname]
|]

data Album  = Album  { albumName :: String} deriving (Eq, Show)
-- many-to-many relation
data ArtistAlbum = ArtistAlbum {artist :: Key Artist (Unique ArtistFullName), 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
    fields:
    - name: artist
      embeddedType: []
    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 ==. ArtistFullNameKey "John" "Lennon") `limitTo` 1
  -- order by primary key
  tracks' <- select $ (AlbumTrackField ==. albumKey') `orderBy` [Asc AutoKeyField] `limitTo` 3
  liftIO $ print tracks'