1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
{-# LANGUAGE DeriveFunctor #-}
module Connection where
import Control.Applicative
import Control.Arrow
import Control.Concurrent.STM
import qualified Data.Map as Map
;import Data.Map (Map)
import PingMachine
-- | This type indicates the current status of a connection. The type
-- parameter indicates protocol-specific status information. To present
-- information as a user-comprehensible string, use 'showStatus'.
data Status status
= Dormant
| InProgress status
| Established
deriving (Show,Eq,Ord,Functor)
-- | A policy indicates a desired connection status.
data Policy
= RefusingToConnect -- ^ We desire no connection.
| OpenToConnect -- ^ We will cooperate if a remote side initiates.
| TryingToConnect -- ^ We desire to be connected.
deriving (Eq,Ord,Show)
-- | Read-only information obtained via the 'connections' interface to
-- 'Manager'.
data Connection status = Connection
{ connStatus :: STM (Status status)
, connPolicy :: STM Policy
, connPingLogic :: PingMachine
}
deriving Functor
-- | This is an interface to make or query status information about connections
-- of a specific kind.
--
-- Type parameters:
--
-- /k/ names a connection. It should implement Ord, and can be parsed and
-- displayed using 'stringToKey' and 'showKey'.
--
-- /status/ indicates the progress of a connection. It is intended as a
-- parameter to the 'InProgress' constructor of 'Status'.
--
data Manager status k = Manager
{ -- | Connect or disconnect a connection.
setPolicy :: k -> Policy -> IO ()
-- | Obtain a list (in Map form) of all possible connections, whether
-- connected or not.
, connections :: STM (Map k (Connection status))
-- | Parse a connection key out of a string. Inverse of 'showKey'.
, stringToKey :: String -> Maybe k
-- | Convert a progress value to a string.
, showProgress :: status -> String
-- | Show a connection key as a string.
, showKey :: k -> String
}
-- | Present status information (visible in a UI) for a connection.
showStatus :: Manager status k -> Status status -> String
showStatus mgr Dormant = "dormant"
showStatus mgr Established = "established"
showStatus mgr (InProgress s) = "in progress ("++showProgress mgr s++")"
-- | Combine two different species of 'Manager' into a single interface using
-- 'Either' to combine key and status types.
addManagers :: (Ord kA, Ord kB) =>
Manager statusA kA
-> Manager statusB kB
-> Manager (Either statusA statusB) (Either kA kB)
addManagers mgrA mgrB = Manager
{ setPolicy = either (setPolicy mgrA) (setPolicy mgrB)
, connections = do
as <- Map.toList <$> connections mgrA
bs <- Map.toList <$> connections mgrB
return $ Map.fromList $ map (Left *** fmap Left) as ++ map (Right *** fmap Right) bs
, stringToKey = \str -> Left <$> stringToKey mgrA str
<|> Right <$> stringToKey mgrB str
, showProgress = either (showProgress mgrA) (showProgress mgrB)
, showKey = either (showKey mgrA) (showKey mgrB)
}
|
