83 lines
1.9 KiB
Haskell
83 lines
1.9 KiB
Haskell
|
module Myriad.Core
|
||
|
( Language
|
||
|
, ContainerName
|
||
|
, ImageName
|
||
|
, EvalResult(..)
|
||
|
, Env(..)
|
||
|
, MyriadConfig(..)
|
||
|
, LanguageConfig(..)
|
||
|
, MyriadT
|
||
|
, MonadWithIO
|
||
|
, runMyriadT
|
||
|
, initEnv
|
||
|
) where
|
||
|
|
||
|
import Control.Monad.Base
|
||
|
import Control.Monad.Logger
|
||
|
import Control.Monad.Reader
|
||
|
import Control.Monad.Trans.Control
|
||
|
|
||
|
import qualified Data.ByteString.Lazy as BL
|
||
|
import qualified Data.Map.Strict as M
|
||
|
import qualified Data.Text as T
|
||
|
import Dhall
|
||
|
import GHC.Generics (Generic)
|
||
|
|
||
|
import Control.Concurrent.QSem
|
||
|
import Data.IORef.Lifted
|
||
|
import Data.Snowflake
|
||
|
|
||
|
type Language = T.Text
|
||
|
type ContainerName = String
|
||
|
type ImageName = String
|
||
|
|
||
|
data EvalResult = EvalOk BL.ByteString | EvalTimedOut | EvalErrored
|
||
|
|
||
|
data Env = Env
|
||
|
{ config :: MyriadConfig
|
||
|
, containers :: IORef (M.Map Language ContainerName)
|
||
|
, containerSems :: IORef (M.Map Language QSem)
|
||
|
, evalSems :: IORef (M.Map Language QSem)
|
||
|
, snowflakeGen :: SnowflakeGen
|
||
|
}
|
||
|
|
||
|
data MyriadConfig = MyriadConfig
|
||
|
{ languages :: [LanguageConfig]
|
||
|
, buildConcurrently :: Bool
|
||
|
, prepareContainers :: Bool
|
||
|
, cleanupInterval :: Natural
|
||
|
, port :: Integer
|
||
|
} deriving (Show, Generic)
|
||
|
|
||
|
instance Interpret MyriadConfig
|
||
|
|
||
|
data LanguageConfig = LanguageConfig
|
||
|
{ name :: Language
|
||
|
, memory :: T.Text
|
||
|
, cpus :: T.Text
|
||
|
, timeout :: Natural
|
||
|
, concurrent :: Natural
|
||
|
, retries :: Natural
|
||
|
} deriving (Show, Generic)
|
||
|
|
||
|
instance Interpret LanguageConfig
|
||
|
|
||
|
type MyriadT m = ReaderT Env (LoggingT m)
|
||
|
|
||
|
type MonadWithIO m = (MonadIO m, MonadBase IO m, MonadBaseControl IO m)
|
||
|
|
||
|
readConfig :: T.Text -> IO MyriadConfig
|
||
|
readConfig path = input auto path
|
||
|
|
||
|
initEnv :: T.Text -> IO Env
|
||
|
initEnv path =
|
||
|
Env
|
||
|
<$> readConfig path
|
||
|
<*> newIORef M.empty
|
||
|
<*> newIORef M.empty
|
||
|
<*> newIORef M.empty
|
||
|
<*> newSnowflakeGen defaultConfig 0
|
||
|
|
||
|
runMyriadT :: MonadIO m => Env -> MyriadT m a -> m a
|
||
|
runMyriadT env f = runStdoutLoggingT $ runReaderT f env
|