persistent-hssqlppp-0.1: Test.hs

{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings, TypeFamilies, GADTs #-}

import Control.Monad
import Database.Persist
import Database.Persist.Base
import Database.Persist.TH
import Database.Persist.Postgresql
import Database.Persist.HsSqlPpp
import Database.HsSqlPpp.Pretty

-- We need to import EntityDef declaraion
-- to pass it to 'share' function because of
-- GHC stage restriction.
import TestSQL

-- Generate instance PersistEntity Stats.
share [mkPersist sqlSettings] [entity {entityName = "Stats"}]
-- Note that usual persistent query functions,
-- such as 'selectList' or 'insert', would not
-- work with Stats type, because there is no "Stats"
-- table in the DB. Only way to get data from
-- this query is using 'selectFromQuery' function.

-- A shortcut function to run DB actions
runPG :: SqlPersist IO (Either String a) -> IO a
runPG db = withPostgresqlConn "" $ runSqlConn $ do
  res <- db
  case res of
    Right x -> return x
    Left msg -> fail msg

test :: IO ()
test = do
   putStrLn "Executing a query:"
   putStrLn $ printQueryExpr queryText
   list <- runPG $ selectFromQuery queryText []
   putStrLn "Query results:"
   putStrLn "Department\tEmployee count\tAverage salary"
   forM_ list $ \stat ->
     putStrLn $ statsDept stat ++ "\t" ++ show (statsCount stat) ++ "\t" ++ show (statsAvg stat)

printRow :: (a -> String) -> [a] -> IO ()
printRow f list = do
   forM_ list $ \str -> putStr (f str ++ "\t")
   putStrLn ""

allowedTables = ["employee", "department"]

-- Now consider we want to execute a SELECT
-- query (maybe even query is received from user).
-- Almost arbitrary queries are allowed but only "safe"
-- (i.e., no saved functions calls, no complex constructs etc).
test2 :: IO ()
test2 = do
  let sql = "SELECT d.name AS dept, e.family FROM Employee e, Department d WHERE e.dept = d.id"
  putStrLn "Executing a query:"
  putStrLn sql
  (columns, rows) <- runPG $ selectFromQuery' allowedTables sql
  printRow id columns
  forM_ rows (printRow show)

testDialog :: IO ()
testDialog = do
  putStr "SQL> "
  sql <- getLine
  if sql == "quit"
    then return ()
    else do
         (columns, rows) <- runPG $ selectFromQuery' allowedTables sql
         printRow id columns
         forM_ rows (printRow show)
         testDialog