From a7c0a5f8c8ef0c1c652c7a1760116a240983ec23 Mon Sep 17 00:00:00 2001 From: Rodrigo Setti Date: Fri, 4 Aug 2017 18:53:52 -0700 Subject: [PATCH] initial commit --- .ghci | 1 + .gitignore | 26 +++++++ README.md | 98 ++++++++++++++++++++++++ Setup.hs | 2 + app/Main.hs | 4 + master-plan.cabal | 47 ++++++++++++ src/MasterPlan/Data.hs | 124 ++++++++++++++++++++++++++++++ src/MasterPlan/Parser.hs | 0 stack.yaml | 66 ++++++++++++++++ test/MasterPlan/DataSpec.hs | 145 ++++++++++++++++++++++++++++++++++++ test/Spec.hs | 1 + 11 files changed, 514 insertions(+) create mode 100644 .ghci create mode 100644 .gitignore create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 app/Main.hs create mode 100644 master-plan.cabal create mode 100644 src/MasterPlan/Data.hs create mode 100644 src/MasterPlan/Parser.hs create mode 100644 stack.yaml create mode 100644 test/MasterPlan/DataSpec.hs create mode 100644 test/Spec.hs diff --git a/.ghci b/.ghci new file mode 100644 index 0000000..222adaf --- /dev/null +++ b/.ghci @@ -0,0 +1 @@ +:set -XOverloadedStrings diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0621534 --- /dev/null +++ b/.gitignore @@ -0,0 +1,26 @@ + +# Created by https://www.gitignore.io/api/haskell + +### Haskell ### +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +.HTF/ + +# End of https://www.gitignore.io/api/haskell diff --git a/README.md b/README.md new file mode 100644 index 0000000..91c46c9 --- /dev/null +++ b/README.md @@ -0,0 +1,98 @@ +# master-plan + +Master Plan is a text based project management tool that implements an +algebra of projects. + +These are the values propositions of master plan: + + * Simplicity: keep project management into a single text file. + * Agility: embrace change, by allowing projects to specify uncertainty and allow + for refinement anytime. + * 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. + +## Algebra of Projects + +In the algebra of projects, a project is an expression of sub-projects +combined using dependency operators. These operators define how sub-projects +relate to the higher-level projects in terms of execution and structural +dependency, that is, in which order (if any) the sub-projects must be executed, +and also whether all or some of the sub-projects must be executed at all. + +At some level, sub-projects will be small enough that they don't break down +further, in this case, they consist of a unit of execution. + +There is also the notion cost estimation and risk. Cost may mean different +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.txt` file +using a simple language. There are defaults for most constrains and properties +such that things can be less verbose if using the defaults. + +The tool is able to build visualizations and reports from the plan file. + +Ideally, the plan file should be kept in version control so that execution and +planning progress can be recorded. + +### Commands + +The `mp` command line tool supports the following commands: + + * `prioritize` - list, in order of priority, the projects ready for execution. + * `render` - generate a report output, specified by one of the backend formats. + +### Syntax + +Comments are preceded by hashtag (`#`), and extend to the end of line +(like Shell and Python). + +Everything else are definitions, in the form `lrs = rhs`. +There are two kinds of definitions with respect to `lrs` (left hand side): + + * Definition of a project: in the form `identifier = expression` + * 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 +are three operators: + + * `p = a + b` - Sum: `p` is executed when `a` or `b` is executed. + * `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 + +Following is a list of supported properties of projects: + +| Property name | Expected Type | Description | +|---------------|---------------|-------------| +| name | text | title of the project | +| 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 | +| status | blocked,ready,progress,done,cancelled | status of execution | +| progress | percentage | how much progress has been made so far | +| cost | number | estimated cost (aliases: "time", "estimation") | +| risk | percentage | risk of failure | + +#### Grammar + +``` +definition = project_def | predicate_def + +project_def = identifier "=" expression +expression = term ((">>" | "x") term)* +term = factor ("+" factor)* +factor = "(" expression ")" | identifier + +predicate_def = identifier "(" identifier ")" "=" value +value = number | text +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..e0eb2e2 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn $ "hello " ++ "world" diff --git a/master-plan.cabal b/master-plan.cabal new file mode 100644 index 0000000..2c76150 --- /dev/null +++ b/master-plan.cabal @@ -0,0 +1,47 @@ +name: master-plan +version: 0.1.0.0 +synopsis: Text based project management tool +-- description: +homepage: https://github.com/rsetti/master-plan#readme +author: Rodrigo Setti +maintainer: rodrigosetti@gmail.com +copyright: 2017 Rodrigo Setti. All rights reserved +category: Tools +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +executable master-plan + hs-source-dirs: app + main-is: Main.hs + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + , UnicodeSyntax + build-depends: base + , master-plan + , optparse-applicative + +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + build-depends: base + , megaparsec + , containers + exposed-modules: MasterPlan.Data + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + ghc-options: -Wall + default-language: Haskell2010 + build-depends: base + , master-plan + , random + , mtl + , hspec + , QuickCheck + other-modules: MasterPlan.DataSpec diff --git a/src/MasterPlan/Data.hs b/src/MasterPlan/Data.hs new file mode 100644 index 0000000..7035f71 --- /dev/null +++ b/src/MasterPlan/Data.hs @@ -0,0 +1,124 @@ +module MasterPlan.Data where + +import Data.Foldable (asum) +import Data.List (find, inits) +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromMaybe) + +type Percentage = Float +type Cost = Float + +-- | properties that common to composed and atomic projects +data ProjectProperties = ProjectProperties { + name :: String, + description :: Maybe[String], + url :: Maybe[String], + owner :: Maybe[String] +} deriving (Eq, Show) + +data Status = Ready | Blocked | InProgress | Done | Cancelled + deriving (Eq, Show) + +data Project = SumProj { + props :: ProjectProperties, + subprojects :: NE.NonEmpty Project + } | + ProductProj { + props :: ProjectProperties, + subprojects :: NE.NonEmpty Project + } | + SequenceProj { + props :: ProjectProperties, + subprojects :: NE.NonEmpty Project + } | + TaskProj { + props :: ProjectProperties, + reportedCost :: Cost, + reportedConfidence :: Percentage, + reportedStatus :: Status, + reportedProgress :: Percentage + } + deriving (Eq, Show) + + +defaultProjectProps :: ProjectProperties +defaultProjectProps = ProjectProperties { name = "root" + , description = Nothing + , url = Nothing + , owner = Nothing } + +defaultTaskProj :: Project +defaultTaskProj = TaskProj { props = defaultProjectProps + , reportedCost = 0 + , reportedConfidence = 1 + , reportedStatus = Ready + , reportedProgress = 0 } + +isOpen :: Project -> Bool +isOpen p = status p `elem` [InProgress, Ready, Blocked] + +isClosed :: Project -> Bool +isClosed = not . isOpen + +-- | Expected cost +cost :: Project -> Cost +cost TaskProj { reportedCost=c } = c +cost SequenceProj { subprojects=ps } = costConjunction $ NE.dropWhile isClosed ps +cost ProductProj { subprojects=ps } = costConjunction $ NE.filter isOpen ps +cost SumProj { subprojects=s } = + final_cost + where + final_prob = scanl (\a b -> a + b*(1-a)) 0 $ map confidence opens + final_cost = sum $ map (\x -> (1 - snd x) * fst x) $ zip costs final_prob + costs = map cost opens + opens = NE.filter isOpen s + +costConjunction :: [Project] -> Cost +costConjunction ps = + sum $ zipWith (*) costs accConfidences + where + costs = map cost ps + accConfidences = map product $ inits $ map confidence ps + +-- | Expected confidence probability +confidence :: Project -> Percentage +confidence TaskProj { reportedConfidence=c } = c +confidence SequenceProj { subprojects=ps } = confidenceConjunction $ NE.dropWhile isClosed ps +confidence ProductProj { subprojects=ps } = confidenceConjunction $ NE.filter isOpen ps +confidence SumProj { subprojects=s } = + if null opens then 1 else final_prob + where + final_prob = foldl (\a b -> a + b*(1-a)) 0 $ map confidence opens + opens = NE.filter isOpen s + +confidenceConjunction :: [Project] -> Percentage +confidenceConjunction ps = product $ map confidence ps + +progress :: Project -> Percentage +progress TaskProj { reportedProgress=p, reportedStatus=s } = if s == Done then 1 else p +progress SequenceProj { subprojects=s } = progressConjunction s +progress ProductProj { subprojects=s } = progressConjunction s +progress SumProj { subprojects=s } = maximum $ NE.map progress s + +progressConjunction :: NE.NonEmpty Project -> Percentage +progressConjunction ps = + let opens = NE.filter isOpen ps + in if null opens + then 1 + else sum (map progress opens) / fromIntegral (length opens) + +status :: Project -> Status +status TaskProj { reportedProgress=p, reportedStatus=s } = if p >= 1 then Done else s +status SequenceProj { subprojects=s } = + let rest = NE.dropWhile isClosed s + in case rest of (p : _) -> status p + [] -> Done +status ProductProj { subprojects=ps } = + statusPriority [InProgress, Ready, Blocked, Cancelled, Done] ps +status SumProj { subprojects=ps } = + statusPriority [Done, InProgress, Ready, Blocked, Cancelled] ps + +statusPriority :: [Status] -> NE.NonEmpty Project -> Status +statusPriority priority ps = + let ss = NE.map status ps + in fromMaybe Done $ asum $ map (\x -> find (x ==) ss) priority diff --git a/src/MasterPlan/Parser.hs b/src/MasterPlan/Parser.hs new file mode 100644 index 0000000..e69de29 diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..a928773 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-9.0 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: [] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.4" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor \ No newline at end of file diff --git a/test/MasterPlan/DataSpec.hs b/test/MasterPlan/DataSpec.hs new file mode 100644 index 0000000..f16b4ad --- /dev/null +++ b/test/MasterPlan/DataSpec.hs @@ -0,0 +1,145 @@ +module MasterPlan.DataSpec where + +import Data.Bool (bool) +import MasterPlan.Data +import Test.Hspec +import Test.QuickCheck hiding (sample) + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad.State +import qualified Data.List.NonEmpty as NE +import System.Random + +instance Arbitrary ProjectProperties where + + arbitrary = pure defaultProjectProps +{- + arbitrary = ProjectProperties <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + + shrink p = [ p { name = t } | t <- shrink $ name p ] ++ + [ p { description = t } | t <- shrink $ description p ] ++ + [ p { url = t } | t <- shrink $ url p ] ++ + [ p { owner = t } | t <- shrink $ owner p ] +-} + +instance Arbitrary Status where + + arbitrary = oneof [ pure Ready, pure Blocked, pure InProgress, pure Done, pure Cancelled ] + +instance Arbitrary Project where + + arbitrary = + let shrinkFactor n = 2 * n `quot` 5 + unitGen = choose (0.0, 1.0) + in oneof [ SumProj <$> arbitrary <*> scale shrinkFactor arbitrary + , ProductProj <$> arbitrary <*> scale shrinkFactor arbitrary + , SequenceProj <$> arbitrary <*> scale shrinkFactor arbitrary + , TaskProj <$> arbitrary + <*> unitGen + <*> unitGen + <*> arbitrary + <*> unitGen ] + + shrink (SumProj p ps) = map (SumProj p) (shrink ps) ++ NE.toList ps + shrink (ProductProj p ps) = map (ProductProj p) (shrink ps) ++ NE.toList ps + shrink (SequenceProj p ps) = map (SequenceProj p) (shrink ps) ++ NE.toList ps + shrink TaskProj {} = [] + +average :: RandomGen g => State g Float -> Int -> State g Float +average sample n = do total <- replicateM n sample + pure $ sum total / fromIntegral n + +simulate :: RandomGen g => Project -> State g (Bool, Cost) +simulate TaskProj { reportedConfidence=t, reportedCost=c } = + do n <- state $ randomR (0, 1) + pure (t > n, c) + +simulate SequenceProj { subprojects=ps } = simulateConjunction $ NE.dropWhile isClosed ps +simulate ProductProj { subprojects=ps } = simulateConjunction $ NE.filter isOpen ps +simulate SumProj { subprojects=ps } = + if null opens then pure (True, 0) else simulate' opens + where + opens = NE.filter isOpen ps + simulate' :: RandomGen g => [Project] -> State g (Bool, Cost) + simulate' [] = pure (False, 0) + simulate' (p:rest) = do (success, c) <- simulate p + if success then + pure (True, c) + else + do (success', c') <- simulate' rest + pure (success', c + c') + +simulateConjunction :: RandomGen g => [Project] -> State g (Bool, Cost) +simulateConjunction [] = pure (True, 0) +simulateConjunction (p:rest) = do (success, c) <- simulate p + if success then do + (success', c') <- simulateConjunction rest + pure (success', c + c') + else + pure (False, c) + +monteCarloConfidenceAndCost :: RandomGen g => Int -> Project -> State g (Percentage, Cost) +monteCarloConfidenceAndCost n p = do results <- replicateM n $ simulate p + let confidences = map (bool 0 1 . fst) results + let costs = map snd results + pure (sum confidences / fromIntegral n, + sum costs / fromIntegral n) + +aproximatelyEqual :: Float -> Float -> Property +aproximatelyEqual x y = + counterexample (show x ++ " /= " ++ show y) (abs (x - y) <= epislon) + where + epislon = 0.05 + +spec :: Spec +spec = do + describe "estimations" $ do + + let g = mkStdGen 837183 + + it "monte-carlo and analytical implementations should agree on cost" $ do + let propertyMCAndAnalyticalEq :: Project -> Property + propertyMCAndAnalyticalEq p = + cost' `aproximatelyEqual` cost p + where + (_, cost') = evalState (monteCarloConfidenceAndCost 10000 p) g + + property propertyMCAndAnalyticalEq + + it "monte-carlo and analytical implementations should agree on confidence" $ do + let propertyMCAndAnalyticalEq :: Project -> Property + propertyMCAndAnalyticalEq p = + confidence' `aproximatelyEqual` confidence p + where + (confidence', _) = evalState (monteCarloConfidenceAndCost 10000 p) g + + property propertyMCAndAnalyticalEq + + describe "cost" $ do + let p1 = defaultTaskProj { reportedCost = 10 + , reportedConfidence = 0.8 + , reportedProgress=1 + , reportedStatus = Done } + let p2 = defaultTaskProj { reportedCost = 5 + , reportedConfidence = 1 + , reportedProgress = 0.2 + , reportedStatus = InProgress } + let p3 = defaultTaskProj { reportedCost = 7 + , reportedConfidence = 1 + , reportedProgress = 0 + , reportedStatus = Ready } + let p4 = defaultTaskProj { reportedCost = 2 + , reportedConfidence = 1 + , reportedProgress = 0 + , reportedStatus = Ready } + + it "is correct for sequences" $ do + let p = SequenceProj defaultProjectProps $ NE.fromList [p1, p2, p3, p4] + cost p `shouldBe` 14 + + it "is correct for products" $ do + let p = ProductProj defaultProjectProps $ NE.fromList [p1, p2, p3, p4] + cost p `shouldBe` 14 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}