botlistprojects/botspider/spider/tests/haskell/src/Tests/Data/TestBasicHSQL.hs

   1 --
   2 -- Test Basic HSQL (sqlite3)
   3 --
   4 -- Date: 2/2/2008
   5 -- Author: Berlin Brown
   6 --
   7 -- Description:
   8 --
   9 -- Imperative oriented test case for hsql-sqlite3
  10 -- read/write operations
  11 --
  12 module Tests.Data.TestBasicHSQL where
  13
  14 import IO
  15 import Database.HSQL as Hsql
  16 import Database.HSQL.SQLite3 as Hsql
  17
  18 simpleDB = "tmp/simple.db"
  19
  20 sqlCreate = "create table if not exists simpletable(mydata)"
  21 sqlInsert = "insert into simpletable values('dogs and')"
  22 sqlSelect = "select mydata from simpletable"
  23 sqlSelectUniq = "select mydata from simpletable where mydata = 'dogs and'"
  24
  25 --
  26 -- Get Rows routine from David at davblog48
  27 getRows :: Statement -> IO [[String]]
  28 getRows stmt = do
  29   let fieldtypes = map (\(a,b,c) -> a) $ getFieldsTypes stmt
  30   rowdata <- collectRows (\s -> mapM (getFieldValue s) fieldtypes ) stmt
  31   return rowdata
  32
  33 runTestBasicHSQL = do
  34   putStrLn "Test HSQL"
  35   tryconn <- try $ Hsql.connect simpleDB ReadWriteMode
  36   conn <- case tryconn of
  37             Left _ -> error "Invalid Database Path"
  38             Right conn -> return conn
  39
  40   -- Run a simple create query
  41   stmt <- Hsql.query conn sqlCreate
  42   Hsql.closeStatement stmt
  43   stmt <- Hsql.query conn sqlInsert
  44   Hsql.closeStatement stmt
  45   stmt <- Hsql.query conn sqlSelect
  46   rows <- getRows stmt
  47   putStrLn $ "Length rows=" ++ show (length rows)
  48   mapM_ (\val -> putStrLn $ show val) rows
  49   Hsql.closeStatement stmt
  50   -- Find unique values.
  51   stmtu <- Hsql.query conn sqlSelectUniq
  52   rows <- getRows stmtu
  53   putStrLn $ "Length rows=" ++ show (length rows)
  54   Hsql.closeStatement stmtu
  55   -- Disconnect
  56   Hsql.disconnect conn
  57
  58 -- End of File