gdritter repos bb8 / master src / BB8 / Types.hs
master

Tree @master (Download .tar.gz)

Types.hs @masterraw · history · blame

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module BB8.Types where

import           Control.Exception.Base
import           Data.Aeson ((.=), (.:), (.:?))
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time.Clock as Time
import qualified Database.SQLite.Simple as SQL
import qualified Database.SQLite.Simple.FromField as SQL
import qualified Database.SQLite.Simple.ToField as SQL
import qualified Database.SQLite.Simple.Ok as SQL

-- * Configuration

data Config = Config
  { configSleepAmount   :: Int
  , configDBPath        :: FilePath
  , configWorkDirectory :: FilePath
  }


-- * Job-related types

type JobName = T.Text
type JobID   = Integer


-- ** User

data User = User
  { userName :: T.Text
  , userTeam :: T.Text
  } deriving (Eq, Show, Read)

instance Aeson.ToJSON User where
  toJSON user = Aeson.object
    [ "username" .= userName user
    , "userteam" .= userTeam user
    ]

instance Aeson.FromJSON User where
  parseJSON = Aeson.withObject "user" $ \o -> do
    userName <- o .: "username"
    userTeam <- o .: "userteam"
    return User { .. }


-- ** State

data FailureReason
  = FailedDuringBuilding Int
  | FailedDuringRunning Int
    deriving (Eq, Show, Read)

-- | How far along a job is, including a failure state
data JobState
  = QueuedState
  | FetchingState
  | BuildingState
  | RunningState
  | FinishingState
  | DoneState
  | FailedState
  | DeletedState
    deriving (Eq, Show, Read)

isFinished :: Job -> Bool
isFinished Job { jobState = st } =
  st == DoneState || st == FailedState || st == DeletedState

instance Aeson.ToJSON JobState where
  toJSON QueuedState    = Aeson.String "queued"
  toJSON FetchingState  = Aeson.String "fetching"
  toJSON BuildingState  = Aeson.String "building"
  toJSON RunningState   = Aeson.String "running"
  toJSON FinishingState = Aeson.String "finishing"
  toJSON DoneState      = Aeson.String "done"
  toJSON FailedState    = Aeson.String "failed"
  toJSON DeletedState   = Aeson.String "deleted"

data InvalidState = InvalidState
  deriving (Eq, Show)

instance Exception InvalidState where

instance SQL.FromField JobState where
  fromField f = case SQL.fieldData f of
    SQL.SQLText "queued"    -> return QueuedState
    SQL.SQLText "fetching"  -> return FetchingState
    SQL.SQLText "building"  -> return BuildingState
    SQL.SQLText "running"   -> return RunningState
    SQL.SQLText "finishing" -> return FinishingState
    SQL.SQLText "done"      -> return DoneState
    SQL.SQLText "failed"    -> return FailedState
    SQL.SQLText "deleted"   -> return DeletedState
    _                       -> SQL.Errors [toException InvalidState]

instance SQL.ToField JobState where
  toField f = case f of
    QueuedState    -> SQL.SQLText "queued"
    FetchingState  -> SQL.SQLText "fetching"
    BuildingState  -> SQL.SQLText "building"
    RunningState   -> SQL.SQLText "running"
    FinishingState -> SQL.SQLText "finishing"
    DoneState      -> SQL.SQLText "done"
    FailedState    -> SQL.SQLText "failed"
    DeletedState   -> SQL.SQLText "deleted"

-- ** Job

data Job = Job
  { jobName  :: T.Text
  , jobUser  :: User
  , jobID    :: JobID
  , jobState :: JobState
  , jobJira  :: Maybe T.Text
  , jobTag   :: Maybe T.Text
  } deriving (Eq, Show, Read)

instance Aeson.ToJSON Job where
  toJSON job = Aeson.object
    [ "name"  .= jobName job
    , "user"  .= jobUser job
    , "id"    .= jobID job
    , "state" .= jobState job
    ]

instance Aeson.FromJSON Job where
  parseJSON = Aeson.withObject "job" $ \o -> do
    jobName <- o .: "name"
    jobUser <- o .: "user"
    let jobID = 0
        jobState = FetchingState
    jobJira <- o .:? "jira"
    jobTag  <- o .:? "tag"
    return Job { .. }


-- ** Timing Info

data TimingInfo = TimingInfo
  { timingName   :: T.Text -- ^ The name of the timing phase
  , timingStart  :: Time.UTCTime -- ^ The point at which the timing
                                 -- phase started
  , timingEnd    :: Time.UTCTime -- ^ The point at which the timing
                                 -- phase ended
  , timingLength :: Integer -- ^ The total length of the time
  } deriving (Eq, Show)

-- | Lines in the output trace are either from stdout or from stderr
data LineSource
  = SourceStdout
  | SourceStderr
    deriving (Eq, Show, Read)

-- | An output line has a timestamp, a source, and the raw text of
-- that line
data OutputLine = OutputLine
  { lineTime   :: Time.UTCTime
  , lineSource :: LineSource
  , lineText   :: BS.ByteString
  } deriving (Eq, Show, Read)

-- * The values we send the web front-end

data QueueState = QueueState
  { queueJobs :: [Job]
  } deriving (Eq, Show, Read)

instance Aeson.ToJSON QueueState where
  toJSON queue = Aeson.toJSON (queueJobs queue)

data JobTrace = JobTrace
  { buildTrace :: Maybe BS.ByteString
  , runTrace   :: Maybe BS.ByteString
  } deriving (Eq, Show, Read)

instance Aeson.ToJSON JobTrace where
  toJSON trace = Aeson.object
    [ "build" .= Aeson.toJSON (fmap T.decodeUtf8 (buildTrace trace))
    , "run"   .= Aeson.toJSON (fmap T.decodeUtf8 (runTrace trace))
    ]