rendering backend working

.ghci

@@ -1 +1,2 @@
+:set prompt "%s\n>"
 :set -XUnicodeSyntax

.hlint.yaml

@@ -0,0 +1,60 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+##########################
+
+# This file contains a template configuration file, which is typically
+# placed as .hlint.yaml in the root of your project
+
+
+# Specify additional command line arguments
+#
+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
+
+
+# Control which extensions/flags/modules/functions can be used
+#
+# - extensions:
+#   - default: false # all extension are banned by default
+#   - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
+#   - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
+#
+# - flags:
+#   - {name: -w, within: []} # -w is allowed nowhere
+#
+# - modules:
+#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
+#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely
+#
+# - functions:
+#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
+
+
+# Add custom hints for this project
+#
+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
+
+
+# Turn on hints that are off by default
+#
+# Ban "module X(module X) where", to require a real export list
+# - warn: {name: Use explicit module export list}
+#
+# Replace a $ b $ c with a . b $ c
+# - group: {name: dollar, enabled: true}
+#
+# Generalise map to fmap, ++ to <>
+# - group: {name: generalise, enabled: true}
+
+
+# Ignore some builtin hints
+# - ignore: {name: Use let}
+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
+
+
+# Define some custom infix operators
+# - fixity: infixr 3 ~^#^~
+
+
+# To generate a suitable file for HLint do:
+# $ hlint --default > .hlint.yaml

app/Main.hs

@@ -16,69 +16,65 @@ import qualified Data.Map                    as M
 import           Data.Maybe                  (catMaybes, fromMaybe)
 import           Data.Semigroup              ((<>))
 import qualified Data.Text.IO                as TIO
-import qualified MasterPlan.Backend.Graph    as BG
+import           MasterPlan.Backend.Graph
-import qualified MasterPlan.Backend.Html     as BH
-import qualified MasterPlan.Backend.Identity as BI
-import qualified MasterPlan.Backend.Text     as BT
 import           MasterPlan.Data
 import qualified MasterPlan.Parser           as P
 import           Options.Applicative
-import           System.IO                   (hPutStr, stderr)
+import           System.IO                   (hPutStr, stderr, stdin)
 
 -- |Type output from the command line parser
-data Opts = Opts { inputPath  :: FilePath
+data Opts = Opts { inputPath       :: Maybe FilePath
                  , outputPath      :: Maybe FilePath
                  , projFilter      :: ProjFilter -- ^ filter to consider
-                 , properties :: [ProjProperty] -- ^ which properties to consider
+                 , renderOptions   :: RenderOptions }
-                 , prioritize :: Bool -- ^ order by priority
-                 , renderMode :: RenderMode }
   deriving (Show)
 
-newtype ProjFilter = ProjFilter (ProjectBinding → Bool)
+newtype ProjFilter = ProjFilter (ProjectSystem -> Project → Bool)
 
 noFilter ∷ ProjFilter
-noFilter = ProjFilter $ const True
+noFilter = ProjFilter $ const $ const True
 
 instance Show ProjFilter where
   show _ = "ProjFilter"
 
-data RenderMode = IdentityRenderMode | TextRenderMode | GraphRenderMode | HtmlMode
-  deriving (Eq, Show)
-
 readEnum ∷ [(String, a)] → ReadM a
 readEnum mapping = maybeReader $ flip lookup mapping
 
 -- |The command line parser
 cmdParser ∷ Parser Opts
-cmdParser = Opts <$> strOption ( long "input"
+cmdParser = Opts <$> optional (strArgument ( help "plan file to read from (default from stdin)"
-                               <> short 'i'
+                                           <> metavar "FILENAME" ))
-                               <> help "plan file to read from"
-                               <> value "master.plan"
-                               <> showDefault
-                               <> metavar "FILENAME" )
                  <*> optional (strOption ( long "output"
                                          <> short 'o'
-                                         <> help "output file name"
+                                         <> help "output file name (.png, .tif, .bmp, .jpg and .pdf supported)"
                                          <> metavar "FILENAME" ))
                  <*> (filterParser <|> pure noFilter)
+                 <*> renderOptionsParser
+  where
+    renderOptionsParser :: Parser RenderOptions
+    renderOptionsParser = RenderOptions <$> switch ( long "color"
+                                                   <> short 'c'
+                                                   <> help "color each project by progress")
+                                        <*> option auto ( long "width"
+                                                         <> short 'w'
+                                                         <> help "width of the output image"
+                                                         <> value (-1)
+                                                         <> metavar "NUMBER")
+                                        <*> option auto ( long "height"
+                                                         <> help "height of the output image"
+                                                         <> value (-1)
+                                                         <> metavar "NUMBER")
+                                        <*> strOption ( long "root"
+                                                       <> short 'r'
+                                                       <> help "name of the root project definition"
+                                                       <> value "root"
+                                                       <> showDefault
+                                                       <> metavar "NAME")
                                         <*> (invertProps <$> many (option property ( long "hide"
                                                                                    <> help "hide a particular property"
                                                                                    <> metavar (intercalate "|" $ map fst propertyNames))))
-                 <*> switch ( long "prioritize"
-                            <> short 'p'
-                            <> help "prioritize projects to minimize cost")
-                 <*> option parseRenderMode ( long "mode"
-                                            <> short 'm'
-                                            <> help "render mode"
-                                            <> metavar (intercalate "|" $ map fst nameRenderModes))
-  where
     propertyNames = map (\p -> (show p, p)) [minBound :: ProjProperty ..]
-    nameRenderModes = [ ("identity", IdentityRenderMode)
-                      , ("text", TextRenderMode)
-                      , ("graph", GraphRenderMode)
-                      , ("html", HtmlMode) ]
     property = readEnum propertyNames
-    parseRenderMode = readEnum nameRenderModes
 
     invertProps ∷ [ProjProperty] → [ProjProperty]
     invertProps l = filter (`notElem` l) $ map snd propertyNames
@@ -88,8 +84,7 @@ cmdParser = Opts <$> strOption ( long "input"
                                                                    <> help "only display projects which progress is < N%"
                                                                    <> metavar "N" )
       where
-        mkProgressFilter n (TaskProj _ _ _ p) = p*100 < n
+        mkProgressFilter n sys p = progress sys p * 100 < n
-        mkProgressFilter _ _                  = True
 
 main ∷ IO ()
 main = masterPlan =<< execParser opts
@@ -100,38 +95,25 @@ main = masterPlan =<< execParser opts
      <> header "master-plan - project management tool for hackers" )
 
 filterBinding ∷ ProjectSystem → ProjFilter → ProjectBinding → Maybe ProjectBinding
-filterBinding sys (ProjFilter f) (ExpressionProj r p) = ExpressionProj r <$> filterProj p
+filterBinding sys (ProjFilter f) (ExpressionProj r e) = ExpressionProj r <$> filterProj e
   where
-  filterProj (SumProj ps) = SumProj <$> filterProjs ps
+  filterProj p@(SumProj ps) = filterHelper p ps SumProj
-  filterProj (ProductProj ps) = ProductProj <$> filterProjs ps
+  filterProj p@(ProductProj ps) = filterHelper p ps ProductProj
-  filterProj (SequenceProj ps) = SequenceProj <$> filterProjs ps
+  filterProj p@(SequenceProj ps) = filterHelper p ps SequenceProj
-  filterProj rp@(RefProj n) = do b <- M.lookup n $ bindings sys
+  filterProj p = if f sys p then Just p else Nothing
-                                 if f b then Just rp else Nothing
 
+  filterHelper p ps c = if f sys p then c <$> filterProjs ps else Nothing
   filterProjs ps = NE.nonEmpty (catMaybes $ NE.toList $ NE.map filterProj ps)
+
 filterBinding _   _ b = Just b
 
 masterPlan ∷ Opts → IO ()
 masterPlan opts =
-    do contents <- TIO.readFile filename
+    do contents <- maybe (TIO.hGetContents stdin) TIO.readFile $ inputPath opts
-       case P.runParser filename contents of
+       case P.runParser (fromMaybe "stdin" $ inputPath opts) contents of
           Left e    -> hPutStr stderr e
           Right sys@(ProjectSystem b) ->
-            render $ maybeOptimize $ ProjectSystem $ M.mapMaybe
+            do let sys' = optimizeSys $ ProjectSystem $ M.mapMaybe
                                                     (filterBinding sys $ projFilter opts) b
-  where
+               let outfile = fromMaybe (fromMaybe "output" (outputPath opts) ++ ".pdf") $ outputPath opts
-    filename = inputPath opts
+               render outfile (renderOptions opts) sys'
-
-    maybeOptimize = if prioritize opts then optimizeSys else id
-
-    outputToFileOrOut s = case outputPath opts of
-                             Nothing   -> TIO.putStr s
-                             Just path -> TIO.writeFile path s
-
-    render sys =
-      case renderMode opts of
-        IdentityRenderMode -> outputToFileOrOut $ BI.render sys $ properties opts
-        TextRenderMode -> outputToFileOrOut $ BT.render sys $ properties opts
-        HtmlMode -> outputToFileOrOut $ BH.render sys $ properties opts
-        GraphRenderMode -> do let outfile = fromMaybe (filename ++ ".png") $ outputPath opts
-                              BG.render outfile sys $ properties opts

examples/example1.plan

@@ -0,0 +1,52 @@
+
+title(root) = "business";
+description(root) = "can we run a successful business";
+owner(root) = "CEO";
+
+root = x + p;
+
+// -------
+
+title(x) = "build technology";
+description(x) = "can we build the technology ourselves";
+
+x = h * b;
+
+title(h) = "hire";
+description(h) = "can we attract and retain talent";
+cost(h) = 20;
+owner(h) = "HR";
+
+title(b) = "build";
+description(b) = "our technology can be built and scale";
+
+b = phase1 -> phase2 -> phase3;
+
+title(phase1) = "validate prototype";
+trust(phase1) = 70%;
+progress(phase1) = 100%;
+owner(phase1) = "engineering";
+
+title(phase2) = "launch in small market";
+trust(phase2) = 50%;
+progress(phase2) = 32%;
+owner(phase2) = "engineering";
+
+title(phase3) = "scale nationwide";
+trust(phase3) = 20%;
+owner(phase3) = "engineering";
+
+// ------
+
+title(p) = "tech partner";
+description(p) = "secure a tech partnership";
+
+p = sa + sb;
+
+title(sa) = "supplier A"; trust(sa) = 90%; cost(sa) = 10;
+url(sa) = "www.supplier.a.com";
+owner(sa) = "partnerships";
+
+title(sb) = "supplier B"; trust(sb) = 60%; cost(sb) = 5;
+url(sb) = "www.supplier.b.com";
+owner(sb) = "partnerships";

master-plan.cabal

@@ -1,7 +1,16 @@
 name:                master-plan
 version:             0.1.0.0
 synopsis:            The project management tool for hackers
--- description:
+description:         Master Plan is a tool that parses files that describes
+                     projects using a simple and powerful syntax in which
+                     project structures are encoded using a special algebra
+                     with combinators for specifying the different kinds
+                     of dependencies. It also supports estimations of cost and
+                     risk, as well as some metadata. The tool is then able
+                     to compute the priority of execution that minimizes costs,
+                     and also output a nice visual representation of the structure.
+                     Becase the plan description is plan text, it's portable
+                     and fits well within source control.
 homepage:            https://github.com/rodrigosetti/master-plan
 bug-reports:         https://github.com/rodrigosetti/master-plan/issues
 author:              Rodrigo Setti
@@ -15,6 +24,10 @@ build-type:          Simple
 cabal-version:       >=1.10
 extra-source-files:  README.md
 
+source-repository head
+  type:     git
+  location: git://github.com/rodrigosetti/master-plan.git
+
 executable master-plan
   hs-source-dirs:      app
   main-is:             Main.hs
@@ -34,6 +47,9 @@ library
     default-extensions:  UnicodeSyntax
     build-depends:       base
                        , containers
+                       , diagrams
+                       , diagrams-lib
+                       , diagrams-rasterific
                        , megaparsec
                        , mtl
                        , text
@@ -41,9 +57,7 @@ library
     exposed-modules:     MasterPlan.Data
                        , MasterPlan.Parser
                        , MasterPlan.Backend.Graph
-                       , MasterPlan.Backend.Html
                        , MasterPlan.Backend.Identity
-                       , MasterPlan.Backend.Text
 
 test-suite spec
   type:             exitcode-stdio-1.0

src/MasterPlan/Backend/Graph.hs

@@ -8,9 +8,171 @@ Stability   : experimental
 Portability : POSIX
 -}
 {-# LANGUAGE UnicodeSyntax #-}
-module MasterPlan.Backend.Graph (render) where
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE FlexibleContexts          #-}
+{-# LANGUAGE TypeFamilies              #-}
+{-# LANGUAGE TupleSections             #-}
+module MasterPlan.Backend.Graph (render, RenderOptions(..)) where
 
 import           MasterPlan.Data
+import           Diagrams.Prelude hiding (render)
+import           Diagrams.Backend.Rasterific
+import qualified Data.Map as M
+import qualified Data.List.NonEmpty as NE
+import           Data.Maybe (fromMaybe, catMaybes)
+import           Text.Printf (printf)
+import Data.List (intersperse)
+--import Diagrams.TwoD.Text (Text)
 
-render ∷ FilePath -> ProjectSystem → [ProjProperty] -> IO ()
+-- text :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any
-render = error "not implemented"
+-- text = texterific
+
+-- * Types
+
+-- |Generic tree
+data Tree t n = Tree t n (NE.NonEmpty (Tree t n)) | Leaf n
+
+data NodeType = SumNode | ProductNode | SequenceNode
+
+-- |Data type used by the tree
+data Node = Node (Maybe ProjectKey)
+                 (Maybe ProjectProperties)
+                 Cost
+                 Trust
+                 Progress
+          | NodeRef ProjectKey
+
+type RenderModel = Tree NodeType Node
+
+-- |Translates a ProjectSystem into a Tree Node
+toRenderModel :: ProjectSystem -> ProjectKey -> Maybe RenderModel
+toRenderModel sys rootK = bindingToRM rootK <$> M.lookup rootK (bindings sys)
+  where
+    bindingToRM :: ProjectKey -> ProjectBinding -> RenderModel
+    bindingToRM key (ExpressionProj prop p) = projToRM p (Just key) (Just prop)
+    bindingToRM key (TaskProj prop c t p) = Leaf $ Node (Just key)
+                                                        (Just prop)
+                                                        c t p
+    bindingToRM key (UnconsolidatedProj prop) = Leaf $ Node (Just key)
+                                                            (Just prop)
+                                                            defaultCost
+                                                            defaultTrust
+                                                            defaultProgress
+    mkNode :: (Node -> NE.NonEmpty RenderModel -> RenderModel) -> Project -> NE.NonEmpty Project -> Maybe ProjectKey -> Maybe ProjectProperties -> RenderModel
+    mkNode f p ps key prop = f (Node key prop
+                                     (cost sys p)
+                                     (trust sys p)
+                                     (progress sys p))
+                               $ NE.map (\p' -> projToRM p' Nothing Nothing) ps
+
+    projToRM :: Project -> Maybe ProjectKey -> Maybe ProjectProperties -> RenderModel
+    projToRM p@(SumProj ps) = mkNode (Tree SumNode) p ps
+    projToRM p@(SequenceProj ps) = mkNode (Tree SequenceNode) p ps
+    projToRM p@(ProductProj ps) = mkNode (Tree ProductNode) p ps
+    projToRM (RefProj n) = -- TODO: avoid repeating
+      \k p -> case M.lookup n $ bindings sys of
+          Nothing -> Leaf $ Node k p 1 1 0
+          Just b -> bindingToRM n b
+
+-- |how many children
+treeSize :: Num a => Tree t n -> a
+treeSize (Tree _ _ ts) = sum $ NE.map treeSize ts
+treeSize _ = 1
+
+data RenderOptions = RenderOptions { colorByProgress :: Bool
+                                   , renderWidth :: Integer
+                                   , renderHeight :: Integer
+                                   , rootKey :: ProjectKey
+                                   , whitelistedProps :: [ProjProperty] }
+                          deriving (Eq, Show)
+
+-- | The main rendering function
+render ∷ FilePath -> RenderOptions-> ProjectSystem → IO ()
+render fp (RenderOptions colorByP w h rootK props) sys =
+  let noRootEroor = text $ "no project named \"" ++ rootK ++ "\" found."
+      dia :: QDiagram B V2 Double Any
+      dia = fromMaybe noRootEroor $ renderTree colorByP props <$> toRenderModel sys rootK
+  in renderRasterific fp (dims $ V2 (fromInteger w) (fromInteger h)) $ pad 1.05 $ centerXY dia
+
+renderTree :: Bool -> [ProjProperty] -> RenderModel -> QDiagram B V2 Double Any
+renderTree colorByP props (Leaf n) = alignL $ renderNode colorByP props n
+renderTree colorByP props t@(Tree ty n ts) =
+    (strut (V2 0 siz) <> alignL (centerY $ renderNode colorByP props n))
+    |||  (translateX 2 typeSymbol # withEnvelope (mempty :: D V2 Double) <> hrule 4)
+    |||  centerY (headBar === treeBar (map ((* 6) . treeSize) ts'))
+    |||  centerY (vcat $ map renderSubTree ts')
+  where
+    siz = 12 * treeSize t
+    renderSubTree subtree = hrule 4 ||| renderTree colorByP props subtree
+    ts' = NE.toList ts
+
+    headBar = strut $ V2 0 $ treeSize (NE.head ts) * 6
+
+    treeBar :: [Double] -> QDiagram B V2 Double Any
+    treeBar (s1:s2:ss) = vrule s1 === vrule s2 === treeBar (s2:ss)
+    treeBar [s1] = strut $ V2 0 s1
+    treeBar _ = mempty
+
+    typeSymbol = case ty of
+                    SumNode -> text "+" <> circle 1 # fc white # lw 1
+                    ProductNode -> text "x" <> circle 1 # fc white # lw 1
+                    SequenceNode -> text ">" <> circle 1 # fc white # lw 1
+
+renderNode :: Bool -> [ProjProperty] -> Node -> QDiagram B V2 Double Any
+renderNode _        _     (NodeRef n) = pad 1.1 $ roundedRect 30 2 0.5 <> text n
+renderNode colorByP props (Node key prop c t p) =
+   centerY nodeDia # withEnvelope (rect 30 12 :: D V2 Double)
+  where
+    nodeDia =
+      let hSizeAndSections = catMaybes [ (,2) <$> headerSection
+                                       , (,6) <$> descriptionSection
+                                       , (,2) <$> urlSection
+                                       , (,2) <$> bottomSection]
+          sections = map (\s -> strut (V2 0 $ snd s) <> fst s) hSizeAndSections
+          outerRect = rect 30 $ sum $ map snd hSizeAndSections
+          sectionsWithSep = vcat (intersperse (hrule 30 # dashingN [0.005, 0.005] 0 # lw 1) sections)
+      in outerRect # fcColor `beneath` centerY sectionsWithSep
+
+    givenProp :: ProjProperty -> Maybe a -> Maybe a
+    givenProp pro x = if pro `elem` props then x else Nothing
+
+    headerSection = case (progressHeader, titleHeader, costHeader) of
+                        (Nothing, Nothing, Nothing) -> Nothing
+                        (x, y, z) -> Just $ centerX $ fromMaybe mempty x
+                                                 |||  fromMaybe mempty y
+                                                 |||  fromMaybe mempty z
+    progressHeader = givenProp PProgress $ Just $ strut (V2 5 0) <> displayProgress p
+    titleHeader = givenProp PTitle $ ((strut (V2 20 0) <>) . bold . text . title) <$> prop
+    costHeader = givenProp PCost $ Just $ strut (V2 5 0) <> displayCost c
+
+    descriptionSection, urlSection, bottomSection :: Maybe (QDiagram B V2 Double Any)
+    descriptionSection = givenProp PDescription $ prop >>= description >>= (pure . text) -- TODO line breaks
+    urlSection = givenProp PUrl $ prop >>= url >>= (pure . text) -- TODO ellipsis
+
+    bottomSection = case (trustSubSection, ownerSubSection) of
+                      (Nothing, Nothing) -> Nothing
+                      (ma, mb) -> let st = strut (V2 15 0)
+                                   in Just $ centerX $ (st <> fromMaybe mempty ma) |||
+                                                       (st <> fromMaybe mempty mb)
+
+    ownerSubSection = prop >>= owner >>= (pure . text)
+    trustSubSection = case t of
+                          _  | PTrust `notElem` props -> Nothing
+                          t' | t' == 1 -> Nothing
+                          t' | t' == 0 -> Just $ text "impossible"
+                          _ -> Just $ text ("trust = " ++ percentageText t)
+
+    displayCost c'
+      | c' == 0   = mempty
+      | otherwise = text $ "(" ++ printf "%.1f" c' ++ ")"
+    displayProgress p'
+      | p' == 1 = text "done"
+      | p' == 0 = mempty
+      | otherwise = text $ percentageText p'
+
+    fcColor =
+      fc $ if colorByP then
+                (if p <= 0.25 then pink else if p == 1 then lightgreen else lightyellow)
+           else white
+
+    percentageText pct = show ((round $ pct * 100) :: Integer) ++ "%"

src/MasterPlan/Backend/Html.hs

@@ -1,18 +0,0 @@
-{-|
-Module      : MasterPlan.Backend.Html
-Description : a backend that renders to a UI HTML
-Copyright   : (c) Rodrigo Setti, 2017
-License     : MIT
-Maintainer  : rodrigosetti@gmail.com
-Stability   : experimental
-Portability : POSIX
--}
-{-# LANGUAGE UnicodeSyntax #-}
-{-# LANGUAGE OverloadedStrings #-}
-module MasterPlan.Backend.Html (render) where
-
-import           MasterPlan.Data
-import qualified Data.Text          as T
-
-render ∷ ProjectSystem → [ProjProperty] -> T.Text
-render = error "not implemented"

src/MasterPlan/Backend/Text.hs

@@ -1,18 +0,0 @@
-{-|
-Module      : MasterPlan.Backend.Text
-Description : a backend that renders to a UI text
-Copyright   : (c) Rodrigo Setti, 2017
-License     : MIT
-Maintainer  : rodrigosetti@gmail.com
-Stability   : experimental
-Portability : POSIX
--}
-{-# LANGUAGE UnicodeSyntax #-}
-{-# LANGUAGE OverloadedStrings #-}
-module MasterPlan.Backend.Text (render) where
-
-import           MasterPlan.Data
-import qualified Data.Text          as T
-
-render ∷ ProjectSystem → [ProjProperty] -> T.Text
-render = error "not implemented"

src/MasterPlan/Data.hs

@@ -19,8 +19,10 @@ module MasterPlan.Data ( Project(..)
                        , Trust
                        , Cost
                        , Progress
-                       , rootKey
                        , defaultProjectProps
+                       , defaultCost
+                       , defaultTrust
+                       , defaultProgress
                        , defaultTaskProj
                        , cost
                        , progress
@@ -35,7 +37,7 @@ import           Control.Monad.Writer
 import           Data.Generics
 import           Data.List.NonEmpty   (NonEmpty ((:|)))
 import qualified Data.List.NonEmpty   as NE
-import qualified Data.Map             as M
+import qualified Data.Map             as M (Map, lookup)
 import           Data.Semigroup       (sconcat)
 
 -- * Types
@@ -84,17 +86,23 @@ instance Show ProjProperty where
 newtype ProjectSystem = ProjectSystem { bindings :: M.Map ProjectKey ProjectBinding }
                           deriving (Eq, Show, Data, Typeable)
 
-rootKey ∷ ProjectKey
-rootKey = "root"
-
 defaultProjectProps ∷ ProjectProperties
-defaultProjectProps = ProjectProperties { title = rootKey
+defaultProjectProps = ProjectProperties { title = "?"
                                         , description = Nothing
                                         , url = Nothing
                                         , owner = Nothing }
 
+defaultCost :: Cost
+defaultCost = 0
+
+defaultTrust :: Trust
+defaultTrust = 1
+
+defaultProgress :: Progress
+defaultProgress = 0
+
 defaultTaskProj ∷ ProjectProperties → ProjectBinding
-defaultTaskProj pr = TaskProj pr 0 1 0
+defaultTaskProj pr = TaskProj pr defaultCost defaultTrust defaultProgress
 
 -- | Expected cost
 cost ∷ ProjectSystem → Project → Cost
@@ -102,8 +110,8 @@ cost sys (RefProj n) =
   case M.lookup n (bindings sys) of
     Just (TaskProj _ c _ p)     -> c * (1-p) -- cost is weighted by remaining progress
     Just (ExpressionProj _ p)   -> cost sys p -- TODO: avoid cyclic
-    Just (UnconsolidatedProj _) -> 0 -- default
+    Just (UnconsolidatedProj _) -> defaultCost -- default
-    Nothing                     -> 0 -- should not happen
+    Nothing                     -> error $ "project \"" ++ n ++ "\" is undefined" -- should not happen
 cost sys (SequenceProj ps) = costConjunction sys ps
 cost sys (ProductProj ps) = costConjunction sys ps
 cost sys (SumProj ps) =
@@ -125,8 +133,8 @@ trust sys (RefProj n) =
   case M.lookup n (bindings sys) of
     Just (TaskProj _ _ t p)     -> p + t * (1-p)
     Just (ExpressionProj _ p)   -> trust sys p -- TODO: avoid cyclic
-    Just (UnconsolidatedProj _) -> 1 -- default
+    Just (UnconsolidatedProj _) -> defaultTrust -- default
-    Nothing                     -> 0 -- should not happen
+    Nothing                     -> error $ "project \"" ++ n ++ "\" is undefined" -- should not happen
 trust sys (SequenceProj ps) = trustConjunction sys ps
 trust sys (ProductProj ps) = trustConjunction sys ps
 trust sys (SumProj ps) =
@@ -140,8 +148,8 @@ progress sys (RefProj n) =
   case M.lookup n (bindings sys) of
     Just (TaskProj _ _ _ p)     -> p
     Just (ExpressionProj _ p)   -> progress sys p -- TODO: avoid cyclic
-    Just (UnconsolidatedProj _) -> 0 -- default
+    Just (UnconsolidatedProj _) -> defaultProgress -- default
-    Nothing                     -> 0 -- should not happen
+    Nothing                     -> error $ "project \"" ++ n ++ "\" is undefined" -- should not happen
 progress sys (SequenceProj ps)   = progressConjunction sys ps
 progress sys (ProductProj ps)    = progressConjunction sys ps
 progress sys (SumProj ps)        = maximum $ NE.map (progress sys) ps

src/MasterPlan/Parser.hs

@@ -146,9 +146,7 @@ dependencies sys = everything (++) ([] `mkQ` collectDep)
 projectSystem :: Parser ProjectSystem
 projectSystem =
     do between sc eof definitionSeq
-       ps <- lift get
+       lift get
-       unless (M.member rootKey $ bindings ps) $ fail $ "expected project \"" ++ rootKey ++ "\" to be defined."
-       pure ps
  where
    definitionSeq = void $ endBy1 definition (symbol ";")
 

test/MasterPlan/Arbitrary.hs

@@ -27,7 +27,7 @@ instance Arbitrary ProjectSystem where
 
   arbitrary = do bs <- replicateM (length testingKeys) arbitrary
                  rootB <- ExpressionProj <$> arbitrary <*> arbitrary
-                 pure $ ProjectSystem $ M.insert rootKey rootB $ M.fromList $ zip testingKeys bs
+                 pure $ ProjectSystem $ M.insert "root" rootB $ M.fromList $ zip testingKeys bs
 
   shrink (ProjectSystem bs) =
       map ProjectSystem $ concatMap shrinkOne testingKeys

test/MasterPlan/DataSpec.hs

@@ -81,7 +81,7 @@ spec = do
               (counterexample "disagree on cost"  $ cost'  `eq` cost  sys p) .&&.
               (counterexample "disagree on trust" $ trust' `eq` trust sys p)
              where
-               p = RefProj rootKey
+               p = RefProj "root"
                (trust', cost') = evalState (monteCarloTrustAndCost 50000 sys p) g
 
         property monteCarloAndAnalyticalAgree
@@ -103,7 +103,7 @@ spec = do
       let propSimplifyIsStable :: ProjectSystem -> Property
           propSimplifyIsStable sys =
             let sys' = simplify sys
-                p    = RefProj rootKey
+                p    = RefProj "root"
              in cost sys p `eq` cost sys' p .&&. trust sys p `eq` trust sys' p
 
       property propSimplifyIsStable