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

cli: be more robust at finding hledger-* add-ons

Browse Source 
Previously executables with eg digits in their name were ignored.
It now finds all files beginning with hledger-, optionally ending with
.hs or .lhs, and with no other dots in the name.
As before, we don't check for executable permission (performance ?).
This commit is contained in:
Simon Michael 2014-02-27 11:40:41 -08:00
parent 8d3161f6d6
commit bab6ec041b
1 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
hledger/Hledger/Cli/Options.hs
View File

@ -554,22 +554,25 @@ getHledgerExesInPath :: IO [String]
getHledgerExesInPath = do getHledgerExesInPath = do
pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH" pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"
pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
let hledgernamed = nub $ sort $ filter isHledgerNamed pathfiles let hledgernamed = nub $ sort $ filter isHledgerExeName pathfiles
-- hledgerexes <- filterM isExecutable hledgernamed -- hledgerexes <- filterM isExecutable hledgernamed
return hledgernamed return hledgernamed
-- isExecutable f = getPermissions f >>= (return . executable) -- isExecutable f = getPermissions f >>= (return . executable)
isHledgerNamed = isRight . parsewith (do isHledgerExeName = isRight . parsewith hledgerexenamep
where
hledgerexenamep = do
string progname string progname
char '-' char '-'
many1 (letter <|> char '-') many1 (noneOf ".")
optional $ (string ".hs" <|> string ".lhs") optional (string ".hs" <|> string ".lhs")
eof eof
)
getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "") getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")
getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return [])
getDirectoryContentsSafe d =
(filter (not . (`elem` [".",".."])) `fmap` getDirectoryContents d) `C.catch` (\(_::C.IOException) -> return [])
-- | Raise an error, showing the specified message plus a hint about --help. -- | Raise an error, showing the specified message plus a hint about --help.
optserror = error' . (++ " (run with --help for usage)") optserror = error' . (++ " (run with --help for usage)")