cli: be more robust at finding hledger-* add-ons
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:
		
							parent
							
								
									8d3161f6d6
								
							
						
					
					
						commit
						bab6ec041b
					
				@ -554,22 +554,25 @@ getHledgerExesInPath :: IO [String]
 | 
			
		||||
getHledgerExesInPath = do
 | 
			
		||||
  pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"
 | 
			
		||||
  pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
 | 
			
		||||
  let hledgernamed = nub $ sort $ filter isHledgerNamed pathfiles
 | 
			
		||||
  let hledgernamed = nub $ sort $ filter isHledgerExeName pathfiles
 | 
			
		||||
  -- hledgerexes <- filterM isExecutable hledgernamed
 | 
			
		||||
  return hledgernamed
 | 
			
		||||
 | 
			
		||||
-- isExecutable f = getPermissions f >>= (return . executable)
 | 
			
		||||
 | 
			
		||||
isHledgerNamed = isRight . parsewith (do
 | 
			
		||||
isHledgerExeName = isRight . parsewith hledgerexenamep
 | 
			
		||||
    where
 | 
			
		||||
      hledgerexenamep = do
 | 
			
		||||
        string progname
 | 
			
		||||
        char '-'
 | 
			
		||||
        many1 (letter <|> char '-')
 | 
			
		||||
        optional $ (string ".hs" <|> string ".lhs")
 | 
			
		||||
        many1 (noneOf ".")
 | 
			
		||||
        optional (string ".hs" <|> string ".lhs")
 | 
			
		||||
        eof
 | 
			
		||||
        )
 | 
			
		||||
 | 
			
		||||
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.
 | 
			
		||||
optserror = error' . (++ " (run with --help for usage)")
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user