module System.JBI
( WrappedTool
, Valid
, defaultTools
, withTool
, chooseTool
, toolName
, infoProjectDir
, Env(..)
, getEnvironment
, ToolEnv(..)
, toolEnv
, Config(..)
, defaultConfig
, Information (..)
, getInformation
, prepare
, targets
, build
, repl
, clean
, test
, bench
, exec
, run
, update
) where
import System.JBI.Commands
import System.JBI.Commands.BuildTool (ToolInformation)
import System.JBI.Commands.Cabal
import System.JBI.Commands.Stack
import System.JBI.Config
import System.JBI.Environment
import Control.Applicative ((<|>))
import Data.Aeson (ToJSON)
import Data.List (find)
import Data.Maybe (catMaybes, listToMaybe)
import Data.Proxy (Proxy(..))
import GHC.Generics (Generic)
import qualified Control.Monad.Parallel as P
defaultTools :: [WrappedTool Proxy]
defaultTools = [ Wrapped (Proxy :: Proxy Stack)
, Wrapped (Proxy :: Proxy (Cabal Nix))
, Wrapped (Proxy :: Proxy (Cabal Sandbox))
]
withTool :: Config -> IO res
-> (Env -> WrappedTool Valid -> IO res)
-> [WrappedTool proxy] -> IO res
withTool cfg onFailure f tools = do
env <- getEnvironment cfg
mtool <- chooseTool env tools
maybe onFailure (f env) mtool
chooseTool :: Env -> [WrappedTool proxy] -> IO (Maybe (WrappedTool Valid))
chooseTool env tools = do
valid <- catMaybes <$> P.mapM (checkValidity env) tools
return (find alreadyUsed valid <|> listToMaybe valid)
data Information = Information
{ environment :: !ToolEnv
, toolDetails :: ![WrappedTool ToolInformation]
} deriving (Show, Generic, ToJSON)
getInformation :: Config -> [WrappedTool proxy] -> IO Information
getInformation cfg tools = do
tenv <- toolEnv cfg
Information tenv <$> mapMer (toolInformation (Env cfg tenv)) tools
where
mapMer | debugMode cfg = mapM
| otherwise = P.mapM
getEnvironment :: Config -> IO Env
getEnvironment cfg = Env cfg <$> toolEnv cfg