diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/History.hs | 10 | ||||
| -rw-r--r-- | app/Issue/Sort.hs | 68 | ||||
| -rw-r--r-- | app/Main.hs | 30 |
3 files changed, 99 insertions, 9 deletions
diff --git a/app/History.hs b/app/History.hs index 8fdbd0a..ff7f889 100644 --- a/app/History.hs +++ b/app/History.hs @@ -13,6 +13,7 @@ import GHC.Generics (Generic) import Issue (Issue (..), fromMatch, id) import Issue.Filter (Filter, applyFilter) import Issue.Tag qualified as I +import Issue.Sort (Sort, applySort) import Parallel (parMapM) import Process (proc, sh, sh_) import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory) @@ -26,8 +27,8 @@ import TreeGrepper.Result qualified as G import Prelude hiding (id, lines) import Prelude qualified as Prelude -listIssues :: [Filter] -> [FilePath] -> IO [Issue] -listIssues filters paths = do +listIssues :: [Sort] -> [Filter] -> [FilePath] -> IO [Issue] +listIssues sort filters paths = do commitHashes <- fmap reverse getCommitHashes case commitHashes of [] -> @@ -53,12 +54,13 @@ listIssues filters paths = do let eventses = getEvents hashFirst issuesInitial (commitInfos ++ [commitInfoWorkingTree]) let issues = mapMaybe issueFromIssueEvents eventses issuesFiltered = filter (applyFilter filters) issues + issuesSorted = applySort sort issuesFiltered issuesWithinPaths = case paths of [] -> - issuesFiltered + issuesSorted _ -> - filter withinPaths issuesFiltered + filter withinPaths issuesSorted pure issuesWithinPaths where withinPaths issue = diff --git a/app/Issue/Sort.hs b/app/Issue/Sort.hs new file mode 100644 index 0000000..1a0b3ff --- /dev/null +++ b/app/Issue/Sort.hs @@ -0,0 +1,68 @@ +module Issue.Sort + ( Sort, + Order, + SortBy, + applySort, + sortArg, + ) +where + +import Data.List (sort, sortBy) +import Data.Maybe (mapMaybe) +import Data.Ord (comparing) +import Data.Text (Text) +import Data.Text qualified as T +import Issue (Issue (..)) +import Issue.Tag (Tag (..)) +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 Asc (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 + +applySort :: [Sort] -> [Issue] -> [Issue] +applySort 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 (comparing (applySortBy sortBy')) + +applySortBy :: SortBy -> Issue -> [Text] +applySortBy (SortByTag k) i = + sort + ( mapMaybe + (\(Tag k' v) -> if k' == k then Just v else Nothing) + (i.tags ++ i.internalTags) + ) diff --git a/app/Main.hs b/app/Main.hs index 961fb99..e95d5f7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -258,6 +258,22 @@ -- Additionally using `--reversed`, the order will be reversed. -- -- @topic options +-- +-- COMMENT `anissue list` now supports `--sort` which allows sorting by tags. +-- To facilitate the first use-case, sorting by creation, an internal tag +-- `@createdAt` has been added. Reversing is possible, ie. `--sort +-- '-@createdAt'` +-- +-- Supposing we want to go this direction, I feel like all of the use-cases can +-- be implemented using internal tags and adding support for a couple of data +-- types within String-valued tags. (Sorting by `@createdAt` currently only +-- works because date-based ordering coincides with string-based ordering on +-- the used `YYYY-MM-DD` format.) +-- +-- What do you think? +-- +-- PS. Nothing prevents us later to extend functionality by special cases, +-- should we dislike an internal `@title` tag. -- TODO Add command for (re)generating the cache -- @@ -334,6 +350,8 @@ import Issue (Issue (..)) import Issue qualified as I import Issue.Filter (Filter) import Issue.Filter qualified as I +import Issue.Sort (Sort) +import Issue.Sort qualified as I import Issue.Tag qualified as I import Options.Applicative ((<**>)) import Options.Applicative qualified as O @@ -368,7 +386,8 @@ internalTagsFlag = data Command = List { files :: [String], - filters :: [Filter] + filters :: [Filter], + sort :: [Sort] } | Show { id :: String, @@ -390,6 +409,7 @@ listCmd = List <$> filesArg <*> I.filterArg + <*> I.sortArg showCmd :: O.Parser Command showCmd = @@ -406,7 +426,7 @@ idArg = ( O.metavar "ID" <> O.completer ( O.listIOCompleter $ - catMaybes . map I.id <$> listIssues [] [] + catMaybes . map I.id <$> listIssues [] [] [] ) ) @@ -430,8 +450,8 @@ die s = do main :: IO () main = do O.execParser (O.info (options <**> O.helper) O.idm) >>= \case - Options {internalTags, command = List {filters, files}} -> do - issues <- listIssues filters files + Options {internalTags, command = List {sort, filters, files}} -> do + issues <- listIssues sort filters files putDoc . P.vsep $ map ( \issue -> @@ -451,7 +471,7 @@ main = do ) issues Options {command = Show {id, width}} -> do - issues <- listIssues [] [] + issues <- listIssues [] [] [] case find ((==) (Just id) . I.id) issues of Nothing -> die (printf "no issue with id `%s'\n" id) Just issue -> do |