{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances, ConstraintKinds, FlexibleContexts, TemplateHaskell #-}
module HsDev.Database.Update.Types (
Status(..), Progress(..), Task(..),
UpdateOptions(..), updateTasks, updateGhcOpts, updateDocs, updateInfer,
UpdateState(..), updateOptions, updateWorker, withUpdateState, sendUpdateAction,
UpdateM(..), UpdateMonad,
taskName, taskStatus, taskSubjectType, taskSubjectName, taskProgress,
module HsDev.Server.Types
) where
import Control.Applicative
import Control.Lens (makeLenses)
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Fail (MonadFail)
import Control.Monad.Morph
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Trans.Control
import Data.Aeson
import Data.Functor
import Data.Default
import qualified System.Log.Simple as Log
import Control.Concurrent.Worker
import HsDev.Server.Types hiding (Command(..))
import HsDev.Symbols
import HsDev.Types
import HsDev.Util ((.::), logAll)
data Status = StatusWorking | StatusOk | StatusError HsDevError
instance ToJSON Status where
toJSON :: Status -> Value
toJSON Status
StatusWorking = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"working" :: String)
toJSON Status
StatusOk = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"ok" :: String)
toJSON (StatusError HsDevError
e) = HsDevError -> Value
forall a. ToJSON a => a -> Value
toJSON HsDevError
e
instance FromJSON Status where
parseJSON :: Value -> Parser Status
parseJSON Value
v = [Parser Status] -> Parser Status
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Parser Status] -> Parser Status)
-> [Parser Status] -> Parser Status
forall a b. (a -> b) -> a -> b
$ ((Value -> Parser Status) -> Parser Status)
-> [Value -> Parser Status] -> [Parser Status]
forall a b. (a -> b) -> [a] -> [b]
map ((Value -> Parser Status) -> Value -> Parser Status
forall a b. (a -> b) -> a -> b
$ Value
v) [
String -> (Text -> Parser Status) -> Value -> Parser Status
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"status" ((Text -> Parser Status) -> Value -> Parser Status)
-> (Text -> Parser Status) -> Value -> Parser Status
forall a b. (a -> b) -> a -> b
$ \Text
t -> Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"working") Parser () -> Status -> Parser Status
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Status
StatusWorking,
String -> (Text -> Parser Status) -> Value -> Parser Status
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"status" ((Text -> Parser Status) -> Value -> Parser Status)
-> (Text -> Parser Status) -> Value -> Parser Status
forall a b. (a -> b) -> a -> b
$ \Text
t -> Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"ok") Parser () -> Status -> Parser Status
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Status
StatusOk,
(HsDevError -> Status) -> Parser HsDevError -> Parser Status
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HsDevError -> Status
StatusError (Parser HsDevError -> Parser Status)
-> (Value -> Parser HsDevError) -> Value -> Parser Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser HsDevError
forall a. FromJSON a => Value -> Parser a
parseJSON]
data Progress = Progress {
Progress -> Int
progressCurrent :: Int,
Progress -> Int
progressTotal :: Int }
instance ToJSON Progress where
toJSON :: Progress -> Value
toJSON (Progress Int
c Int
t) = [Pair] -> Value
object [
Text
"current" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
c,
Text
"total" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
t]
instance FromJSON Progress where
parseJSON :: Value -> Parser Progress
parseJSON = String -> (Object -> Parser Progress) -> Value -> Parser Progress
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"progress" ((Object -> Parser Progress) -> Value -> Parser Progress)
-> (Object -> Parser Progress) -> Value -> Parser Progress
forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> Int -> Progress
Progress (Int -> Int -> Progress) -> Parser Int -> Parser (Int -> Progress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"current") Parser (Int -> Progress) -> Parser Int -> Parser Progress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"total")
data Task = Task {
Task -> String
_taskName :: String,
Task -> Status
_taskStatus :: Status,
Task -> String
_taskSubjectType :: String,
Task -> String
_taskSubjectName :: String,
Task -> Maybe Progress
_taskProgress :: Maybe Progress }
makeLenses ''Task
instance ToJSON Task where
toJSON :: Task -> Value
toJSON Task
t = [Pair] -> Value
object [
Text
"task" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Task -> String
_taskName Task
t,
Text
"status" Text -> Status -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Task -> Status
_taskStatus Task
t,
Text
"type" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Task -> String
_taskSubjectType Task
t,
Text
"name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Task -> String
_taskSubjectName Task
t,
Text
"progress" Text -> Maybe Progress -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Task -> Maybe Progress
_taskProgress Task
t]
instance FromJSON Task where
parseJSON :: Value -> Parser Task
parseJSON = String -> (Object -> Parser Task) -> Value -> Parser Task
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"task" ((Object -> Parser Task) -> Value -> Parser Task)
-> (Object -> Parser Task) -> Value -> Parser Task
forall a b. (a -> b) -> a -> b
$ \Object
v -> String -> Status -> String -> String -> Maybe Progress -> Task
Task (String -> Status -> String -> String -> Maybe Progress -> Task)
-> Parser String
-> Parser (Status -> String -> String -> Maybe Progress -> Task)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"task") Parser (Status -> String -> String -> Maybe Progress -> Task)
-> Parser Status
-> Parser (String -> String -> Maybe Progress -> Task)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Object
v Object -> Text -> Parser Status
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"status") Parser (String -> String -> Maybe Progress -> Task)
-> Parser String -> Parser (String -> Maybe Progress -> Task)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"type") Parser (String -> Maybe Progress -> Task)
-> Parser String -> Parser (Maybe Progress -> Task)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"name") Parser (Maybe Progress -> Task)
-> Parser (Maybe Progress) -> Parser Task
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Object
v Object -> Text -> Parser (Maybe Progress)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"progress")
data UpdateOptions = UpdateOptions {
UpdateOptions -> [Task]
_updateTasks :: [Task],
UpdateOptions -> [String]
_updateGhcOpts :: [String],
UpdateOptions -> Bool
_updateDocs :: Bool,
UpdateOptions -> Bool
_updateInfer :: Bool }
instance Default UpdateOptions where
def :: UpdateOptions
def = [Task] -> [String] -> Bool -> Bool -> UpdateOptions
UpdateOptions [] [] Bool
False Bool
False
makeLenses ''UpdateOptions
data UpdateState = UpdateState {
UpdateState -> UpdateOptions
_updateOptions :: UpdateOptions,
UpdateState -> Worker (ServerM IO)
_updateWorker :: Worker (ServerM IO) }
makeLenses ''UpdateState
withUpdateState :: SessionMonad m => UpdateOptions -> (UpdateState -> m a) -> m a
withUpdateState :: UpdateOptions -> (UpdateState -> m a) -> m a
withUpdateState UpdateOptions
uopts UpdateState -> m a
fn = do
Session
session <- m Session
forall (m :: * -> *). SessionMonad m => m Session
getSession
m (Worker (ServerM IO))
-> (Worker (ServerM IO) -> m ())
-> (Worker (ServerM IO) -> m a)
-> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO (Worker (ServerM IO)) -> m (Worker (ServerM IO))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Worker (ServerM IO)) -> m (Worker (ServerM IO)))
-> IO (Worker (ServerM IO)) -> m (Worker (ServerM IO))
forall a b. (a -> b) -> a -> b
$ (ServerM IO () -> IO ())
-> (ServerM IO () -> ServerM IO ())
-> (ServerM IO () -> ServerM IO ())
-> IO (Worker (ServerM IO))
forall (m :: * -> *).
MonadIO m =>
(m () -> IO ())
-> (m () -> m ()) -> (m () -> m ()) -> IO (Worker m)
startWorker (Session -> ServerM IO () -> IO ()
forall (m :: * -> *) a. Session -> ServerM m a -> m a
withSession Session
session (ServerM IO () -> IO ())
-> (ServerM IO () -> ServerM IO ()) -> ServerM IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ServerM IO () -> ServerM IO ()
forall (m :: * -> *) a. MonadLog m => Text -> m a -> m a
Log.component Text
"sqlite" (ServerM IO () -> ServerM IO ())
-> (ServerM IO () -> ServerM IO ())
-> ServerM IO ()
-> ServerM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ServerM IO () -> ServerM IO ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
Log.scope Text
"update") ServerM IO () -> ServerM IO ()
forall a. a -> a
id ServerM IO () -> ServerM IO ()
forall (m :: * -> *). (MonadLog m, MonadCatch m) => m () -> m ()
logAll) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (Worker (ServerM IO) -> IO ()) -> Worker (ServerM IO) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Worker (ServerM IO) -> IO ()
forall (m :: * -> *). Worker m -> IO ()
joinWorker) ((Worker (ServerM IO) -> m a) -> m a)
-> (Worker (ServerM IO) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Worker (ServerM IO)
w ->
UpdateState -> m a
fn (UpdateOptions -> Worker (ServerM IO) -> UpdateState
UpdateState UpdateOptions
uopts Worker (ServerM IO)
w)
type UpdateMonad m = (CommandMonad m, MonadReader UpdateState m, MonadWriter [ModuleLocation] m)
sendUpdateAction :: UpdateMonad m => ServerM IO () -> m ()
sendUpdateAction :: ServerM IO () -> m ()
sendUpdateAction ServerM IO ()
act = do
Worker (ServerM IO)
w <- (UpdateState -> Worker (ServerM IO)) -> m (Worker (ServerM IO))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks UpdateState -> Worker (ServerM IO)
_updateWorker
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Worker (ServerM IO) -> ServerM IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
Worker m -> m a -> IO a
inWorker Worker (ServerM IO)
w ServerM IO ()
act
newtype UpdateM m a = UpdateM { UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
runUpdateM :: ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a }
deriving (Functor (UpdateM m)
a -> UpdateM m a
Functor (UpdateM m)
-> (forall a. a -> UpdateM m a)
-> (forall a b. UpdateM m (a -> b) -> UpdateM m a -> UpdateM m b)
-> (forall a b c.
(a -> b -> c) -> UpdateM m a -> UpdateM m b -> UpdateM m c)
-> (forall a b. UpdateM m a -> UpdateM m b -> UpdateM m b)
-> (forall a b. UpdateM m a -> UpdateM m b -> UpdateM m a)
-> Applicative (UpdateM m)
UpdateM m a -> UpdateM m b -> UpdateM m b
UpdateM m a -> UpdateM m b -> UpdateM m a
UpdateM m (a -> b) -> UpdateM m a -> UpdateM m b
(a -> b -> c) -> UpdateM m a -> UpdateM m b -> UpdateM m c
forall a. a -> UpdateM m a
forall a b. UpdateM m a -> UpdateM m b -> UpdateM m a
forall a b. UpdateM m a -> UpdateM m b -> UpdateM m b
forall a b. UpdateM m (a -> b) -> UpdateM m a -> UpdateM m b
forall a b c.
(a -> b -> c) -> UpdateM m a -> UpdateM m b -> UpdateM m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (UpdateM m)
forall (m :: * -> *) a. Applicative m => a -> UpdateM m a
forall (m :: * -> *) a b.
Applicative m =>
UpdateM m a -> UpdateM m b -> UpdateM m a
forall (m :: * -> *) a b.
Applicative m =>
UpdateM m a -> UpdateM m b -> UpdateM m b
forall (m :: * -> *) a b.
Applicative m =>
UpdateM m (a -> b) -> UpdateM m a -> UpdateM m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> UpdateM m a -> UpdateM m b -> UpdateM m c
<* :: UpdateM m a -> UpdateM m b -> UpdateM m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
UpdateM m a -> UpdateM m b -> UpdateM m a
*> :: UpdateM m a -> UpdateM m b -> UpdateM m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
UpdateM m a -> UpdateM m b -> UpdateM m b
liftA2 :: (a -> b -> c) -> UpdateM m a -> UpdateM m b -> UpdateM m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> UpdateM m a -> UpdateM m b -> UpdateM m c
<*> :: UpdateM m (a -> b) -> UpdateM m a -> UpdateM m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
UpdateM m (a -> b) -> UpdateM m a -> UpdateM m b
pure :: a -> UpdateM m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> UpdateM m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (UpdateM m)
Applicative, Applicative (UpdateM m)
UpdateM m a
Applicative (UpdateM m)
-> (forall a. UpdateM m a)
-> (forall a. UpdateM m a -> UpdateM m a -> UpdateM m a)
-> (forall a. UpdateM m a -> UpdateM m [a])
-> (forall a. UpdateM m a -> UpdateM m [a])
-> Alternative (UpdateM m)
UpdateM m a -> UpdateM m a -> UpdateM m a
UpdateM m a -> UpdateM m [a]
UpdateM m a -> UpdateM m [a]
forall a. UpdateM m a
forall a. UpdateM m a -> UpdateM m [a]
forall a. UpdateM m a -> UpdateM m a -> UpdateM m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). Alternative m => Applicative (UpdateM m)
forall (m :: * -> *) a. Alternative m => UpdateM m a
forall (m :: * -> *) a.
Alternative m =>
UpdateM m a -> UpdateM m [a]
forall (m :: * -> *) a.
Alternative m =>
UpdateM m a -> UpdateM m a -> UpdateM m a
many :: UpdateM m a -> UpdateM m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
UpdateM m a -> UpdateM m [a]
some :: UpdateM m a -> UpdateM m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
UpdateM m a -> UpdateM m [a]
<|> :: UpdateM m a -> UpdateM m a -> UpdateM m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
UpdateM m a -> UpdateM m a -> UpdateM m a
empty :: UpdateM m a
$cempty :: forall (m :: * -> *) a. Alternative m => UpdateM m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (UpdateM m)
Alternative, Applicative (UpdateM m)
a -> UpdateM m a
Applicative (UpdateM m)
-> (forall a b. UpdateM m a -> (a -> UpdateM m b) -> UpdateM m b)
-> (forall a b. UpdateM m a -> UpdateM m b -> UpdateM m b)
-> (forall a. a -> UpdateM m a)
-> Monad (UpdateM m)
UpdateM m a -> (a -> UpdateM m b) -> UpdateM m b
UpdateM m a -> UpdateM m b -> UpdateM m b
forall a. a -> UpdateM m a
forall a b. UpdateM m a -> UpdateM m b -> UpdateM m b
forall a b. UpdateM m a -> (a -> UpdateM m b) -> UpdateM m b
forall (m :: * -> *). Monad m => Applicative (UpdateM m)
forall (m :: * -> *) a. Monad m => a -> UpdateM m a
forall (m :: * -> *) a b.
Monad m =>
UpdateM m a -> UpdateM m b -> UpdateM m b
forall (m :: * -> *) a b.
Monad m =>
UpdateM m a -> (a -> UpdateM m b) -> UpdateM m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> UpdateM m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> UpdateM m a
>> :: UpdateM m a -> UpdateM m b -> UpdateM m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
UpdateM m a -> UpdateM m b -> UpdateM m b
>>= :: UpdateM m a -> (a -> UpdateM m b) -> UpdateM m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
UpdateM m a -> (a -> UpdateM m b) -> UpdateM m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (UpdateM m)
Monad, Monad (UpdateM m)
Monad (UpdateM m)
-> (forall a. String -> UpdateM m a) -> MonadFail (UpdateM m)
String -> UpdateM m a
forall a. String -> UpdateM m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (UpdateM m)
forall (m :: * -> *) a. MonadFail m => String -> UpdateM m a
fail :: String -> UpdateM m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> UpdateM m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (UpdateM m)
MonadFail, Monad (UpdateM m)
Alternative (UpdateM m)
UpdateM m a
Alternative (UpdateM m)
-> Monad (UpdateM m)
-> (forall a. UpdateM m a)
-> (forall a. UpdateM m a -> UpdateM m a -> UpdateM m a)
-> MonadPlus (UpdateM m)
UpdateM m a -> UpdateM m a -> UpdateM m a
forall a. UpdateM m a
forall a. UpdateM m a -> UpdateM m a -> UpdateM m a
forall (m :: * -> *). MonadPlus m => Monad (UpdateM m)
forall (m :: * -> *). MonadPlus m => Alternative (UpdateM m)
forall (m :: * -> *) a. MonadPlus m => UpdateM m a
forall (m :: * -> *) a.
MonadPlus m =>
UpdateM m a -> UpdateM m a -> UpdateM m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: UpdateM m a -> UpdateM m a -> UpdateM m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
UpdateM m a -> UpdateM m a -> UpdateM m a
mzero :: UpdateM m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => UpdateM m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (UpdateM m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (UpdateM m)
MonadPlus, Monad (UpdateM m)
Monad (UpdateM m)
-> (forall a. IO a -> UpdateM m a) -> MonadIO (UpdateM m)
IO a -> UpdateM m a
forall a. IO a -> UpdateM m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (UpdateM m)
forall (m :: * -> *) a. MonadIO m => IO a -> UpdateM m a
liftIO :: IO a -> UpdateM m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> UpdateM m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (UpdateM m)
MonadIO, Monad (UpdateM m)
e -> UpdateM m a
Monad (UpdateM m)
-> (forall e a. Exception e => e -> UpdateM m a)
-> MonadThrow (UpdateM m)
forall e a. Exception e => e -> UpdateM m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (UpdateM m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> UpdateM m a
throwM :: e -> UpdateM m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> UpdateM m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (UpdateM m)
MonadThrow, MonadThrow (UpdateM m)
MonadThrow (UpdateM m)
-> (forall e a.
Exception e =>
UpdateM m a -> (e -> UpdateM m a) -> UpdateM m a)
-> MonadCatch (UpdateM m)
UpdateM m a -> (e -> UpdateM m a) -> UpdateM m a
forall e a.
Exception e =>
UpdateM m a -> (e -> UpdateM m a) -> UpdateM m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (UpdateM m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
UpdateM m a -> (e -> UpdateM m a) -> UpdateM m a
catch :: UpdateM m a -> (e -> UpdateM m a) -> UpdateM m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
UpdateM m a -> (e -> UpdateM m a) -> UpdateM m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (UpdateM m)
MonadCatch, MonadCatch (UpdateM m)
MonadCatch (UpdateM m)
-> (forall b.
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b)
-> (forall b.
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b)
-> (forall a b c.
UpdateM m a
-> (a -> ExitCase b -> UpdateM m c)
-> (a -> UpdateM m b)
-> UpdateM m (b, c))
-> MonadMask (UpdateM m)
UpdateM m a
-> (a -> ExitCase b -> UpdateM m c)
-> (a -> UpdateM m b)
-> UpdateM m (b, c)
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
forall b.
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
forall a b c.
UpdateM m a
-> (a -> ExitCase b -> UpdateM m c)
-> (a -> UpdateM m b)
-> UpdateM m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (UpdateM m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
forall (m :: * -> *) a b c.
MonadMask m =>
UpdateM m a
-> (a -> ExitCase b -> UpdateM m c)
-> (a -> UpdateM m b)
-> UpdateM m (b, c)
generalBracket :: UpdateM m a
-> (a -> ExitCase b -> UpdateM m c)
-> (a -> UpdateM m b)
-> UpdateM m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
UpdateM m a
-> (a -> ExitCase b -> UpdateM m c)
-> (a -> UpdateM m b)
-> UpdateM m (b, c)
uninterruptibleMask :: ((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
mask :: ((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. UpdateM m a -> UpdateM m a) -> UpdateM m b)
-> UpdateM m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (UpdateM m)
MonadMask, a -> UpdateM m b -> UpdateM m a
(a -> b) -> UpdateM m a -> UpdateM m b
(forall a b. (a -> b) -> UpdateM m a -> UpdateM m b)
-> (forall a b. a -> UpdateM m b -> UpdateM m a)
-> Functor (UpdateM m)
forall a b. a -> UpdateM m b -> UpdateM m a
forall a b. (a -> b) -> UpdateM m a -> UpdateM m b
forall (m :: * -> *) a b.
Functor m =>
a -> UpdateM m b -> UpdateM m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> UpdateM m a -> UpdateM m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> UpdateM m b -> UpdateM m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> UpdateM m b -> UpdateM m a
fmap :: (a -> b) -> UpdateM m a -> UpdateM m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> UpdateM m a -> UpdateM m b
Functor, MonadReader UpdateState, MonadWriter [ModuleLocation])
instance MonadTrans UpdateM where
lift :: m a -> UpdateM m a
lift = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a)
-> (m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> m a
-> UpdateM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [ModuleLocation] (ClientM m) a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [ModuleLocation] (ClientM m) a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> (m a -> WriterT [ModuleLocation] (ClientM m) a)
-> m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM m a -> WriterT [ModuleLocation] (ClientM m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClientM m a -> WriterT [ModuleLocation] (ClientM m) a)
-> (m a -> ClientM m a)
-> m a
-> WriterT [ModuleLocation] (ClientM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ClientM m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (MonadIO m, MonadMask m) => Log.MonadLog (UpdateM m) where
askLog :: UpdateM m Log
askLog = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Log
-> UpdateM m Log
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Log
-> UpdateM m Log)
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Log
-> UpdateM m Log
forall a b. (a -> b) -> a -> b
$ WriterT [ModuleLocation] (ClientM m) Log
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Log
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [ModuleLocation] (ClientM m) Log
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Log)
-> WriterT [ModuleLocation] (ClientM m) Log
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Log
forall a b. (a -> b) -> a -> b
$ ClientM m Log -> WriterT [ModuleLocation] (ClientM m) Log
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ClientM m Log
forall (m :: * -> *). MonadLog m => m Log
Log.askLog
localLog :: (Log -> Log) -> UpdateM m a -> UpdateM m a
localLog Log -> Log
fn = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a)
-> (UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> UpdateM m a
-> UpdateM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
WriterT [ModuleLocation] (ClientM m) a
-> WriterT [ModuleLocation] (ClientM m) a)
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. ClientM m a -> ClientM m a)
-> WriterT [ModuleLocation] (ClientM m) a
-> WriterT [ModuleLocation] (ClientM m) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((Log -> Log) -> ClientM m a -> ClientM m a
forall (m :: * -> *) a. MonadLog m => (Log -> Log) -> m a -> m a
Log.localLog Log -> Log
fn)) (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> (UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall (m :: * -> *) a.
UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
runUpdateM
instance ServerMonadBase m => SessionMonad (UpdateM m) where
getSession :: UpdateM m Session
getSession = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Session
-> UpdateM m Session
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) Session
-> UpdateM m Session)
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) Session
-> UpdateM m Session
forall a b. (a -> b) -> a -> b
$ WriterT [ModuleLocation] (ClientM m) Session
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) Session
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [ModuleLocation] (ClientM m) Session
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) Session)
-> WriterT [ModuleLocation] (ClientM m) Session
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) Session
forall a b. (a -> b) -> a -> b
$ ClientM m Session -> WriterT [ModuleLocation] (ClientM m) Session
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ClientM m Session
forall (m :: * -> *). SessionMonad m => m Session
getSession
localSession :: (Session -> Session) -> UpdateM m a -> UpdateM m a
localSession Session -> Session
fn = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a)
-> (UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> UpdateM m a
-> UpdateM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
WriterT [ModuleLocation] (ClientM m) a
-> WriterT [ModuleLocation] (ClientM m) a)
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. ClientM m a -> ClientM m a)
-> WriterT [ModuleLocation] (ClientM m) a
-> WriterT [ModuleLocation] (ClientM m) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((Session -> Session) -> ClientM m a -> ClientM m a
forall (m :: * -> *) a.
SessionMonad m =>
(Session -> Session) -> m a -> m a
localSession Session -> Session
fn)) (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> (UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall (m :: * -> *) a.
UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
runUpdateM
instance ServerMonadBase m => CommandMonad (UpdateM m) where
getOptions :: UpdateM m CommandOptions
getOptions = ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) CommandOptions
-> UpdateM m CommandOptions
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) CommandOptions
-> UpdateM m CommandOptions)
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) CommandOptions
-> UpdateM m CommandOptions
forall a b. (a -> b) -> a -> b
$ WriterT [ModuleLocation] (ClientM m) CommandOptions
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) CommandOptions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [ModuleLocation] (ClientM m) CommandOptions
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) CommandOptions)
-> WriterT [ModuleLocation] (ClientM m) CommandOptions
-> ReaderT
UpdateState (WriterT [ModuleLocation] (ClientM m)) CommandOptions
forall a b. (a -> b) -> a -> b
$ ClientM m CommandOptions
-> WriterT [ModuleLocation] (ClientM m) CommandOptions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ClientM m CommandOptions
forall (m :: * -> *). CommandMonad m => m CommandOptions
getOptions
instance MonadBase b m => MonadBase b (UpdateM m) where
liftBase :: b α -> UpdateM m α
liftBase = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) α
-> UpdateM m α
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) α
-> UpdateM m α)
-> (b α
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) α)
-> b α
-> UpdateM m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance MonadBaseControl b m => MonadBaseControl b (UpdateM m) where
type StM (UpdateM m) a = StM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m))) a
liftBaseWith :: (RunInBase (UpdateM m) b -> b a) -> UpdateM m a
liftBaseWith RunInBase (UpdateM m) b -> b a
f = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a)
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
forall a b. (a -> b) -> a -> b
$ (RunInBase
(ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m))) b
-> b a)
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase
(ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m))) b
f' -> RunInBase (UpdateM m) b -> b a
f (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> b (StM m (a, [ModuleLocation]))
RunInBase
(ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m))) b
f' (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> b (StM m (a, [ModuleLocation])))
-> (UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> UpdateM m a
-> b (StM m (a, [ModuleLocation]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall (m :: * -> *) a.
UpdateM m a
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
runUpdateM))
restoreM :: StM (UpdateM m) a -> UpdateM m a
restoreM = ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
forall (m :: * -> *) a.
ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a
UpdateM (ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
-> UpdateM m a)
-> (StM m (a, [ModuleLocation])
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a)
-> StM m (a, [ModuleLocation])
-> UpdateM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m (a, [ModuleLocation])
-> ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM