Make dbscorer fill the DB with the result
[L-seed.git] / src / Lseed / DB.hs
1 module Lseed.DB 
2         ( DBCode(..)
3         , getCodeToRun
4         , addFinishedSeasonResults
5         ) where
6
7 import Database.HDBC
8 import Database.HDBC.ODBC
9 import Data.Map((!))
10
11 import Lseed.Data
12 import Lseed.Data.Functions
13
14 data DBCode = DBCode
15         { dbcUserName :: String
16         , dbcUserID :: Integer
17         , dbcPlantName :: String
18         , dbcPlantID :: Integer
19         , dbcCode :: String
20         }
21         deriving (Show)
22
23 withLseedDB ::  (Connection -> IO t) -> IO t
24 withLseedDB what = do
25         dn <- readFile "../db.conf"
26         conn <- connectODBC dn  
27         res <- what conn
28         disconnect conn
29         return res
30
31 getCodeToRun ::  IO [DBCode]
32 getCodeToRun = withLseedDB $ \conn -> do
33         let getCodeQuery = "SELECT plant.ID AS plantid, user.ID AS userid, code, plant.Name AS plantname, user.Name AS username from plant, user WHERE user.NextSeed = plant.ID;"
34         stmt <- prepare conn getCodeQuery
35         execute stmt []
36         result <- fetchAllRowsMap' stmt
37         return $ flip map result $ \m -> 
38                 DBCode (fromSql (m ! "username"))
39                        (fromSql (m ! "userid"))
40                        (fromSql (m ! "plantname"))
41                        (fromSql (m ! "plantid"))
42                        (fromSql (m ! "code"))
43
44 addFinishedSeasonResults garden = withLseedDB $ \conn -> do 
45         run conn "INSERT INTO SEASON VALUES (NULL, False)" []
46         stmt <- prepare conn "SELECT LAST_INSERT_ID()"
47         execute stmt []
48         id <- (head . head) `fmap` fetchAllRows' stmt
49         stmt <- prepare conn "INSERT INTO seasonscore VALUES (NULL, ?, ?, ?)"
50         executeMany stmt $ map (\planted ->
51                 [ toSql $ plantOwner planted
52                 , id
53                 , toSql $ plantLength (phenotype planted)]
54                 ) garden
55