module MasterPlan.Data ( ProjectExpr(..)
, ProjectProperties(..)
, ProjectSystem(..)
, Binding(..)
, ProjectKey(..)
, ProjAttribute(..)
, Trust(..)
, Cost(..)
, Progress(..)
, defaultProjectProps
, defaultCost
, defaultTrust
, defaultProgress
, defaultTaskProj
, bindingTitle
, cost
, progress
, trust
, simplify
, simplifyProj
, prioritizeSys
, prioritizeProj ) where
import Data.Generics
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.String (IsString)
newtype Trust = Trust { getTrust :: Float }
deriving (Show, Eq, Data, Typeable, Ord, Num, Real, RealFrac, Fractional)
newtype Cost = Cost { getCost :: Float }
deriving (Show, Eq, Data, Typeable, Ord, Num, Real, RealFrac, Fractional)
newtype Progress = Progress { getProgress :: Float }
deriving (Show, Eq, Data, Typeable, Ord, Num, Real, RealFrac, Fractional)
newtype ProjectKey = ProjectKey { getProjectKey :: String }
deriving (Show, Eq, Data, Typeable, Ord, IsString)
data ProjectExpr = Sum (NE.NonEmpty ProjectExpr)
| Product (NE.NonEmpty ProjectExpr)
| Sequence (NE.NonEmpty ProjectExpr)
| Reference ProjectKey
deriving (Eq, Show, Data, Typeable)
data Binding = BindingAtomic ProjectProperties Cost Trust Progress
| BindingExpr ProjectProperties ProjectExpr
deriving (Eq, Show, Data, Typeable)
data ProjectProperties = ProjectProperties { title :: String
, description :: Maybe String
, url :: Maybe String
, owner :: Maybe String
} deriving (Eq, Show, Data, Typeable)
data ProjAttribute = PTitle | PDescription | PUrl | POwner | PCost | PTrust | PProgress
deriving (Eq, Enum, Bounded)
instance Show ProjAttribute where
show PTitle = "title"
show PDescription = "description"
show PUrl = "url"
show POwner = "owner"
show PCost = "cost"
show PTrust = "trust"
show PProgress = "progress"
newtype ProjectSystem = ProjectSystem { bindings :: M.Map ProjectKey Binding }
deriving (Eq, Show, Data, Typeable)
defaultProjectProps ∷ ProjectProperties
defaultProjectProps = ProjectProperties { title = "?"
, description = Nothing
, url = Nothing
, owner = Nothing }
defaultCost ∷ Cost
defaultCost = 0
defaultTrust ∷ Trust
defaultTrust = 1
defaultProgress ∷ Progress
defaultProgress = 0
defaultTaskProj ∷ ProjectProperties → Binding
defaultTaskProj pr = BindingAtomic pr defaultCost defaultTrust defaultProgress
bindingTitle ∷ Binding → String
bindingTitle (BindingAtomic ProjectProperties { title=t} _ _ _) = t
bindingTitle (BindingExpr ProjectProperties { title=t} _) = t
cost ∷ ProjectSystem → ProjectExpr → Cost
cost sys (Reference n) =
case M.lookup n (bindings sys) of
Just (BindingAtomic _ (Cost c) _ (Progress p)) -> Cost $ c * (1 p)
Just (BindingExpr _ p) -> cost sys p
Nothing -> defaultCost
cost sys (Sequence ps) = costConjunction sys ps
cost sys (Product ps) = costConjunction sys ps
cost sys (Sum ps) =
Cost $ sum $ map (\x -> (1 snd x) * fst x) $ zip costs accTrusts
where
costs = NE.toList $ (getCost . cost sys) <$> ps
accTrusts = NE.toList $ NE.scanl (\a b -> a + b*(1a)) 0 $ (getTrust . trust sys) <$> ps
costConjunction ∷ ProjectSystem → NE.NonEmpty ProjectExpr → Cost
costConjunction sys ps =
Cost $ sum $ zipWith (*) costs accTrusts
where
costs = NE.toList $ (getCost . cost sys) <$> ps
accTrusts = NE.toList $ product <$> NE.inits ((getTrust . trust sys) <$> ps)
trust ∷ ProjectSystem → ProjectExpr → Trust
trust sys (Reference n) =
case M.lookup n (bindings sys) of
Just (BindingAtomic _ _ (Trust t) (Progress p)) -> Trust $ p + t * (1p)
Just (BindingExpr _ p) -> trust sys p
Nothing -> defaultTrust
trust sys (Sequence ps) = trustConjunction sys ps
trust sys (Product ps) = trustConjunction sys ps
trust sys (Sum ps) =
Trust $ foldl (\a b -> a + b*(1a)) 0 $ (getTrust . trust sys) <$> ps
trustConjunction ∷ ProjectSystem → NE.NonEmpty ProjectExpr → Trust
trustConjunction sys ps = Trust $ product $ (getTrust . trust sys) <$> ps
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
Nothing -> defaultProgress
progress sys (Sequence ps) = progressConjunction sys ps
progress sys (Product ps) = progressConjunction sys ps
progress sys (Sum ps) = maximum $ progress sys <$> ps
progressConjunction ∷ ProjectSystem → NE.NonEmpty ProjectExpr → Progress
progressConjunction sys ps = sum (progress sys <$> ps) / fromIntegral (length ps)
simplify ∷ ProjectSystem → ProjectSystem
simplify = everywhere (mkT simplifyProj)
simplifyProj ∷ ProjectExpr → ProjectExpr
simplifyProj (Sum (p :| [])) = simplifyProj p
simplifyProj (Product (p :| [])) = simplifyProj p
simplifyProj (Sequence (p :| [])) = simplifyProj p
simplifyProj (Sum ps) =
Sum $ (reduce . simplifyProj) =<< ps
where
reduce (Sum ps') = reduce =<< ps'
reduce p = [simplifyProj p]
simplifyProj (Product ps) =
Product $ (reduce . simplifyProj) =<< ps
where
reduce (Product ps') = reduce =<< ps'
reduce p = [simplifyProj p]
simplifyProj (Sequence ps) =
Sequence $ (reduce . simplifyProj) =<< ps
where
reduce (Sequence ps') = reduce =<< ps'
reduce p = [simplifyProj p]
simplifyProj p@Reference {} = p
prioritizeSys ∷ ProjectSystem → ProjectSystem
prioritizeSys sys = everywhere (mkT $ prioritizeProj sys) sys
prioritizeProj ∷ ProjectSystem → ProjectExpr → ProjectExpr
prioritizeProj sys (Sum ps) =
let f p = getCost (cost sys' p) / getTrust (trust sys' p)
sys' = prioritizeSys sys
in Sum $ NE.sortWith (nanToInf . f) $ prioritizeProj sys' <$> ps
prioritizeProj sys (Product ps) =
let f p = getCost (cost sys' p) / (1 getTrust (trust sys' p))
sys' = prioritizeSys sys
in Product $ NE.sortWith (nanToInf . f) $ prioritizeProj sys' <$> ps
prioritizeProj sys (Sequence ps) =
Sequence $ prioritizeProj sys <$> ps
prioritizeProj _ p = p
nanToInf :: RealFloat a => a -> a
nanToInf x = if isNaN x then 1/0 else x