Add capitalized cost

We are trying a new strategy to capitalize our development. Individual
tasks will be marked as capitalized or not. At the end of the iteration
the total velocity calculation will also include a sub calculation of
the completed capitalized work.

This commit:
- Adds `sCapitalized` to the `Story` data type. It defaults to `False`.
- We need to duplicate stat calculations for capitalized stories. The
  printing of stats and calculation of stats has been decoupled with the
  `CompletionStats` data type.

close-iteration/Main.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
 module Main (main) where
 
 import RIO
@@ -45,36 +47,69 @@ main = do
           (True, Pessimistic) -> story { sCarryOver = sCost }
           (_, _) -> story
 
-    let
-      isCarried = isJust . sCarryOver
-      (completedAndCarriedStories, incompleteStories) =
-        partition sCompleted stories
+    let capitalizedStats = statStories $ filter sCapitalized stories
+    hPutBuilder stdout $ getUtf8Builder $ foldMap
+      ("\n" <>)
+      [ "Capitalized"
+      , "- " <> display (completed capitalizedStats) <> " / " <> display
+        (commitment capitalizedStats)
+      ]
+    printStats $ statStories stories
 
-      (carriedStories, completedStories) =
-        partition isCarried completedAndCarriedStories
-      completedCost = sum $ mapMaybe sCost completedStories
-      completedCarryOver = sum $ mapMaybe sCarryOver carriedStories
+printStats :: MonadIO m => CompletionStats -> m ()
+printStats stats@CompletionStats {..} =
+  hPutBuilder stdout $ getUtf8Builder $ foldMap
+    ("\n" <>)
+    [ "Completed"
+    , "- new points: " <> display completedNewCost
+    , "- carried over points: " <> display completedCarryOver
+    , "- new stories: " <> display completedNewCount
+    , "- carried over stories: " <> display carriedCount
+    , "Incomplete"
+    , "- points completed: " <> display (incompleteCost - incompleteCarryOver)
+    , "- carry over points: " <> display incompleteCarryOver
+    , "- carry over stories: " <> display incompleteCount
+    , ""
+    , display (completed stats) <> " / " <> display (commitment stats)
+    ]
 
-      incompleteCost = sum $ mapMaybe sCost incompleteStories
-      incompleteCarryOver = sum $ mapMaybe sCarryOver incompleteStories
+completed :: CompletionStats -> Integer
+completed CompletionStats {..} =
+  completedNewCost + completedCarryOver + (incompleteCost - incompleteCarryOver)
 
-    hPutBuilder stdout . getUtf8Builder $ foldMap
-      ("\n" <>)
-      [ "Completed"
-      , "- new points: " <> display completedCost
-      , "- carried over points: " <> display completedCarryOver
-      , "- new stories: " <> display (length completedStories)
-      , "- carried over stories: " <> display (length carriedStories)
-      , "Incomplete"
-      , "- points completed: " <> display (incompleteCost - incompleteCarryOver)
-      , "- carry over points: " <> display incompleteCarryOver
-      , "- carry over stories: " <> display (length incompleteStories)
-      , ""
-      , display
-        (completedCost
-        + completedCarryOver
-        + (incompleteCost - incompleteCarryOver)
-        )
-      <> " / "
-      <> display (completedCost + completedCarryOver + incompleteCost)
-      ]
+commitment :: CompletionStats -> Integer
+commitment CompletionStats {..} =
+  completedNewCost + completedCarryOver + incompleteCost
+
+statStories :: [Story] -> CompletionStats
+statStories stories = CompletionStats
+  { completedNewCost
+  , completedCarryOver
+  , incompleteCost
+  , incompleteCarryOver
+  , completedNewCount = length completedStories
+  , carriedCount = length carriedStories
+  , incompleteCount = length incompleteStories
+  }
+ where
+  isCarried = isJust . sCarryOver
+  (completedAndCarriedStories, incompleteStories) =
+    partition sCompleted stories
+
+  (carriedStories, completedStories) =
+    partition isCarried completedAndCarriedStories
+  completedNewCost = sum $ mapMaybe sCost completedStories
+  completedCarryOver = sum $ mapMaybe sCarryOver carriedStories
+
+  incompleteCost = sum $ mapMaybe sCost incompleteStories
+  incompleteCarryOver = sum $ mapMaybe sCarryOver incompleteStories
+
+data CompletionStats = CompletionStats
+  { completedNewCount :: Int
+  , carriedCount :: Int
+  , incompleteCount :: Int
+  , completedNewCost :: Integer
+  , completedCarryOver :: Integer
+  , incompleteCost :: Integer
+  , incompleteCarryOver :: Integer
+  }

library/Asana/Story.hs

@@ -26,6 +26,7 @@ data Story = Story
   , sCarryOver :: Maybe Integer
   , sCanDo :: Maybe Bool
   , sReproduced :: Maybe Bool
+  , sCapitalized :: Bool
   , sGid :: Gid
   }
   deriving Show
@@ -45,6 +46,7 @@ fromTask Task {..} = case tResourceSubtype of
     , sCarryOver = findInteger "carryover" tCustomFields
     , sCanDo = findYesNo "can do?" tCustomFields
     , sReproduced = findYesNo "Reproduces on seed data?" tCustomFields
+    , sCapitalized = fromMaybe False $ findYesNo "cap?" tCustomFields
     , sGid = tGid
     }
  where
@@ -68,7 +70,7 @@ findYesNo x = fmap parse . listToMaybe . mapMaybe go
  where
   go (CustomEnum _ name _ mn) | caseFoldEq name x = mn
   go _ = Nothing
-  parse = (== "Yes")
+  parse str = str == "Yes" || str == "Y"
 
 caseFoldEq :: Text -> Text -> Bool
 caseFoldEq x y = T.toCaseFold x == T.toCaseFold y