OnRmt-1.0.0.0: sample/GetRemotes.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module GetRemotes where

import Data.List
import Data.Maybe
import qualified Data.Text as T
import Control.Concurrent
import Network.OnRmt (WorkEntry(..), WorkGroup(..), WorkItems(..))


data EntryData = EData T.Text (Maybe T.Text) [T.Text]
data Entry a = EGroup T.Text (Entry a) | EList [a] | Entry a :++: Entry a

summarize (EData n _ is) = T.intercalate "\n" $ n : is
identifyEnt (EData n ma is) _ = n
                              `T.append` maybe "" (\a -> " @ " `T.append` a) ma
                              `T.append` if null is then "" else " -- " `T.append` head is
nameEnt (EData n _ _) = n

getEntries :: IO (Entry EntryData)
getEntries = return $
             (EGroup "Server" $ EGroup "Dev" $
                     EList [ EData "serverhost01" Nothing ["x86_64 dev host"
                                                          ,"in dev lab"]
                           , EData "serverhost02" Nothing ["AMD dev host"
                                                          ,"dev Lab"]
                           , EData "serverhost03" Nothing ["x32 dev host"
                                                          ,"dev Lab"]
                           ])
             :++: (EGroup "Server" $ EGroup "Test" $
                          EList [ EData "testhost01" Nothing ["TEST/QA host"]
                                , EData "testhost02" Nothing ["TEST/QA host"]
                                ])
             :++: (EGroup "Server" $ EGroup "PROD" $
                          EList [ EData "host01" Nothing ["Zone1 PRODUCTION host"
                                                         ,"Canada Datacenter"]
                                , EData "host02" Nothing ["Zone2 PRODUCTION host"
                                                         ,"England Datacenter"]
                                , EData "host03" Nothing ["Zone3 PRODUCTION host"
                                                         ,"Singapore Datacenter"]
                                ])
             :++: (EGroup "DBase" $ EGroup "PROD" $
                          EList [EData "dbs001.prod.company.co"
                                       Nothing ["MySQL Controller"]])
             :++: (EGroup "DBase" $ EGroup "PROD" $
                              (EGroup "Linux" $
                                      EList [ EData "dbs002"
                                                        (Just "dbs001.prod.company.co")
                                                        ["MySQL Primary Node"]
                                            , EData "dbs003" (Just "127.0.0.1") ["DB Node"]
                                            , EData "dbs004" (Just "127.0.0.1") ["DB Node"]
                                            , EData "dbs005" (Just "127.0.0.1") ["DB Node"]])
                              :++: (EGroup "Windows" $
                                           EList [ EData "mssql01.prod.company.co" Nothing ["MSSQL Node"]
                                                 , EData "mssql02.prod.company.co" Nothing ["MSSQL Node"]
                                                 , EData "mssql01b" (Just "127.0.0.1") ["MSSQL Standby Node"]
                                                 , EData "mssql02b" (Just "localhost") ["MSSQL Standby Node"]]))
             :++: (EGroup "WebServer" $ EGroup "Prod" $
                           (EGroup "WestCoast" $
                                   EList [ EData "websrv-3" (Just "websrv-3") ["WebServer Node"]
                                         , EData "websrv-4" (Just "websrv-4") ["WebServer Node"]
                                         , EData "websrv008" (Just "websrv008") ["WebServer Node"]
                                         , EData "webserv009" (Just "websrv009") ["WebServer Node"]])
                           :++: (EGroup "EastCoast" $
                                        EList [ EData "websrvec001" (Just "websrvec001") ["WebServer Node"]
                                              , EData "websrvec002" (Just "websrvec002") ["WebServer Node"]
                                              , EData "websrvec19" (Just "websrvec19") ["WebServer Node"]
                                              ]))

             :++: (EList (EData "localhost" Nothing ["Current system"]
                          : map (\n -> EData (T.append "Host#" $ T.pack $ show n) (Just "localhost") []) [1..255]))


segregate :: Entry a -> [WorkItems]
segregate (EList ls) = [WorkItems $ length ls]
segregate (EGroup g e) = map (WorkGroup g) $ segregate e
segregate (a :++: b) = segregate a ++ segregate b


cntEntries :: Entry a -> Int
cntEntries (EList ls)   = length ls
cntEntries (EGroup _ g) = cntEntries g
cntEntries (a :++: b)   = cntEntries a + cntEntries b


entryNum :: Entry a -> Int -> a
entryNum es n = either id (error "Invalid Entry #") $ eNum (Right n) es
    where eNum rem (EList ls) = rem >>= \n -> if n >= length ls
                                              then Right (n - length ls)
                                              else Left (ls !! n)
          eNum rem (EGroup _ s) = eNum rem s
          eNum rem (a :++: b) = eNum (eNum rem a) b


instance WorkEntry EntryData where
    name     = nameEnt
    identify = identifyEnt
    rmtaddr (EData n ma _) = maybe n id ma

instance WorkEntry a => WorkGroup (Entry a) where
    type GroupEntry (Entry a) = a
    getItems   = segregate
    numEntries = cntEntries
    getEntry   = entryNum