DSH-0.10.0.0: examples/Example02.hs

{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RebindableSyntax    #-}
{-# LANGUAGE ViewPatterns        #-}

module Main where

import qualified Prelude as P
import Database.DSH
import Database.DSH.Compiler

import Database.HDBC.PostgreSQL

employees :: Q [(Text, Text, Integer)]
employees = toQ [ ("Simon",  "MS",   80)
                , ("Erik",   "MS",   90)
                , ("Phil",   "Ed",   40)
                , ("Gordon", "Ed",   45)
                , ("Paul",   "Yale", 60)
                ]

dept :: Q (Text, Text, Integer) -> Q Text
dept (view -> (_, d, _)) = d

sal :: Q (Text, Text, Integer) -> Q Integer
sal (view -> (_, _, s)) = s

name :: Q (Text, Text, Integer) -> Q Text
name (view -> (n, _, _)) = n

-- The duplicate-free list of departments.
departments :: Q [Text]
departments = nub [ dept e | e <- employees]

-- The total salary for a given department
deptSalary :: Q Text -> Q Double
deptSalary d = avg [ sal e | e <- employees , d == dept e ]

-- For each department, compute the total salary.
deptSalaries :: Q [(Text, Double)]
deptSalaries = [ pair d (deptSalary d)
               | d <- departments
               ]

-- Alternatively, employ the 'groupWithKey' combinator to express
-- grouping.
deptSalaries' :: Q [(Text, Double)]
deptSalaries' = [ pair d (avg [ sal ge | ge <- g ])
                | (view -> (d, g)) <- groupWithKey dept employees
                ]

-- Query with a nested result: For each department, compute the list
-- of employees.
employeesPerDept :: Q [(Text, [Text])]
employeesPerDept = [ pair d [ name e | e <- employees, dept e == d ]
                   | d <- departments
                   ]

getConn :: IO Connection
getConn = connectPostgreSQL "user = 'au' password = 'foobar' host = 'localhost' dbname = 'test'"

execQ :: (Show a,QA a) => Q a -> IO ()
execQ q = getConn P.>>= \conn -> (runQ conn q P.>>= P.print) P.>> disconnect conn

main :: IO ()
main = execQ deptSalaries
       P.>> execQ deptSalaries'
       P.>> execQ employeesPerDept