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
return (map (\(name,bin) ->
FunD (mkName name)
[Clause []
(NormalB (AppE (VarE 'variadicProcess)
(LitE (StringL bin))))
[]])
(nubBy (on (==) fst)
(filter (not . null . fst)
(map (normalize &&& id) bins))))
where normalize = remap . 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']
remap :: [Char] -> [Char]
remap name =
case name of
"head" -> "head'"
"seq" -> "seq'"
"zip" -> "zip'"
"print" -> "print'"
"id" -> "id'"
"unzip" -> "unzip'"
"join" -> "join'"
"init" -> "init'"
"last" -> "last'"
"tail" -> "tail'"
"find" -> "find'"
"sort" -> "sort'"
"sum" -> "sum'"
"compare" -> "compare'"
"truncate" -> "truncate'"
"lex" -> "lex'"
"env" -> "env'"
e -> e
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 []))