Make db conf file configurable
authorJoachim Breitner <mail@joachim-breitner.de>
Thu, 25 Jun 2009 20:55:27 +0000 (22:55 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Thu, 25 Jun 2009 20:55:27 +0000 (22:55 +0200)
src/Lseed/DB.hs
src/dbclient.hs
src/dbscorer.hs

index e28445a..7443a96 100644 (file)
@@ -23,16 +23,16 @@ data DBCode = DBCode
        }
        deriving (Show)
 
-withLseedDB ::  (Connection -> IO t) -> IO t
-withLseedDB what = do
-       dn <- readFile "../db.conf"
+withLseedDB :: FilePath -> (Connection -> IO t) -> IO t
+withLseedDB conf what = do
+       dn <- readFile conf
        conn <- connectODBC dn  
        res <- what conn
        disconnect conn
        return res
 
-getCodeToRun ::  IO [DBCode]
-getCodeToRun = withLseedDB $ \conn -> do
+getCodeToRun :: FilePath -> IO [DBCode]
+getCodeToRun conf = withLseedDB conf $ \conn -> do
        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;"
        stmt <- prepare conn getCodeQuery
        execute stmt []
@@ -44,8 +44,8 @@ getCodeToRun = withLseedDB $ \conn -> do
                       (fromSql (m ! "plantid"))
                       (fromSql (m ! "code"))
 
-getUpdatedCodeFromDB :: Integer -> IO (Maybe DBCode)
-getUpdatedCodeFromDB userid = withLseedDB $ \conn -> do
+getUpdatedCodeFromDB :: FilePath -> Integer -> IO (Maybe DBCode)
+getUpdatedCodeFromDB conf userid = withLseedDB conf $ \conn -> do
        let query = "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 AND user.ID = ?;"
        stmt <- prepare conn query
        execute stmt [toSql userid]
@@ -57,7 +57,7 @@ getUpdatedCodeFromDB userid = withLseedDB $ \conn -> do
                       (fromSql (m ! "plantid"))
                       (fromSql (m ! "code"))
 
-addFinishedSeasonResults garden = withLseedDB $ \conn -> do 
+addFinishedSeasonResults conf garden = withLseedDB conf $ \conn -> do 
        let owernerscore = M.toList $ foldr go M.empty garden
                where go p = M.insertWith (+) (plantOwner p) (plantLength (phenotype p))
        run conn "INSERT INTO SEASON VALUES (NULL, False)" []
index eaae6b5..2ca5641 100644 (file)
@@ -7,9 +7,9 @@ import Lseed.Renderer.Cairo
 import Control.Applicative
 import Control.Monad
 import Text.Printf
+import System.Environment
 
-
-getDBGarden = spread <$> map compileDBCode <$> getCodeToRun
+getDBGarden conf = spread <$> map compileDBCode <$> getCodeToRun conf
   where spread gs = zipWith (\(u,n,g) p ->
                 Planted ((fromIntegral p + 0.5) / l)
                         u
@@ -25,9 +25,18 @@ compileDBCode dbc =
                Right grammarFile -> (dbcUserID dbc, dbcUserName dbc, grammarFile)
 dbc2genome = either (error.show) id . parseGrammar "" . dbcCode
 
-getDBUpdate planted = maybe (genome planted) dbc2genome <$>
-                      getUpdatedCodeFromDB (plantOwner planted)
+getDBUpdate conf planted = maybe (genome planted) dbc2genome <$>
+                      getUpdatedCodeFromDB conf (plantOwner planted)
 
 main = do
-       obs <- cairoObserver
-       lseedMainLoop True obs (GardenSource getDBGarden getDBUpdate) 200
+       args <- getArgs
+       case args of
+         [conf] -> do
+               obs <- cairoObserver
+               lseedMainLoop True
+                             obs
+                             (GardenSource (getDBGarden conf) (getDBUpdate conf))
+                             200
+         _ -> do
+               putStrLn "L-Seed DB client application."
+               putStrLn "Please pass DB configuration file on the command line."
index bcf86a7..be86ede 100644 (file)
@@ -6,8 +6,9 @@ import Lseed.Mainloop
 import Control.Applicative
 import Control.Monad
 import Text.Printf
+import System.Environment
 
-getDBGarden = spread <$> map compileDBCode <$> getCodeToRun
+getDBGarden conf = spread <$> map compileDBCode <$> getCodeToRun conf
   where spread gs = zipWith (\(u,n,g) p ->
                 Planted ((fromIntegral p + 0.5) / l)
                         u
@@ -24,17 +25,27 @@ compileDBCode dbc =
 
 dbc2genome = either (error.show) id . parseGrammar "" . dbcCode
 
-getDBUpdate planted = maybe (genome planted) dbc2genome <$>
-                      getUpdatedCodeFromDB (plantOwner planted)
+getDBUpdate conf planted = maybe (genome planted) dbc2genome <$>
+                      getUpdatedCodeFromDB conf (plantOwner planted)
 
-scoringObs = nullObserver {
+scoringObs conf = nullObserver {
        obFinished = \garden -> do
                forM_ garden $ \planted -> do
                        printf "Plant from %d at %.4f: Total size %.4f\n"
                                (plantOwner planted)
                                (plantPosition planted)
                                (plantLength (phenotype planted))
-               addFinishedSeasonResults garden
+               addFinishedSeasonResults conf garden
        }
 
-main = lseedMainLoop False scoringObs (GardenSource getDBGarden getDBUpdate) 10
+main = do
+       args <- getArgs
+       case args of
+         [conf] -> do
+               lseedMainLoop False
+                             (scoringObs conf)
+                             (GardenSource (getDBGarden conf) (getDBUpdate conf))
+                             10
+         _ -> do
+               putStrLn "L-Seed DB client application."
+               putStrLn "Please pass DB configuration file on the command line."