Update parser. Fixes #5

README.md

@@ -14,7 +14,7 @@ These are the values propositions of master plan:
  * **Freedom**: master plan is a open specification, not dependent on tools or hosting.
    There is this current open-source implementation, but anyone can implement
    tools or visualizations on top of it.
-   
+
 See the [wiki](https://github.com/rodrigosetti/master-plan/wiki) for details and examples.
 
 ## Algebra of Projects
@@ -34,9 +34,9 @@ things depending on the domain, but most usually it's time.
 Given all these constraints and structure, master plan will build an optimum
 prioritization of projects and sub-projects for execution.
 
-The entire definition of a project is defined into a single `.plan` file
+The entire definition of a project is defined into a single `.plan` file using a
-using a simple C-like language. There are defaults for most constrains and properties
+simple language. There are defaults for most constrains and properties such that
-such that things can be less verbose if using the defaults.
+things can be less verbose if using the defaults.
 
 The tool is able to build visualizations from the plan file.
 
@@ -70,18 +70,11 @@ Available options:
 
 ### Syntax
 
-Comments are C-style: multiline in between `/*` and `*/`, and single line starts
+Comments start with ">" and go until the end of line.
-with `//`, extending to the end of line. Every definition must end with semicolon (`;`).
 
-Everything else are definitions, in the form `lrs = rhs`.
+Everything else are definitions, in the form `name [attributes] [expression] ;`.
-There are two kinds of definitions with respect to `lrs` (left hand side):
 
- * Definition of a project: in the form `identifier = expression`
+A project name should be unique. Definitions end with semicolon.
- * Definition of a property of a project: in the form `identifier(identifier) = expression`.
-   This is used to define properties of names.
-
-A project is identified by a unique identifier. The "root" project is identified
-by a special `root` identifier.
 
 Project expressions are expressions where project identifiers are combined via
 binary operators. Parenthesis can be used to enforce operator precedence. There
@@ -91,9 +84,12 @@ are three operators:
  * `p = a x b` - Product: `p` is executed when `a` and `b` is executed.
  * `p = a -> b` - Sequence: `p` is executed when `a` and `b` is executed, in order.
 
-#### Properties
+Please note that a equal sign (`=`) can be placed optionally just before the
+definition of the expression.
 
-Following is a list of supported properties of projects:
+#### Attributes
+
+Following is a list of supported attributes of projects:
 
 | Property name | Expected Type | Description |
 |---------------|---------------|-------------|
@@ -101,23 +97,37 @@ Following is a list of supported properties of projects:
 | description   | text          | longer description of what the project is |
 | url           | URL           | reference in the web for more context about the project |
 | owner         | username      | name of the person responsible for execution |
-| progress      | percentage    | how much progress has been made so far |
+| progress      | percentage    | how much progress has been made so far (default 0%) |
-| cost          | number        | estimated cost |
+| cost          | number        | estimated cost (default 0) |
-| trust         | percentage    | probability of success |
+| trust         | percentage    | probability of success (default 100%) |
 
-#### Grammar
+Attributes can be specified between brackets, like, _e.g._:
 
 ```
-plan = (definition ";")*
+b {
-definition = project_def | predicate_def
+  title "build"
-
+  description "our technology can be built and scale"
-project_def = identifier "=" expression
+} phase1 -> phase2 -> phase3;
-expression = term (("->" | "*") term)*
+```
-term = factor ("+" factor)*
+
-factor = "(" expression ")" | identifier
+Or, optionally, if only "title" is define, as a single string literal, as _e.g._:
-
+
-predicate_def = identifier "(" identifier ")" "=" value
+```
-value = percentage | literalString
+approvalProcess "approval process" legal -> budget -> executive;
-
+```
-percentage = nonNegativeNumber "%"
+
+There are "atomic" attributes that should be defined only for projects without
+expressions: "cost", "trust", and "progress". Defining them and also expressions
+is an error.
+
+Example of atomic project:
+
+```
+sb {
+  title "supplier B"
+  trust 60%
+  cost 5
+  url "www.supplier.b.com"
+  owner "partnerships"
+};
 ```

app/Main.hs

@@ -73,10 +73,10 @@ cmdParser = Opts <$> optional (strArgument ( help "plan file to read from (defau
                                         <*> (invertProps <$> many (option property ( long "hide"
                                                                                    <> help "hide a particular property"
                                                                                    <> metavar (intercalate "|" $ map fst propertyNames))))
-    propertyNames = map (\p -> (show p, p)) [minBound :: ProjProperty ..]
+    propertyNames = map (\p -> (show p, p)) [minBound :: ProjAttribute ..]
     property = readEnum propertyNames
 
-    invertProps ∷ [ProjProperty] → [ProjProperty]
+    invertProps ∷ [ProjAttribute] → [ProjAttribute]
     invertProps l = filter (`notElem` l) $ map snd propertyNames
 
     filterParser ∷ Parser ProjFilter

examples/example1.plan

@@ -1,64 +1,93 @@
-/**
+> This project is a business plan, which vision is state in
- * This project is a business plan, which vision is state in
+> the "root" project - which is run a successful tech-based
- * the "root" project - which is run a successful tech-based
+> business in a certain market.
- * business in a certain market.
- */
-title(root) = "business";
-description(root) = "can we run a successful business";
-owner(root) = "CEO";
 
-root = x + p;
+root {
+  title "business"
+  description "can we run a successful business"
+  owner "CEO"
+} x + p;
 
-// -------
+x {
+  title "build technology"
+  description "can we build the technology ourselves"
+} h * b;
 
-title(x) = "build technology";
+h hire + acquihire;
-description(x) = "can we build the technology ourselves";
 
-x = h * b;
+hire {
+  title "hire"
+  description "can we attract and retain talent"
+  cost 20
+  owner "HR"
+  trust 50%
+};
 
-title(h) = "hire";
+acquihire {
-description(h) = "can we attract and retain talent";
+  description "can we buy talent"
-cost(h) = 20;
+  cost 100
-owner(h) = "HR";
+  owner "HR"
+  trust 100%
+};
 
-title(b) = "build";
+b {
-description(b) = "our technology can be built and scale";
+  title "build"
+  description "our technology can be built and scale"
+} phase1 -> phase2 -> phase3;
 
-b = phase1 -> phase2 -> phase3;
+phase1 {
+  title "validate prototype"
+  trust 70%
+  progress 100%
+  owner "engineering"
+};
 
-title(phase1) = "validate prototype";
+phase2 {
-trust(phase1) = 70%;
+  title "launch in small market"
-progress(phase1) = 100%;
+  trust 50%
-owner(phase1) = "engineering";
+  progress 32%
+  owner "engineering"
+};
 
-title(phase2) = "launch in small market";
+phase3 {
-trust(phase2) = 50%;
+  title "scale nationwide"
-progress(phase2) = 32%;
+  trust 20%
-owner(phase2) = "engineering";
+  owner "engineering"
+};
 
-title(phase3) = "scale nationwide";
+> Another way to get technology is to parner,
-trust(phase3) = 20%;
+> instead of building it:
-owner(phase3) = "engineering";
 
-// Another way to get technology is to parner,
+p {
-// instead of building it:
+  title "tech partner"
+  description "secure a tech partnership"
+} (approvalProcess -> sa) + (approvalProcess -> sb);
 
-title(p) = "tech partner";
+sa {
-description(p) = "secure a tech partnership";
+  title "supplier A"
+  trust 90%
+  cost 10
+  url "www.supplier.a.com"
+  owner "partnerships"
+};
 
-p = (approvalProcess -> sa) + (approvalProcess -> sb);
+sb {
+  title "supplier B"
+  trust 60%
+  cost 5
+  url "www.supplier.b.com"
+  owner "partnerships"
+};
 
-title(sa) = "supplier A"; trust(sa) = 90%; cost(sa) = 10;
+> Approval process is a sub-project we have to go once
-url(sa) = "www.supplier.a.com";
+> regardless of which partnership, will "open the way"
-owner(sa) = "partnerships";
 
-title(sb) = "supplier B"; trust(sb) = 60%; cost(sb) = 5;
+approvalProcess "approval process" legal -> budget -> executive;
-url(sb) = "www.supplier.b.com";
-owner(sb) = "partnerships";
 
-/*
+legal {
- * Approval process is a sub-project we have to go once
+  description "figure out how to write the contract"
- * regardless of which partnership, will "open the way"
+};
- */
+
-approvalProcess = legal -> budget -> executive;
+budget {
-title(approvalProcess) = "approval process";
+  description "can we afford?"
+};

src/MasterPlan/Backend/Graph.hs

@@ -64,11 +64,6 @@ toRenderModel sys rootK = case M.lookup rootK (bindings sys) of
     bindingToRM key (BindingAtomic prop c t p) = pure $ mkLeaf $ PNode (Just key)
                                                                        (Just prop)
                                                                        c t p
-    bindingToRM key (BindingPlaceholder prop) = pure $ mkLeaf $ PNode (Just key)
-                                                                      (Just prop)
-                                                                      defaultCost
-                                                                      defaultTrust
-                                                                      defaultProgress
 
     mkNode :: (PNode -> [RenderModel] -> RenderModel)
            -> ProjectExpr
@@ -104,7 +99,7 @@ data RenderOptions = RenderOptions { colorByProgress :: Bool -- ^Whether to colo
                                    , renderWidth :: Integer -- ^The width of the output image
                                    , renderHeight :: Integer -- ^The height of the output image
                                    , rootKey :: ProjectKey -- ^The name of the root project
-                                   , whitelistedProps :: [ProjProperty] -- ^Properties that should be rendered
+                                   , whitelistedProps :: [ProjAttribute] -- ^Properties that should be rendered
                                    } deriving (Eq, Show)
 
 -- | The main rendering function
@@ -114,7 +109,7 @@ render fp (RenderOptions colorByP w h rootK props) sys =
       dia = fromMaybe noRootEroor $ renderTree colorByP props <$> evalState (toRenderModel sys rootK) []
   in renderRasterific fp (dims2D (fromInteger w) (fromInteger h)) $ bgFrame 1 white $ centerXY dia
 
-renderTree :: Bool -> [ProjProperty] -> RenderModel -> QDiagram B V2 Double Any
+renderTree :: Bool -> [ProjAttribute] -> RenderModel -> QDiagram B V2 Double Any
 renderTree colorByP props (Node (_, n) [])    = alignL $ renderNode colorByP props n
 renderTree colorByP props x@(Node (ty, n) ts@(t:_)) =
     (strutY (12 * treeSize x) <> alignL (centerY $ renderNode colorByP props n))
@@ -140,7 +135,7 @@ renderTree colorByP props x@(Node (ty, n) ts@(t:_)) =
                     AtomicNode -> mempty
       in txt # fontSizeL 2 # bold <> circle 2 # fc white # lwO 1
 
-renderNode :: Bool -> [ProjProperty] -> PNode -> QDiagram B V2 Double Any
+renderNode :: Bool -> [ProjAttribute] -> PNode -> QDiagram B V2 Double Any
 renderNode _        _     (NodeRef n) =
    text n <> roundedRect 30 12 0.5 # lwO 2 # fc white # dashingN [0.005, 0.005] 0
 renderNode colorByP props (PNode _   prop c t p) =
@@ -156,7 +151,7 @@ renderNode colorByP props (PNode _   prop c t p) =
           sectionsWithSep = vcat (intersperse (hrule 30 # dashingN [0.005, 0.005] 0 # lwO 1) sections)
       in outerRect # fcColor `beneath` centerY sectionsWithSep
 
-    givenProp :: ProjProperty -> Maybe a -> Maybe a
+    givenProp :: ProjAttribute -> Maybe a -> Maybe a
     givenProp pro x = if pro `elem` props then x else Nothing
 
     headerSection = case [progressHeader, titleHeader, costHeader] of
@@ -167,8 +162,8 @@ renderNode colorByP props (PNode _   prop c t p) =
     costHeader = givenProp PCost $ Just $ displayCost c # translateX 14
 
     descriptionSection, urlSection, bottomSection :: Maybe (QDiagram B V2 Double Any)
-    descriptionSection = givenProp PDescription $ prop >>= description >>= (pure . text) -- TODO line breaks
+    descriptionSection = givenProp PDescription $ prop >>= description >>= (pure . text) -- TODO:50 line breaks
-    urlSection = givenProp PUrl $ prop >>= url >>= (pure . text) -- TODO ellipsis
+    urlSection = givenProp PUrl $ prop >>= url >>= (pure . text) -- TODO:40 ellipsis
 
     bottomSection = case [trustSubSection, ownerSubSection] of
                       [Nothing, Nothing] -> Nothing

src/MasterPlan/Backend/Identity.hs

@@ -11,82 +11,81 @@ Portability : POSIX
 {-# LANGUAGE OverloadedStrings #-}
 module MasterPlan.Backend.Identity (render) where
 
-import           Control.Monad      (when, void)
+import           Control.Monad      (when)
-import           Control.Monad.RWS  (RWS, evalRWS, gets, tell, modify, asks)
+import           Control.Monad.RWS  (RWS, evalRWS, gets, tell, modify)
 import           Data.Generics
 import           Data.List          (nub)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map           as M
-import           Data.Monoid ((<>))
+import           Data.Monoid        ((<>))
 import qualified Data.Text          as T
-import           Data.Maybe         (fromMaybe)
+import           Data.Maybe         (isJust)
 import           MasterPlan.Data
 
 -- |Plain text renderer
-render ∷ ProjectSystem → [ProjProperty] -> T.Text
+render ∷ ProjectSystem → [ProjAttribute] -> T.Text
 render (ProjectSystem bs) whitelist =
    snd $ evalRWS (renderName "root" >> renderRest) whitelist bs
  where
    renderRest = gets M.keys >>= mapM_ renderName
 
-type RenderMonad = RWS [ProjProperty] T.Text (M.Map String Binding)
+type RenderMonad = RWS [ProjAttribute] T.Text (M.Map String Binding)
-
-renderLine ∷ T.Text → RenderMonad ()
-renderLine s = tell $ s <> ";\n"
 
 renderName ∷ ProjectKey → RenderMonad ()
 renderName projName =
   do mb <- gets $ M.lookup projName
      case mb of
        Nothing -> pure ()
-       Just b  -> do rendered <- renderBinding projName b
+       Just b  -> do tell $ T.pack projName
-                     when rendered $ tell "\n" -- empty line to separate bindings
+                     when (hasAttribute b) $ do
+                       tell " {\n"
+                       renderAttr b
+                       tell "}"
+                     case b of
+                       BindingExpr _ e -> tell $ " " <> expressionToStr False e <> ";\n"
+                       _ -> tell ";\n"
                      modify $ M.delete projName
                      mapM_ renderName $ dependencies b
+ where
+   hasAttribute (BindingExpr props _) = hasProperty props
+   hasAttribute (BindingAtomic props c t p) =  hasProperty props
+                                            || c /= defaultCost
+                                            || t /= defaultTrust
+                                            || p  /= defaultProgress
+   hasProperty props =  title props /= projName
+                     || isJust (description props)
+                     || isJust (owner props)
+                     || isJust (url props)
+
+   percentage n = T.pack $ show (n * 100) <> "%"
+
+   renderAttr (BindingExpr props _) = renderProps props
+   renderAttr (BindingAtomic props c t p) =
+     do renderProps props
+        when (c /= defaultCost) $ tell $ "cost " <> T.pack (show c) <> "\n"
+        when (t /= defaultTrust) $ tell $ "trust " <> percentage t <> "\n"
+        when (p /= defaultProgress) $ tell $ "progress " <> percentage p <> "\n"
+
+   renderProps :: ProjectProperties -> RenderMonad ()
+   renderProps p = do let maybeRender :: T.Text -> Maybe String -> RenderMonad ()
+                          maybeRender n = maybe (pure ()) (\x -> tell $ n <> " " <> T.pack (show x) <> "\n")
+                      when (title p /= projName) $ tell $ "title " <> T.pack (show $ title p) <> "\n"
+                      maybeRender "description" (description p)
+                      maybeRender "url" (url p)
+                      maybeRender "owner" (owner p)
+
+   combinedEToStr parens op ps = let sube = map (expressionToStr True) $ NE.toList ps
+                                     s = T.intercalate (" " <> op <> " ") sube
+                                  in if parens && length ps > 1 then "(" <> s <> ")" else s
+
+   expressionToStr :: Bool -> ProjectExpr -> T.Text
+   expressionToStr _      (Reference n) = T.pack n
+   expressionToStr parens (Product ps)  = combinedEToStr parens "*" ps
+   expressionToStr parens (Sequence ps) = combinedEToStr parens "->" ps
+   expressionToStr parens (Sum ps)      = combinedEToStr parens "+" ps
 
 dependencies ∷ Binding → [ProjectKey]
 dependencies = nub . everything (++) ([] `mkQ` collectDep)
   where
     collectDep (Reference n) = [n]
     collectDep _           = []
-
-renderProps ∷ String → ProjectProperties → RenderMonad Bool
-renderProps projName p =
-  or <$> sequence [ renderProperty projName PTitle (title p) projName (T.pack . show)
-                  , renderProperty projName PDescription (description p) Nothing (T.pack . show . fromMaybe "")
-                  , renderProperty projName PUrl (url p) Nothing (T.pack . show . fromMaybe "")
-                  , renderProperty projName POwner (owner p) Nothing (T.pack . show . fromMaybe "") ]
-
-renderProperty ∷ Eq a ⇒ ProjectKey → ProjProperty → a → a → (a → T.Text) → RenderMonad Bool
-renderProperty projName prop val def toText
-  | val == def = pure False
-  | otherwise = do whitelisted <- asks (prop `elem`)
-                   when whitelisted $
-                        renderLine $ T.pack (show prop) <> "(" <> T.pack projName <> ") = " <> toText val
-                   pure whitelisted
-
-renderBinding ∷ ProjectKey → Binding → RenderMonad Bool
-renderBinding projName (BindingPlaceholder p) = renderProps projName p
-renderBinding projName (BindingAtomic props c t p) =
-    or <$> sequence [ renderProps projName props
-                    , renderProperty projName PCost c 0 (T.pack . show)
-                    , renderProperty projName PTrust t 1 percentage
-                    , renderProperty projName PProgress p 0 percentage ]
-  where
-    percentage n = T.pack $ show (n * 100) <> "%"
-
-
-renderBinding projName (BindingExpr pr e) =
-    do void $ renderProps projName pr
-       renderLine $ T.pack projName <> " = " <> expressionToStr False e
-       pure True
-  where
-    combinedEToStr parens op ps = let sube = map (expressionToStr True) $ NE.toList ps
-                                      s = T.intercalate (" " <> op <> " ") sube
-                                   in if parens && length ps > 1 then "(" <> s <> ")" else s
-
-    expressionToStr :: Bool -> ProjectExpr -> T.Text
-    expressionToStr _      (Reference n)       = T.pack n
-    expressionToStr parens (Product ps)  = combinedEToStr parens "*" ps
-    expressionToStr parens (Sequence ps) = combinedEToStr parens "->" ps
-    expressionToStr parens (Sum ps)      = combinedEToStr parens "+" ps

src/MasterPlan/Data.hs

@@ -15,7 +15,7 @@ module MasterPlan.Data ( ProjectExpr(..)
                        , ProjectSystem(..)
                        , Binding(..)
                        , ProjectKey
-                       , ProjProperty(..)
+                       , ProjAttribute(..)
                        , Trust
                        , Cost
                        , Progress
@@ -57,7 +57,6 @@ data ProjectExpr = Sum (NE.NonEmpty ProjectExpr)
 -- properties
 data Binding = BindingAtomic ProjectProperties Cost Trust Progress
                     | BindingExpr ProjectProperties ProjectExpr
-                    | BindingPlaceholder ProjectProperties
                    deriving (Eq, Show, Data, Typeable)
 
 -- |Any binding (with a name) may have associated properties
@@ -67,10 +66,10 @@ data ProjectProperties = ProjectProperties { title       :: String
                                            , owner       :: Maybe String
                                            } deriving (Eq, Show, Data, Typeable)
 
-data ProjProperty = PTitle | PDescription | PUrl | POwner | PCost | PTrust | PProgress
+data ProjAttribute = PTitle | PDescription | PUrl | POwner | PCost | PTrust | PProgress
   deriving (Eq, Enum, Bounded)
 
-instance Show ProjProperty where
+instance Show ProjAttribute where
   show PTitle       = "title"
   show PDescription = "description"
   show PUrl         = "url"
@@ -105,15 +104,13 @@ defaultTaskProj pr = BindingAtomic pr defaultCost defaultTrust defaultProgress
 bindingTitle ∷ Binding → String
 bindingTitle (BindingAtomic ProjectProperties { title=t} _ _ _) = t
 bindingTitle (BindingExpr ProjectProperties { title=t} _)       = t
-bindingTitle (BindingPlaceholder ProjectProperties { title=t})  = t
 
 -- | Expected cost
 cost ∷ ProjectSystem → ProjectExpr → Cost
 cost sys (Reference n) =
   case M.lookup n (bindings sys) of
     Just (BindingAtomic _ c _ p) -> c * (1-p) -- cost is weighted by remaining progress
-    Just (BindingExpr _ p)       -> cost sys p -- TODO: avoid cyclic
+    Just (BindingExpr _ p)       -> cost sys p -- TODO:0 avoid cyclic
-    Just (BindingPlaceholder _)  -> defaultCost -- mentioned but no props neither task defined
     Nothing                      -> defaultCost -- mentioned but no props neither task defined
 cost sys (Sequence ps) = costConjunction sys ps
 cost sys (Product ps) = costConjunction sys ps
@@ -135,8 +132,7 @@ trust ∷ ProjectSystem → ProjectExpr → Trust
 trust sys (Reference n) =
   case M.lookup n (bindings sys) of
     Just (BindingAtomic _ _ t p) -> p + t * (1-p)
-    Just (BindingExpr _ p)       -> trust sys p -- TODO: avoid cyclic
+    Just (BindingExpr _ p)       -> trust sys p -- TODO:10 avoid cyclic
-    Just (BindingPlaceholder _)  -> defaultTrust -- mentioned but no props neither task defined
     Nothing                      -> defaultTrust -- mentioned but no props neither task defined
 trust sys (Sequence ps) = trustConjunction sys ps
 trust sys (Product ps) = trustConjunction sys ps
@@ -150,8 +146,7 @@ progress ∷ ProjectSystem → ProjectExpr → Progress
 progress sys (Reference n) =
   case M.lookup n (bindings sys) of
     Just (BindingAtomic _ _ _ p) -> p
-    Just (BindingExpr _ p)       -> progress sys p -- TODO: avoid cyclic
+    Just (BindingExpr _ p)       -> progress sys p -- TODO:20 avoid cyclic
-    Just (BindingPlaceholder _)  -> defaultProgress -- props without task or expression
     Nothing                      -> defaultProgress -- mentioned but no props neither task defined
 progress sys (Sequence ps)   = progressConjunction sys ps
 progress sys (Product ps)    = progressConjunction sys ps

src/MasterPlan/Internal/Debug.hs

@@ -26,7 +26,6 @@ debugSys sys@(ProjectSystem bs) = void $ M.traverseWithKey printBinding bs
                             case b of
                               BindingExpr _ e -> putStr "\n" >> debugProj sys e
                               BindingAtomic _ c t p -> putStrLn $ printf "(c:%.2f,t:%.2f,p:%2.f)" c t p
-                              BindingPlaceholder _ -> putStrLn "?"
 
 -- |Print a Project Expression in a Project System to standard output.
 -- The expression is printed in a tree like fashion.

src/MasterPlan/Parser.hs

@@ -13,10 +13,12 @@ Portability : POSIX
 module MasterPlan.Parser (runParser) where
 
 import           Control.Monad.State
-import           Data.Generics
+import           Control.Applicative        (empty)
+import           Data.Generics              hiding (empty)
 import           Data.List                  (nub)
 import qualified Data.List.NonEmpty         as NE
 import qualified Data.Map                   as M
+import           Data.Maybe                 (fromMaybe, isJust)
 import qualified Data.Text                  as T
 import           Data.Void
 import           MasterPlan.Data
@@ -25,14 +27,11 @@ import           Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer as L
 import           Text.Megaparsec.Expr
 
-type Parser = ParsecT Void T.Text (State ProjectSystem)
+type Parser = Parsec Void T.Text
 
 -- |Space consumer
 sc ∷ Parser ()
-sc = L.space space1 lineCmnt blockCmnt
+sc = L.space space1 (L.skipLineComment ">") empty
-  where
-    lineCmnt  = L.skipLineComment "//"
-    blockCmnt = L.skipBlockComment "/*" "*/"
 
 lexeme ∷ Parser a → Parser a
 lexeme = L.lexeme sc
@@ -46,12 +45,14 @@ parens = between (symbol "(") (symbol ")")
 
 -- |list of reserved words
 rws ∷ [String]
-rws = map show [minBound :: ProjProperty ..]
+rws = map show [minBound :: ProjAttribute ..]
 
 identifier ∷ Parser String
-identifier = (lexeme . try) (p >>= check)
+identifier = (lexeme . try) $ (:) <$> letterChar <*> many alphaNumChar
+
+nonKeywordIdentifier :: Parser String
+nonKeywordIdentifier = identifier >>= check
   where
-    p       = (:) <$> letterChar <*> many alphaNumChar
     check x
       | x `elem` rws = fail $ "keyword " ++ show x ++ " cannot be an identifier"
       | otherwise    = pure x
@@ -68,67 +69,11 @@ percentage = do n <- L.float <?> "percentage value"
 nonNegativeNumber :: Parser Float
 nonNegativeNumber = L.float
 
-definition ∷ Parser ()
+expression ∷ Parser ProjectExpr
-definition =
+expression =
-    choice ([ propsProp PTitle stringLiteral (\v p -> p { title = v })
-            , propsProp PDescription stringLiteral (\v p -> p { description = Just v})
-            , propsProp PUrl stringLiteral (\v p -> p { url = Just v})
-            , propsProp POwner stringLiteral (\v p -> p { owner = Just v})
-            , taskProp  PCost nonNegativeNumber (\v b -> case b of BindingAtomic r _ t p -> BindingAtomic r v t p; _ -> b)
-            , taskProp  PTrust percentage (\v b -> case b of BindingAtomic r c _ p -> BindingAtomic r c v p; _ -> b)
-            , taskProp  PProgress percentage (\v b -> case b of BindingAtomic r c t _ -> BindingAtomic r c t v; _ -> b)
-            , structure ] :: [Parser ()])
-  where
-    structure :: Parser ()
-    structure = do projName <- identifier
-                   projectExpr <- symbol "=" *> expressionParser
-                   sys <- lift get
-
-                   -- check if it's recursive
-                   let deps = dependencies sys projectExpr
-                   when (projName `elem` deps) $ fail $ "definition of \"" ++ projName ++ "\" is recursive"
-
-                   let binding = M.lookup projName $ bindings sys
-                   newBinding <- case binding of
-                                   Nothing -> pure $ BindingExpr (defaultProjectProps { title=projName }) projectExpr
-                                   Just BindingExpr {} -> fail $ "Redefinition of \"" ++ projName ++ "\"."
-                                   Just (BindingPlaceholder p) -> pure $ BindingExpr p projectExpr
-                                   Just BindingAtomic {} -> fail $ "ProjectExpr \"" ++ projName ++ "\" is atomic"
-
-                   lift $ put $ sys { bindings = M.insert projName newBinding $ bindings sys }
-
-    propsProp :: ProjProperty -> Parser a -> (a -> ProjectProperties -> ProjectProperties) -> Parser ()
-    propsProp prop valueParser modifier =
-       property prop valueParser setter
-     where
-       setter projName val Nothing = pure $ BindingPlaceholder $ modifier val $ defaultProjectProps { title=projName }
-       setter _ val (Just p) = pure $ everywhere (mkT $ modifier val) p
-
-    taskProp :: ProjProperty -> Parser a -> (a -> Binding -> Binding) -> Parser ()
-    taskProp prop valueParser modifier =
-       property prop valueParser setter
-     where
-       setter projName val Nothing = pure $ modifier val $ defaultTaskProj defaultProjectProps { title=projName }
-       setter projName _ (Just BindingExpr {}) = fail $ "ProjectExpr \"" ++ projName ++ "\" is not atomic."
-       setter _ val (Just (BindingPlaceholder p)) = pure $ modifier val $ defaultTaskProj p
-       setter _ val (Just p@BindingAtomic {}) = pure $ modifier val p
-
-    property ∷ ProjProperty → Parser a → (String -> a -> Maybe Binding -> Parser Binding) -> Parser ()
-    property prop valueParser setter =
-       do void $ symbol $ T.pack $ show prop
-          projName <- parens identifier
-          mBinding <- lift $ M.lookup projName <$> gets bindings
-          value <- symbol "=" *> valueParser
-          newBinding <- setter projName value mBinding
-          let modifySys :: ProjectSystem -> ProjectSystem
-              modifySys sys = sys { bindings = M.insert projName newBinding $ bindings sys }
-          lift $ modify modifySys
-
-expressionParser ∷ Parser ProjectExpr
-expressionParser =
     simplifyProj <$> makeExprParser term table <?> "expression"
   where
-    term = parens expressionParser <|> (Reference <$> identifier)
+    term = parens expression <|> (Reference <$> nonKeywordIdentifier)
     table = [[binary "*" (combineWith Product)]
             ,[binary "->" (combineWith Sequence)]
             ,[binary "+" (combineWith Sum)]]
@@ -137,7 +82,63 @@ expressionParser =
     combineWith :: (NE.NonEmpty ProjectExpr -> ProjectExpr) -> ProjectExpr -> ProjectExpr -> ProjectExpr
     combineWith c p1 p2 = c $ p1 NE.<| [p2]
 
-dependencies ∷ ProjectSystem -> ProjectExpr → [ProjectKey]
+
+binding :: ProjectKey -> Parser Binding
+--binding key = do (props, mc, mt, mp) <- bracketAttributes
+binding key = do (props, mc, mt, mp) <- try simpleTitle <|> try bracketAttributes <|> noAttributes
+                 case (mc, mt, mp) of
+                  (Nothing, Nothing, Nothing) ->
+                     try (BindingExpr props <$> (sc *> optional (symbol "=") *> expression)) <|>
+                       pure (BindingAtomic props defaultCost defaultTrust defaultProgress)
+                  (mc', mt', mp') -> pure $ BindingAtomic props
+                                                         (fromMaybe defaultCost mc')
+                                                         (fromMaybe defaultTrust mt')
+                                                         (fromMaybe defaultProgress mp')
+ where
+   attrKey :: Parser ProjAttribute
+   attrKey = do n <- identifier <?> "attribute name"
+                case lookup n [(show a, a) | a <- [minBound::ProjAttribute ..]] of
+                  Nothing -> fail $ "invalid attribute: \"" ++ n ++ "\""
+                  Just a -> pure a
+
+   simpleTitle, bracketAttributes, noAttributes :: Parser (ProjectProperties, Maybe Cost, Maybe Trust, Maybe Progress)
+   simpleTitle = do s <- stringLiteral <?> "title"
+                    pure (defaultProjectProps {title=s}, Nothing, Nothing, Nothing)
+
+   bracketAttributes = symbol "{" *> attributes (defaultProjectProps {title=key}) Nothing Nothing Nothing
+
+   noAttributes = pure (defaultProjectProps {title=key}, Nothing, Nothing, Nothing)
+
+   attributes :: ProjectProperties -> Maybe Cost -> Maybe Trust -> Maybe Progress
+              -> Parser (ProjectProperties, Maybe Cost, Maybe Trust, Maybe Progress)
+   attributes props mc mt mp =
+     try (sc *> symbol "}" *> pure (props, mc, mt, mp)) <|>
+         do attr <- sc *> attrKey
+            case attr of
+              PTitle -> do s <- stringLiteral <?> "title"
+                           attributes (props {title=s}) mc mt mp
+              PDescription -> do when (isJust $ description props) $ fail "redefinition of description"
+                                 s <- stringLiteral <?> "description"
+                                 attributes (props {description=Just s}) mc mt mp
+              PUrl -> do when (isJust $ url props) $ fail "redefinition of url"
+                         s <- stringLiteral <?> "url"
+                         attributes (props {url=Just s}) mc mt mp
+              POwner -> do when (isJust $ owner props) $ fail "redefinition of owner"
+                           s <- stringLiteral <?> "owner"
+                           attributes (props {owner=Just s}) mc mt mp
+              PCost -> do when (isJust mc) $ fail "redefinition of cost"
+                          c <- nonNegativeNumber <?> "cost"
+                          attributes props (Just c) mt mp
+              PTrust -> do when (isJust mt) $ fail "redefinition of cost"
+                           t <- percentage <?> "trust"
+                           attributes props mc (Just t) mp
+              PProgress -> do when (isJust mp) $ fail "redefinition of progress"
+                              p <- percentage <?> "progress"
+                              attributes props mc mt (Just p)
+
+
+-- find out all the names that a particular binding references
+dependencies ∷ ProjectSystem -> Binding → [ProjectKey]
 dependencies sys = everything (++) ([] `mkQ` collectDep)
   where
     collectDep (Reference n) = nub $ n : everything (++) ([] `mkQ` collectDep) (M.lookup n $ bindings sys)
@@ -145,15 +146,22 @@ dependencies sys = everything (++) ([] `mkQ` collectDep)
 
 projectSystem :: Parser ProjectSystem
 projectSystem =
-    do between sc eof definitionSeq
+    mkProjSystem <$> definitions []
-       lift get
  where
-   definitionSeq = void $ endBy1 definition (symbol ";")
+   mkProjSystem = ProjectSystem . M.fromList
 
+   definitions ds = do key <- sc *> nonKeywordIdentifier <?> "project key"
+                       when (key `elem` map fst ds) $ fail $ "redefinition of \"" ++ key ++ "\""
+                       b <- binding key <* symbol ";"
+
+                       -- check if it's recursive
+                       let deps = dependencies (mkProjSystem ds) b
+                       when (key `elem` deps) $ fail $ "definition of \"" ++ key ++ "\" is recursive"
+
+                       let ds' = (key,b):ds
+                       (try eof *> pure ds') <|> definitions ds'
 
 runParser :: FilePath -> T.Text -> Either String ProjectSystem
-runParser filename contents = let mr = runParserT projectSystem filename contents
+runParser filename contents = case parse projectSystem filename contents of
-                                  initialPS = ProjectSystem M.empty
+                                Left e -> Left $ parseErrorPretty' contents e
-                              in case evalState mr initialPS of
+                                Right v -> Right v
-                                    Left e -> Left $ parseErrorPretty' contents e
-                                    Right v -> Right v

test/MasterPlan/Arbitrary.hs

@@ -43,11 +43,10 @@ instance Arbitrary Binding where
   --       to avoid generating cycles
   arbitrary =
     let unitGen = elements [0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0]
-     in frequency [ (50, BindingAtomic <$> arbitrary
+     in BindingAtomic <$> arbitrary
-                                  <*> elements [0, 1 .. 100]
+                      <*> elements [0, 1 .. 100]
-                                  <*> unitGen
+                      <*> unitGen
-                                  <*> unitGen)
+                      <*> unitGen
-                  , (1, pure $ BindingPlaceholder defaultProjectProps) ]
 
   shrink (BindingExpr pr e) = map (BindingExpr pr) $ shrink e
   shrink _                     = []

test/MasterPlan/DataSpec.hs

@@ -27,8 +27,7 @@ simulate sys (Reference n) =
               effectiveTrust = p + t * remainingProgress
               effectiveCost = c * remainingProgress
           pure (effectiveTrust > r, effectiveCost)
-     Just (BindingExpr _ p)       -> simulate sys p -- TODO: avoid cyclic
+     Just (BindingExpr _ p)       -> simulate sys p -- TODO:30 avoid cyclic
-     Just (BindingPlaceholder _)  -> pure (True, defaultCost)
      Nothing                      -> pure (True, defaultCost)
 
 simulate sys (Sequence ps)   = simulateConjunction sys $ NE.toList ps

test/MasterPlan/ParserSpec.hs

@@ -17,7 +17,7 @@ spec ∷ Spec
 spec =
   describe "parser" $ do
 
-    let allProps = [minBound :: ProjProperty ..]
+    let allProps = [minBound :: ProjAttribute ..]
 
     prop "rendered should be parseable" $ do
       let renderedIsParseable ∷ ProjectSystem → Property