Source

hs-cctools-workqueue / Control / Distributed / CCTools / WorkQueue / Internal / Types.hs

Full commit
-- -*- 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