Using Data.Generics

Saved a few lines of code

master-plan.cabal

@@ -34,6 +34,7 @@ library
                        , megaparsec == 6.0.*
                        , containers
                        , mtl
+                       , syb
     exposed-modules:     MasterPlan.Data
                        , MasterPlan.Parser
                        , MasterPlan.Backend.Identity

src/MasterPlan/Backend/Identity.hs

@@ -11,7 +11,8 @@ Portability : POSIX
 module MasterPlan.Backend.Identity (render) where
 
 import           Control.Monad.RWS
-import           Data.List          (intercalate)
+import           Data.Generics
+import           Data.List          (intercalate, nub)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map           as M
 import           Data.Maybe         (fromMaybe)
@@ -43,10 +44,10 @@ renderName projName =
                      mapM_ renderName names
 
 dependencies ∷ Project → [ProjectKey]
-dependencies (RefProj n)       = [n]
-dependencies (SumProj ps)      = concatMap dependencies ps
-dependencies (SequenceProj ps) = concatMap dependencies ps
-dependencies (ProductProj ps)  = concatMap dependencies ps
+dependencies = nub . everything (++) ([] `mkQ` collectDep)
+  where
+    collectDep (RefProj n) = [n]
+    collectDep _           = []
 
 renderProps ∷ String → ProjectProperties → RenderMonad ()
 renderProps projName p = do renderProperty projName "name" (title p) projName show

src/MasterPlan/Data.hs

@@ -7,8 +7,9 @@ Maintainer  : rodrigosetti@email.com
 Stability   : experimental
 Portability : POSIX
 -}
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE UnicodeSyntax   #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedLists    #-}
+{-# LANGUAGE UnicodeSyntax      #-}
 module MasterPlan.Data ( Project(..)
                        , ProjectProperties(..)
                        , ProjectSystem(..)
@@ -25,17 +26,18 @@ module MasterPlan.Data ( Project(..)
                        , trust
                        , simplify
                        , simplifyProj
-                       , optimizeSys
-                       , optimizeBinding
                        , optimizeProj
                        , printStructure) where
 
 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           Data.Semigroup       (sconcat)
 
+-- * Types
+
 type Trust = Float
 type Cost = Float
 type Progress = Float
@@ -46,7 +48,7 @@ data Project = SumProj (NE.NonEmpty Project)
              | ProductProj (NE.NonEmpty Project)
              | SequenceProj (NE.NonEmpty Project)
              | RefProj ProjectKey
-            deriving (Eq, Show)
+            deriving (Eq, Show, Data, Typeable)
 
 -- |A binding of a name can refer to an expression. If there are no
 -- associated expressions (i.e. equation) then it can have task-level
@@ -54,19 +56,19 @@ data Project = SumProj (NE.NonEmpty Project)
 data ProjectBinding = TaskProj ProjectProperties Cost Trust Progress
                     | ExpressionProj ProjectProperties Project
                     | UnconsolidatedProj ProjectProperties
-                   deriving (Eq, Show)
+                   deriving (Eq, Show, Data, Typeable)
 
 -- |Any binding (with a name) may have associated properties
 data ProjectProperties = ProjectProperties { title       :: String
                                            , description :: Maybe String
                                            , url         :: Maybe String
                                            , owner       :: Maybe String
-                                           } deriving (Eq, Show)
+                                           } deriving (Eq, Show, Data, Typeable)
 
 -- |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 }
-                          deriving (Eq, Show)
+                          deriving (Eq, Show, Data, Typeable)
 
 rootKey ∷ ProjectKey
 rootKey = "root"
@@ -134,9 +136,8 @@ progressConjunction ∷ ProjectSystem → NE.NonEmpty Project → Progress
 progressConjunction sys ps = sum (NE.map (progress sys) ps) / fromIntegral (length ps)
 
 -- |Simplify a project binding structure
-simplify ∷ ProjectBinding → ProjectBinding
-simplify (ExpressionProj pr e) = ExpressionProj pr $ simplifyProj e
-simplify p                     = p
+simplify ∷ ProjectSystem → ProjectSystem
+simplify = everywhere (mkT simplifyProj)
 
 -- |Helper function: concatMap for NonEmpty
 neConcatMap ∷ (a → NE.NonEmpty b) → NE.NonEmpty a → NE.NonEmpty b
@@ -166,13 +167,6 @@ simplifyProj (SequenceProj ps) =
     reduce p                  = [simplifyProj p]
 simplifyProj p@RefProj {}     = p
 
-optimizeSys ∷ ProjectSystem → ProjectSystem
-optimizeSys sys@(ProjectSystem b) = ProjectSystem $ M.map (optimizeBinding sys) b
-
-optimizeBinding ∷ ProjectSystem → ProjectBinding → ProjectBinding
-optimizeBinding sys (ExpressionProj pr e) = ExpressionProj pr $ optimizeProj sys e
-optimizeBinding _   p                     = p
-
 -- Sort project in order that minimizes cost
 optimizeProj ∷ ProjectSystem → Project → Project
 optimizeProj sys (SumProj ps)      =

src/MasterPlan/Parser.hs

@@ -21,6 +21,7 @@ import           Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer as L
 import           Text.Megaparsec.Expr
 import Data.List (nub)
+import Data.Generics
 
 type Parser = ParsecT Void String (State ProjectSystem)
 
@@ -97,9 +98,7 @@ definition =
        property propName valueParser setter
      where
        setter projName val Nothing = pure $ UnconsolidatedProj $ modifier val $ defaultProjectProps { title=projName }
-       setter _ val (Just (TaskProj pr c t p)) = pure $ TaskProj (modifier val pr) c t p
-       setter _ val (Just (ExpressionProj pr p)) = pure $ ExpressionProj (modifier val pr) p
-       setter _ val (Just (UnconsolidatedProj pr)) = pure $ UnconsolidatedProj $ modifier val pr
+       setter _ val (Just p) = pure $ everywhere (mkT $ modifier val) p
 
     taskProp :: String -> Parser a -> (a -> ProjectBinding -> ProjectBinding) -> Parser ()
     taskProp propName valueParser modifier =
@@ -140,14 +139,11 @@ expressionParser =
     combineSum ∷ Project → Project → Project
     combineSum p1 p2 = SumProj $ p1 NE.<| [p2]
 
-
 dependencies ∷ ProjectSystem -> Project → [ProjectKey]
-dependencies sys (RefProj n)       = nub $ n : bindingDeps (M.lookup n $ bindings sys)
-  where bindingDeps (Just (ExpressionProj _ e)) = dependencies sys e
-        bindingDeps _ = []
-dependencies sys (SumProj ps)      = nub $ concatMap (dependencies sys) ps
-dependencies sys (SequenceProj ps) = nub $ concatMap (dependencies sys) ps
-dependencies sys (ProductProj ps)  = nub $ concatMap (dependencies sys) ps
+dependencies sys = everything (++) ([] `mkQ` collectDep)
+  where
+    collectDep (RefProj n) = nub $ n : everything (++) ([] `mkQ` collectDep) (M.lookup n $ bindings sys)
+    collectDep _ = []
 
 projectSystem :: Parser ProjectSystem
 projectSystem =

test/MasterPlan/DataSpec.hs

@@ -102,7 +102,7 @@ spec = do
     it "is stable" $ do
       let propSimplifyIsStable :: ProjectSystem -> Property
           propSimplifyIsStable sys =
-            let sys' = sys { bindings = M.map simplify $ bindings sys }
+            let sys' = simplify sys
                 p    = RefProj rootKey
              in cost sys p `eq` cost sys' p .&&. trust sys p `eq` trust sys' p
 

test/MasterPlan/ParserSpec.hs

@@ -26,7 +26,7 @@ spec =
 
       let propertyParseAndOutputIdentity ∷ ProjectSystem → Property
           propertyParseAndOutputIdentity sys =
-            let sys' = sys { bindings = M.map simplify $ bindings sys}
+            let sys' = simplify sys
                 parsed = runParser "test2" (render sys')
              in isRight parsed ==> parsed === Right sys'