git.iko.soy/distributed-process
on master help sign in
Replace data-lens with data-accessor

which is less dependency-heavy

commit8ce24374960d233b76d55bc2460a45f6627b03a6 authorEdsko de Vries <edsko@edsko.net> dateTue 15 May 2012, 13:25 (14 years ago) parentd4be8a7
3 files changed+54−52
compare with master
unifiedsplit
network-transport-2/network-transport.cabal+4−4 network-transport-2/src/Network/Transport/Chan.hs+16−15 network-transport-2/src/Network/Transport/TCP.hs+34−33
network-transport-2/network-transport.cabal+4−4
@@ -11,7 +11,7 @@ Library
1111 Build-Depends: base,
1212 bytestring,
1313 containers,
14− data-lens,
14+ data-accessor,
1515 network,
1616 mtl,
1717 transformers
@@ -29,7 +29,7 @@ Test-Suite TestTCP
2929 Build-Depends: base,
3030 containers,
3131 bytestring,
32− data-lens,
32+ data-accessor,
3333 network,
3434 mtl,
3535 transformers,
@@ -44,7 +44,7 @@ Test-Suite TestMulticastInMemory
4444 Build-Depends: base,
4545 containers,
4646 bytestring,
47− data-lens,
47+ data-accessor,
4848 mtl,
4949 transformers,
5050 ansi-terminal
@@ -58,7 +58,7 @@ Test-Suite TestInMemory
5858 Build-Depends: base,
5959 containers,
6060 bytestring,
61− data-lens,
61+ data-accessor,
6262 mtl,
6363 transformers,
6464 ansi-terminal
network-transport-2/src/Network/Transport/Chan.hs+16−15
@@ -11,7 +11,8 @@ import Data.Map (Map)
1111import qualified Data.Map as Map (empty, insert, size, delete, findWithDefault)
1212import Data.ByteString (ByteString)
1313import 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)
1516
1617-- Global state: next available "address", mapping from addresses to channels and next available connection
1718data TransportState = State { _channels :: Map EndPointAddress (Chan Event)
@@ -19,25 +20,25 @@ data TransportState = State { _channels :: Map EndPointAddress (Chan Eve
1920 , _multigroups :: Map MulticastAddress (MVar [Chan Event])
2021 }
2122
22−channels :: Lens TransportState (Map EndPointAddress (Chan Event))
23−channels = lens _channels (\ch st -> st { _channels = ch })
23+channels :: Accessor TransportState (Map EndPointAddress (Chan Event))
24+channels = accessor _channels (\ch st -> st { _channels = ch })
2425
25−nextConnectionId :: Lens TransportState (Map EndPointAddress ConnectionId)
26−nextConnectionId = lens _nextConnectionId (\cid st -> st { _nextConnectionId = cid })
26+nextConnectionId :: Accessor TransportState (Map EndPointAddress ConnectionId)
27+nextConnectionId = accessor _nextConnectionId (\cid st -> st { _nextConnectionId = cid })
2728
28−multigroups :: Lens TransportState (Map MulticastAddress (MVar [Chan Event]))
29−multigroups = lens _multigroups (\gs st -> st { _multigroups = gs })
29+multigroups :: Accessor TransportState (Map MulticastAddress (MVar [Chan Event]))
30+multigroups = accessor _multigroups (\gs st -> st { _multigroups = gs })
3031
31−at :: Ord k => k -> String -> Lens (Map k v) v
32−at k err = lens (Map.findWithDefault (error err) k) (Map.insert k)
32+at :: Ord k => k -> String -> Accessor (Map k v) v
33+at k err = accessor (Map.findWithDefault (error err) k) (Map.insert k)
3334
34−channelAt :: EndPointAddress -> Lens TransportState (Chan Event)
35+channelAt :: EndPointAddress -> Accessor TransportState (Chan Event)
3536channelAt addr = channels >>> at addr "Invalid channel"
3637
37−nextConnectionIdAt :: EndPointAddress -> Lens TransportState ConnectionId
38+nextConnectionIdAt :: EndPointAddress -> Accessor TransportState ConnectionId
3839nextConnectionIdAt addr = nextConnectionId >>> at addr "Invalid connection ID"
3940
40−multigroupAt :: MulticastAddress -> Lens TransportState (MVar [Chan Event])
41+multigroupAt :: MulticastAddress -> Accessor TransportState (MVar [Chan Event])
4142multigroupAt addr = multigroups >>> at addr "Invalid multigroup"
4243
4344-- | Create a new Transport.
@@ -72,7 +73,7 @@ apiConnect myAddress state theirAddress _ = do
7273 (chan, conn) <- modifyMVar state $ \st -> do
7374 let chan = st ^. channelAt theirAddress
7475 let conn = st ^. nextConnectionIdAt theirAddress
75− return (nextConnectionIdAt theirAddress ^+= 1 $ st, (chan, conn))
76+ return (nextConnectionIdAt theirAddress ^: (+ 1) $ st, (chan, conn))
7677 writeChan chan $ ConnectionOpened conn ReliableOrdered myAddress
7778 connAlive <- newMVar True
7879 return . Right $ Connection { send = apiSend chan conn connAlive
@@ -117,7 +118,7 @@ apiNewMulticastGroup state endpoint = do
117118createMulticastGroup :: MVar TransportState -> Chan Event -> MulticastAddress -> MVar [Chan Event] -> MulticastGroup
118119createMulticastGroup state endpoint addr group =
119120 MulticastGroup { multicastAddress = addr
120− , deleteMulticastGroup = modifyMVar_ state $ return . (multigroups ^%= Map.delete addr)
121+ , deleteMulticastGroup = modifyMVar_ state $ return . (multigroups ^: Map.delete addr)
121122 , maxMsgSize = Nothing
122123 , multicastSend = \payload -> do
123124 cs <- readMVar group
@@ -133,7 +134,7 @@ apiResolveMulticastGroup :: MVar TransportState
133134 -> MulticastAddress
134135 -> IO (Either (FailedWith ResolveMulticastGroupErrorCode) MulticastGroup)
135136apiResolveMulticastGroup state endpoint addr = do
136− group <- (^. (multigroups >>> mapLens addr)) <$> readMVar state
137+ group <- (^. (multigroups >>> DAC.mapMaybe addr)) <$> readMVar state
137138 case group of
138139 Nothing -> return . Left $ FailedWith ResolveMulticastGroupNotFound ("Group " ++ show addr ++ " not found")
139140 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)
8484import qualified Data.IntSet as IntSet (empty, insert, elems, singleton, null, delete, unions)
8585import Data.Map (Map)
8686import 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)
8889import System.IO (hPutStrLn, stderr)
8990
9091-- $design
@@ -181,7 +182,7 @@ import System.IO (hPutStrLn, stderr)
181182-- Internal datatypes --
182183--------------------------------------------------------------------------------
183184
184−-- We use underscores for fields that we might update (using lenses)
185+-- We use underscores for fields that we might update (using accessores)
185186--
186187-- All data types follow the same structure:
187188--
@@ -396,7 +397,7 @@ apiClose theirEndPoint connId connAlive = void . tryIO $ do
396397 then do
397398 writeIORef connAlive False
398399 sendOn vst [encodeInt32 CloseConnection, encodeInt32 connId]
399− return (RemoteEndPointValid . (remoteOutgoing ^+= (-1)) $ vst)
400+ return (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)) $ vst)
400401 else
401402 return (RemoteEndPointValid vst)
402403 RemoteEndPointClosed -> do
@@ -559,7 +560,7 @@ requestConnectionTo ourEndPoint theirAddress = go
559560 endPointStateSnapshot <- modifyMVar theirState $ \st ->
560561 case st of
561562 RemoteEndPointValid ep ->
562− return (RemoteEndPointValid . (remoteOutgoing ^+= 1) $ ep, st)
563+ return (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)) $ ep, st)
563564 _ ->
564565 return (st, st)
565566
@@ -595,7 +596,7 @@ requestConnectionTo ourEndPoint theirAddress = go
595596 let failureHandler :: IOException -> IO b
596597 failureHandler err = do
597598 modifyMVar_ theirState $ \(RemoteEndPointValid ep) ->
598− return (RemoteEndPointValid . (remoteOutgoing ^+= (-1)) $ ep)
599+ return (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)) $ ep)
599600 -- TODO: should we call closeIfUnused here?
600601 throw $ FailedWith ConnectFailed (show err)
601602
@@ -754,7 +755,7 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do
754755 reqId <- modifyMVar (localState ourEndPoint) $ \st -> case st of
755756 LocalEndPointValid vst -> do
756757 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)
758759 LocalEndPointClosed ->
759760 throw (userError "Local endpoint closed")
760761 withMVar (remoteState theirEndPoint) $ \(RemoteEndPointValid vst) ->
@@ -785,7 +786,7 @@ forkEndPointThread ourEndPoint p =
785786 modifyMVar ourState $ \st -> case st of
786787 LocalEndPointValid vst -> do
787788 tid <- forkIO (p >> removeThread)
788− return (LocalEndPointValid . (internalThreads ^%= (tid :)) $ vst, True)
789+ return (LocalEndPointValid . (internalThreads ^: (tid :)) $ vst, True)
789790 LocalEndPointClosed ->
790791 return (LocalEndPointClosed, False)
791792 where
@@ -794,7 +795,7 @@ forkEndPointThread ourEndPoint p =
794795 tid <- myThreadId
795796 modifyMVar_ ourState $ \st -> case st of
796797 LocalEndPointValid vst ->
797− return (LocalEndPointValid . (internalThreads ^%= filter (/= tid)) $ vst)
798+ return (LocalEndPointValid . (internalThreads ^: filter (/= tid)) $ vst)
798799 LocalEndPointClosed ->
799800 return LocalEndPointClosed
800801
@@ -944,7 +945,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
944945 modifyMVar_ theirState $ \st -> do
945946 vst <- case st of
946947 RemoteEndPointValid vst ->
947− return (remoteIncoming ^%= IntSet.insert newId $ vst)
948+ return (remoteIncoming ^: IntSet.insert newId $ vst)
948949 RemoteEndPointClosing resolved vst -> do
949950 -- If the endpoint is in closing state that means we send a
950951 -- CloseSocket request to the remote endpoint. If the remote
@@ -987,7 +988,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
987988 -- TODO: we should check that this connection is in fact open
988989 writeChan ourChannel (ConnectionClosed cid)
989990 modifyMVar_ theirState $ \(RemoteEndPointValid vst) ->
990− return (RemoteEndPointValid . (remoteIncoming ^%= IntSet.delete cid) $ vst)
991+ return (RemoteEndPointValid . (remoteIncoming ^: IntSet.delete cid) $ vst)
991992 closeIfUnused theirEndPoint
992993
993994 -- Close the socket (if we don't have any outgoing connections)
@@ -1090,38 +1091,38 @@ firstNonReservedConnectionId :: ConnectionId
10901091firstNonReservedConnectionId = 1024
10911092
10921093--------------------------------------------------------------------------------
1093−-- Lens definitions --
1094+-- Accessor definitions --
10941095--------------------------------------------------------------------------------
10951096
1096−localEndPoints :: Lens ValidTransportState (Map EndPointAddress LocalEndPoint)
1097−localEndPoints = lens _localEndPoints (\es st -> st { _localEndPoints = es })
1097+localEndPoints :: Accessor ValidTransportState (Map EndPointAddress LocalEndPoint)
1098+localEndPoints = accessor _localEndPoints (\es st -> st { _localEndPoints = es })
10981099
1099−pendingCtrlRequests :: Lens ValidLocalEndPointState (IntMap (MVar [ByteString]))
1100−pendingCtrlRequests = lens _pendingCtrlRequests (\rep st -> st { _pendingCtrlRequests = rep })
1100+pendingCtrlRequests :: Accessor ValidLocalEndPointState (IntMap (MVar [ByteString]))
1101+pendingCtrlRequests = accessor _pendingCtrlRequests (\rep st -> st { _pendingCtrlRequests = rep })
11011102
1102−nextCtrlRequestId :: Lens ValidLocalEndPointState ControlRequestId
1103−nextCtrlRequestId = lens _nextCtrlRequestId (\cid st -> st { _nextCtrlRequestId = cid })
1103+nextCtrlRequestId :: Accessor ValidLocalEndPointState ControlRequestId
1104+nextCtrlRequestId = accessor _nextCtrlRequestId (\cid st -> st { _nextCtrlRequestId = cid })
11041105
1105−nextConnectionId :: Lens ValidLocalEndPointState ConnectionId
1106−nextConnectionId = lens _nextConnectionId (\cix st -> st { _nextConnectionId = cix })
1106+nextConnectionId :: Accessor ValidLocalEndPointState ConnectionId
1107+nextConnectionId = accessor _nextConnectionId (\cix st -> st { _nextConnectionId = cix })
11071108
1108−localConnections :: Lens ValidLocalEndPointState (Map EndPointAddress RemoteEndPoint)
1109−localConnections = lens _localConnections (\es st -> st { _localConnections = es })
1109+localConnections :: Accessor ValidLocalEndPointState (Map EndPointAddress RemoteEndPoint)
1110+localConnections = accessor _localConnections (\es st -> st { _localConnections = es })
11101111
1111−internalThreads :: Lens ValidLocalEndPointState [ThreadId]
1112−internalThreads = lens _internalThreads (\ts st -> st { _internalThreads = ts })
1112+internalThreads :: Accessor ValidLocalEndPointState [ThreadId]
1113+internalThreads = accessor _internalThreads (\ts st -> st { _internalThreads = ts })
11131114
1114−localEndPointAt :: EndPointAddress -> Lens ValidTransportState (Maybe LocalEndPoint)
1115−localEndPointAt addr = localEndPoints >>> mapLens addr
1115+localEndPointAt :: EndPointAddress -> Accessor ValidTransportState (Maybe LocalEndPoint)
1116+localEndPointAt addr = localEndPoints >>> DAC.mapMaybe addr
11161117
1117−pendingCtrlRequestsAt :: ControlRequestId -> Lens ValidLocalEndPointState (Maybe (MVar [ByteString]))
1118−pendingCtrlRequestsAt ix = pendingCtrlRequests >>> intMapLens (fromIntegral ix)
1118+pendingCtrlRequestsAt :: ControlRequestId -> Accessor ValidLocalEndPointState (Maybe (MVar [ByteString]))
1119+pendingCtrlRequestsAt ix = pendingCtrlRequests >>> DAC.intMapMaybe (fromIntegral ix)
11191120
1120−localConnectionTo :: EndPointAddress -> Lens ValidLocalEndPointState (Maybe RemoteEndPoint)
1121−localConnectionTo addr = localConnections >>> mapLens addr
1121+localConnectionTo :: EndPointAddress -> Accessor ValidLocalEndPointState (Maybe RemoteEndPoint)
1122+localConnectionTo addr = localConnections >>> DAC.mapMaybe addr
11221123
1123−remoteOutgoing :: Lens ValidRemoteEndPointState Int
1124−remoteOutgoing = lens _remoteOutgoing (\cs conn -> conn { _remoteOutgoing = cs })
1124+remoteOutgoing :: Accessor ValidRemoteEndPointState Int
1125+remoteOutgoing = accessor _remoteOutgoing (\cs conn -> conn { _remoteOutgoing = cs })
11251126
1126−remoteIncoming :: Lens ValidRemoteEndPointState IntSet
1127−remoteIncoming = lens _remoteIncoming (\cs conn -> conn { _remoteIncoming = cs })
1127+remoteIncoming :: Accessor ValidRemoteEndPointState IntSet
1128+remoteIncoming = accessor _remoteIncoming (\cs conn -> conn { _remoteIncoming = cs })