Make dbscorer fill the DB with the result
authorJoachim Breitner <mail@joachim-breitner.de>
Sun, 24 May 2009 20:36:36 +0000 (22:36 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Sun, 24 May 2009 20:36:36 +0000 (22:36 +0200)
src/Lseed/DB.hs
src/dbscorer.hs

index 51e9e6e..04df6ab 100644 (file)
@@ -1,17 +1,21 @@
 module Lseed.DB 
        ( DBCode(..)
        , getCodeToRun
+       , addFinishedSeasonResults
        ) where
 
 import Database.HDBC
 import Database.HDBC.ODBC
 import Data.Map((!))
 
+import Lseed.Data
+import Lseed.Data.Functions
+
 data DBCode = DBCode
        { dbcUserName :: String
-       , dbcUserID :: Int
+       , dbcUserID :: Integer
        , dbcPlantName :: String
-       , dbcPlantID :: Int
+       , dbcPlantID :: Integer
        , dbcCode :: String
        }
        deriving (Show)
@@ -37,3 +41,15 @@ getCodeToRun = withLseedDB $ \conn -> do
                       (fromSql (m ! "plantid"))
                       (fromSql (m ! "code"))
 
+addFinishedSeasonResults garden = withLseedDB $ \conn -> do 
+       run conn "INSERT INTO SEASON VALUES (NULL, False)" []
+       stmt <- prepare conn "SELECT LAST_INSERT_ID()"
+       execute stmt []
+       id <- (head . head) `fmap` fetchAllRows' stmt
+       stmt <- prepare conn "INSERT INTO seasonscore VALUES (NULL, ?, ?, ?)"
+       executeMany stmt $ map (\planted ->
+               [ toSql $ plantOwner planted
+               , id
+               , toSql $ plantLength (phenotype planted)]
+               ) garden
+
index 6bebace..0d749d6 100644 (file)
@@ -8,11 +8,16 @@ import Control.Applicative
 import Control.Monad
 import Text.Printf
 
-getGarden = spread <$> map (either (error.show) compileGrammarFile . parseGrammar "" . dbcCode)
+getGarden = spread <$> map compileDBCode
                   <$> getCodeToRun
-  where spread gs = zipWith (\g p -> Planted ((fromIntegral p + 0.5) / l) p g (Stipe () 0 [])) gs [0..]
+  where spread gs = zipWith (\(u,g) p -> Planted ((fromIntegral p + 0.5) / l) u g (Stipe () 0 [])) gs [0..]
          where l = fromIntegral (length gs)
 
+compileDBCode dbc =
+       case  parseGrammar "" (dbcCode dbc) of
+               Left err          -> error (show err)
+               Right grammarFile -> (dbcUserID dbc, compileGrammarFile grammarFile)
+
 scoringObs = nullObserver {
        obFinished = \garden -> do
                forM_ garden $ \planted -> do
@@ -20,6 +25,7 @@ scoringObs = nullObserver {
                                (plantOwner planted)
                                (plantPosition planted)
                                (plantLength (phenotype planted))
+               addFinishedSeasonResults garden
        }
 
 main = do