diff options
Diffstat (limited to 'app/Issue/Sort.hs')
-rw-r--r-- | app/Issue/Sort.hs | 32 |
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) |