content: {-|
  Module      : MasterPlan.Data
  Description : Types for defining project and project systems
  Copyright   : (c) Rodrigo Setti, 2017
  License     : MIT
  Maintainer  : rodrigosetti@gmail.com
  Stability   : experimental
  Portability : POSIX
  -}
  {-# LANGUAGE DeriveDataTypeable         #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedLists            #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE UnicodeSyntax              #-}
  module MasterPlan.Data ( ProjectExpr
                         , ProjectKey
                         , Project(..)
                         , ProjectProperties(..)
                         , ProjAttribute(..)
                         , Trust(..)
                         , Cost(..)
                         , Progress(..)
                         , defaultProjectProps
                         , defaultCost
                         , defaultTrust
                         , defaultProgress
                         , defaultAtomic
                         , properties
                         , cost
                         , progress
                         , trust
                         , simplify
                         , subprojects
                         , prioritize ) where
  
  import           Data.Generics
  import           Data.List.NonEmpty (NonEmpty ((:|)))
  import qualified Data.List.NonEmpty as NE
  import           Data.Void          (Void)
  
  -- * Types
  
  -- |When using to reference projects by name
  type ProjectKey = String
  
  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)
  
  -- |Structure of a project expression
  data Project e = Sum ProjectProperties (NE.NonEmpty (Project e))
                 | Product ProjectProperties (NE.NonEmpty (Project e))
                 | Sequence ProjectProperties (NE.NonEmpty (Project e))
                 | Atomic ProjectProperties Cost Trust Progress
                 | Annotated e
                deriving (Eq, Show, Data, Typeable)
  
  type ProjectExpr = Project Void
  
  -- |Any binding (with a name) may have associated properties
  data ProjectProperties = ProjectProperties { title       :: Maybe 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"
  
  defaultProjectProps ∷ ProjectProperties
  defaultProjectProps = ProjectProperties { title = Nothing
                                          , description = Nothing
                                          , url = Nothing
                                          , owner = Nothing }
  
  defaultCost ∷ Cost
  defaultCost = 0
  
  defaultTrust ∷ Trust
  defaultTrust = 1
  
  defaultProgress ∷ Progress
  defaultProgress = 0
  
  defaultAtomic :: Project a
  defaultAtomic = Atomic defaultProjectProps defaultCost defaultTrust defaultProgress
  
  -- | Expected cost
  cost ∷ ProjectExpr → Cost
  cost (Atomic _ (Cost c) _ (Progress p)) = Cost $ c * (1 - p) -- cost is weighted by remaining progress
  cost (Sequence _ ps) = costConjunction ps
  cost (Product _ ps) = costConjunction ps
  cost (Sum _ ps) =
     Cost $ sum $ map (\x -> (1 - snd x) * fst x) $ zip costs accTrusts
   where
     costs = NE.toList $ (getCost . cost) <$> ps
     accTrusts = NE.toList $ NE.scanl (\a b -> a + b*(1-a)) 0 $ (getTrust . trust) <$> ps
  cost (Annotated _) = undefined
  
  costConjunction ∷ NE.NonEmpty ProjectExpr → Cost
  costConjunction ps =
     Cost $ sum $ zipWith (*) costs accTrusts
    where
      costs = NE.toList $ (getCost . cost) <$> ps
      accTrusts = NE.toList $ product <$> NE.inits ((getTrust . trust) <$> ps)
  
  -- | Expected probability of succeeding
  trust ∷ ProjectExpr → Trust
  trust (Atomic _ _ (Trust t) (Progress p)) = Trust $ p + t * (1-p) -- reduced by progress
  trust (Sequence _ ps) = trustConjunction ps
  trust (Product _ ps) = trustConjunction ps
  trust (Sum _ ps) =
    Trust $ foldl (\a b -> a + b*(1-a)) 0 $ (getTrust . trust) <$> ps
  trust (Annotated _) = undefined
  
  trustConjunction ∷ NE.NonEmpty ProjectExpr → Trust
  trustConjunction ps = Trust $ product $ (getTrust . trust) <$> ps
  
  subprojects :: Project a -> [Project a]
  subprojects (Sequence _ ps) = NE.toList ps
  subprojects (Product _ ps)  = NE.toList ps
  subprojects (Sum _ ps)      = NE.toList ps
  subprojects _               = []
  
  
  properties :: Project a -> Maybe ProjectProperties
  properties (Annotated _)        = Nothing
  properties (Product props _)    = Just props
  properties (Sequence props _)   = Just props
  properties (Sum props _)        = Just props
  properties (Atomic props _ _ _) = Just props
  
  progress ∷ ProjectExpr → Progress
  progress (Atomic _ _ _ p) = p
  progress (Sequence _ ps)  = progressConjunction ps
  progress (Product _ ps)   = progressConjunction ps
  progress (Sum _ ps)       = maximum $ progress <$> ps
  progress (Annotated _)    = undefined
  
  progressConjunction ∷ NE.NonEmpty ProjectExpr → Progress
  progressConjunction ps = sum (progress <$> ps) / fromIntegral (length ps)
  
  -- |Simplify a project expression structure
  --  1) transform singleton collections into it's only child
  --  2) flatten same constructor of the collection
  simplify ∷ Project a → Project a
  simplify (Sum _ (p :| []))      = simplify p
  simplify (Product _ (p :| []))  = simplify p
  simplify (Sequence _ (p :| [])) = simplify p
  simplify (Sum r ps) =
      Sum r $ (reduce . simplify) =<< ps
    where
      reduce (Sum _ ps') = reduce =<< ps'
      reduce p           = [simplify p]
  simplify (Product r ps) =
      Product r $ (reduce . simplify) =<< ps
    where
      reduce (Product _ ps') = reduce =<< ps'
      reduce p               = [simplify p]
  simplify (Sequence r ps) =
      Sequence r $ (reduce . simplify) =<< ps
    where
      reduce (Sequence _ ps') = reduce =<< ps'
      reduce p                = [simplify p]
  simplify p = p
  
  -- |Sort project in order that minimizes cost
  prioritize ∷ ProjectExpr → ProjectExpr
  prioritize (Sum r ps)      =
    let f p = getCost (cost p) / getTrust (trust p)
    in Sum r $ NE.sortWith (nanToInf . f) $ prioritize <$> ps
  prioritize (Product r ps)  =
    let f p = getCost (cost p) / (1 - getTrust (trust p))
    in Product r $ NE.sortWith (nanToInf . f) $ prioritize <$> ps
  prioritize (Sequence r ps)  =
    Sequence r $ prioritize <$> ps
  prioritize p        = p
  
  -- |Helper function to transform any Nan (not a number) to positive infinity
  nanToInf :: RealFloat a => a -> a
  nanToInf x = if isNaN x then 1/0 else x
  