module Development.Shake.Plus.Core (
MonadAction(..)
, MonadRules(..)
, UnliftAction(..)
, MonadUnliftAction(..)
, withUnliftAction
, askUnliftAction
, toAction
, RAction
, ShakePlus
, runRAction
, runShakePlus
, Development.Shake.Action
, Development.Shake.Rules
, Development.Shake.FilePattern
, Development.Shake.shake
, Development.Shake.shakeOptions
) where
import Control.Exception
import Development.Shake (Action, FilePattern, Rules, shake,
shakeOptions)
import RIO
class MonadIO m => MonadAction m where
liftAction :: Action a -> m a
instance MonadAction Action where
liftAction = id
instance MonadAction m => MonadAction (ReaderT r m) where
liftAction = lift . liftAction
newtype UnliftAction m = UnliftAction { unliftAction :: forall a. m a -> Action a }
class MonadAction m => MonadUnliftAction m where
{-# INLINE withRunInAction #-}
withRunInAction :: ((forall a. m a -> Action a) -> Action b) -> m b
withRunInAction inner = askUnliftAction >>= \u -> liftAction (inner (unliftAction u))
instance MonadUnliftAction Action where
{-# INLINE withRunInAction #-}
withRunInAction inner = inner id
instance MonadUnliftAction m => MonadUnliftAction (ReaderT r m) where
{-# INLINE withRunInAction #-}
withRunInAction inner =
ReaderT $ \r ->
withRunInAction $ \run ->
inner (run . flip runReaderT r)
class Monad m => MonadRules m where
liftRules :: Rules a -> m a
instance MonadRules Rules where
liftRules = id
instance MonadRules m => MonadRules (ReaderT r m) where
liftRules = lift . liftRules
withUnliftAction :: MonadUnliftAction m => (UnliftAction m -> Action a) -> m a
withUnliftAction inner = askUnliftAction >>= liftAction . inner
askUnliftAction :: MonadUnliftAction m => m (UnliftAction m)
askUnliftAction = withRunInAction (\run -> return (UnliftAction run))
toAction :: MonadUnliftAction m => m a -> m (Action a)
toAction m = withRunInAction $ \run -> return $ run m
newtype RAction r a = RAction (ReaderT r Action a)
deriving (Functor, Applicative, Monad, MonadReader r, MonadIO, MonadAction, MonadUnliftAction, MonadFail)
newtype ShakePlus r a = ShakePlus (ReaderT r Rules a)
deriving (Functor, Applicative, Monad, MonadReader r, MonadIO, MonadRules)
runRAction :: MonadAction m => env -> RAction env a -> m a
runRAction r (RAction (ReaderT f)) = liftAction (f r)
runShakePlus :: MonadRules m => env -> ShakePlus env a -> m a
runShakePlus r (ShakePlus (ReaderT f)) = liftRules (f r)
instance MonadThrow (RAction r) where
throwM = liftIO . Control.Exception.throwIO
instance MonadThrow (ShakePlus r) where
throwM = liftIO . Control.Exception.throwIO