module B9.Invokation ( B9Invokation()
, invokeB9
, invokeB9_
, overrideWorkingDirectory
, doAfterConfiguration
, overrideB9ConfigPath
, modifyInvokationConfig
, modifyPermanentConfig) where
import B9.B9Config
import Data.ConfigFile.B9Extras
import Control.Monad.IO.Class
import Control.Monad.State
import Control.Monad.Reader
import Control.Lens
import Control.Exception (bracket)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import Data.Semigroup as Sem
import Data.Maybe (fromMaybe)
import Text.Printf ( printf )
newtype B9Invokation a = B9Inv {runB9Invokation :: StateT InternalState IO a}
deriving (MonadState InternalState, Monad, Applicative, Functor, MonadIO)
data InternalState = IS { _initialConfigOverride :: B9ConfigOverride
, _permanentB9ConfigUpdate :: Maybe (ConfigParser -> Either CPError ConfigParser)
, _changeWorkingDirectory :: Maybe FilePath
, _buildAction :: ReaderT B9Config IO Bool
}
makeLenses ''InternalState
initialState :: InternalState
initialState =
IS (B9ConfigOverride Nothing mempty) Nothing Nothing (return True)
invokeB9 :: B9Invokation a -> IO (a, Bool)
invokeB9 act = do
(a, st) <- runStateT (runB9Invokation act) initialState
let cfgPath = st ^. initialConfigOverride . customB9ConfigPath
cp0 <- openOrCreateB9Config cfgPath
let cpExtErr = fmap ($ cp0) (st ^. permanentB9ConfigUpdate)
cpExt <- maybe
(return Nothing)
( either
( fail
. printf "Internal configuration error! Please report this: %s\n"
. show
)
(return . Just)
)
cpExtErr
let cp = fromMaybe cp0 cpExt
mapM_ (writeB9ConfigParser cfgPath) cpExt
case parseB9Config cp of
Left e -> fail (printf "Configuration error: %s\n" (show e))
Right permanentConfig -> do
let runtimeCfg =
permanentConfig
Sem.<> st
^. initialConfigOverride
. customB9Config
completeBuildAction = bracket
getCurrentDirectory
setCurrentDirectory
( const
( do
mapM_ setCurrentDirectory
(st ^. changeWorkingDirectory)
runReaderT (st ^. buildAction) runtimeCfg
)
)
res <- completeBuildAction
return (a, res)
invokeB9_ :: B9Invokation a -> IO Bool
invokeB9_ act = snd <$> invokeB9 act
doAfterConfiguration :: ReaderT B9Config IO Bool -> B9Invokation ()
doAfterConfiguration action = buildAction %= (>> action)
overrideB9ConfigPath :: SystemPath -> B9Invokation ()
overrideB9ConfigPath p = initialConfigOverride . customB9ConfigPath .= Just p
overrideWorkingDirectory :: FilePath -> B9Invokation ()
overrideWorkingDirectory p = changeWorkingDirectory .= Just p
modifyInvokationConfig :: (B9Config -> B9Config) -> B9Invokation ()
modifyInvokationConfig f = initialConfigOverride . customB9Config %= f
modifyPermanentConfig :: (B9Config -> B9Config) -> B9Invokation ()
modifyPermanentConfig g = permanentB9ConfigUpdate %= go
where
go Nothing = go (Just return)
go (Just f) = Just (\cp -> f cp >>= modifyConfigParser g)