make sort type-aware

1 files changed, 22 insertions, 10 deletions

diff --git a/app/Issue/Sort.hs b/app/Issue/Sort.hs
index 46f4a19..5499f9c 100644
--- a/app/Issue/Sort.hs
+++ b/app/Issue/Sort.hs
@@ -8,12 +8,12 @@ module Issue.Sort
 where
 
 import Data.List (sort, sortBy)
-import Data.Maybe (mapMaybe)
-import Data.Ord (comparing)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Issue (Issue (..))
 import Issue.Tag (Tag (..))
+import Issue.TypedValue (cast)
 import Options.Applicative qualified as O
 
 data Sort = Sort Order SortBy
@@ -57,12 +57,24 @@ applySorts cs = compose (defaultSort : cs)
     toSort :: Sort -> ([Issue] -> [Issue])
     toSort (Sort order sortBy') =
       (if order == Desc then reverse else id)
-        . sortBy (comparing (applySortBy sortBy'))
+        . sortBy (sortByCompare sortBy')
 
-applySortBy :: SortBy -> Issue -> [Text]
-applySortBy (SortByTag k) i =
-  sort
-    ( mapMaybe
-        (\(Tag k' v) -> if k' == k then v else Nothing)
-        (i.tags ++ i.internalTags)
-    )
+sortByCompare :: SortBy -> (Issue -> Issue -> Ordering)
+sortByCompare (SortByTag k) i1 i2 =
+  compareList
+    (incomparableFirst (cast compare))
+    (sort $ tagValues k (i1.tags ++ i1.internalTags))
+    (sort $ tagValues k (i2.tags ++ i2.internalTags))
+
+tagValues :: Text -> [Tag] -> [Text]
+tagValues k = mapMaybe (\(Tag k' v) -> if k' == k then v else Nothing)
+
+compareList :: (a -> a -> Ordering) -> ([a] -> [a] -> Ordering)
+compareList _ [] _ = LT
+compareList _ _ [] = GT
+compareList g (a : as) (b : bs)
+  | g a b == EQ = compareList g as bs
+  | otherwise = g a b
+
+incomparableFirst :: (a -> a -> Maybe Ordering) -> (a -> a -> Ordering)
+incomparableFirst cmp a b = fromMaybe LT (cmp a b)