git.iko.soy/distributed-process
on master help sign in
Replace data-lens with data-accessor
8ce2437Edsko de Vries
network-transport-2/network-transport.cabal+4−4
compare with master
unifiedsplit
@@ -11,7 +11,7 @@ Library
11 Build-Depends: base,
11 Build-Depends: base,
12 bytestring,
12 bytestring,
13 containers,
13 containers,
14− data-lens,
14+ data-accessor,
15 network,
15 network,
16 mtl,
16 mtl,
17 transformers
17 transformers
@@ -29,7 +29,7 @@ Test-Suite TestTCP
29 Build-Depends: base,
29 Build-Depends: base,
30 containers,
30 containers,
31 bytestring,
31 bytestring,
32− data-lens,
32+ data-accessor,
33 network,
33 network,
34 mtl,
34 mtl,
35 transformers,
35 transformers,
@@ -44,7 +44,7 @@ Test-Suite TestMulticastInMemory
44 Build-Depends: base,
44 Build-Depends: base,
45 containers,
45 containers,
46 bytestring,
46 bytestring,
47− data-lens,
47+ data-accessor,
48 mtl,
48 mtl,
49 transformers,
49 transformers,
50 ansi-terminal
50 ansi-terminal
@@ -58,7 +58,7 @@ Test-Suite TestInMemory
58 Build-Depends: base,
58 Build-Depends: base,
59 containers,
59 containers,
60 bytestring,
60 bytestring,
61− data-lens,
61+ data-accessor,
62 mtl,
62 mtl,
63 transformers,
63 transformers,
64 ansi-terminal
64 ansi-terminal
network-transport-2/src/Network/Transport/Chan.hs+16−15
@@ -11,7 +11,8 @@ import Data.Map (Map)
11import qualified Data.Map as Map (empty, insert, size, delete, findWithDefault)
11import qualified Data.Map as Map (empty, insert, size, delete, findWithDefault)
12import Data.ByteString (ByteString)
12import Data.ByteString (ByteString)
13import qualified Data.ByteString.Char8 as BSC (pack)
13import qualified Data.ByteString.Char8 as BSC (pack)
14−import Data.Lens.Lazy (Lens, lens, (^.), (^%=), (^=), (^+=), mapLens)
14+import Data.Accessor (Accessor, accessor, (^.), (^=), (^:))
15+import qualified Data.Accessor.Container as DAC (mapMaybe)
15
16
16-- Global state: next available "address", mapping from addresses to channels and next available connection
17-- Global state: next available "address", mapping from addresses to channels and next available connection
17data TransportState = State { _channels :: Map EndPointAddress (Chan Event)
18data TransportState = State { _channels :: Map EndPointAddress (Chan Event)
@@ -19,25 +20,25 @@ data TransportState = State { _channels :: Map EndPointAddress (Chan Eve
19 , _multigroups :: Map MulticastAddress (MVar [Chan Event])
20 , _multigroups :: Map MulticastAddress (MVar [Chan Event])
20 }
21 }
21
22
22−channels :: Lens TransportState (Map EndPointAddress (Chan Event))
23+channels :: Accessor TransportState (Map EndPointAddress (Chan Event))
23−channels = lens _channels (\ch st -> st { _channels = ch })
24+channels = accessor _channels (\ch st -> st { _channels = ch })
24
25
25−nextConnectionId :: Lens TransportState (Map EndPointAddress ConnectionId)
26+nextConnectionId :: Accessor TransportState (Map EndPointAddress ConnectionId)
26−nextConnectionId = lens _nextConnectionId (\cid st -> st { _nextConnectionId = cid })
27+nextConnectionId = accessor _nextConnectionId (\cid st -> st { _nextConnectionId = cid })
27
28
28−multigroups :: Lens TransportState (Map MulticastAddress (MVar [Chan Event]))
29+multigroups :: Accessor TransportState (Map MulticastAddress (MVar [Chan Event]))
29−multigroups = lens _multigroups (\gs st -> st { _multigroups = gs })
30+multigroups = accessor _multigroups (\gs st -> st { _multigroups = gs })
30
31
31−at :: Ord k => k -> String -> Lens (Map k v) v
32+at :: Ord k => k -> String -> Accessor (Map k v) v
32−at k err = lens (Map.findWithDefault (error err) k) (Map.insert k)
33+at k err = accessor (Map.findWithDefault (error err) k) (Map.insert k)
33
34
34−channelAt :: EndPointAddress -> Lens TransportState (Chan Event)
35+channelAt :: EndPointAddress -> Accessor TransportState (Chan Event)
35channelAt addr = channels >>> at addr "Invalid channel"
36channelAt addr = channels >>> at addr "Invalid channel"
36
37
37−nextConnectionIdAt :: EndPointAddress -> Lens TransportState ConnectionId
38+nextConnectionIdAt :: EndPointAddress -> Accessor TransportState ConnectionId
38nextConnectionIdAt addr = nextConnectionId >>> at addr "Invalid connection ID"
39nextConnectionIdAt addr = nextConnectionId >>> at addr "Invalid connection ID"
39
40
40−multigroupAt :: MulticastAddress -> Lens TransportState (MVar [Chan Event])
41+multigroupAt :: MulticastAddress -> Accessor TransportState (MVar [Chan Event])
41multigroupAt addr = multigroups >>> at addr "Invalid multigroup"
42multigroupAt addr = multigroups >>> at addr "Invalid multigroup"
42
43
43-- | Create a new Transport.
44-- | Create a new Transport.
@@ -72,7 +73,7 @@ apiConnect myAddress state theirAddress _ = do
72 (chan, conn) <- modifyMVar state $ \st -> do
73 (chan, conn) <- modifyMVar state $ \st -> do
73 let chan = st ^. channelAt theirAddress
74 let chan = st ^. channelAt theirAddress
74 let conn = st ^. nextConnectionIdAt theirAddress
75 let conn = st ^. nextConnectionIdAt theirAddress
75− return (nextConnectionIdAt theirAddress ^+= 1 $ st, (chan, conn))
76+ return (nextConnectionIdAt theirAddress ^: (+ 1) $ st, (chan, conn))
76 writeChan chan $ ConnectionOpened conn ReliableOrdered myAddress
77 writeChan chan $ ConnectionOpened conn ReliableOrdered myAddress
77 connAlive <- newMVar True
78 connAlive <- newMVar True
78 return . Right $ Connection { send = apiSend chan conn connAlive
79 return . Right $ Connection { send = apiSend chan conn connAlive
@@ -117,7 +118,7 @@ apiNewMulticastGroup state endpoint = do
117createMulticastGroup :: MVar TransportState -> Chan Event -> MulticastAddress -> MVar [Chan Event] -> MulticastGroup
118createMulticastGroup :: MVar TransportState -> Chan Event -> MulticastAddress -> MVar [Chan Event] -> MulticastGroup
118createMulticastGroup state endpoint addr group =
119createMulticastGroup state endpoint addr group =
119 MulticastGroup { multicastAddress = addr
120 MulticastGroup { multicastAddress = addr
120− , deleteMulticastGroup = modifyMVar_ state $ return . (multigroups ^%= Map.delete addr)
121+ , deleteMulticastGroup = modifyMVar_ state $ return . (multigroups ^: Map.delete addr)
121 , maxMsgSize = Nothing
122 , maxMsgSize = Nothing
122 , multicastSend = \payload -> do
123 , multicastSend = \payload -> do
123 cs <- readMVar group
124 cs <- readMVar group
@@ -133,7 +134,7 @@ apiResolveMulticastGroup :: MVar TransportState
133 -> MulticastAddress
134 -> MulticastAddress
134 -> IO (Either (FailedWith ResolveMulticastGroupErrorCode) MulticastGroup)
135 -> IO (Either (FailedWith ResolveMulticastGroupErrorCode) MulticastGroup)
135apiResolveMulticastGroup state endpoint addr = do
136apiResolveMulticastGroup state endpoint addr = do
136− group <- (^. (multigroups >>> mapLens addr)) <$> readMVar state
137+ group <- (^. (multigroups >>> DAC.mapMaybe addr)) <$> readMVar state
137 case group of
138 case group of
138 Nothing -> return . Left $ FailedWith ResolveMulticastGroupNotFound ("Group " ++ show addr ++ " not found")
139 Nothing -> return . Left $ FailedWith ResolveMulticastGroupNotFound ("Group " ++ show addr ++ " not found")
139 Just mvar -> return . Right $ createMulticastGroup state endpoint addr mvar
140 Just mvar -> return . Right $ createMulticastGroup state endpoint addr mvar
network-transport-2/src/Network/Transport/TCP.hs+34−33
@@ -84,7 +84,8 @@ import Data.IntSet (IntSet)
84import qualified Data.IntSet as IntSet (empty, insert, elems, singleton, null, delete, unions)
84import qualified Data.IntSet as IntSet (empty, insert, elems, singleton, null, delete, unions)
85import Data.Map (Map)
85import Data.Map (Map)
86import qualified Data.Map as Map (empty, elems, size)
86import qualified Data.Map as Map (empty, elems, size)
87−import Data.Lens.Lazy (Lens, lens, intMapLens, mapLens, (^.), (^=), (^+=), (^%=))
87+import Data.Accessor (Accessor, accessor, (^.), (^=), (^:))
88+import qualified Data.Accessor.Container as DAC (mapMaybe, intMapMaybe)
88import System.IO (hPutStrLn, stderr)
89import System.IO (hPutStrLn, stderr)
89
90
90-- $design
91-- $design
@@ -181,7 +182,7 @@ import System.IO (hPutStrLn, stderr)
181-- Internal datatypes --
182-- Internal datatypes --
182--------------------------------------------------------------------------------
183--------------------------------------------------------------------------------
183
184
184−-- We use underscores for fields that we might update (using lenses)
185+-- We use underscores for fields that we might update (using accessores)
185--
186--
186-- All data types follow the same structure:
187-- All data types follow the same structure:
187--
188--
@@ -396,7 +397,7 @@ apiClose theirEndPoint connId connAlive = void . tryIO $ do
396 then do
397 then do
397 writeIORef connAlive False
398 writeIORef connAlive False
398 sendOn vst [encodeInt32 CloseConnection, encodeInt32 connId]
399 sendOn vst [encodeInt32 CloseConnection, encodeInt32 connId]
399− return (RemoteEndPointValid . (remoteOutgoing ^+= (-1)) $ vst)
400+ return (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)) $ vst)
400 else
401 else
401 return (RemoteEndPointValid vst)
402 return (RemoteEndPointValid vst)
402 RemoteEndPointClosed -> do
403 RemoteEndPointClosed -> do
@@ -559,7 +560,7 @@ requestConnectionTo ourEndPoint theirAddress = go
559 endPointStateSnapshot <- modifyMVar theirState $ \st ->
560 endPointStateSnapshot <- modifyMVar theirState $ \st ->
560 case st of
561 case st of
561 RemoteEndPointValid ep ->
562 RemoteEndPointValid ep ->
562− return (RemoteEndPointValid . (remoteOutgoing ^+= 1) $ ep, st)
563+ return (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)) $ ep, st)
563 _ ->
564 _ ->
564 return (st, st)
565 return (st, st)
565
566
@@ -595,7 +596,7 @@ requestConnectionTo ourEndPoint theirAddress = go
595 let failureHandler :: IOException -> IO b
596 let failureHandler :: IOException -> IO b
596 failureHandler err = do
597 failureHandler err = do
597 modifyMVar_ theirState $ \(RemoteEndPointValid ep) ->
598 modifyMVar_ theirState $ \(RemoteEndPointValid ep) ->
598− return (RemoteEndPointValid . (remoteOutgoing ^+= (-1)) $ ep)
599+ return (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)) $ ep)
599 -- TODO: should we call closeIfUnused here?
600 -- TODO: should we call closeIfUnused here?
600 throw $ FailedWith ConnectFailed (show err)
601 throw $ FailedWith ConnectFailed (show err)
601
602
@@ -754,7 +755,7 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do
754 reqId <- modifyMVar (localState ourEndPoint) $ \st -> case st of
755 reqId <- modifyMVar (localState ourEndPoint) $ \st -> case st of
755 LocalEndPointValid vst -> do
756 LocalEndPointValid vst -> do
756 let reqId = vst ^. nextCtrlRequestId
757 let reqId = vst ^. nextCtrlRequestId
757− return (LocalEndPointValid . (nextCtrlRequestId ^+= 1) . (pendingCtrlRequestsAt reqId ^= Just reply) $ vst, reqId)
758+ return (LocalEndPointValid . (nextCtrlRequestId ^: (+ 1)) . (pendingCtrlRequestsAt reqId ^= Just reply) $ vst, reqId)
758 LocalEndPointClosed ->
759 LocalEndPointClosed ->
759 throw (userError "Local endpoint closed")
760 throw (userError "Local endpoint closed")
760 withMVar (remoteState theirEndPoint) $ \(RemoteEndPointValid vst) ->
761 withMVar (remoteState theirEndPoint) $ \(RemoteEndPointValid vst) ->
@@ -785,7 +786,7 @@ forkEndPointThread ourEndPoint p =
785 modifyMVar ourState $ \st -> case st of
786 modifyMVar ourState $ \st -> case st of
786 LocalEndPointValid vst -> do
787 LocalEndPointValid vst -> do
787 tid <- forkIO (p >> removeThread)
788 tid <- forkIO (p >> removeThread)
788− return (LocalEndPointValid . (internalThreads ^%= (tid :)) $ vst, True)
789+ return (LocalEndPointValid . (internalThreads ^: (tid :)) $ vst, True)
789 LocalEndPointClosed ->
790 LocalEndPointClosed ->
790 return (LocalEndPointClosed, False)
791 return (LocalEndPointClosed, False)
791 where
792 where
@@ -794,7 +795,7 @@ forkEndPointThread ourEndPoint p =
794 tid <- myThreadId
795 tid <- myThreadId
795 modifyMVar_ ourState $ \st -> case st of
796 modifyMVar_ ourState $ \st -> case st of
796 LocalEndPointValid vst ->
797 LocalEndPointValid vst ->
797− return (LocalEndPointValid . (internalThreads ^%= filter (/= tid)) $ vst)
798+ return (LocalEndPointValid . (internalThreads ^: filter (/= tid)) $ vst)
798 LocalEndPointClosed ->
799 LocalEndPointClosed ->
799 return LocalEndPointClosed
800 return LocalEndPointClosed
800
801
@@ -944,7 +945,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
944 modifyMVar_ theirState $ \st -> do
945 modifyMVar_ theirState $ \st -> do
945 vst <- case st of
946 vst <- case st of
946 RemoteEndPointValid vst ->
947 RemoteEndPointValid vst ->
947− return (remoteIncoming ^%= IntSet.insert newId $ vst)
948+ return (remoteIncoming ^: IntSet.insert newId $ vst)
948 RemoteEndPointClosing resolved vst -> do
949 RemoteEndPointClosing resolved vst -> do
949 -- If the endpoint is in closing state that means we send a
950 -- If the endpoint is in closing state that means we send a
950 -- CloseSocket request to the remote endpoint. If the remote
951 -- CloseSocket request to the remote endpoint. If the remote
@@ -987,7 +988,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
987 -- TODO: we should check that this connection is in fact open
988 -- TODO: we should check that this connection is in fact open
988 writeChan ourChannel (ConnectionClosed cid)
989 writeChan ourChannel (ConnectionClosed cid)
989 modifyMVar_ theirState $ \(RemoteEndPointValid vst) ->
990 modifyMVar_ theirState $ \(RemoteEndPointValid vst) ->
990− return (RemoteEndPointValid . (remoteIncoming ^%= IntSet.delete cid) $ vst)
991+ return (RemoteEndPointValid . (remoteIncoming ^: IntSet.delete cid) $ vst)
991 closeIfUnused theirEndPoint
992 closeIfUnused theirEndPoint
992
993
993 -- Close the socket (if we don't have any outgoing connections)
994 -- Close the socket (if we don't have any outgoing connections)
@@ -1090,38 +1091,38 @@ firstNonReservedConnectionId :: ConnectionId
1090firstNonReservedConnectionId = 1024
1091firstNonReservedConnectionId = 1024
1091
1092
1092--------------------------------------------------------------------------------
1093--------------------------------------------------------------------------------
1093−-- Lens definitions --
1094+-- Accessor definitions --
1094--------------------------------------------------------------------------------
1095--------------------------------------------------------------------------------
1095
1096
1096−localEndPoints :: Lens ValidTransportState (Map EndPointAddress LocalEndPoint)
1097+localEndPoints :: Accessor ValidTransportState (Map EndPointAddress LocalEndPoint)
1097−localEndPoints = lens _localEndPoints (\es st -> st { _localEndPoints = es })
1098+localEndPoints = accessor _localEndPoints (\es st -> st { _localEndPoints = es })
1098
1099
1099−pendingCtrlRequests :: Lens ValidLocalEndPointState (IntMap (MVar [ByteString]))
1100+pendingCtrlRequests :: Accessor ValidLocalEndPointState (IntMap (MVar [ByteString]))
1100−pendingCtrlRequests = lens _pendingCtrlRequests (\rep st -> st { _pendingCtrlRequests = rep })
1101+pendingCtrlRequests = accessor _pendingCtrlRequests (\rep st -> st { _pendingCtrlRequests = rep })
1101
1102
1102−nextCtrlRequestId :: Lens ValidLocalEndPointState ControlRequestId
1103+nextCtrlRequestId :: Accessor ValidLocalEndPointState ControlRequestId
1103−nextCtrlRequestId = lens _nextCtrlRequestId (\cid st -> st { _nextCtrlRequestId = cid })
1104+nextCtrlRequestId = accessor _nextCtrlRequestId (\cid st -> st { _nextCtrlRequestId = cid })
1104
1105
1105−nextConnectionId :: Lens ValidLocalEndPointState ConnectionId
1106+nextConnectionId :: Accessor ValidLocalEndPointState ConnectionId
1106−nextConnectionId = lens _nextConnectionId (\cix st -> st { _nextConnectionId = cix })
1107+nextConnectionId = accessor _nextConnectionId (\cix st -> st { _nextConnectionId = cix })
1107
1108
1108−localConnections :: Lens ValidLocalEndPointState (Map EndPointAddress RemoteEndPoint)
1109+localConnections :: Accessor ValidLocalEndPointState (Map EndPointAddress RemoteEndPoint)
1109−localConnections = lens _localConnections (\es st -> st { _localConnections = es })
1110+localConnections = accessor _localConnections (\es st -> st { _localConnections = es })
1110
1111
1111−internalThreads :: Lens ValidLocalEndPointState [ThreadId]
1112+internalThreads :: Accessor ValidLocalEndPointState [ThreadId]
1112−internalThreads = lens _internalThreads (\ts st -> st { _internalThreads = ts })
1113+internalThreads = accessor _internalThreads (\ts st -> st { _internalThreads = ts })
1113
1114
1114−localEndPointAt :: EndPointAddress -> Lens ValidTransportState (Maybe LocalEndPoint)
1115+localEndPointAt :: EndPointAddress -> Accessor ValidTransportState (Maybe LocalEndPoint)
1115−localEndPointAt addr = localEndPoints >>> mapLens addr
1116+localEndPointAt addr = localEndPoints >>> DAC.mapMaybe addr
1116
1117
1117−pendingCtrlRequestsAt :: ControlRequestId -> Lens ValidLocalEndPointState (Maybe (MVar [ByteString]))
1118+pendingCtrlRequestsAt :: ControlRequestId -> Accessor ValidLocalEndPointState (Maybe (MVar [ByteString]))
1118−pendingCtrlRequestsAt ix = pendingCtrlRequests >>> intMapLens (fromIntegral ix)
1119+pendingCtrlRequestsAt ix = pendingCtrlRequests >>> DAC.intMapMaybe (fromIntegral ix)
1119
1120
1120−localConnectionTo :: EndPointAddress -> Lens ValidLocalEndPointState (Maybe RemoteEndPoint)
1121+localConnectionTo :: EndPointAddress -> Accessor ValidLocalEndPointState (Maybe RemoteEndPoint)
1121−localConnectionTo addr = localConnections >>> mapLens addr
1122+localConnectionTo addr = localConnections >>> DAC.mapMaybe addr
1122
1123
1123−remoteOutgoing :: Lens ValidRemoteEndPointState Int
1124+remoteOutgoing :: Accessor ValidRemoteEndPointState Int
1124−remoteOutgoing = lens _remoteOutgoing (\cs conn -> conn { _remoteOutgoing = cs })
1125+remoteOutgoing = accessor _remoteOutgoing (\cs conn -> conn { _remoteOutgoing = cs })
1125
1126
1126−remoteIncoming :: Lens ValidRemoteEndPointState IntSet
1127+remoteIncoming :: Accessor ValidRemoteEndPointState IntSet
1127−remoteIncoming = lens _remoteIncoming (\cs conn -> conn { _remoteIncoming = cs })
1128+remoteIncoming = accessor _remoteIncoming (\cs conn -> conn { _remoteIncoming = cs })