Job.hs

{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE RecordWildCards #-}

module Periodic.Types.Job
  ( FuncName (..)
  , JobName (..)
  , Workload (..)
  , JobHandle
  , Job
  , initJob
  , setWorkload
  , setSchedAt
  , setCount
  , setTimeout
  , getFuncName
  , getName
  , getWorkload
  , getSchedAt
  , getCount
  , getTimeout
  , getHandle
  , unHandle
  , jobHandle
  ) where

import           Data.Byteable           (Byteable (..))
import           Data.ByteString         (ByteString)
import qualified Data.ByteString.Char8   as B (empty, length)
import           Data.ByteString.Lazy    (toStrict)
import           Data.Hashable
import           Data.Int                (Int64)
import           GHC.Generics            (Generic)

import           Data.String             (IsString (..))
import           Periodic.Types.Internal

import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Put

newtype FuncName  = FuncName {unFN :: ByteString}
  deriving (Generic, Eq, Ord, Show)

instance Hashable FuncName

instance IsString FuncName where
  fromString = FuncName . fromString

instance FromBS FuncName where
  fromBS = FuncName . fromBS

instance Binary FuncName where
  get = do
    size <- getWord8
    dat <- getByteString $ fromIntegral size
    return $ FuncName dat
  put (FuncName dat) = do
    putWord8 . fromIntegral $ B.length dat
    putByteString dat

instance Validatable FuncName where
  validate (FuncName n) = validateLength "FuncName" 1 255 $ B.length n

newtype JobName   = JobName {unJN :: ByteString}
  deriving (Generic, Eq, Ord, Show)

instance Hashable JobName

instance IsString JobName where
  fromString = JobName . fromString

instance FromBS JobName where
  fromBS = JobName . fromBS

instance Binary JobName where
  get = do
    size <- getWord8
    dat <- getByteString $ fromIntegral size
    return $ JobName dat
  put (JobName dat) = do
    putWord8 . fromIntegral $ B.length dat
    putByteString dat

instance Validatable JobName where
  validate (JobName n) = validateLength "JobName" 1 255 $ B.length n

data JobHandle = JobHandle FuncName JobName
    deriving (Generic, Eq, Ord, Show)

instance Hashable JobHandle

instance Binary JobHandle where
  get = do
    fn <- get
    JobHandle fn <$> get
  put (JobHandle fn jn) = do
    put fn
    put jn

instance Validatable JobHandle where
  validate (JobHandle fn jn) = do
    validate fn
    validate jn

newtype Workload  = Workload {unWL :: ByteString}
  deriving (Generic, Eq, Ord, Show)

instance Hashable Workload

instance IsString Workload where
  fromString = Workload . fromString

instance FromBS Workload where
  fromBS = Workload . fromBS

instance Binary Workload where
  get = do
    size <- getWord32be
    dat <- getByteString $ fromIntegral size
    return $ Workload dat
  put (Workload dat) = do
    putWord32be . fromIntegral $ B.length dat
    putByteString dat

instance Validatable Workload where
  validate (Workload n) = validateLength "Workload" 0 maxBound $ B.length n

data Job = Job
    { jFuncName :: FuncName
    , jName     :: JobName
    , jWorkload :: Workload
    , jSchedAt  :: Int64
    , jCount    :: Int
    , jTimeout  :: Int
    }
    deriving (Show)

instance Byteable Job where
  toBytes = toStrict . encode

data JVer = V0
    | V1
    | V2
    | V3

toVer :: Int -> JVer
toVer 0 = V0
toVer 1 = V1
toVer 2 = V2
toVer 3 = V3
toVer _ = V0

fromVer :: JVer -> Int
fromVer V0 = 0
fromVer V1 = 1
fromVer V2 = 2
fromVer V3 = 3

calcVer :: Job -> JVer
calcVer Job{jCount = count, jTimeout = to}
  | count > 0 && to > 0 = V3
  | to > 0 = V2
  | count > 0 = V1
  | otherwise = V0


instance Binary Job where
  get = do
    jFuncName <- get
    jName <- get
    jWorkload <- get
    jSchedAt <- getInt64be
    ver <- toVer . fromIntegral <$> getWord8
    (jCount, jTimeout) <-
      case ver of
        V0 -> pure (0, 0)
        V1 -> do
          v <- fromIntegral <$> getInt32be
          pure (v, 0)
        V2 -> do
          v <- fromIntegral <$> getInt32be
          pure (0, v)
        V3 -> do
          v0 <- fromIntegral <$> getInt32be
          v1 <- fromIntegral <$> getInt32be
          pure (v0, v1)
    return Job {..}
  put j@Job {..} = do
    put jFuncName
    put jName
    put jWorkload
    putInt64be jSchedAt
    let ver = calcVer j

    putWord8 $ fromIntegral $ fromVer ver

    case ver of
      V0 -> pure ()
      V1 -> putInt32be $ fromIntegral jCount
      V2 -> putInt32be $ fromIntegral jTimeout
      V3 -> do
        putInt32be $ fromIntegral jCount
        putInt32be $ fromIntegral jTimeout

instance Validatable Job where
  validate (Job fn jn w _ c t) = do
    validate fn
    validate jn
    validate w
    validateNum "JobCount" 0 maxBound c
    validateNum "JobTimeout" 0 maxBound t

initJob :: FuncName -> JobName -> Job
initJob jFuncName jName = Job
  { jWorkload = Workload B.empty
  , jSchedAt = 0
  , jCount = 0
  , jTimeout = 0
  , ..
  }

setSchedAt :: Int64 -> Job -> Job
setSchedAt schedAt job = job {jSchedAt = schedAt}

setWorkload :: Workload -> Job -> Job
setWorkload w job = job {jWorkload = w}

setCount :: Int -> Job -> Job
setCount c job = job {jCount = c}

setTimeout :: Int -> Job -> Job
setTimeout t job = job {jTimeout = t}

getFuncName :: Job -> FuncName
getFuncName = jFuncName

getName :: Job -> JobName
getName = jName

getSchedAt :: Job -> Int64
getSchedAt = jSchedAt

getWorkload :: Job -> Workload
getWorkload = jWorkload

getCount :: Job -> Int
getCount = jCount

getTimeout :: Job -> Int
getTimeout = jTimeout

getHandle :: Job -> JobHandle
getHandle job = jobHandle (getFuncName job) (getName job)

unHandle :: JobHandle -> (FuncName, JobName)
unHandle (JobHandle fn jn) = (fn, jn)

jobHandle :: FuncName -> JobName -> JobHandle
jobHandle = JobHandle