Refactor ranking into a separate Mulkup.Ranking module.

Change-Id: Ieeef3f837756e6afe96f0a0c3dba591f285daae5
diff --git a/mulkup.cabal b/mulkup.cabal
index 82fc1a6..3c06e38 100644
--- a/mulkup.cabal
+++ b/mulkup.cabal
@@ -100,6 +100,7 @@
       Mulkup.Logging
       Mulkup.Main
       Mulkup.Prelude
+      Mulkup.Ranking
 
   hs-source-dirs:
       src
diff --git a/src/Mulkup/Config.hs b/src/Mulkup/Config.hs
index f3d9fee..4be5b64 100644
--- a/src/Mulkup/Config.hs
+++ b/src/Mulkup/Config.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE UndecidableInstances #-}
 
-module Mulkup.Config (TierConfig (..), MulkupConfig (..), readConfig) where
+module Mulkup.Config (TierConfig (..), TierConfigs (..), StashConfig (..), MulkupConfig (..), readConfig) where
 
 import Dhall
 import Mulkup.Prelude
diff --git a/src/Mulkup/Main.hs b/src/Mulkup/Main.hs
index 3b080c4..829ef5d 100644
--- a/src/Mulkup/Main.hs
+++ b/src/Mulkup/Main.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -6,14 +5,13 @@
 
 import Colog (Message, richMessageAction, simpleMessageAction)
 import Colog.Polysemy.Effect (Log, runLogAction)
-import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Set as Set
-import Data.Time
 import Mulkup.Bupstash
 import Mulkup.Config
 import Mulkup.Flags
 import Mulkup.Logging
 import Mulkup.Prelude
+import Mulkup.Ranking
 import Optics
 import Options.Applicative
   ( execParser,
@@ -59,24 +57,7 @@
 
     currentItems <- bupList (BupFilter labels Nothing)
 
-    let tiers =
-          [ (utctHour . bupItemUTCTime, #hourly),
-            (utctJulianDay . bupItemUTCTime, #daily),
-            (utctWeek . bupItemUTCTime, #weekly),
-            (utctMonth . bupItemUTCTime, #monthly)
-          ]
-
-    let keepIds =
-          Set.unions $
-            map
-              ( \(discriminator, cfgLens) ->
-                  let tierCfg = stash ^. #tiers ^. cfgLens
-                   in tierKeepIds discriminator (tierCfg ^. #keep) currentItems
-              )
-              tiers
-
-    let currentIds = Set.fromList (map (^. #id) currentItems)
-    let rmIds = Set.difference currentIds keepIds
+    let (keepIds, rmIds) = rankBupItems (stash ^. #tiers) currentItems
 
     logInfo (show labels <> " Keeping: " <> show (Set.toList keepIds))
     logInfo (show labels <> " Removing: " <> show (Set.toList rmIds))
@@ -87,32 +68,3 @@
       (stash ^. #baseDir)
       (stash ^. #exclusions)
       labels
-
-tierKeepIds :: (BupItem -> Integer) -> Natural -> [BupItem] -> Set Text
-tierKeepIds discriminator keep items =
-  fromList $
-    take (fromIntegral keep) $
-      map (^. #id) $
-        reverse $
-          sortWith bupItemUTCTime $
-            map (head . NonEmpty.sortWith bupItemUTCTime) $
-              elems $
-                (groupBy discriminator items :: HashMap Integer (NonEmpty BupItem))
-
-utctHour :: UTCTime -> Integer
-utctHour (UTCTime (ModifiedJulianDay julianDay) tdiff) = (julianDay * 24) + (diffTimeToPicoseconds tdiff `div` (10 ^ (12 :: Integer)) `div` 3600)
-
-utctJulianDay :: UTCTime -> Integer
-utctJulianDay (UTCTime (ModifiedJulianDay julianDay) _) = julianDay
-
-utctWeek :: UTCTime -> Integer
-utctWeek (UTCTime day _) =
-  julianDay + fromIntegral (dayOfWeekDiff (dayOfWeek day) Sunday)
-  where
-    (ModifiedJulianDay julianDay) = day
-    dayOfWeekDiff a b = mod (fromEnum a - fromEnum b) 7
-
-utctMonth :: UTCTime -> Integer
-utctMonth (UTCTime day _) = fromIntegral m
-  where
-    (_, m, _) = toGregorian day
diff --git a/src/Mulkup/Ranking.hs b/src/Mulkup/Ranking.hs
new file mode 100644
index 0000000..f162895
--- /dev/null
+++ b/src/Mulkup/Ranking.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Mulkup.Ranking (rankBupItems) where
+
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Set as Set
+import Data.Time
+import Mulkup.Bupstash
+import Mulkup.Config
+import Mulkup.Prelude
+import Optics
+
+rankBupItems :: TierConfigs -> [BupItem] -> (Set Text, Set Text)
+rankBupItems tierConfigs currentItems =
+  (keepIds, rmIds)
+  where
+    tiers =
+      [ (utctHour . bupItemUTCTime, #hourly),
+        (utctJulianDay . bupItemUTCTime, #daily),
+        (utctWeek . bupItemUTCTime, #weekly),
+        (utctMonth . bupItemUTCTime, #monthly)
+      ]
+
+    keepIds =
+      Set.unions $
+        map
+          ( \(discriminator, cfgLens) ->
+              let tierCfg = tierConfigs ^. cfgLens
+               in tierKeepIds discriminator (tierCfg ^. #keep) currentItems
+          )
+          tiers
+
+    currentIds = Set.fromList (map (^. #id) currentItems)
+    rmIds = Set.difference currentIds keepIds
+
+tierKeepIds :: (BupItem -> Integer) -> Natural -> [BupItem] -> Set Text
+tierKeepIds discriminator keep items =
+  fromList $
+    take (fromIntegral keep) $
+      map (^. #id) $
+        reverse $
+          sortWith bupItemUTCTime $
+            map (head . NonEmpty.sortWith bupItemUTCTime) $
+              elems
+                (groupBy discriminator items :: HashMap Integer (NonEmpty BupItem))
+
+utctHour :: UTCTime -> Integer
+utctHour (UTCTime (ModifiedJulianDay julianDay) tdiff) = (julianDay * 24) + (diffTimeToPicoseconds tdiff `div` (10 ^ (12 :: Integer)) `div` 3600)
+
+utctJulianDay :: UTCTime -> Integer
+utctJulianDay (UTCTime (ModifiedJulianDay julianDay) _) = julianDay
+
+utctWeek :: UTCTime -> Integer
+utctWeek (UTCTime day _) =
+  julianDay + fromIntegral (dayOfWeekDiff (dayOfWeek day) Sunday)
+  where
+    (ModifiedJulianDay julianDay) = day
+    dayOfWeekDiff a b = mod (fromEnum a - fromEnum b) 7
+
+utctMonth :: UTCTime -> Integer
+utctMonth (UTCTime day _) = fromIntegral m
+  where
+    (_, m, _) = toGregorian day