69d199c03b4a9913ecb22674286f02d729b5ec5b
[L-seed.git] / src / Lseed / Grammar.hs
1 -- | Grammer-like representation for a plant genome
2 module Lseed.Grammar where
3
4 import Lseed.Data
5 import Data.List
6
7 -- | A complete grammar file
8 type GrammarFile = [ GrammarRule ]
9
10 type Priority = Int
11 type Weight = Int
12
13 type UserTag = String
14
15 defaultPriority :: Priority
16 defaultPriority = 0
17
18 defaultWeight :: Weight
19 defaultWeight = 1
20
21 -- | A single Rule. For now, only single branches
22 --   can be matched, not whole subtree structures
23 data GrammarRule = GrammarRule
24         { grName :: String
25         , grPriority :: Priority
26         , grWeight :: Weight
27         , grCondition :: Condition
28         , grActions :: [GrammarAction]
29         }
30         deriving (Read,Show)
31
32 data Matchable
33         = MatchLight
34         | MatchTotalLight
35         | MatchLength
36         | MatchTotalLength
37         | MatchDirection
38         | MatchAngle
39         deriving (Read,Show)
40
41 data Cmp
42         = LE
43         | Less
44         | Equals
45         | Greater
46         | GE 
47         deriving (Read,Show)
48
49 data Condition
50         = Always Bool -- constant conditions
51         | Condition `And` Condition
52         | Condition `Or` Condition
53         | UserTagIs String
54         | NumCond Matchable Cmp Double
55         deriving (Read,Show)
56          
57 data GrammarAction
58         = SetLength LengthDescr (Maybe UserTag)
59         | AddBranch Double Angle Double (Maybe UserTag)
60         deriving (Read,Show)
61
62 data LengthDescr = Absolute Double
63                  | Additional Double
64                  | AdditionalRelative Double -- ^ in Percent
65         deriving (Read,Show)
66
67 actionsAreInvalid :: [GrammarAction] -> Maybe String
68 actionsAreInvalid [_] = Nothing
69 actionsAreInvalid acts
70         = if all isAddBranch acts 
71           then case nub (map addBranchAngle acts) of
72             [frac] -> Nothing
73             _      -> Just "Can not branch at different points at the same time."
74           else        Just "Can not grow and branch at the same time."
75
76 isAddBranch (AddBranch _ _ _ _) = True
77 isAddBranch _ = False
78
79 addBranchAngle (AddBranch angle _ _ _) = angle
80