Merge branch 'master' of git+ssh://gitosis@nomeata.de/L-seed
[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
10 getDBGarden = spread <$> map compileDBCode <$> getCodeToRun
11   where spread gs = zipWith (\(u,n,g) p ->
12                  Planted ((fromIntegral p + 0.5) / l)
13                          u
14                          n
15                          g
16                          inititalPlant
17                 ) gs [0..]
18           where l = fromIntegral (length gs)
19
20 compileDBCode dbc =
21         case  parseGrammar "" (dbcCode dbc) of
22                 Left err          -> error (show err)
23                 Right grammarFile -> (dbcUserID dbc, dbcUserName dbc, grammarFile)
24
25 dbc2genome = either (error.show) id . parseGrammar "" . dbcCode
26
27 getDBUpdate planted = maybe (genome planted) dbc2genome <$>
28                       getUpdatedCodeFromDB (plantOwner planted)
29
30 scoringObs = nullObserver {
31         obFinished = \garden -> do
32                 forM_ garden $ \planted -> do
33                         printf "Plant from %d at %.4f: Total size %.4f\n"
34                                 (plantOwner planted)
35                                 (plantPosition planted)
36                                 (plantLength (phenotype planted))
37                 addFinishedSeasonResults garden
38         }
39
40 main = lseedMainLoop False scoringObs (GardenSource getDBGarden getDBUpdate) 10