Make db conf file configurable
[L-seed.git] / src / dbscorer.hs
1 import Lseed.Data
2 import Lseed.Data.Functions
3 import Lseed.DB
4 import Lseed.Grammar.Parse
5 import Lseed.Mainloop
6 import Control.Applicative
7 import Control.Monad
8 import Text.Printf
9 import System.Environment
10
11 getDBGarden conf = spread <$> map compileDBCode <$> getCodeToRun conf
12   where spread gs = zipWith (\(u,n,g) p ->
13                  Planted ((fromIntegral p + 0.5) / l)
14                          u
15                          n
16                          g
17                          inititalPlant
18                 ) gs [0..]
19           where l = fromIntegral (length gs)
20
21 compileDBCode dbc =
22         case  parseGrammar "" (dbcCode dbc) of
23                 Left err          -> error (show err)
24                 Right grammarFile -> (dbcUserID dbc, dbcUserName dbc, grammarFile)
25
26 dbc2genome = either (error.show) id . parseGrammar "" . dbcCode
27
28 getDBUpdate conf planted = maybe (genome planted) dbc2genome <$>
29                       getUpdatedCodeFromDB conf (plantOwner planted)
30
31 scoringObs conf = nullObserver {
32         obFinished = \garden -> do
33                 forM_ garden $ \planted -> do
34                         printf "Plant from %d at %.4f: Total size %.4f\n"
35                                 (plantOwner planted)
36                                 (plantPosition planted)
37                                 (plantLength (phenotype planted))
38                 addFinishedSeasonResults conf garden
39         }
40
41 main = do
42         args <- getArgs
43         case args of
44           [conf] -> do
45                 lseedMainLoop False
46                               (scoringObs conf)
47                               (GardenSource (getDBGarden conf) (getDBUpdate conf))
48                               10
49           _ -> do
50                 putStrLn "L-Seed DB client application."
51                 putStrLn "Please pass DB configuration file on the command line."