cli: simplify addons detection, fix deduplication

This commit is contained in:
Simon Michael 2017-03-28 04:07:01 -07:00
parent 8169383f29
commit e2faf08088
2 changed files with 43 additions and 39 deletions

View File

@ -74,6 +74,7 @@ import Data.Functor.Compat ((<$>))
import Data.Functor.Identity (Identity)
import Data.List.Compat
import Data.List.Split (splitOneOf)
import Data.Ord
import Data.Maybe
-- import Data.Text (Text)
import qualified Data.Text as T
@ -599,35 +600,41 @@ defaultBalanceLineFormat = BottomAligned [
-- Other utils
-- | Get the sorted unique precise names and display names of hledger
-- add-on executables found in the current user's PATH.
-- Precise names are the file names with the "hledger-" prefix removed.
-- Display names also have the file extension removed, except when it's
-- needed to disambiguate multiple add-ons with similar filenames.
-- When there are exactly two similar names that look like a source
-- and compiled version (.exe, .com, or no extension), the source
-- version is excluded (even if it happens to be newer).
-- Add-on names matching built-in command names could be returned
-- by this function, though hledger will ignore them.
-- | Get the sorted unique canonical names of hledger addon commands
-- found in the current user's PATH. These are used in command line
-- parsing and to display the commands list.
--
hledgerAddons :: IO ([String],[String])
-- Canonical addon names are the filenames of hledger-* executables in
-- PATH, without the "hledger-" prefix, and without the file extension
-- except when it's needed for disambiguation (see below).
--
-- When there are exactly two versions of an executable (same base
-- name, different extensions) that look like a source and compiled
-- pair (one has .exe, .com, or no extension), the source version will
-- be excluded (even if it happens to be newer). When there are three
-- or more versions (or two versions that don't look like a
-- source/compiled pair), they are all included, with file extensions
-- intact.
--
hledgerAddons :: IO [String]
hledgerAddons = do
exes <- hledgerExecutablesInPath
let precisenames = concatMap dropRedundant $
groupBy (\a b -> dropExtension a == dropExtension b) $
map stripprefix exes
let displaynames = concatMap stripext $
groupBy (\a b -> dropExtension a == dropExtension b) precisenames
return (precisenames, displaynames)
where
stripprefix = drop (length progname + 1)
stripext [f] = [dropExtension f]
stripext fs = fs
compiledExts = ["",".com",".exe"]
dropRedundant [f,g]
-- past bug generator
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 as3 = sortBy (comparing 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 as5 = concatMap dropRedundantSourceVersion as4 -- ["check","check.hs","check.py","check-dates"]
return as5
stripPrognamePrefix = drop (length progname + 1)
dropRedundantSourceVersion [f,g]
| takeExtension f `elem` compiledExts = [f]
| takeExtension g `elem` compiledExts = [g]
dropRedundant fs = fs
dropRedundantSourceVersion fs = fs
compiledExts = ["",".com",".exe"]
-- | Get the sorted unique filenames of all hledger-* executables in
-- the current user's PATH. Currently these are: files in any of the

View File

@ -233,25 +233,22 @@ main = do
dbgIO "raw args before command" argsbeforecmd
dbgIO "raw args after command" argsaftercmd
-- Search PATH for add-ons, excluding any that match built-in names.
-- The precise addon names (including file extension) are used for command
-- parsing, and the display names are used for displaying the commands list.
(addonPreciseNames', addonDisplayNames') <- hledgerAddons
let addonPreciseNames = filter (not . (`elem` builtinCommandNames) . dropExtension) addonPreciseNames'
let addonDisplayNames = filter (not . (`elem` builtinCommandNames)) addonDisplayNames'
-- Search PATH for add-ons, excluding any that match built-in command names
addonNames' <- hledgerAddons
let addonNames = filter (not . (`elem` builtinCommandNames) . dropExtension) addonNames'
-- parse arguments with cmdargs
opts <- argsToCliOpts args addonPreciseNames
opts <- argsToCliOpts args addonNames
-- select an action and run it.
let
cmd = command_ opts -- the full matched internal or external command name, if any
isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)
isExternalCommand = not (null cmd) && cmd `elem` addonPreciseNames -- probably
isExternalCommand = not (null cmd) && cmd `elem` addonNames -- probably
isBadCommand = not (null rawcmd) && null cmd
hasVersion = ("--version" `elem`)
hasDetailedVersion = ("--version+" `elem`)
printUsage = putStr $ showModeUsage $ mainmode addonDisplayNames
printUsage = putStr $ showModeUsage $ mainmode addonNames
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
hasShortHelpFlag args = any (`elem` args) ["-h"]
hasLongHelpFlag args = any (`elem` args) ["--help"]
@ -279,9 +276,9 @@ main = do
runHledgerCommand
-- high priority flags and situations. -h, then --help, then --info are highest priority.
| hasShortHelpFlag argsbeforecmd = dbgIO "" "-h before command, showing general usage" >> printUsage
| hasLongHelpFlag argsbeforecmd = dbgIO "" "--help before command, showing general manual" >> printHelpForTopic (topicForMode $ mainmode addonDisplayNames)
| hasManFlag argsbeforecmd = dbgIO "" "--man before command, showing general manual with man" >> runManForTopic (topicForMode $ mainmode addonDisplayNames)
| hasInfoFlag argsbeforecmd = dbgIO "" "--info before command, showing general manual with info" >> runInfoForTopic (topicForMode $ mainmode addonDisplayNames)
| hasLongHelpFlag argsbeforecmd = dbgIO "" "--help before command, showing general manual" >> printHelpForTopic (topicForMode $ mainmode addonNames)
| hasManFlag argsbeforecmd = dbgIO "" "--man before command, showing general manual with man" >> runManForTopic (topicForMode $ mainmode addonNames)
| hasInfoFlag argsbeforecmd = dbgIO "" "--info before command, showing general manual with info" >> runInfoForTopic (topicForMode $ mainmode addonNames)
| not (hasSomeHelpFlag argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))
= putStrLn prognameandversion
| not (hasSomeHelpFlag argsaftercmd) && (hasDetailedVersion argsbeforecmd || (hasDetailedVersion argsaftercmd && isInternalCommand))