slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cln: hlint: Clean up some examples of using sortOn.

Browse Source
This commit is contained in:
Stephen Morgan 2021-08-27 22:44:05 +10:00 committed by Simon Michael
parent b7bf780c52
commit 35be02a4f3
3 changed files with 9 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
hledger/Hledger/Cli/CliOptions.hs
View File

@ -75,9 +75,8 @@ import Data.Default
import Data.Either (isRight) import Data.Either (isRight)
import Data.Functor.Identity (Identity) import Data.Functor.Identity (Identity)
import "base-compat-batteries" Data.List.Compat import "base-compat-batteries" Data.List.Compat
import Data.List.Extra (nubSort) import Data.List.Extra (groupSortOn, nubSort)
import Data.List.Split (splitOneOf) import Data.List.Split (splitOneOf)
import Data.Ord
import Data.Maybe import Data.Maybe
--import Data.String.Here --import Data.String.Here
-- import Data.Text (Text) -- import Data.Text (Text)
@ -662,12 +661,11 @@ registerWidthsFromOpts CliOpts{width_=Just s} =
hledgerAddons :: IO [String] hledgerAddons :: IO [String]
hledgerAddons = do hledgerAddons = do
-- past bug generator -- past bug generator
as1 <- hledgerExecutablesInPath -- ["hledger-check","hledger-check-dates","hledger-check-dates.hs","hledger-check.hs","hledger-check.py"] as1 <- hledgerExecutablesInPath -- ["hledger-check","hledger-check-dates","hledger-check-dates.hs","hledger-check.hs","hledger-check.py"]
let as2 = map stripPrognamePrefix as1 -- ["check","check-dates","check-dates.hs","check.hs","check.py"] let as2 = map stripPrognamePrefix as1 -- ["check","check-dates","check-dates.hs","check.hs","check.py"]
let as3 = sortBy (comparing takeBaseName) as2 -- ["check","check.hs","check.py","check-dates","check-dates.hs"] let as3 = groupSortOn takeBaseName as2 -- [["check","check.hs","check.py"],["check-dates","check-dates.hs"]]
let as4 = groupBy (\a b -> takeBaseName a == takeBaseName b) as3 -- [["check","check.hs","check.py"],["check-dates","check-dates.hs"]] let as4 = concatMap dropRedundantSourceVersion as3 -- ["check","check.hs","check.py","check-dates"]
let as5 = concatMap dropRedundantSourceVersion as4 -- ["check","check.hs","check.py","check-dates"] return as4
return as5
stripPrognamePrefix = drop (length progname + 1) stripPrognamePrefix = drop (length progname + 1)

7
hledger/Hledger/Cli/Commands/Diff.hs
View File

@ -12,7 +12,7 @@ module Hledger.Cli.Commands.Diff (
,diff ,diff
) where ) where
import Data.List ((\\), groupBy, nubBy, sortBy) import Data.List.Extra ((\\), groupSortOn, nubBy, sortBy)
import Data.Function (on) import Data.Function (on)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
@ -56,14 +56,11 @@ allPostingsWithPath j = do
(pidx, p) <- zip [0..] $ tpostings txn (pidx, p) <- zip [0..] $ tpostings txn
return PostingWithPath { ppposting = p, pptxnidx = txnidx, pppidx = pidx } return PostingWithPath { ppposting = p, pptxnidx = txnidx, pppidx = pidx }
binBy :: Ord b => (a -> b) -> [a] -> [[a]]
binBy f = groupBy ((==) `on` f) . sortBy (comparing f)
combine :: ([a], [b]) -> [Either a b] combine :: ([a], [b]) -> [Either a b]
combine (ls, rs) = map Left ls ++ map Right rs combine (ls, rs) = map Left ls ++ map Right rs
combinedBinBy :: Ord b => (a -> b) -> ([a], [a]) -> [([a], [a])] combinedBinBy :: Ord b => (a -> b) -> ([a], [a]) -> [([a], [a])]
combinedBinBy f = map partitionEithers . binBy (either f f) . combine combinedBinBy f = map partitionEithers . groupSortOn (either f f) . combine
greedyMaxMatching :: (Eq a, Eq b) => [(a,b)] -> [(a,b)] greedyMaxMatching :: (Eq a, Eq b) => [(a,b)] -> [(a,b)]
greedyMaxMatching = greedyMaxMatching' [] greedyMaxMatching = greedyMaxMatching' []

2
tools/listbydeps.hs
View File

@ -56,5 +56,5 @@ main = do [ base, pkgFile ] <- getArgs
mods <- mapM (allDeps base) pkgs mods <- mapM (allDeps base) pkgs
let deps = zip pkgs mods let deps = zip pkgs mods
let deps' = sortBy (comparing fst) deps let deps' = sortBy (comparing fst) deps
mapM_ (print . fst) (sortBy (comparing $ length . snd) deps') mapM_ (print . fst) (sortOn (length . snd) deps')