SeldaTutorial.hs

{-# LANGUAGE DeriveGeneric, OverloadedStrings, OverloadedLabels #-}
module Main where

import Database.Selda
import Database.Selda.SQLite
import Database.Selda.Backend

data Pet = Dog | Horse | Dragon
  deriving (Show, Read, Bounded, Enum)
instance SqlType Pet

data Person = Person
  { pid :: ID Person
  , name :: Text
  , age  :: Int
  , pet  :: Maybe Pet
  } deriving (Generic, Show)
instance SqlRow Person

people :: Table Person
people = table "people" [#pid :- autoPrimary]

insertAndPrintPK :: SeldaM ()
insertAndPrintPK = do
  pk <- insertWithPK people [Person def "Sara" 14 Nothing]
  liftIO (print pk)

petsForEveryone :: SeldaM Int
petsForEveryone = do
  update people
    (\person -> isNull (person ! #pet))
    (\person -> person `with` [#pet := just (literal Dog)])

compiledPetsForEveryone = compileUpdate defPPConfig
  people
    (\person -> person `with` [#pet := just (literal Dog)])
    (\person -> isNull (person ! #pet))

getAdultsAndTheirPets = do
  person <- select people
  restrict (person ! #age .>= 18)
  return (person ! #name :*: person ! #pet)

-- main :: SeldaM ()
main = withSQLite "people-2.sqlite" $ do
  dropTable people
  createTable people
  insert_ people
    [ Person def "Velvet"    19 (Just Dog)
    , Person def "Kobayashi" 23 (Just Dragon)
    , Person def "Miyu"      10 Nothing
    , Person { pid = def, name = "Brad", age = 31, pet = Nothing }
    ]

  adultsAndTheirPets <- query $ getAdultsAndTheirPets
  liftIO $ print adultsAndTheirPets -- ["Velvet" :*: Just Dog,"Kobayashi" :*: Just Dragon,"Brad" :*: Nothing]

  liftIO $ print compiledPetsForEveryone -- ("UPDATE \"people\" SET \"pet\" = CAST($1 AS TEXT) WHERE (\"pet\") IS NULL",[Param "Dog"])

  numUpdates <- petsForEveryone
  liftIO $ print numUpdates -- 2
  adultsAndTheirPets <- query $ getAdultsAndTheirPets
  liftIO $ print adultsAndTheirPets -- ["Velvet" :*: Just Dog,"Kobayashi" :*: Just Dragon,"Brad" :*: Just Dog]