{-# 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