module Data.Conduit.Shell.TH
(generateBinaries)
where
import Data.Conduit.Shell.Variadic
import Control.Arrow
import Control.Monad
import Data.Char
import Data.Function
import Data.List
import Data.List.Split
import Language.Haskell.TH
import System.Directory
import System.Environment
import System.FilePath
generateBinaries :: Q [Dec]
generateBinaries =
do bins <- runIO getAllBinaries
mapM (\(name,bin) ->
do uniqueName <- getUniqueName name
return (FunD uniqueName
[Clause []
(NormalB (AppE (VarE 'variadicProcess)
(LitE (StringL bin))))
[]]))
(nubBy (on (==) fst)
(filter (not . null . fst)
(map (normalize &&& id) bins)))
where normalize = uncapitalize . go
where go (c:cs)
| c == '-' || c == '_' =
case go cs of
(z:zs) -> toUpper z : zs
[] -> []
| not (elem (toLower c) allowed) = go cs
| otherwise = c : go cs
go [] = []
uncapitalize (c:cs)
| isDigit c = '_' : c : cs
| otherwise = toLower c : cs
uncapitalize [] = []
allowed =
['a' .. 'z'] ++
['0' .. '9']
getUniqueName :: String -> Q Name
getUniqueName candidate =
do inScope <- recover (return False)
(do void (reify (mkName candidate))
return True)
if inScope
then getUniqueName (candidate ++ "'")
else return (mkName candidate)
getAllBinaries :: IO [FilePath]
getAllBinaries =
do path <- getEnv "PATH"
fmap concat
(forM (splitOn ":" path)
(\dir ->
do exists <- doesDirectoryExist dir
if exists
then do contents <- getDirectoryContents dir
filterM (\file ->
do exists' <- doesFileExist (dir </> file)
if exists'
then do perms <- getPermissions (dir </> file)
return (executable perms)
else return False)
contents
else return []))