Holumbus-Distribution-0.0.1: source/Holumbus/Network/Site.hs

-- ----------------------------------------------------------------------------

{- |
  Module     : Holumbus.Network.Site
  Copyright  : Copyright (C) 2008 Stefan Schmidt
  License    : MIT

  Maintainer : Stefan Schmidt (stefanschmidt@web.de)
  Stability  : experimental
  Portability: portable
  Version    : 0.1

  Just a little Id to help us to decide if two thread are running in the
  same program or just on the same machine or on differen machines. 

-}

-- ----------------------------------------------------------------------------

module Holumbus.Network.Site
(
-- * Datatypes
  SiteId
, SiteMap
  
-- * Operations on the SiteId
, getSiteId
, getSiteHost
, getSiteProcess
, isSameHost
, isSameProcess
, nearestId

-- * Operations on the SiteMap
, 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




-- ----------------------------------------------------------------------------
-- Datatypes
-- ----------------------------------------------------------------------------


-- | The datatype of the SiteId, it contains the hostname and a processid,
--   so it is possible to decide if two site ids belong to the same process
--   or the the same computer or are on distinct computers.
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)


-- | Just a little Map to hold the SiteIds an to get the neighbout Ids.
type SiteMap = Map.Map HostName (Set.Set SiteId)




-- ----------------------------------------------------------------------------
-- Operations on the SiteId
-- ----------------------------------------------------------------------------


-- | Little helper function.
getHostName :: IO (HostName)
getHostName
  = do
    (hn, _) <- getNameInfo [] True False (SockAddrUnix "localhost")
    return (maybe "localhost" id hn)
    

-- | Gets the SiteId for the calling program. 
getSiteId :: IO (SiteId)
getSiteId
  = do
    hn <- getHostName
    pid <- getProcessID
    return (SiteId hn pid)

       
-- | Extracts the Hostname from the SiteId.
getSiteHost :: SiteId -> HostName
getSiteHost (SiteId hn _) = hn


-- | Extracts the ProcessID from the SiteId.
getSiteProcess :: SiteId -> ProcessID
getSiteProcess (SiteId _ pid) = pid


-- | Test, if the two Ids are located on the same host.
isSameHost :: SiteId -> SiteId -> Bool
isSameHost (SiteId hn1 _) (SiteId hn2 _) = hn1 == hn2


-- | Test, if the two Ids are located on the same host an in the same process.
isSameProcess :: SiteId -> SiteId -> Bool
isSameProcess = (==)


-- | The filtering function.
--   Splits the given Id-list into three sublists:
--   the Ids from the same process,
--   the Ids from the same computer,
--   all other Ids.
--   This is some sort of distance function, a simple one, but for now it
--   should do its work.
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


-- | Gets the nearest item from an Id-list compared to a given Id.
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
  
  
  
  
-- ----------------------------------------------------------------------------
-- Operations on the SiteMap
-- ----------------------------------------------------------------------------

-- | Empty SiteId-Map.
emptySiteMap :: SiteMap
emptySiteMap = Map.empty


-- | Adds an id to the map.
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)


-- | Deletes an id from the map.
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


-- | Delete a hostname an all its ids from the map.
deleteHostFromMap :: HostName -> SiteMap -> SiteMap
deleteHostFromMap hn m
  = Map.alter f hn m
    where
      f _ = Nothing


-- | Test, if the site id is already in the list.
isSiteIdMember :: SiteId -> SiteMap -> Bool 
isSiteIdMember i m
  = maybe False (\s -> Set.member i s) (Map.lookup hn m) 
    where
      hn = getSiteHost i


-- | Gets all ids which are on the same host, but not
--   the original siteid itself.
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