    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE QuasiQuotes #-}

    -- | Generate top-level names for binaries.

    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

    -- | Generate top-level names for all binaries in PATH.
    generateBinaries :: Q [Dec]
    generateBinaries :: Q [Dec]
    generateBinaries =
      do bins <- IO [String] -> Q [String]
    forall a. IO a -> Q a
    runIO IO [String]
    getAllBinaries
         mapM (\(String
    name,String
    bin) ->
                 do uniqueName <- String -> Q Name
    getUniqueName String
    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 :: String -> String
    normalize = String -> String
    uncapitalize (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    go
              where go :: String -> String
    go (Char
    c:String
    cs)
                      | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_' =
                        case String -> String
    go String
    cs of
                          (Char
    z:String
    zs) -> Char -> Char
    toUpper Char
    z Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    zs
                          [] -> []
                      | Bool -> Bool
    not (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem (Char -> Char
    toLower Char
    c) String
    allowed) = String -> String
    go String
    cs
                      | Bool
    otherwise = Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    go String
    cs
                    go [] = []
            uncapitalize :: String -> String
    uncapitalize (Char
    c:String
    cs)
              | Char -> Bool
    isDigit Char
    c = Char
    '_' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    cs
              | Bool
    otherwise = Char -> Char
    toLower Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    cs
            uncapitalize [] = []
            allowed :: String
    allowed =
              [Char
    'a' .. Char
    'z'] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
              [Char
    '0' .. Char
    '9']

    -- | Get a version of the given name available to be bound.
    getUniqueName :: String -> Q Name
    getUniqueName :: String -> Q Name
    getUniqueName String
    candidate =
      do inScope <- Q Bool -> Q Bool -> Q Bool
    forall a. Q a -> Q a -> Q a
    recover (Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False)
                            (do Q Info -> Q ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Name -> Q Info
    reify (String -> Name
    mkName String
    candidate))
                                Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True)
         if inScope || candidate `elem` disallowedNames
            then getUniqueName (candidate ++ "'")
            else return (mkName candidate)
      where
        disallowedNames :: [String]
    disallowedNames = [
          String
    "class",
          String
    "data",
          String
    "do",
          String
    "import",
          String
    "type"
          ]

    -- | Get a list of all binaries in PATH.
    getAllBinaries :: IO [FilePath]
    getAllBinaries :: IO [String]
    getAllBinaries =
      do path <- String -> IO String
    getEnv String
    "PATH"
         fmap concat
              (forM (splitOn ":" path)
                    (\String
    dir ->
                       do exists <- String -> IO Bool
    doesDirectoryExist String
    dir
                          if exists
                             then do contents <- getDirectoryContents dir
                                     filterM (\String
    file ->
                                                do exists' <- String -> IO Bool
    doesFileExist (String
    dir String -> String -> String
    </> String
    file)
                                                   if exists'
                                                      then do perms <- getPermissions (dir </> file)
                                                              return (executable perms)
                                                      else return False)
                                             contents
                             else return []))