CastInstances.hs

-- -*- indent-tabs-mode: nil -*- --

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Control.Distributed.CCTools.WorkQueue.Internal.CastInstances where

import Bindings.CCTools.WorkQueue

import Control.Distributed.CCTools.WorkQueue.Internal.Cast
import Control.Distributed.CCTools.WorkQueue.Internal.Types

import Foreign.C.Types

import Control.Lens ((^.))

-- * Haskell-provided

-- ** 'Int' <-> 'CInt'
instance Castable Int CInt       where cast = fromIntegral
instance Castable CInt Int       where cast = fromIntegral

-- ** 'Double' <-> 'CDouble'
instance Castable Double CDouble where cast = fromRational . toRational
instance Castable CDouble Double where cast = fromRational . toRational



-- * For WorkQueue

-- ** Utilities

-- *** 'Castable' a b => 'Castable' ('NPlus' a) b
instance Castable a b => Castable (NPlus a) b where
    cast (NP v) = cast v

instance ( Castable a b
         , Num a, Num b
         , Ord a
         , Show a)
    => Castable a (NPlus b)
    where
      cast v | v > 0     = NP    $ cast v
             | otherwise = error $ "Got a non-positive value when constructing an NPlus: " ++ show v

-- *** DataSize

instance Castable (DataSize a) Integer where
    cast = _unDS

-- *** Time

instance Castable (EpochTime a) Integer where cast = _unET
instance Castable (DiffTime  a) Integer where cast = _unDT


-- *** File Locality

instance Castable (Location a) FilePath where cast = _unL


-- ** 'MasterMode'

instance Castable MasterMode CInt where
    cast Standalone = c'WORK_QUEUE_MASTER_MODE_STANDALONE
    cast Catalog    = c'WORK_QUEUE_MASTER_MODE_CATALOG

instance Castable CInt MasterMode where
    cast v | v == c'WORK_QUEUE_MASTER_MODE_STANDALONE = Standalone
              | v == c'WORK_QUEUE_MASTER_MODE_CATALOG    = Catalog
              | otherwise                                = error $ "Cannot cast to MasterMode: " ++ show v


-- ** 'Hunger'

instance Castable CInt Hunger where
    cast v | v <= 0    = Full
              | otherwise = Hungry $ fromIntegral v


-- ** 'FastAbort'

instance Castable FastAbort CDouble where
    cast FastAbortOff = 0
    cast (FastAbort v) = cast v

-- ** 'Timeout'

instance Castable Timeout CInt where
    cast Forever = -1
    cast (Seconds v) = fromIntegral v

-- ** 'Cached'

instance Castable Cached CInt where
    cast c = if c
                then c'WORK_QUEUE_CACHE
                else c'WORK_QUEUE_NOCACHE


-- ** 'WorkerScheduleAlg'

instance Castable WorkerScheduleAlg CInt where
    cast FCFS  = c'WORK_QUEUE_SCHEDULE_FCFS
    cast FILES = c'WORK_QUEUE_SCHEDULE_FILES
    cast TIME  = c'WORK_QUEUE_SCHEDULE_TIME
    cast RAND  = c'WORK_QUEUE_SCHEDULE_RAND  

instance Castable CInt WorkerScheduleAlg where
    cast v | v == c'WORK_QUEUE_SCHEDULE_FCFS  = FCFS
              | v == c'WORK_QUEUE_SCHEDULE_FILES = FILES
              | v == c'WORK_QUEUE_SCHEDULE_TIME  = TIME
              | v == c'WORK_QUEUE_SCHEDULE_RAND  = RAND
              | otherwise                        = error $ "Cannot cast CInt to WorkerScheduleAlg: " ++ show v

-- ** 'TaskOrdering'

instance Castable TaskOrdering CInt where
    cast LIFO = c'WORK_QUEUE_TASK_ORDER_LIFO
    cast FIFO = c'WORK_QUEUE_TASK_ORDER_FIFO

-- ** 'FileType'

instance Castable FileType CInt where
    cast InputFile  = c'WORK_QUEUE_INPUT
    cast OutputFile = c'WORK_QUEUE_OUTPUT

-- ** TaskID

instance Castable CInt TaskID where
    cast = TID . fromIntegral

instance Integral b => Castable TaskID b where
    cast (TID v) = fromIntegral v


-- ** Port

instance Castable (Maybe Port) CInt where
    cast Nothing = c'WORK_QUEUE_RANDOM_PORT
    cast (Just p) = cast $ p^.unP

-- ** Command

instance Castable Command String where
    cast = _unC