-- -*- indent-tabs-mode: nil -*- -- {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} module Control.Distributed.CCTools.WorkQueue.Internal.Types where import Bindings.CCTools.WorkQueue import Foreign.Ptr import Foreign.ForeignPtr import Control.Lens -- * Usefull types newtype NPlus a = NP { _unZP :: a } deriving (Enum, Num, Real, Eq, Ord, Show) deriving instance Integral a => Integral (NPlus a) nplus :: (Ord a, Num a, Show a) => a -> NPlus a nplus v | v > 0 = NP v | otherwise = error $ "Cannot create an NPlus with: " ++ show v -- ** Unit-typed data volume data Bytes newtype DataSize a = DS { _unDS :: Integer } makeLenses ''DataSize bytes :: Integral i => i -> DataSize Bytes bytes = DS . fromIntegral -- ** Unit-typed time data Seconds data MicroSeconds -- | Time since January 1, 1970 newtype EpochTime a = ET { _unET :: Integer } -- | Difference between two 'EpochTime's newtype DiffTime a = DT { _unDT :: Integer } makeLenses ''EpochTime makeLenses ''DiffTime diffTime :: EpochTime a -> EpochTime a -> DiffTime a diffTime t1 t0 = DT $ t1' - t0' where t0' = view unET t0 t1' = view unET t1 epoch :: Integral i => i -> EpochTime a epoch = ET . fromIntegral epochSeconds :: Integral i => i -> EpochTime Seconds epochSeconds = epoch epochMicroSeconds :: Integral i => i -> EpochTime MicroSeconds epochMicroSeconds = epoch -- ** Locality data Local data Remote newtype Location a = L { _unL :: FilePath } makeLenses ''Location remote :: FilePath -> Location Remote remote = L local :: FilePath -> Location Local local = L -- * WorkQueue-related -- ** Interface to WorkQueue newtype WorkQueue = WQ { _unWQ :: ForeignPtr C'work_queue } newtype Task = T { _unT :: Ptr C'work_queue_task } newtype Stats = S { _unS :: ForeignPtr C'work_queue_stats } makeLenses ''WorkQueue makeLenses ''Task makeLenses ''Stats data MasterMode = Standalone | Catalog deriving Show data Hunger = Full | Hungry (NPlus Int) deriving (Eq , Show) data FastAbort = FastAbortOff | FastAbort (NPlus Double) deriving Show data Timeout = Forever | Seconds (NPlus Int) deriving Show type Cached = Bool data WorkerScheduleAlg = FCFS | FILES | TIME | RAND deriving (Read, Show) data TaskOrdering = LIFO | FIFO deriving (Read, Show) data FileType = InputFile | OutputFile deriving (Read, Show) -- ** Semantically-typed newtype Command = C { _unC :: String } newtype TaskID = TID { _unTID :: Int } newtype Hostname = H { _unH :: String } newtype Port = P { _unP :: NPlus Int } deriving Show data QueueParams = QP { _qport :: Maybe Port , _name :: Maybe String , _fastabort :: Maybe FastAbort , _taskordering :: Maybe TaskOrdering , _priority :: Maybe Int , _mode :: Maybe MasterMode , _logfile :: Maybe FilePath , _scheduler :: Maybe WorkerScheduleAlg } deriving Show makeLenses ''Command makeLenses ''TaskID makeLenses ''Port makeLenses ''Hostname makeLenses ''QueueParams -- *** Smart Constructors -- | A 'Port' is a postive 'Int' port :: Int -> Port port = P . fromIntegral -- | Creates a 'Timeout' using 'Seconds' seconds :: Integral i => i -> Timeout seconds = Seconds . nplus . fromIntegral -- | A 'Command' to be executed remotely cmd :: String -> Command cmd = C -- | The 'Hostname' of a node hostname :: String -> Hostname hostname = H -- * Enabling WorkQueue debugging data DebugFlag = All | WorkQueue