QueryMonad.hs

{- |
some queries implemented using the list monad

A special Table type instead of plain lists
could provide an efficient implementation.
-}
module Example.QueryMonad where

-- unqualified import for simplified usage in GHCi
import Query
import Company

import Data.Function (on, )
import Data.List (nub, nubBy, sortBy, maximumBy, )
import Data.Ord (comparing, )
import Control.Monad (guard, )


{- |
all employees
-}
employees :: [Emp]
employees = emp

{- |
all clerks
-}
clerks :: [Emp]
clerks = do
   e <- emp
   guard (job e == Clerk)
   return e

{- |
all clerks with salary at least 1000
-}
richClerks :: [Emp]
richClerks = do
   e <- emp
   guard (job e == Clerk && sal e >= 1000)
   return e

{- |
all employees in research department
-}
researchers :: [Emp]
researchers = do
   e <- emp
   d <- dept
   guard (deptno e == deptno d && dname d == "RESEARCH")
   return e

researchers0 :: [Emp]
researchers0 = do
   d <- dept
   guard (dname d == "RESEARCH")
   e <- emp
   guard (deptno e == deptno d)
   return e

{- |
names of all employees and their managers
if the employee has a manager so far
-}
managers :: [(String, String)]
managers = do
   e <- emp
   m <- emp
   guard (Just (empno m) == mgr e)
   return (ename e, ename m)

{- |
names of all employees and their managers;
if the employee has no manager, return an empty string
-}
managers0 :: [(String, String)]
managers0 = do
   e <- emp
   mname <-
      case mgr e of
         Nothing ->
            return ""
         Just mgre -> do
            m <- emp
            guard (empno m == mgre)
            return (ename m)
   return (ename e, mname)

{- |
names of managers that have at least one employee
-}
realManagers :: [String]
realManagers = nub $ do
   e <- emp
   m <- emp
   guard (Just (empno m) == mgr e)
   return (ename m)

{- |
managers that have at least one employee
-}
realManagersFull :: [Emp]
realManagersFull =
   nubBy ((==) `on` ename) $ do
      e <- emp
      m <- emp
      guard (Just (empno m) == mgr e)
      return m

{- |
managers that have at least one employee, sorted by their names.
-}
realManagersSortedFull :: [Emp]
realManagersSortedFull =
   sortBy (comparing ename) $
   nubBy ((==) `on` ename) $ do
      e <- emp
      m <- emp
      guard (Just (empno m) == mgr e)
      return m

{- |
maximum salary amongst all employees
-}
maximumSalary :: Int
maximumSalary = maximum $ do
   e <- emp
   return (sal e)

{- |
employee with maximum salary without a back-join
-}
richestEmployee :: Emp
richestEmployee =
   maximumBy (comparing sal) emp

{- |
employees grouped by their managers
implemented with a sub-query
-}
teams :: [(String, [String])]
teams = do
   m <- emp
   let es = do
         e <- emp
         guard (Just (empno m) == mgr e)
         return (ename e)
   guard (not (null es))
   return (ename m, es)

{- |
employees grouped by their managers
implemented with a GROUP BY
-}
teams0 :: [(String, [String])]
teams0 = do
   (mm,es) <- groupBy mgr emp
   m <- emp
   guard (Just (empno m) == mm)
   return (ename m, map ename es)

{- |
average salary in each department
-}
averageSalariesInDepartments :: [(String, Int)]
averageSalariesInDepartments = do
   (dm,es) <- groupBy deptno emp
   d <- dept
   guard (deptno d == dm)
   return (dname d, Query.averageInt (map sal es))


{- |
manager with most employees
-}
managerOfLargestTeam :: (String, Int)
managerOfLargestTeam = maximumBy (comparing snd) $ do
   (mm,es) <- groupBy mgr emp
   m <- emp
   guard (Just (empno m) == mm)
   return (ename m, length es)


{- |
A recursive query:
Compute the total salary for each manager
and the total set of employees he conducts.
-}
teamSalaries0 :: [(String, Int)]
teamSalaries0 =
   let recurse mgrsal mgrno =
          (\(sals,emps) ->
             let s = mgrsal + sum sals
             in  (s, (mgrno, s) : concat emps)) $
          unzip $
          map (\e -> recurse (sal e) (Just (empno e))) $
          filter (\e -> mgr e == mgrno) emp
   in  do (mno,esal) <- snd (recurse 0 Nothing)
          e <- emp
          guard (Just (empno e) == mno)
          return (ename e, esal)

teamSalaries :: [(String, Int)]
teamSalaries =
   let recurse mgrno =
          (\(sals,emps) -> (sum sals, concat emps)) $
          unzip $
          map (\e ->
             let (teamSal, team) = recurse (Just (empno e))
                 totalSal = teamSal + sal e
             in  (totalSal, (ename e, totalSal) : team)) $
          filter (\e -> mgr e == mgrno) emp
   in  snd (recurse Nothing)