{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}

module Development.Shake.TH ( checkExecutable
                            , mkVersions
                            , mkExecChecks
                            , commonVersion
                            , MBool
                            ) where

import           Control.Monad.IO.Class
import           Data.Maybe             (isJust)
import           Development.Shake
import           Language.Haskell.TH
import           System.Directory       (findExecutable)

type MBool = forall m. MonadIO m => m Bool

-- | Attempt to get version information from a given exectuable.
commonVersion :: String -- ^ Executable name
              -> Action String
commonVersion :: String -> Action String
commonVersion String
prog = do
    ~(Stdout String
out) <- [CmdOption] -> String -> [String] -> Action (Stdout String)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [CmdOption]
forall a. Monoid a => a
mempty String
prog [String
"--version"]
    String -> Action String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Action String)
-> (String -> String) -> String -> Action String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
last ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Action String) -> String -> Action String
forall a b. (a -> b) -> a -> b
$ String
out

mkSigVersion :: String -> Dec
mkSigVersion :: String -> Dec
mkSigVersion String
s = Name -> Type -> Dec
SigD (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Version") (Name -> Type
ConT ''Action Type -> Type -> Type
`AppT` Name -> Type
ConT ''String)

mkVersion :: String -> Dec
mkVersion :: String -> Dec
mkVersion String
s = Name -> [Clause] -> Dec
FunD (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Version") [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat]
forall a. Monoid a => a
mempty (Exp -> Body
NormalB Exp
expr) [Dec]
forall a. Monoid a => a
mempty]
    where expr :: Exp
expr = Name -> Exp
VarE 'commonVersion Exp -> Exp -> Exp
`AppE` (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
s)

mkVersions :: [String] -> Q [Dec]
mkVersions :: [String] -> Q [Dec]
mkVersions = [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> ([String] -> [Dec]) -> [String] -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [Dec]
g (String -> [Dec]) -> [String] -> [Dec]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
    where g :: String -> [Dec]
g String
s = [String -> Dec
mkVersion String
s, String -> Dec
mkSigVersion String
s]

mkSig :: String -> Dec
mkSig :: String -> Dec
mkSig String
s = Name -> Type -> Dec
SigD (String -> Name
mkName String
s) (Name -> Type
ConT ''MBool)

-- | Check for the presence of some executable.
checkExecutable :: (MonadIO m) => String -> m Bool
checkExecutable :: String -> m Bool
checkExecutable = (Maybe String -> Bool) -> m (Maybe String) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (m (Maybe String) -> m Bool)
-> (String -> m (Maybe String)) -> String -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> (String -> IO (Maybe String)) -> String -> m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
findExecutable

mkExecCheck :: String -> Dec
mkExecCheck :: String -> Dec
mkExecCheck String
s = Name -> [Clause] -> Dec
FunD (String -> Name
mkName String
s) [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat]
forall a. Monoid a => a
mempty (Exp -> Body
NormalB Exp
expr) [Dec]
forall a. Monoid a => a
mempty]
    where expr :: Exp
expr = Name -> Exp
VarE 'checkExecutable Exp -> Exp -> Exp
`AppE` (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
s)

mkExecChecks :: [String] -> Q [Dec]
mkExecChecks :: [String] -> Q [Dec]
mkExecChecks = [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Q [Dec]) -> ([String] -> [Dec]) -> [String] -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [Dec]) -> [String] -> [Dec]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) String -> [Dec]
g
    where g :: String -> [Dec]
g String
s = [String -> Dec
mkExecCheck String
s, String -> Dec
mkSig String
s]