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