Skip to content

Commit bc98de1

Browse files
committed
remote: drop MonadRemote* store aliases
1 parent 217ea1b commit bc98de1

File tree

5 files changed

+150
-73
lines changed

5 files changed

+150
-73
lines changed

hnix-store-remote/src/System/Nix/Store/Remote.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ import qualified System.Nix.Hash
7272
import qualified System.Nix.Signature
7373
import qualified System.Nix.StorePath
7474

75-
import System.Nix.Store.Remote.MonadStore (MonadRemoteStore, getStoreDir, RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
75+
import System.Nix.Store.Remote.MonadStore (RemoteStoreT, getStoreDir, RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
7676
import System.Nix.Store.Remote.Client (Run, runStoreSocket, runOp, runOpArgs, runOpArgsIO, simpleOp, simpleOpArgs)
7777
import System.Nix.Store.Remote.Socket
7878
import System.Nix.Store.Remote.Types
@@ -83,11 +83,11 @@ import System.Nix.Store.Remote.Serialize.Prim
8383

8484
-- * Compat
8585

86-
type MonadStore = MonadRemoteStore
86+
type MonadStore = RemoteStoreT StoreConfig IO
8787

8888
-- * Runners
8989

90-
runStore :: MonadStore a -> Run a
90+
runStore :: MonadStore a -> Run IO a
9191
runStore = runStoreOpts defaultSockPath def
9292
where
9393
defaultSockPath :: String
@@ -97,7 +97,7 @@ runStoreOpts
9797
:: FilePath
9898
-> StoreDir
9999
-> MonadStore a
100-
-> Run a
100+
-> Run IO a
101101
runStoreOpts socketPath =
102102
runStoreOpts'
103103
Network.Socket.AF_UNIX
@@ -108,7 +108,7 @@ runStoreOptsTCP
108108
-> Int
109109
-> StoreDir
110110
-> MonadStore a
111-
-> Run a
111+
-> Run IO a
112112
runStoreOptsTCP host port sd code = do
113113
Network.Socket.getAddrInfo
114114
(Just Network.Socket.defaultHints)
@@ -128,7 +128,7 @@ runStoreOpts'
128128
-> SockAddr
129129
-> StoreDir
130130
-> MonadStore a
131-
-> Run a
131+
-> Run IO a
132132
runStoreOpts' sockFamily sockAddr storeRootDir code =
133133
Control.Exception.bracket
134134
open

hnix-store-remote/src/System/Nix/Store/Remote/Client.hs

Lines changed: 57 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ module System.Nix.Store.Remote.Client
1313

1414
import Control.Monad (unless, when)
1515
import Control.Monad.Except (throwError)
16-
import Control.Monad.IO.Class (liftIO)
16+
import Control.Monad.IO.Class (MonadIO, liftIO)
1717
import Data.Serialize.Put (Put, runPut)
1818

1919
import qualified Data.Bool
@@ -26,17 +26,30 @@ import System.Nix.Store.Remote.Socket (sockPutS, sockGetS)
2626
import System.Nix.Store.Remote.Serializer (bool, enum, int, mapErrorS, protoVersion, text, trustedFlag, workerMagic)
2727
import System.Nix.Store.Remote.Types.Handshake (Handshake(..))
2828
import System.Nix.Store.Remote.Types.Logger (Logger)
29-
import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..), ourProtoVersion)
30-
import System.Nix.Store.Remote.Types.StoreConfig (PreStoreConfig, preStoreConfigToStoreConfig)
29+
import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion, ProtoVersion(..), ourProtoVersion)
30+
import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket, PreStoreConfig, StoreConfig, preStoreConfigToStoreConfig)
3131
import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
3232
import System.Nix.Store.Remote.Types.WorkerOp (WorkerOp)
3333

34-
type Run a = IO (Either RemoteStoreError a, [Logger])
35-
36-
simpleOp :: WorkerOp -> MonadRemoteStore Bool
34+
simpleOp
35+
:: ( Monad m
36+
, MonadIO m
37+
, HasProtoVersion r
38+
, HasStoreSocket r
39+
)
40+
=> WorkerOp
41+
-> RemoteStoreT r m Bool
3742
simpleOp op = simpleOpArgs op $ pure ()
3843

39-
simpleOpArgs :: WorkerOp -> Put -> MonadRemoteStore Bool
44+
simpleOpArgs
45+
:: ( Monad m
46+
, MonadIO m
47+
, HasProtoVersion r
48+
, HasStoreSocket r
49+
)
50+
=> WorkerOp
51+
-> Put
52+
-> RemoteStoreT r m Bool
4053
simpleOpArgs op args = do
4154
runOpArgs op args
4255
err <- gotError
@@ -48,21 +61,41 @@ simpleOpArgs op args = do
4861
)
4962
err
5063

51-
runOp :: WorkerOp -> MonadRemoteStore ()
64+
runOp
65+
:: ( Monad m
66+
, MonadIO m
67+
, HasProtoVersion r
68+
, HasStoreSocket r
69+
)
70+
=> WorkerOp
71+
-> RemoteStoreT r m ()
5272
runOp op = runOpArgs op $ pure ()
5373

54-
runOpArgs :: WorkerOp -> Put -> MonadRemoteStore ()
74+
runOpArgs
75+
:: ( Monad m
76+
, MonadIO m
77+
, HasProtoVersion r
78+
, HasStoreSocket r
79+
)
80+
=> WorkerOp
81+
-> Put
82+
-> RemoteStoreT r m ()
5583
runOpArgs op args =
5684
runOpArgsIO
5785
op
5886
(\encode -> encode $ runPut args)
5987

6088
runOpArgsIO
61-
:: WorkerOp
62-
-> ((Data.ByteString.ByteString -> MonadRemoteStore ())
63-
-> MonadRemoteStore ()
89+
:: ( Monad m
90+
, MonadIO m
91+
, HasProtoVersion r
92+
, HasStoreSocket r
93+
)
94+
=> WorkerOp
95+
-> ((Data.ByteString.ByteString -> RemoteStoreT r m ())
96+
-> RemoteStoreT r m ()
6497
)
65-
-> MonadRemoteStore ()
98+
-> RemoteStoreT r m ()
6699
runOpArgsIO op encoder = do
67100
sockPutS (mapErrorS RemoteStoreError_SerializerPut enum) op
68101

@@ -76,10 +109,15 @@ runOpArgsIO op encoder = do
76109
-- TODO: don't use show
77110
getErrors >>= throwError . RemoteStoreError_Fixme . show
78111

112+
type Run m a = m (Either RemoteStoreError a, [Logger])
113+
79114
runStoreSocket
80-
:: PreStoreConfig
81-
-> MonadRemoteStore a
82-
-> Run a
115+
:: ( Monad m
116+
, MonadIO m
117+
)
118+
=> PreStoreConfig
119+
-> RemoteStoreT StoreConfig m a
120+
-> Run m a
83121
runStoreSocket preStoreConfig code =
84122
runRemoteStoreT preStoreConfig $ do
85123
Handshake{..} <- greet
@@ -88,7 +126,9 @@ runStoreSocket preStoreConfig code =
88126
code
89127

90128
where
91-
greet :: MonadRemoteStoreHandshake Handshake
129+
greet
130+
:: MonadIO m
131+
=> RemoteStoreT PreStoreConfig m Handshake
92132
greet = do
93133

94134
sockPutS

hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,12 +3,13 @@ module System.Nix.Store.Remote.Logger
33
) where
44

55
import Control.Monad.Except (throwError)
6+
import Control.Monad.IO.Class (MonadIO)
67
import Data.ByteString (ByteString)
78
import Data.Serialize (Result(..))
89
import System.Nix.Store.Remote.Serialize.Prim (putByteString)
910
import System.Nix.Store.Remote.Serializer (LoggerSError, logger, runSerialT)
1011
import System.Nix.Store.Remote.Socket (sockGet8, sockPut)
11-
import System.Nix.Store.Remote.MonadStore (MonadRemoteStore0, RemoteStoreError(..), clearData, getData, getProtoVersion)
12+
import System.Nix.Store.Remote.MonadStore (RemoteStoreT, RemoteStoreError(..), clearData, getData, getProtoVersion)
1213
import System.Nix.Store.Remote.Types.Logger (Logger(..))
1314
import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
1415
import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..))
@@ -18,10 +19,12 @@ import qualified Data.Serialize.Get
1819
import qualified Data.Serializer
1920

2021
processOutput
21-
:: ( HasProtoVersion r
22+
:: ( Monad m
23+
, MonadIO m
24+
, HasProtoVersion r
2225
, HasStoreSocket r
2326
)
24-
=> MonadRemoteStore0 r [Logger]
27+
=> RemoteStoreT r m [Logger]
2528
processOutput = do
2629
protoVersion <- getProtoVersion
2730
sockGet8 >>= go . (decoder protoVersion)
@@ -35,11 +38,13 @@ processOutput = do
3538
(runSerialT protoVersion $ Data.Serializer.getS logger)
3639

3740
go
38-
:: ( HasProtoVersion r
41+
:: ( Monad m
42+
, MonadIO m
43+
, HasProtoVersion r
3944
, HasStoreSocket r
4045
)
4146
=> Result (Either LoggerSError Logger)
42-
-> MonadRemoteStore0 r [Logger]
47+
-> RemoteStoreT r m [Logger]
4348
go (Done ectrl leftover) = do
4449

4550
Control.Monad.unless (leftover == mempty) $

hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs

Lines changed: 25 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,6 @@ module System.Nix.Store.Remote.MonadStore
77
, RemoteStoreT
88
, runRemoteStoreT
99
, mapStoreConfig
10-
, MonadRemoteStore0
11-
, MonadRemoteStore
12-
, MonadRemoteStoreHandshake
1310
-- * Reader helpers
1411
, getStoreDir
1512
, getStoreSocket
@@ -41,7 +38,7 @@ import System.Nix.StorePath (HasStoreDir(..), StoreDir)
4138
import System.Nix.Store.Remote.Serializer (HandshakeSError, LoggerSError, SError)
4239
import System.Nix.Store.Remote.Types.Logger (Logger, isError)
4340
import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
44-
import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), PreStoreConfig, StoreConfig)
41+
import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..))
4542

4643
data RemoteStoreState = RemoteStoreState {
4744
remoteStoreState_logs :: [Logger]
@@ -111,15 +108,9 @@ runRemoteStoreT r =
111108
, remoteStoreState_mData = Nothing
112109
}
113110

114-
type MonadRemoteStore0 r = RemoteStoreT r IO
115-
116-
type MonadRemoteStore = MonadRemoteStore0 StoreConfig
117-
118-
type MonadRemoteStoreHandshake = MonadRemoteStore0 PreStoreConfig
119-
120111
mapStoreConfig
121112
:: (rb -> ra)
122-
-> (MonadRemoteStore0 ra a -> MonadRemoteStore0 rb a)
113+
-> (RemoteStoreT ra m a -> RemoteStoreT rb m a)
123114
mapStoreConfig f =
124115
RemoteStoreT
125116
. ( mapExceptT
@@ -129,43 +120,55 @@ mapStoreConfig f =
129120
. _unRemoteStoreT
130121

131122
-- | Ask for a @StoreDir@
132-
getStoreDir :: HasStoreDir r => MonadRemoteStore0 r StoreDir
123+
getStoreDir
124+
:: ( Monad m
125+
, HasStoreDir r
126+
)
127+
=> RemoteStoreT r m StoreDir
133128
getStoreDir = hasStoreDir <$> RemoteStoreT ask
134129

135130
-- | Ask for a @StoreDir@
136-
getStoreSocket :: HasStoreSocket r => MonadRemoteStore0 r Socket
131+
getStoreSocket
132+
:: ( Monad m
133+
, HasStoreSocket r
134+
)
135+
=> RemoteStoreT r m Socket
137136
getStoreSocket = hasStoreSocket <$> RemoteStoreT ask
138137

139138
-- | Ask for a @StoreDir@
140-
getProtoVersion :: HasProtoVersion r => MonadRemoteStore0 r ProtoVersion
139+
getProtoVersion
140+
:: ( Monad m
141+
, HasProtoVersion r
142+
)
143+
=> RemoteStoreT r m ProtoVersion
141144
getProtoVersion = hasProtoVersion <$> RemoteStoreT ask
142145

143146
-- * Logs
144147

145-
gotError :: MonadRemoteStore0 r Bool
148+
gotError :: Monad m => RemoteStoreT r m Bool
146149
gotError = any isError <$> getLogs
147150

148-
getErrors :: MonadRemoteStore0 r [Logger]
151+
getErrors :: Monad m => RemoteStoreT r m [Logger]
149152
getErrors = filter isError <$> getLogs
150153

151-
appendLogs :: [Logger] -> MonadRemoteStore0 r ()
154+
appendLogs :: Monad m => [Logger] -> RemoteStoreT r m ()
152155
appendLogs x = RemoteStoreT
153156
$ modify
154157
$ \s -> s { remoteStoreState_logs = remoteStoreState_logs s <> x }
155158

156-
getLogs :: MonadRemoteStore0 r [Logger]
159+
getLogs :: Monad m => RemoteStoreT r m [Logger]
157160
getLogs = remoteStoreState_logs <$> RemoteStoreT get
158161

159-
flushLogs :: MonadRemoteStore0 r ()
162+
flushLogs :: Monad m => RemoteStoreT r m ()
160163
flushLogs = RemoteStoreT $ modify $ \s -> s { remoteStoreState_logs = mempty }
161164

162165
-- * Data required from client
163166

164-
getData :: MonadRemoteStore0 r (Maybe ByteString)
167+
getData :: Monad m => RemoteStoreT r m (Maybe ByteString)
165168
getData = remoteStoreState_mData <$> RemoteStoreT get
166169

167-
setData :: ByteString -> MonadRemoteStore0 r ()
170+
setData :: Monad m => ByteString -> RemoteStoreT r m ()
168171
setData x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mData = pure x }
169172

170-
clearData :: MonadRemoteStore0 r ()
173+
clearData :: Monad m => RemoteStoreT r m ()
171174
clearData = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mData = Nothing }

0 commit comments

Comments
 (0)