Add size of all plants of one owner
[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 import qualified Data.Map as M
11
12 import Lseed.Data
13 import Lseed.Data.Functions
14
15 data DBCode = DBCode
16         { dbcUserName :: String
17         , dbcUserID :: Integer
18         , dbcPlantName :: String
19         , dbcPlantID :: Integer
20         , dbcCode :: String
21         }
22         deriving (Show)
23
24 withLseedDB ::  (Connection -> IO t) -> IO t
25 withLseedDB what = do
26         dn <- readFile "../db.conf"
27         conn <- connectODBC dn  
28         res <- what conn
29         disconnect conn
30         return res
31
32 getCodeToRun ::  IO [DBCode]
33 getCodeToRun = withLseedDB $ \conn -> do
34         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;"
35         stmt <- prepare conn getCodeQuery
36         execute stmt []
37         result <- fetchAllRowsMap' stmt
38         return $ flip map result $ \m -> 
39                 DBCode (fromSql (m ! "username"))
40                        (fromSql (m ! "userid"))
41                        (fromSql (m ! "plantname"))
42                        (fromSql (m ! "plantid"))
43                        (fromSql (m ! "code"))
44
45 addFinishedSeasonResults garden = withLseedDB $ \conn -> do 
46         let owernerscore = M.toList $ foldr go M.empty garden
47                 where go p = M.insertWith (+) (plantOwner p) (plantLength (phenotype p))
48         run conn "INSERT INTO SEASON VALUES (NULL, False)" []
49         stmt <- prepare conn "SELECT LAST_INSERT_ID()"
50         execute stmt []
51         id <- (head . head) `fmap` fetchAllRows' stmt
52         stmt <- prepare conn "INSERT INTO seasonscore VALUES (NULL, ?, ?, ?)"
53         executeMany stmt $ map (\(o,l)->
54                 [ toSql $ o
55                 , id
56                 , toSql $ l
57                 ]) owernerscore
58