git.iko.soy/distributed-process
on 2e682fb help sign in
660d554
swap
10 ahead, 755 behind
27 files changed+509−69
since splitsnapshots
unifiedsplit
distributed-process/distributed-process.cabal+6−6 distributed-process/src/Control/Distributed/Process.hs+24−7 distributed-process/src/Control/Distributed/Process/Internal/Closure/BuiltIn.hs+2−2 distributed-process/src/Control/Distributed/Process/Internal/Closure/TH.hs+1−1 distributed-process/src/Control/Distributed/Process/Internal/Node.hs+12−5 distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs+43−1 distributed-process/src/Control/Distributed/Process/Internal/Types.hs+14−14 distributed-process/src/Control/Distributed/Process/Node.hs+22−2 distributed-process/src/Control/Distributed/Process/Serializable.hs+6−6 distributed-static/distributed-static.cabal+2−2 distributed-static/src/Control/Distributed/Static.hs+2−3 network-transport-tcp/network-transport-tcp.cabal+5−3 network-transport-tcp/src/Network/Transport/TCP.hs+5−5 network-transport-tcp/src/Network/Transport/TCP/Internal.hs+3−3 network-transport/network-transport.cabal+2−2 network-transport/src/Network/Transport.hs+2−2 network-transport/src/Network/Transport/Internal.hs+5−5 not-bytestring/LICENSE+30 not-bytestring/Setup.hs+2 not-bytestring/not-bytestring.cabal+34 not-bytestring/src/Data/NotByteString.hs+85 not-bytestring/src/Data/NotByteString/Char8.hs+24 not-bytestring/src/Data/NotByteString/Internal.hs+24 not-bytestring/src/Data/NotByteString/Lazy.hs+101 not-bytestring/src/Data/NotByteString/Lazy/Binary.hs+14 not-bytestring/src/Data/NotByteString/Lazy/Char8.hs+24 not-bytestring/src/Data/NotByteString/NBS.hs+15
distributed-process/distributed-process.cabal+6−6
@@ -37,7 +37,6 @@ Library
3737 transformers >= 0.2 && < 0.4,
3838 mtl >= 2.0 && < 2.2,
3939 data-accessor >= 0.2 && < 0.3,
40− bytestring >= 0.9 && < 0.11,
4140 containers >= 0.4 && < 0.6,
4241 old-locale >= 1.0 && < 1.1,
4342 time >= 1.2 && < 1.5,
@@ -46,7 +45,8 @@ Library
4645 ghc-prim >= 0.2 && < 0.4,
4746 distributed-static >= 0.1 && < 0.2,
4847 rank1dynamic >= 0.1 && < 0.2,
49− syb >= 0.3 && < 0.4
48+ syb >= 0.3 && < 0.4,
49+ not-bytestring
5050 Exposed-modules: Control.Distributed.Process,
5151 Control.Distributed.Process.Serializable,
5252 Control.Distributed.Process.Closure,
@@ -82,7 +82,6 @@ Test-Suite TestCH
8282 transformers >= 0.2 && < 0.4,
8383 mtl >= 2.0 && < 2.2,
8484 data-accessor >= 0.2 && < 0.3,
85− bytestring >= 0.9 && < 0.11,
8685 containers >= 0.4 && < 0.6,
8786 old-locale >= 1.0 && < 1.1,
8887 time >= 1.2 && < 1.5,
@@ -91,7 +90,8 @@ Test-Suite TestCH
9190 ghc-prim >= 0.2 && < 0.4,
9291 ansi-terminal >= 0.5 && < 0.6,
9392 distributed-static >= 0.1 && < 0.2,
94− rank1dynamic >= 0.1 && < 0.2
93+ rank1dynamic >= 0.1 && < 0.2,
94+ not-bytestring
9595 Extensions: RankNTypes,
9696 ScopedTypeVariables,
9797 FlexibleInstances,
@@ -115,7 +115,6 @@ Test-Suite TestClosure
115115 transformers >= 0.2 && < 0.4,
116116 mtl >= 2.0 && < 2.2,
117117 data-accessor >= 0.2 && < 0.3,
118− bytestring >= 0.9 && < 0.11,
119118 containers >= 0.4 && < 0.6,
120119 old-locale >= 1.0 && < 1.1,
121120 time >= 1.2 && < 1.5,
@@ -125,7 +124,8 @@ Test-Suite TestClosure
125124 ansi-terminal >= 0.5 && < 0.6,
126125 distributed-static >= 0.1 && < 0.2,
127126 rank1dynamic >= 0.1 && < 0.2,
128− syb >= 0.3 && < 0.4
127+ syb >= 0.3 && < 0.4,
128+ not-bytestring
129129 Other-modules: TestAuxiliary
130130 Extensions: RankNTypes,
131131 ScopedTypeVariables,
distributed-process/src/Control/Distributed/Process.hs+24−7
@@ -98,6 +98,10 @@ module Control.Distributed.Process
9898 -- * Local versions of 'spawn'
9999 , spawnLocal
100100 , spawnChannelLocal
101+ -- * Reconnecting
102+ , reconnect
103+ , reconnectNode
104+ , reconnectPort
101105 ) where
102106
103107#if ! MIN_VERSION_base(4,6,0)
@@ -206,6 +210,10 @@ import Control.Distributed.Process.Internal.Primitives
206210 -- Auxiliary API
207211 , expectTimeout
208212 , spawnAsync
213+ -- Reconnecting
214+ , reconnect
215+ , reconnectNode
216+ , reconnectPort
209217 )
210218import Control.Distributed.Process.Serializable (Serializable)
211219import Control.Distributed.Process.Node (forkProcess)
@@ -294,14 +302,14 @@ spawn nid proc = do
294302 `seqCP` proc
295303 mPid <- receiveWait
296304 [ matchIf (\(DidSpawn ref _) -> ref == sRef)
297− (\(DidSpawn _ pid) -> return $ Just pid)
305+ (\(DidSpawn _ pid) -> return $ Right pid)
298306 , matchIf (\(NodeMonitorNotification ref _ _) -> ref == mRef)
299− (\_ -> return Nothing)
307+ (\(NodeMonitorNotification _ _ err) -> return $ Left err)
300308 ]
301309 unmonitor mRef
302310 case mPid of
303− Nothing -> fail "spawn: remote node failed"
304− Just pid -> send pid () >> return pid
311+ Left err -> fail $ "spawn: remote node failed: " ++ show err
312+ Right pid -> send pid () >> return pid
305313
306314-- | Spawn a process and link to it
307315--
@@ -333,7 +341,7 @@ spawnMonitor nid proc = do
333341call :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (Process a) -> Process a
334342call dict nid proc = do
335343 us <- getSelfPid
336− (_, mRef) <- spawnMonitor nid (proc `bindCP` cpSend dict us)
344+ (pid, mRef) <- spawnMonitor nid (proc `bindCP` cpSend dict us)
337345 -- We are guaranteed to receive the reply before the monitor notification
338346 -- (if a reply is sent at all)
339347 -- NOTE: This might not be true if we switch to unreliable delivery.
@@ -343,8 +351,17 @@ call dict nid proc = do
343351 (\(ProcessMonitorNotification _ _ reason) -> return (Left reason))
344352 ]
345353 case mResult of
346− Right a -> unmonitor mRef >> return a
347− Left err -> fail $ "call: remote process died: " ++ show err
354+ Right a -> do
355+ -- Wait for the monitor message so that we the mailbox doesn't grow
356+ receiveWait
357+ [ matchIf (\(ProcessMonitorNotification ref _ _) -> ref == mRef)
358+ (\(ProcessMonitorNotification {}) -> return ())
359+ ]
360+ -- Clean up connection to pid
361+ reconnect pid
362+ return a
363+ Left err ->
364+ fail $ "call: remote process died: " ++ show err
348365
349366-- | Spawn a child process, have the child link to the parent and the parent
350367-- monitor the child
distributed-process/src/Control/Distributed/Process/Internal/Closure/BuiltIn.hs+2−2
@@ -23,8 +23,8 @@ module Control.Distributed.Process.Internal.Closure.BuiltIn
2323 , cpNewChan
2424 ) where
2525
26−import Data.ByteString.Lazy (ByteString)
27−import Data.Binary (decode, encode)
26+import Data.NotByteString.Lazy (ByteString)
27+import Data.NotByteString.Lazy.Binary (decode, encode)
2828import Data.Rank1Typeable (Typeable, ANY, ANY1, ANY2, ANY3, ANY4)
2929import Data.Rank1Dynamic (toDynamic)
3030import Control.Distributed.Static
distributed-process/src/Control/Distributed/Process/Internal/Closure/TH.hs+1−1
@@ -39,7 +39,7 @@ import Language.Haskell.TH
3939 , funD
4040 , sigD
4141 )
42−import Data.Binary (encode)
42+import Data.NotByteString.Lazy.Binary (encode)
4343import Data.Generics (everywhereM, mkM, gmapM)
4444import Data.Rank1Dynamic (toDynamic)
4545import Data.Rank1Typeable
distributed-process/src/Control/Distributed/Process/Internal/Node.hs+12−5
@@ -3,12 +3,14 @@ module Control.Distributed.Process.Internal.Node
33 sendPayload
44 , sendBinary
55 , sendMessage
6+ , reconnect
67 ) where
78
89import Data.Accessor ((^.), (^=))
9−import Data.Binary (Binary, encode)
10−import qualified Data.ByteString.Lazy as BSL (toChunks)
11−import qualified Data.ByteString as BSS (ByteString)
10+import Data.Binary (Binary)
11+import Data.NotByteString.Lazy.Binary (encode)
12+import qualified Data.NotByteString.Lazy as BSL (toChunks)
13+import qualified Data.NotByteString as BSS (ByteString)
1214import Control.Distributed.Process.Internal.StrictMVar (withMVar, modifyMVar_)
1315import Control.Concurrent.Chan (writeChan)
1416import Control.Monad (unless)
@@ -44,8 +46,8 @@ sendPayload node from to payload = do
4446 Just conn -> do
4547 didSend <- NT.send conn payload
4648 case didSend of
47− Left _ -> return False
48− Right _ -> return True
49+ Left _err -> return False
50+ Right () -> return True
4951 Nothing -> return False
5052 unless didSend $
5153 writeChan (localCtrlChan node) NCMsg
@@ -89,3 +91,8 @@ connBetween node from to = do
8991 Nothing -> setupConnBetween node from to
9092 where
9193 nodeState = localState node
94+
95+reconnect :: LocalNode -> Identifier -> Identifier -> IO ()
96+reconnect node from to =
97+ modifyMVar_ (localState node) $ return .
98+ (localConnectionBetween from to ^= Nothing)
distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs+43−1
@@ -59,13 +59,17 @@ module Control.Distributed.Process.Internal.Primitives
5959 , unlinkPort
6060 , monitorNode
6161 , monitorPort
62+ -- * Reconnecting
63+ , reconnect
64+ , reconnectNode
65+ , reconnectPort
6266 ) where
6367
6468#if ! MIN_VERSION_base(4,6,0)
6569import Prelude hiding (catch)
6670#endif
6771
68−import Data.Binary (decode)
72+import Data.NotByteString.Lazy.Binary (decode)
6973import Data.Time.Clock (getCurrentTime)
7074import Data.Time.Format (formatTime)
7175import System.Locale (defaultTimeLocale)
@@ -506,6 +510,44 @@ unClosure closure = do
506510 Left err -> fail $ "Could not resolve closure: " ++ err
507511 Right x -> return x
508512
513+--------------------------------------------------------------------------------
514+-- Reconnecting --
515+--------------------------------------------------------------------------------
516+
517+-- | Cloud Haskell provides the illusion of connection-less, reliable, ordered
518+-- message passing. However, when network connections get disrupted this
519+-- illusion cannot always be maintained. Once a network connection breaks (even
520+-- temporarily) no further communication on that connection will be possible.
521+-- For example, if process A sends a message to process B, and A is then
522+-- notified (by monitor notification) that it got disconnected from B, A will
523+-- not be able to send any further messages to B, /unless/ A explicitly
524+-- indicates that it is acceptable to attempt to reconnect to B using the
525+-- Cloud Haskell 'reconnect' primitive.
526+--
527+-- Importantly, when A calls 'reconnect' it acknowledges that some messages to
528+-- B might have been lost. For instance, if A sends messages m1 and m2 to B,
529+-- then receives a monitor notification that its connection to B has been lost,
530+-- calls 'reconnect' and then sends m3, it is possible that B will receive m1
531+-- and m3 but not m2.
532+--
533+-- Note that 'reconnect' does not mean /reconnect now/ but rather /it is okay
534+-- to attempt to reconnect on the next send/. In particular, if no further
535+-- communication attempts are made to B then A can use reconnect to clean up
536+-- its connection to B.
537+reconnect :: ProcessId -> Process ()
538+reconnect =
539+ sendCtrlMsg Nothing . Reconnect . ProcessIdentifier
540+
541+-- | Reconnect to a node. See 'reconnect' for more information.
542+reconnectNode :: NodeId -> Process ()
543+reconnectNode =
544+ sendCtrlMsg Nothing . Reconnect . NodeIdentifier
545+
546+-- | Reconnect to a sendport. See 'reconnect' for more information.
547+reconnectPort :: SendPort a -> Process ()
548+reconnectPort =
549+ sendCtrlMsg Nothing . Reconnect . SendPortIdentifier . sendPortId
550+
509551--------------------------------------------------------------------------------
510552-- Auxiliary functions --
511553--------------------------------------------------------------------------------
distributed-process/src/Control/Distributed/Process/Internal/Types.hs+14−14
@@ -64,9 +64,10 @@ module Control.Distributed.Process.Internal.Types
6464import Data.Map (Map)
6565import Data.Int (Int32)
6666import Data.Typeable (Typeable)
67−import Data.Binary (Binary(put, get), putWord8, getWord8, encode)
68−import qualified Data.ByteString as BSS (ByteString, concat)
69−import qualified Data.ByteString.Lazy as BSL
67+import Data.Binary (Binary(put, get), putWord8, getWord8)
68+import Data.NotByteString.Lazy.Binary (encode)
69+import qualified Data.NotByteString as BSS (ByteString, concat)
70+import qualified Data.NotByteString.Lazy as BSL
7071 ( ByteString
7172 , toChunks
7273 , splitAt
@@ -104,12 +105,8 @@ import Control.Distributed.Static (RemoteTable, Closure)
104105--------------------------------------------------------------------------------
105106
106107-- | Node identifier
107−data NodeId = NodeId { nodeAddress :: !(NT.EndPointAddress) }
108− deriving (Eq, Ord)
109−
110−instance Binary NodeId where
111− put (NodeId nid) = put nid
112− get = NodeId <$> get
108+newtype NodeId = NodeId { nodeAddress :: NT.EndPointAddress }
109+ deriving (Eq, Ord, Binary)
113110
114111instance Show NodeId where
115112 show (NodeId addr) = "nid://" ++ show addr
@@ -117,8 +114,8 @@ instance Show NodeId where
117114-- | A local process ID consists of a seed which distinguishes processes from
118115-- different instances of the same local node and a counter
119116data LocalProcessId = LocalProcessId
120− { lpidUnique :: !Int32
121− , lpidCounter :: !Int32
117+ { lpidUnique :: {-# UNPACK #-} !Int32
118+ , lpidCounter :: {-# UNPACK #-} !Int32
122119 }
123120 deriving (Eq, Ord, Typeable, Show)
124121
@@ -127,7 +124,7 @@ data ProcessId = ProcessId
127124 { -- | The ID of the node the process is running on
128125 processNodeId :: !NodeId
129126 -- | Node-local identifier for the process
130− , processLocalId :: !LocalProcessId
127+ , processLocalId :: {-# UNPACK #-} !LocalProcessId
131128 }
132129 deriving (Eq, Ord, Typeable)
133130
@@ -218,9 +215,9 @@ type LocalSendPortId = Int32
218215-- to create a SendPort.
219216data SendPortId = SendPortId {
220217 -- | The ID of the process that will receive messages sent on this port
221− sendPortProcessId :: !ProcessId
218+ sendPortProcessId :: {-# UNPACK #-} !ProcessId
222219 -- | Process-local ID of the channel
223− , sendPortLocalId :: !LocalSendPortId
220+ , sendPortLocalId :: {-# UNPACK #-} !LocalSendPortId
224221 }
225222 deriving (Eq, Ord)
226223
@@ -388,6 +385,7 @@ data ProcessSignal =
388385 | WhereIs String
389386 | Register String (Maybe ProcessId) -- Nothing to unregister
390387 | NamedSend String Message
388+ | Reconnect Identifier
391389 deriving Show
392390
393391--------------------------------------------------------------------------------
@@ -432,6 +430,7 @@ instance Binary ProcessSignal where
432430 put (WhereIs label) = putWord8 6 >> put label
433431 put (Register label pid) = putWord8 7 >> put label >> put pid
434432 put (NamedSend label msg) = putWord8 8 >> put label >> put (messageToPayload msg)
433+ put (Reconnect dest) = putWord8 9 >> put dest
435434 get = do
436435 header <- getWord8
437436 case header of
@@ -444,6 +443,7 @@ instance Binary ProcessSignal where
444443 6 -> WhereIs <$> get
445444 7 -> Register <$> get <*> get
446445 8 -> NamedSend <$> get <*> (payloadToMessage <$> get)
446+ 9 -> Reconnect <$> get
447447 _ -> fail "ProcessSignal.get: invalid"
448448
449449instance Binary DiedReason where
distributed-process/src/Control/Distributed/Process/Node.hs+22−2
@@ -14,8 +14,8 @@ import Prelude hiding (catch)
1414#endif
1515
1616import System.IO (fixIO, hPutStrLn, stderr)
17−import qualified Data.ByteString.Lazy as BSL (fromChunks)
18−import Data.Binary (decode)
17+import qualified Data.NotByteString.Lazy as BSL (fromChunks)
18+import Data.NotByteString.Lazy.Binary (decode)
1919import Data.Map (Map)
2020import qualified Data.Map as Map
2121 ( empty
@@ -65,6 +65,7 @@ import qualified Network.Transport as NT
6565 , address
6666 , closeEndPoint
6767 , ConnectionId
68+ , Connection
6869 )
6970import Data.Accessor (Accessor, accessor, (^.), (^=), (^:))
7071import qualified Data.Accessor.Container as DAC (mapDefault, mapMaybe)
@@ -89,6 +90,7 @@ import Control.Distributed.Process.Internal.Types
8990 , localPidCounter
9091 , localPidUnique
9192 , localProcessWithId
93+ , localConnections
9294 , MonitorRef(..)
9395 , ProcessMonitorNotification(..)
9496 , NodeMonitorNotification(..)
@@ -119,6 +121,7 @@ import Control.Distributed.Process.Internal.Node
119121 ( sendBinary
120122 , sendMessage
121123 , sendPayload
124+ , reconnect
122125 )
123126import Control.Distributed.Process.Internal.Primitives (expect, register, finally)
124127import qualified Control.Distributed.Process.Internal.Closure.BuiltIn as BuiltIn (remoteTable)
@@ -214,6 +217,7 @@ forkProcess node proc = modifyMVar (localState node) $ \st -> do
214217 -- [Unified: Table 4, rules termination and exiting]
215218 modifyMVar_ (localState node) $
216219 return . (localProcessWithId lpid ^= Nothing)
220+ . (localConnections ^: removeConnectionsFrom (ProcessIdentifier pid))
217221 writeChan (localCtrlChan node) NCMsg
218222 { ctrlMsgSender = ProcessIdentifier pid
219223 , ctrlMsgSignal = Died (ProcessIdentifier pid) reason
@@ -236,6 +240,13 @@ forkProcess node proc = modifyMVar (localState node) $ \st -> do
236240 , pid
237241 )
238242
243+-- | Remove connections from 'ident' (typically because 'ident' has terminated)
244+removeConnectionsFrom :: Identifier
245+ -> Map (Identifier, Identifier) NT.Connection
246+ -> Map (Identifier, Identifier) NT.Connection
247+removeConnectionsFrom ident =
248+ Map.filterWithKey $ \(fr, _to) _conn -> fr /= ident
249+
239250handleIncomingMessages :: LocalNode -> IO ()
240251handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
241252 where
@@ -424,6 +435,8 @@ nodeController = do
424435 ncEffectWhereIs from label
425436 NCMsg from (NamedSend label msg') ->
426437 ncEffectNamedSend from label msg'
438+ NCMsg from (Reconnect to) ->
439+ ncEffectReconnect from to
427440 unexpected ->
428441 error $ "nodeController: unexpected message " ++ show unexpected
429442
@@ -547,6 +560,12 @@ ncEffectNamedSend from label msg = do
547560 (ProcessIdentifier pid)
548561 (messageToPayload msg)
549562
563+-- Reconnecting
564+ncEffectReconnect :: Identifier -> Identifier -> NC ()
565+ncEffectReconnect from to = do
566+ node <- ask
567+ liftIO $ reconnect node from to
568+
550569--------------------------------------------------------------------------------
551570-- Auxiliary --
552571--------------------------------------------------------------------------------
@@ -592,6 +611,7 @@ destNid (Spawn _ _) = Nothing
592611destNid (Register _ _) = Nothing
593612destNid (WhereIs _) = Nothing
594613destNid (NamedSend _ _) = Nothing
614+destNid (Reconnect _) = Nothing
595615-- We don't need to forward 'Died' signals; if monitoring/linking is setup,
596616-- then when a local process dies the monitoring/linking machinery will take
597617-- care of notifying remote nodes
distributed-process/src/Control/Distributed/Process/Serializable.hs+6−6
@@ -15,12 +15,12 @@ import Data.Typeable.Internal (TypeRep(TypeRep))
1515import Numeric (showHex)
1616import Control.Exception (throw)
1717import GHC.Fingerprint.Type (Fingerprint(..))
18−import Data.ByteString (ByteString)
19−import qualified Data.ByteString as BS
20−import qualified Data.ByteString.Internal as BSI ( unsafeCreate
21− , inlinePerformIO
22− , toForeignPtr
23− )
18+import Data.NotByteString (ByteString)
19+import qualified Data.NotByteString as BS
20+import qualified Data.NotByteString.Internal as BSI ( unsafeCreate
21+ , inlinePerformIO
22+ , toForeignPtr
23+ )
2424import Foreign.Storable (pokeByteOff, peekByteOff, sizeOf)
2525import Foreign.ForeignPtr (withForeignPtr)
2626
distributed-static/distributed-static.cabal+2−2
@@ -29,8 +29,8 @@ Library
2929 Build-Depends: base >= 4 && < 5,
3030 rank1dynamic >= 0.1 && < 0.2,
3131 containers >= 0.4 && < 0.6,
32− bytestring >= 0.9 && < 0.11,
33− binary >= 0.5 && < 0.6
32+ binary >= 0.5 && < 0.6,
33+ not-bytestring
3434 HS-Source-Dirs: src
3535 Extensions: DeriveDataTypeable,
3636 ScopedTypeVariables
distributed-static/src/Control/Distributed/Static.hs+2−3
@@ -228,10 +228,9 @@ import Data.Binary
228228 , Get
229229 , putWord8
230230 , getWord8
231− , encode
232− , decode
233231 )
234−import Data.ByteString.Lazy (ByteString, empty)
232+import Data.NotByteString.Lazy.Binary (decode, encode)
233+import Data.NotByteString.Lazy (ByteString, empty)
235234import Data.Map (Map)
236235import qualified Data.Map as Map (lookup, empty, insert)
237236import Control.Applicative ((<$>), (<*>))
network-transport-tcp/network-transport-tcp.cabal+5−3
@@ -25,8 +25,9 @@ Library
2525 network-transport >= 0.2 && < 0.3,
2626 data-accessor >= 0.2 && < 0.3,
2727 containers >= 0.4 && < 0.6,
28+ network >= 2.3 && < 2.4,
2829 bytestring >= 0.9 && < 0.11,
29− network >= 2.3 && < 2.4
30+ not-bytestring
3031 Exposed-modules: Network.Transport.TCP,
3132 Network.Transport.TCP.Internal
3233 Extensions: CPP
@@ -40,11 +41,12 @@ Test-Suite TestTCP
4041 network-transport >= 0.2 && < 0.3,
4142 data-accessor >= 0.2 && < 0.3,
4243 containers >= 0.4 && < 0.6,
43− bytestring >= 0.9 && < 0.11,
4444 network >= 2.3 && < 2.4,
4545 random >= 1.0 && < 1.1,
4646 ansi-terminal >= 0.5 && < 0.6,
47− mtl >= 2.0 && < 2.2
47+ mtl >= 2.0 && < 2.2,
48+ bytestring >= 0.9 && < 0.11,
49+ not-bytestring
4850 Other-modules: TestAuxiliary,
4951 TestTransport,
5052 Traced
network-transport-tcp/src/Network/Transport/TCP.hs+5−5
@@ -66,7 +66,7 @@ import qualified Network.Socket as N ( HostName
6666 , sOMAXCONN
6767 , AddrInfo
6868 )
69−import Network.Socket.ByteString (sendMany)
69+import Data.NotByteString.NBS (sendMany)
7070import Control.Concurrent (forkIO, ThreadId, killThread, myThreadId)
7171import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
7272import Control.Concurrent.MVar ( MVar
@@ -95,9 +95,9 @@ import Control.Exception ( IOException
9595 , fromException
9696 )
9797import Data.IORef (IORef, newIORef, writeIORef, readIORef)
98−import Data.ByteString (ByteString)
99−import qualified Data.ByteString as BS (concat)
100−import qualified Data.ByteString.Char8 as BSC (pack, unpack, split)
98+import Data.NotByteString (ByteString)
99+import qualified Data.NotByteString as BS (concat)
100+import qualified Data.NotByteString.Char8 as BSC (pack, unpack, split)
101101import Data.Int (Int32)
102102import Data.IntMap (IntMap)
103103import qualified Data.IntMap as IntMap (empty)
@@ -1155,7 +1155,7 @@ setupRemoteEndPoint params (ourEndPoint, theirEndPoint) hints = do
11551155 { remoteSocket = sock
11561156 , _remoteOutgoing = 0
11571157 , _remoteIncoming = IntSet.empty
1158− , sendOn = sendMany sock
1158+ , sendOn = sendMany sock
11591159 , _pendingCtrlRequests = IntMap.empty
11601160 , _nextCtrlRequestId = 0
11611161 }
network-transport-tcp/src/Network/Transport/TCP/Internal.hs+3−3
@@ -28,13 +28,13 @@ import qualified Network.Socket as N ( HostName
2828 , accept
2929 , sClose
3030 )
31−import qualified Network.Socket.ByteString as NBS (recv)
31+import qualified Data.NotByteString.NBS as NBS (recv)
3232import Control.Concurrent (ThreadId)
3333import Control.Monad (forever, when)
3434import Control.Exception (SomeException, catch, bracketOnError, throwIO, mask_)
3535import Control.Applicative ((<$>))
36−import Data.ByteString (ByteString)
37−import qualified Data.ByteString as BS (length, concat, null)
36+import Data.NotByteString (ByteString)
37+import qualified Data.NotByteString as BS (length, concat, null)
3838import Data.Int (Int32)
3939
4040-- | Start a server at the specified address.
network-transport/network-transport.cabal+2−2
@@ -66,8 +66,8 @@ Source-Repository head
6666Library
6767 Build-Depends: base >= 4.3 && < 5,
6868 binary >= 0.5 && < 0.6,
69− bytestring >= 0.9 && < 0.11,
70− transformers >= 0.2 && < 0.4
69+ transformers >= 0.2 && < 0.4,
70+ not-bytestring
7171 Exposed-Modules: Network.Transport,
7272 Network.Transport.Util
7373 Network.Transport.Internal
network-transport/src/Network/Transport.hs+2−2
@@ -22,8 +22,8 @@ module Network.Transport ( -- * Types
2222 , EventErrorCode(..)
2323 ) where
2424
25−import Data.ByteString (ByteString)
26−import qualified Data.ByteString.Char8 as BSC (unpack)
25+import Data.NotByteString (ByteString)
26+import qualified Data.NotByteString.Char8 as BSC (unpack)
2727import Control.Exception (Exception)
2828import Data.Typeable (Typeable)
2929import Data.Binary (Binary)
network-transport/src/Network/Transport/Internal.hs+5−5
@@ -25,11 +25,11 @@ import Prelude hiding (catch)
2525import Foreign.Storable (pokeByteOff, peekByteOff)
2626import Foreign.C (CInt(..), CShort(..))
2727import Foreign.ForeignPtr (withForeignPtr)
28−import Data.ByteString (ByteString)
29−import qualified Data.ByteString as BS (length)
30−import qualified Data.ByteString.Internal as BSI ( unsafeCreate
31− , toForeignPtr
32− , inlinePerformIO)
28+import Data.NotByteString (ByteString)
29+import qualified Data.NotByteString as BS (length)
30+import qualified Data.NotByteString.Internal as BSI ( unsafeCreate
31+ , toForeignPtr
32+ , inlinePerformIO)
3333import Control.Monad.IO.Class (MonadIO, liftIO)
3434import Control.Exception ( IOException
3535 , SomeException
not-bytestring/LICENSEnew file+30
@@ -0,0 +1,30 @@
1+Copyright (c) 2012, Edsko de Vries
2+
3+All rights reserved.
4+
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
7+
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
10+
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Edsko de Vries nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
not-bytestring/Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
not-bytestring/not-bytestring.cabalnew file+34
@@ -0,0 +1,34 @@
1+-- Initial not-bytestring.cabal generated by cabal init. For further
2+-- documentation, see http://haskell.org/cabal/users-guide/
3+
4+name: not-bytestring
5+version: 0.1.0.0
6+synopsis: Not bytestring
7+-- description:
8+homepage: http://github.com/haskell-distribute/distributed-process
9+license: BSD3
10+license-file: LICENSE
11+author: Edsko de Vries
12+maintainer: edsko@well-typed.com
13+-- copyright:
14+category: Data
15+build-type: Simple
16+cabal-version: >=1.8
17+
18+library
19+ exposed-modules: Data.NotByteString
20+ Data.NotByteString.Internal
21+ Data.NotByteString.Char8
22+ Data.NotByteString.Lazy
23+ Data.NotByteString.Lazy.Char8
24+ Data.NotByteString.NBS
25+ Data.NotByteString.Lazy.Binary
26+ build-depends: base ==4.5.*,
27+ bytestring >= 0.9 && < 0.11,
28+ binary >= 0.5 && < 0.6,
29+ network >= 2.3 && < 2.4
30+ hs-source-dirs: src
31+ ghc-options: -Wall
32+ extensions: GeneralizedNewtypeDeriving,
33+ DeriveDataTypeable,
34+ BangPatterns
not-bytestring/src/Data/NotByteString.hsnew file+85
@@ -0,0 +1,85 @@
1+module Data.NotByteString
2+ ( ByteString(Nil, Cons)
3+ , fromString
4+ , toString
5+ , fromByteString
6+ , toByteString
7+ , length
8+ , concat
9+ , null
10+ , empty
11+ , splitAt
12+ , foldr
13+ , foldl'
14+ , (++)
15+ ) where
16+
17+import Prelude hiding (length, null, concat, splitAt, foldr, (++), reverse)
18+import qualified Prelude (length, null, splitAt, foldr)
19+import Data.Binary (Binary(get, put))
20+import Data.Typeable (Typeable)
21+import qualified Data.ByteString as BS (ByteString)
22+import qualified Data.ByteString.Char8 as BSC (pack, foldr)
23+import Control.Applicative ((<$>))
24+
25+data ByteString = Nil | Cons {-# UNPACK #-} !Char !ByteString
26+ deriving (Typeable, Eq, Ord)
27+
28+instance Show ByteString where
29+ show = toString
30+
31+instance Binary ByteString where
32+ get = fromByteString <$> get
33+ put = put . toByteString
34+
35+foldl' :: (a -> Char -> a) -> a -> ByteString -> a
36+foldl' f = go
37+ where
38+ go !acc Nil = acc
39+ go !acc (Cons c cs) = go (acc `f` c) cs
40+
41+foldr :: (Char -> a -> a) -> a -> ByteString -> a
42+foldr f e = go
43+ where
44+ go Nil = e
45+ go (Cons c cs) = c `f` go cs
46+
47+toString :: ByteString -> String
48+toString = foldr (:) []
49+
50+fromString :: String -> ByteString
51+fromString = Prelude.foldr Cons Nil
52+
53+fromByteString :: BS.ByteString -> ByteString
54+fromByteString = BSC.foldr Cons Nil
55+
56+toByteString :: ByteString -> BS.ByteString
57+toByteString = BSC.pack . toString
58+
59+length :: ByteString -> Int
60+length = foldl' (\l _ -> l + 1) 0
61+
62+(++) :: ByteString -> ByteString -> ByteString
63+xs ++ ys = foldr Cons ys xs
64+
65+concat :: [ByteString] -> ByteString
66+concat = Prelude.foldr (++) empty
67+
68+null :: ByteString -> Bool
69+null = foldr (\_ _ -> False) True
70+
71+empty :: ByteString
72+empty = Nil
73+
74+reverse :: ByteString -> ByteString
75+reverse = go Nil
76+ where
77+ go acc Nil = acc
78+ go acc (Cons c cs) = go (Cons c acc) cs
79+
80+splitAt :: Int -> ByteString -> (ByteString, ByteString)
81+splitAt = go Nil
82+ where
83+ go acc 0 cs = (reverse acc, cs)
84+ go acc _ Nil = (reverse acc, Nil)
85+ go acc n (Cons c cs) = go (Cons c acc) (n - 1) cs
not-bytestring/src/Data/NotByteString/Char8.hsnew file+24
@@ -0,0 +1,24 @@
1+module Data.NotByteString.Char8
2+ ( pack
3+ , unpack
4+ , split
5+ ) where
6+
7+import Data.NotByteString
8+ ( ByteString
9+ , fromString
10+ , toString
11+ , fromByteString
12+ , toByteString
13+ )
14+import qualified Data.ByteString.Char8 as BSC (split)
15+
16+pack :: String -> ByteString
17+pack = fromString
18+
19+unpack :: ByteString -> String
20+unpack = toString
21+
22+-- TODO: Avoid roundtrip
23+split :: Char -> ByteString -> [ByteString]
24+split c = map fromByteString . BSC.split c . toByteString
not-bytestring/src/Data/NotByteString/Internal.hsnew file+24
@@ -0,0 +1,24 @@
1+module Data.NotByteString.Internal
2+ ( unsafeCreate
3+ , toForeignPtr
4+ , inlinePerformIO
5+ ) where
6+
7+import Data.NotByteString (ByteString, fromByteString, toByteString)
8+import Foreign.Ptr (Ptr)
9+import Foreign.ForeignPtr (ForeignPtr)
10+import Data.Word (Word8)
11+import qualified Data.ByteString.Internal as BSI
12+ ( unsafeCreate
13+ , toForeignPtr
14+ , inlinePerformIO
15+ )
16+
17+unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
18+unsafeCreate i f = fromByteString $ BSI.unsafeCreate i f
19+
20+toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int)
21+toForeignPtr = BSI.toForeignPtr . toByteString
22+
23+inlinePerformIO :: IO a -> a
24+inlinePerformIO = BSI.inlinePerformIO
not-bytestring/src/Data/NotByteString/Lazy.hsnew file+101
@@ -0,0 +1,101 @@
1+module Data.NotByteString.Lazy
2+ ( ByteString(Nil, Cons)
3+ , fromString
4+ , toString
5+ , fromByteString
6+ , toByteString
7+ , length
8+ , concat
9+ , null
10+ , empty
11+ , splitAt
12+ , foldr
13+ , foldl'
14+ , (++)
15+ , toChunks
16+ , fromChunks
17+ ) where
18+
19+import Prelude hiding (length, null, concat, splitAt, foldr, (++), reverse)
20+import qualified Prelude (length, null, splitAt, foldr)
21+import Data.Binary (Binary(get, put))
22+import Data.Typeable (Typeable)
23+import qualified Data.ByteString.Lazy as BSL (ByteString)
24+import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, foldr)
25+import qualified Data.NotByteString as Strict (ByteString(Nil, Cons), foldr)
26+import Control.Applicative ((<$>))
27+
28+data ByteString = Nil | Cons {-# UNPACK #-} !Char ByteString
29+ deriving (Typeable, Eq, Ord)
30+
31+instance Show ByteString where
32+ show = toString
33+
34+instance Binary ByteString where
35+ get = fromByteString <$> get
36+ put = put . toByteString
37+
38+foldl' :: (a -> Char -> a) -> a -> ByteString -> a
39+foldl' f = go
40+ where
41+ go !acc Nil = acc
42+ go !acc (Cons c cs) = go (acc `f` c) cs
43+
44+foldr :: (Char -> a -> a) -> a -> ByteString -> a
45+foldr f e = go
46+ where
47+ go Nil = e
48+ go (Cons c cs) = c `f` go cs
49+
50+toString :: ByteString -> String
51+toString = foldr (:) []
52+
53+fromString :: String -> ByteString
54+fromString = Prelude.foldr Cons Nil
55+
56+fromByteString :: BSL.ByteString -> ByteString
57+fromByteString = BSLC.foldr Cons Nil
58+
59+toByteString :: ByteString -> BSL.ByteString
60+toByteString = BSLC.pack . toString
61+
62+length :: ByteString -> Int
63+length = foldl' (\l _ -> l + 1) 0
64+
65+(++) :: ByteString -> ByteString -> ByteString
66+xs ++ ys = foldr Cons ys xs
67+
68+concat :: [ByteString] -> ByteString
69+concat = Prelude.foldr (++) empty
70+
71+null :: ByteString -> Bool
72+null = foldr (\_ _ -> False) True
73+
74+empty :: ByteString
75+empty = Nil
76+
77+reverse :: ByteString -> ByteString
78+reverse = go Nil
79+ where
80+ go acc Nil = acc
81+ go acc (Cons c cs) = go (Cons c acc) cs
82+
83+splitAt :: Int -> ByteString -> (ByteString, ByteString)
84+splitAt = go Nil
85+ where
86+ go acc 0 cs = (reverse acc, cs)
87+ go acc _ Nil = (reverse acc, Nil)
88+ go acc n (Cons c cs) = go (Cons c acc) (n - 1) cs
89+
90+toStrict :: ByteString -> Strict.ByteString
91+toStrict = foldr Strict.Cons Strict.Nil
92+
93+fromStrict :: Strict.ByteString -> ByteString
94+fromStrict = Strict.foldr Cons Nil
95+
96+-- | This does not preserve laziness
97+toChunks :: ByteString -> [Strict.ByteString]
98+toChunks = return . toStrict
99+
100+fromChunks :: [Strict.ByteString] -> ByteString
101+fromChunks = concat . map fromStrict
not-bytestring/src/Data/NotByteString/Lazy/Binary.hsnew file+14
@@ -0,0 +1,14 @@
1+module Data.NotByteString.Lazy.Binary
2+ ( encode
3+ , decode
4+ ) where
5+
6+import Data.NotByteString.Lazy (ByteString, fromByteString, toByteString)
7+import Data.Binary (Binary)
8+import qualified Data.Binary as Binary (encode, decode)
9+
10+encode :: Binary a => a -> ByteString
11+encode = fromByteString . Binary.encode
12+
13+decode :: Binary a => ByteString -> a
14+decode = Binary.decode . toByteString
not-bytestring/src/Data/NotByteString/Lazy/Char8.hsnew file+24
@@ -0,0 +1,24 @@
1+module Data.NotByteString.Lazy.Char8
2+ ( pack
3+ , unpack
4+ , split
5+ ) where
6+
7+import Data.NotByteString.Lazy
8+ ( ByteString
9+ , fromString
10+ , toString
11+ , fromByteString
12+ , toByteString
13+ )
14+import qualified Data.ByteString.Lazy.Char8 as BSC (split)
15+
16+pack :: String -> ByteString
17+pack = fromString
18+
19+unpack :: ByteString -> String
20+unpack = toString
21+
22+-- TODO: Avoid roundtrip
23+split :: Char -> ByteString -> [ByteString]
24+split c = map fromByteString . BSC.split c . toByteString
not-bytestring/src/Data/NotByteString/NBS.hsnew file+15
@@ -0,0 +1,15 @@
1+module Data.NotByteString.NBS
2+ ( recv
3+ , sendMany
4+ ) where
5+
6+import Control.Applicative ((<$>))
7+import Data.NotByteString (ByteString, fromByteString, toByteString)
8+import Network.Socket (Socket)
9+import qualified Network.Socket.ByteString as NSB (recv, sendMany)
10+
11+recv :: Socket -> Int -> IO ByteString
12+recv sock n = fromByteString <$> NSB.recv sock n
13+
14+sendMany :: Socket -> [ByteString] -> IO ()
15+sendMany sock = NSB.sendMany sock . map toByteString