cli: simplify addons detection, fix deduplication

hledger/Hledger/Cli/CliOptions.hs

@@ -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]
-      | takeExtension f `elem` compiledExts = [f]
-      | takeExtension g `elem` compiledExts = [g]
-    dropRedundant fs = fs
+  -- 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]
+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

hledger/Hledger/Cli/Main.hs

@@ -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))