blob: 772cd7fadfa92fd79a0834538b593bd610df495c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
module Issue.Sort
( Sort,
Order,
SortBy,
applySorts,
sortArg,
)
where
import Data.List (sort, sortBy)
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
deriving (Show)
data Order
= Asc
| Desc
deriving (Show, Eq)
data SortBy
= SortByTag Text
deriving (Show)
defaultSort :: Sort
defaultSort = Sort Desc (SortByTag "@createdAt")
sortArg :: O.Parser [Sort]
sortArg =
O.many
( O.option
(O.maybeReader (parse . T.pack))
( O.long "sort"
<> O.short 's'
<> O.metavar "SORT"
<> O.help "Sort selected issues. (Defaults: `-@createdAt`)"
)
)
where
parse s
| "@" `T.isPrefixOf` s = Just (Sort Asc (SortByTag (T.drop 1 s)))
| "-@" `T.isPrefixOf` s = Just (Sort Desc (SortByTag (T.drop 2 s)))
| otherwise = Nothing
applySorts :: [Sort] -> [Issue] -> [Issue]
applySorts cs = compose (defaultSort : cs)
where
compose :: [Sort] -> ([Issue] -> [Issue])
compose = foldr (.) id . map toSort
toSort :: Sort -> ([Issue] -> [Issue])
toSort (Sort order sortBy') =
(if order == Desc then reverse else id)
. sortBy (sortByCompare sortBy')
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)
|
