1 files changed, 58 insertions, 0 deletions

diff --git a/Connection.hs b/Connection.hs
new file mode 100644
index 00000000..3287bc1b
--- /dev/null
+++ b/Connection.hs
@@ -0,0 +1,58 @@
+{-# 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
+
+data Status status
+    = Dormant
+    | InProgress status
+    | Established
+ deriving Functor
+
+data Policy
+    = RefusingToConnect
+    | OpenToConnect
+    | TryingToConnect
+
+data Connection status = Connection
+    { connStatus    :: STM (Status status)
+    , connPolicy    :: STM Policy
+    , connPingLogic :: PingMachine
+    }
+ deriving Functor
+
+data Manager status k = Manager
+    { setPolicy    :: k -> Policy -> IO ()
+    , connections  :: STM (Map k (Connection status))
+    , stringToKey  :: String -> Maybe k
+    , showProgress :: status -> String
+    , showKey      :: k -> String
+    }
+
+showStatus :: Manager status k -> Status status -> String
+showStatus mgr Dormant        = "dormant"
+showStatus mgr Established    = "established"
+showStatus mgr (InProgress s) = "in progress ("++showProgress mgr s++")"
+
+
+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)
+    }