module Holumbus.Network.Site
(
SiteId
, SiteMap
, getSiteId
, getSiteHost
, getSiteProcess
, isSameHost
, isSameProcess
, nearestId
, emptySiteMap
, addIdToMap
, deleteIdFromMap
, deleteHostFromMap
, isSiteIdMember
, getNeighbourSiteIds
)
where
import Data.Binary
import qualified Data.List as List
import Network.Socket
import System.Posix
import Text.XML.HXT.Arrow
import qualified Data.Map as Map
import qualified Data.Set as Set
data SiteId = SiteId HostName ProcessID deriving (Show, Eq, Ord)
instance Binary SiteId where
put (SiteId hn pid) = put hn >> put (toInteger pid)
get
= do
hn <- get
pid <- get
return (SiteId hn (fromInteger pid))
instance XmlPickler SiteId where
xpickle = xpSiteId
xpSiteId :: PU SiteId
xpSiteId =
xpElem "siteId" $
xpWrap (\(hn, pid) -> SiteId hn (fromInteger pid), \(SiteId hn pid) -> (hn, toInteger pid)) xpSite
where
xpSite =
xpPair
(xpElem "hostname" xpText)
(xpElem "pid" xpickle)
type SiteMap = Map.Map HostName (Set.Set SiteId)
getHostName :: IO (HostName)
getHostName
= do
(hn, _) <- getNameInfo [] True False (SockAddrUnix "localhost")
return (maybe "localhost" id hn)
getSiteId :: IO (SiteId)
getSiteId
= do
hn <- getHostName
pid <- getProcessID
return (SiteId hn pid)
getSiteHost :: SiteId -> HostName
getSiteHost (SiteId hn _) = hn
getSiteProcess :: SiteId -> ProcessID
getSiteProcess (SiteId _ pid) = pid
isSameHost :: SiteId -> SiteId -> Bool
isSameHost (SiteId hn1 _) (SiteId hn2 _) = hn1 == hn2
isSameProcess :: SiteId -> SiteId -> Bool
isSameProcess = (==)
filterSiteIds :: SiteId -> [SiteId] -> ([SiteId],[SiteId],[SiteId])
filterSiteIds _ [] = ([],[],[])
filterSiteIds i ls
= (same, local, other)
where
(same, temp) = List.partition (\s -> isSameProcess i s) ls
(local, other) = List.partition (\s -> isSameHost i s) temp
nearestId :: SiteId -> [SiteId] -> Maybe SiteId
nearestId s l = nearestId' $ filterSiteIds s l
where
nearestId' ([], [], []) = Nothing
nearestId' ([], [], x:_) = Just x
nearestId' ([], x:_, _) = Just x
nearestId' (x:_, _, _) = Just x
emptySiteMap :: SiteMap
emptySiteMap = Map.empty
addIdToMap :: SiteId -> SiteMap -> SiteMap
addIdToMap i m
= Map.alter f hn m
where
hn = getSiteHost i
f Nothing = (Just $ Set.singleton i)
f (Just s) = (Just $ Set.insert i s)
deleteIdFromMap :: SiteId -> SiteMap -> SiteMap
deleteIdFromMap i m
= Map.alter f hn m
where
hn = getSiteHost i
f Nothing = Nothing
f (Just s) = filterEmpty $ Set.delete i s
filterEmpty s
| s == Set.empty = Nothing
| otherwise = Just s
deleteHostFromMap :: HostName -> SiteMap -> SiteMap
deleteHostFromMap hn m
= Map.alter f hn m
where
f _ = Nothing
isSiteIdMember :: SiteId -> SiteMap -> Bool
isSiteIdMember i m
= maybe False (\s -> Set.member i s) (Map.lookup hn m)
where
hn = getSiteHost i
getNeighbourSiteIds :: SiteId -> SiteMap -> Set.Set SiteId
getNeighbourSiteIds i m
= maybe (Set.empty) (\s -> Set.delete i s) (Map.lookup hn m)
where
hn = getSiteHost i