diff --git a/close-iteration/Main.hs b/close-iteration/Main.hs index f014e42..f8c5fe0 100644 --- a/close-iteration/Main.hs +++ b/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 + } diff --git a/library/Asana/Story.hs b/library/Asana/Story.hs index af7306e..48f1d04 100644 --- a/library/Asana/Story.hs +++ b/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