mirror of
https://github.com/rodrigosetti/master-plan.git
synced 2024-11-22 12:44:13 +03:00
integrated command line with identity
This commit is contained in:
Rodrigo Setti
parent
38ef07d064
commit
d26a700048
70
app/Main.hs
70
app/Main.hs
@ -1,26 +1,31 @@
|
||||
{-# LANGUAGE UnicodeSyntax #-}
|
||||
module Main where
|
||||
module Main (main) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Semigroup ((<>))
|
||||
import MasterPlan.Backend.Identity
|
||||
import qualified MasterPlan.Backend.Identity as ID
|
||||
import MasterPlan.Data
|
||||
import qualified MasterPlan.Parser as P
|
||||
import Options.Applicative
|
||||
import System.IO (hPutStr, stderr)
|
||||
|
||||
-- |Type output from the command line parser
|
||||
data Opts = Opts { inputPath :: FilePath
|
||||
, outputPath :: Maybe FilePath
|
||||
, filters :: [ProjFilter] -- ^ set of filters to consider
|
||||
, projFilter :: ProjFilter -- ^ filter to consider
|
||||
, properties :: [ProjProperty] -- ^ which properties to consider
|
||||
, prioritize :: Bool -- ^ order by priority
|
||||
, renderMode :: RenderMode }
|
||||
deriving (Show)
|
||||
|
||||
data ProjProperty = PTitle | PDescription | PUrl | POwner | PCost | PTrust | PProgress
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype ProjFilter = ProjFilter (ProjectBinding → Bool)
|
||||
|
||||
noFilter ∷ ProjFilter
|
||||
noFilter = ProjFilter $ const True
|
||||
|
||||
instance Show ProjFilter where
|
||||
show _ = "ProjFilter"
|
||||
|
||||
@ -42,32 +47,27 @@ cmdParser = Opts <$> strOption ( long "input"
|
||||
<> short 'o'
|
||||
<> help "output file name"
|
||||
<> metavar "FILENAME" ))
|
||||
<*> many filterParser
|
||||
<*> (filterParser <|> pure noFilter)
|
||||
<*> (invertProps <$> many (option property ( long "hide"
|
||||
<> help "hide a particular property"
|
||||
<> metavar "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 "identity|text|graph")
|
||||
<> metavar (intercalate "|" $ map fst nameRenderModes))
|
||||
where
|
||||
nameProps = [ ("title", PTitle)
|
||||
, ("description", PDescription)
|
||||
, ("url", PUrl)
|
||||
, ("owner", POwner)
|
||||
, ("cost", PCost)
|
||||
, ("trust", PTrust)
|
||||
, ("progress", PProgress) ]
|
||||
property = readEnum nameProps
|
||||
parseRenderMode = readEnum [ ("identity", IdentityRenderMode)
|
||||
propertyNames = map (\p -> (show p, p)) [minBound :: ProjProperty ..]
|
||||
nameRenderModes = [ ("identity", IdentityRenderMode)
|
||||
, ("text", TextRenderMode)
|
||||
, ("graph", GraphRenderMode) ]
|
||||
property = readEnum propertyNames
|
||||
parseRenderMode = readEnum nameRenderModes
|
||||
|
||||
invertProps ∷ [ProjProperty] → [ProjProperty]
|
||||
invertProps l = filter (`notElem` l) $ map snd nameProps
|
||||
invertProps l = filter (`notElem` l) $ map snd propertyNames
|
||||
|
||||
filterParser ∷ Parser ProjFilter
|
||||
filterParser = (ProjFilter . mkProgressFilter) <$> option auto ( long "progress-below"
|
||||
@ -85,9 +85,35 @@ main = masterPlan =<< execParser opts
|
||||
<> progDesc "See documentation on how to write project plan files"
|
||||
<> 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
|
||||
where
|
||||
filterProj (SumProj ps) = SumProj <$> filterProjs ps
|
||||
filterProj (ProductProj ps) = ProductProj <$> filterProjs ps
|
||||
filterProj (SequenceProj ps) = SequenceProj <$> filterProjs ps
|
||||
filterProj rp@(RefProj n) = do b <- M.lookup n $ bindings sys
|
||||
if f b then Just rp else Nothing
|
||||
|
||||
filterProjs ps = NE.nonEmpty (catMaybes $ NE.toList $ NE.map filterProj ps)
|
||||
filterBinding _ _ b = Just b
|
||||
|
||||
masterPlan ∷ Opts → IO ()
|
||||
masterPlan opts = do let filename = inputPath opts
|
||||
masterPlan opts =
|
||||
do let filename = inputPath opts
|
||||
contents <- readFile filename
|
||||
case P.runParser filename contents of
|
||||
Left e -> putStr e
|
||||
Right v -> putStr $ render v
|
||||
Left e -> hPutStr stderr e
|
||||
Right sys@(ProjectSystem b) ->
|
||||
render $ maybeOptimize $ ProjectSystem $ M.mapMaybe
|
||||
(filterBinding sys $ projFilter opts) b
|
||||
where
|
||||
maybeOptimize = if prioritize opts then optimizeSys else id
|
||||
|
||||
render sys =
|
||||
case renderMode opts of
|
||||
IdentityRenderMode -> do let result = ID.render sys $ properties opts
|
||||
case outputPath opts of
|
||||
Nothing -> putStr result
|
||||
Just path -> writeFile path result
|
||||
TextRenderMode -> error "not implemented"
|
||||
GraphRenderMode -> error "not implemented"
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
name: master-plan
|
||||
version: 0.1.0.0
|
||||
synopsis: Text based project management tool
|
||||
synopsis: The project management tool for hackers
|
||||
-- description:
|
||||
homepage: https://github.com/rodrigosetti/master-plan
|
||||
bug-reports: https://github.com/rodrigosetti/master-plan/issues
|
||||
@ -22,6 +22,7 @@ executable master-plan
|
||||
ghc-options: -Wall
|
||||
default-extensions: UnicodeSyntax
|
||||
build-depends: base
|
||||
, containers
|
||||
, master-plan
|
||||
, optparse-applicative
|
||||
|
||||
@ -31,8 +32,8 @@ library
|
||||
ghc-options: -Wall
|
||||
default-extensions: UnicodeSyntax
|
||||
build-depends: base
|
||||
, megaparsec == 6.0.*
|
||||
, containers
|
||||
, megaparsec
|
||||
, mtl
|
||||
, syb
|
||||
exposed-modules: MasterPlan.Data
|
||||
@ -46,13 +47,13 @@ test-suite spec
|
||||
ghc-options: -Wall
|
||||
default-language: Haskell2010
|
||||
build-depends: base
|
||||
, master-plan
|
||||
, random
|
||||
, mtl
|
||||
, QuickCheck
|
||||
, containers
|
||||
, hspec
|
||||
, QuickCheck == 2.10.*
|
||||
, master-plan
|
||||
, mtl
|
||||
, quickcheck-instances
|
||||
, random
|
||||
, random-shuffle
|
||||
other-modules: MasterPlan.DataSpec
|
||||
, MasterPlan.Arbitrary
|
||||
|
||||
@ -19,13 +19,13 @@ import Data.Maybe (fromMaybe)
|
||||
import MasterPlan.Data
|
||||
|
||||
-- |Plain text renderer
|
||||
render ∷ ProjectSystem → String
|
||||
render (ProjectSystem bs) =
|
||||
snd $ evalRWS (renderName "root" >> renderRest) () bs
|
||||
render ∷ ProjectSystem → [ProjProperty] -> String
|
||||
render (ProjectSystem bs) whitelist =
|
||||
snd $ evalRWS (renderName "root" >> renderRest) whitelist bs
|
||||
where
|
||||
renderRest = gets M.keys >>= mapM_ renderName
|
||||
|
||||
type RenderMonad = RWS () String (M.Map String ProjectBinding)
|
||||
type RenderMonad = RWS [ProjProperty] String (M.Map String ProjectBinding)
|
||||
|
||||
renderLine ∷ String → RenderMonad ()
|
||||
renderLine s = tell $ s ++ ";\n"
|
||||
@ -35,8 +35,8 @@ renderName projName =
|
||||
do mb <- gets $ M.lookup projName
|
||||
case mb of
|
||||
Nothing -> pure ()
|
||||
Just b -> do renderBinding projName b
|
||||
tell "\n" -- empty line to separate bindings
|
||||
Just b -> do rendered <- renderBinding projName b
|
||||
when rendered $ tell "\n" -- empty line to separate bindings
|
||||
modify $ M.delete projName
|
||||
mapM_ renderName $ dependencies b
|
||||
|
||||
@ -46,31 +46,35 @@ dependencies = nub . everything (++) ([] `mkQ` collectDep)
|
||||
collectDep (RefProj n) = [n]
|
||||
collectDep _ = []
|
||||
|
||||
renderProps ∷ String → ProjectProperties → RenderMonad ()
|
||||
renderProps projName p = do renderProperty projName "name" (title p) projName show
|
||||
renderProperty projName "description" (description p) Nothing (show . fromMaybe "")
|
||||
renderProperty projName "url" (url p) Nothing (show . fromMaybe "")
|
||||
renderProperty projName "owner" (owner p) Nothing (show . fromMaybe "")
|
||||
renderProps ∷ String → ProjectProperties → RenderMonad Bool
|
||||
renderProps projName p = or <$> sequence [ renderProperty projName PTitle (title p) projName show
|
||||
, renderProperty projName PDescription (description p) Nothing (show . fromMaybe "")
|
||||
, renderProperty projName PUrl (url p) Nothing (show . fromMaybe "")
|
||||
, renderProperty projName POwner (owner p) Nothing (show . fromMaybe "") ]
|
||||
|
||||
renderProperty ∷ Eq a ⇒ ProjectKey → String → a → a → (a → String) → RenderMonad ()
|
||||
renderProperty projName propName val def toStr
|
||||
| val == def = pure ()
|
||||
| otherwise = renderLine $ propName ++ "(" ++ projName ++ ") = " ++ toStr val
|
||||
renderProperty ∷ Eq a ⇒ ProjectKey → ProjProperty → a → a → (a → String) → RenderMonad Bool
|
||||
renderProperty projName prop val def toStr
|
||||
| val == def = pure False
|
||||
| otherwise = do whitelisted <- asks (prop `elem`)
|
||||
when whitelisted $
|
||||
renderLine $ show prop ++ "(" ++ projName ++ ") = " ++ toStr val
|
||||
pure whitelisted
|
||||
|
||||
renderBinding ∷ ProjectKey → ProjectBinding → RenderMonad ()
|
||||
renderBinding ∷ ProjectKey → ProjectBinding → RenderMonad Bool
|
||||
renderBinding projName (UnconsolidatedProj p) = renderProps projName p
|
||||
renderBinding projName (TaskProj props c t p) =
|
||||
do renderProps projName props
|
||||
renderProperty projName "cost" c 0 show
|
||||
renderProperty projName "trust" t 1 percentage
|
||||
renderProperty projName "progress" p 0 percentage
|
||||
or <$> sequence [ renderProps projName props
|
||||
, renderProperty projName PCost c 0 show
|
||||
, renderProperty projName PTrust t 1 percentage
|
||||
, renderProperty projName PProgress p 0 percentage ]
|
||||
where
|
||||
percentage n = show (n * 100) ++ "%"
|
||||
|
||||
|
||||
renderBinding projName (ExpressionProj pr e) =
|
||||
do renderProps projName pr
|
||||
do void $ renderProps projName pr
|
||||
renderLine $ projName ++ " = " ++ expressionToStr False e
|
||||
pure True
|
||||
where
|
||||
combinedEToStr parens op ps = let sube = map (expressionToStr True) $ NE.toList ps
|
||||
s = intercalate (" " ++ op ++ " ") sube
|
||||
|
||||
@ -15,6 +15,7 @@ module MasterPlan.Data ( Project(..)
|
||||
, ProjectSystem(..)
|
||||
, ProjectBinding(..)
|
||||
, ProjectKey
|
||||
, ProjProperty(..)
|
||||
, Trust
|
||||
, Cost
|
||||
, Progress
|
||||
@ -26,6 +27,7 @@ module MasterPlan.Data ( Project(..)
|
||||
, trust
|
||||
, simplify
|
||||
, simplifyProj
|
||||
, optimizeSys
|
||||
, optimizeProj
|
||||
, printStructure) where
|
||||
|
||||
@ -65,6 +67,18 @@ data ProjectProperties = ProjectProperties { title :: String
|
||||
, owner :: Maybe String
|
||||
} deriving (Eq, Show, Data, Typeable)
|
||||
|
||||
data ProjProperty = PTitle | PDescription | PUrl | POwner | PCost | PTrust | PProgress
|
||||
deriving (Eq, Enum, Bounded)
|
||||
|
||||
instance Show ProjProperty where
|
||||
show PTitle = "title"
|
||||
show PDescription = "description"
|
||||
show PUrl = "url"
|
||||
show POwner = "owner"
|
||||
show PCost = "cost"
|
||||
show PTrust = "trust"
|
||||
show PProgress = "progress"
|
||||
|
||||
-- |A project system defines the bindins (mapping from names to expressions or tasks)
|
||||
-- and properties, which can be associated to any binding
|
||||
newtype ProjectSystem = ProjectSystem { bindings :: M.Map ProjectKey ProjectBinding }
|
||||
@ -167,6 +181,9 @@ simplifyProj (SequenceProj ps) =
|
||||
reduce p = [simplifyProj p]
|
||||
simplifyProj p@RefProj {} = p
|
||||
|
||||
optimizeSys ∷ ProjectSystem → ProjectSystem
|
||||
optimizeSys sys = everywhere (mkT $ optimizeProj sys) sys
|
||||
|
||||
-- Sort project in order that minimizes cost
|
||||
optimizeProj ∷ ProjectSystem → Project → Project
|
||||
optimizeProj sys (SumProj ps) =
|
||||
|
||||
@ -44,7 +44,7 @@ parens = between (symbol "(") (symbol ")")
|
||||
|
||||
-- |list of reserved words
|
||||
rws ∷ [String]
|
||||
rws = ["name", "description", "url", "owner", "progress", "cost", "risk"]
|
||||
rws = map show [minBound :: ProjProperty ..]
|
||||
|
||||
identifier ∷ Parser String
|
||||
identifier = (lexeme . try) (p >>= check)
|
||||
@ -68,13 +68,13 @@ nonNegativeNumber = L.float
|
||||
|
||||
definition ∷ Parser ()
|
||||
definition =
|
||||
choice ([ propsProp "name" stringLiteral (\v p -> p { title = v })
|
||||
, propsProp "description" stringLiteral (\v p -> p { description = Just v})
|
||||
, propsProp "url" stringLiteral (\v p -> p { url = Just v})
|
||||
, propsProp "owner" stringLiteral (\v p -> p { owner = Just v})
|
||||
, taskProp "cost" nonNegativeNumber (\v b -> case b of TaskProj r _ t p -> TaskProj r v t p; _ -> b)
|
||||
, taskProp "trust" percentage (\v b -> case b of TaskProj r c _ p -> TaskProj r c v p; _ -> b)
|
||||
, taskProp "progress" percentage (\v b -> case b of TaskProj r c t _ -> TaskProj r c t v; _ -> b)
|
||||
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 TaskProj r _ t p -> TaskProj r v t p; _ -> b)
|
||||
, taskProp PTrust percentage (\v b -> case b of TaskProj r c _ p -> TaskProj r c v p; _ -> b)
|
||||
, taskProp PProgress percentage (\v b -> case b of TaskProj r c t _ -> TaskProj r c t v; _ -> b)
|
||||
, structure ] :: [Parser ()])
|
||||
where
|
||||
structure :: Parser ()
|
||||
@ -95,25 +95,25 @@ definition =
|
||||
|
||||
lift $ put $ sys { bindings = M.insert projName newBinding $ bindings sys }
|
||||
|
||||
propsProp :: String -> Parser a -> (a -> ProjectProperties -> ProjectProperties) -> Parser ()
|
||||
propsProp propName valueParser modifier =
|
||||
property propName valueParser setter
|
||||
propsProp :: ProjProperty -> Parser a -> (a -> ProjectProperties -> ProjectProperties) -> Parser ()
|
||||
propsProp prop valueParser modifier =
|
||||
property prop valueParser setter
|
||||
where
|
||||
setter projName val Nothing = pure $ UnconsolidatedProj $ modifier val $ defaultProjectProps { title=projName }
|
||||
setter _ val (Just p) = pure $ everywhere (mkT $ modifier val) p
|
||||
|
||||
taskProp :: String -> Parser a -> (a -> ProjectBinding -> ProjectBinding) -> Parser ()
|
||||
taskProp propName valueParser modifier =
|
||||
property propName valueParser setter
|
||||
taskProp :: ProjProperty -> Parser a -> (a -> ProjectBinding -> ProjectBinding) -> Parser ()
|
||||
taskProp prop valueParser modifier =
|
||||
property prop valueParser setter
|
||||
where
|
||||
setter projName val Nothing = pure $ modifier val $ defaultTaskProj defaultProjectProps { title=projName }
|
||||
setter projName _ (Just ExpressionProj {}) = fail $ "Project \"" ++ projName ++ "\" is not atomic."
|
||||
setter _ val (Just (UnconsolidatedProj p)) = pure $ modifier val $ defaultTaskProj p
|
||||
setter _ val (Just p@TaskProj {}) = pure $ modifier val p
|
||||
|
||||
property ∷ String → Parser a → (String -> a -> Maybe ProjectBinding -> Parser ProjectBinding) -> Parser ()
|
||||
property propName valueParser setter =
|
||||
do void $ symbol propName
|
||||
property ∷ ProjProperty → Parser a → (String -> a -> Maybe ProjectBinding -> Parser ProjectBinding) -> Parser ()
|
||||
property prop valueParser setter =
|
||||
do void $ symbol $ show prop
|
||||
projName <- parens identifier
|
||||
mBinding <- lift $ M.lookup projName <$> gets bindings
|
||||
value <- symbol "=" *> valueParser
|
||||
|
||||
Loading…
Reference in New Issue
Block a user