{-# 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)
	-- where
	-- 	enterTransaction act = do
	-- 		Log.sendLog Log.Trace "entering sqlite transaction"
	-- 		timer "closed transaction" $ transaction_ Immediate $ do
	-- 			Log.sendLog Log.Debug "updating sql database"
	-- 			_ <- act
	-- 			Log.sendLog Log.Debug "sql database updated"

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