143 lines
4.0 KiB
Haskell
143 lines
4.0 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Myriad.Config
|
|
( LanguageName
|
|
, Config(..)
|
|
, Language(..)
|
|
, readConfig
|
|
) where
|
|
|
|
import Data.Aeson
|
|
import qualified Data.ByteString as B
|
|
import Data.Maybe
|
|
import qualified Data.Text as T
|
|
import Data.Yaml
|
|
|
|
import Optics
|
|
|
|
type LanguageName = T.Text
|
|
|
|
data Language = Language
|
|
{ _name :: LanguageName
|
|
, _runtime :: T.Text
|
|
, _memory :: T.Text
|
|
, _cpus :: Double
|
|
, _timeout :: Int
|
|
, _concurrent :: Int
|
|
, _retries :: Int
|
|
, _outputLimit :: T.Text
|
|
} deriving (Show)
|
|
|
|
makeFieldLabelsWith classUnderscoreNoPrefixFields ''Language
|
|
|
|
data Config = Config
|
|
{ _languages :: [Language]
|
|
, _buildConcurrently :: Bool
|
|
, _prepareContainers :: Bool
|
|
, _cleanupInterval :: Int
|
|
, _port :: Int
|
|
} deriving (Show)
|
|
|
|
makeFieldLabelsWith classUnderscoreNoPrefixFields ''Config
|
|
|
|
data DefaultLanguage = DefaultLanguage
|
|
{ _runtime :: T.Text
|
|
, _memory :: T.Text
|
|
, _cpus :: Double
|
|
, _timeout :: Int
|
|
, _concurrent :: Int
|
|
, _retries :: Int
|
|
, _outputLimit :: T.Text
|
|
} deriving (Show)
|
|
|
|
makeFieldLabelsWith classUnderscoreNoPrefixFields ''DefaultLanguage
|
|
|
|
instance FromJSON DefaultLanguage where
|
|
parseJSON = withObject "default language" $ \m -> DefaultLanguage
|
|
<$> m .: "runtime"
|
|
<*> m .: "memory"
|
|
<*> m .: "cpus"
|
|
<*> m .: "timeout"
|
|
<*> m .: "concurrent"
|
|
<*> m .: "retries"
|
|
<*> m .: "outputLimit"
|
|
|
|
data RawLanguage = RawLanguage
|
|
{ _name :: LanguageName
|
|
, _runtime :: Maybe T.Text
|
|
, _memory :: Maybe T.Text
|
|
, _cpus :: Maybe Double
|
|
, _timeout :: Maybe Int
|
|
, _concurrent :: Maybe Int
|
|
, _retries :: Maybe Int
|
|
, _outputLimit :: Maybe T.Text
|
|
} deriving (Show)
|
|
|
|
makeFieldLabelsWith classUnderscoreNoPrefixFields ''RawLanguage
|
|
|
|
instance FromJSON RawLanguage where
|
|
parseJSON = withObject "language" $ \m -> RawLanguage
|
|
<$> m .: "name"
|
|
<*> m .:? "runtime"
|
|
<*> m .:? "memory"
|
|
<*> m .:? "cpus"
|
|
<*> m .:? "timeout"
|
|
<*> m .:? "concurrent"
|
|
<*> m .:? "retries"
|
|
<*> m .:? "outputLimit"
|
|
|
|
data RawConfig = RawConfig
|
|
{ _languages :: [RawLanguage]
|
|
, _defaultLanguage :: DefaultLanguage
|
|
, _buildConcurrently :: Bool
|
|
, _prepareContainers :: Bool
|
|
, _cleanupInterval :: Int
|
|
, _port :: Int
|
|
} deriving (Show)
|
|
|
|
makeFieldLabelsWith classUnderscoreNoPrefixFields ''RawConfig
|
|
|
|
instance FromJSON RawConfig where
|
|
parseJSON = withObject "config" $ \m -> RawConfig
|
|
<$> m .: "languages"
|
|
<*> m .: "defaultLanguage"
|
|
<*> m .: "buildConcurrently"
|
|
<*> m .: "prepareContainers"
|
|
<*> m .: "cleanupInterval"
|
|
<*> m .: "port"
|
|
|
|
readConfig :: FilePath -> IO Config
|
|
readConfig = fmap fromRawConfig . readRawConfig
|
|
|
|
readRawConfig :: FilePath -> IO RawConfig
|
|
readRawConfig f = do
|
|
x <- B.readFile f
|
|
case Data.Yaml.decodeEither' x of
|
|
Left e -> error $ prettyPrintParseException e
|
|
Right y -> pure y
|
|
|
|
fromRawConfig :: RawConfig -> Config
|
|
fromRawConfig r =
|
|
Config
|
|
{ _languages = map (fromRawLanguage (r ^. #defaultLanguage)) $ r ^. #languages
|
|
, _buildConcurrently = r ^. #buildConcurrently
|
|
, _prepareContainers = r ^. #prepareContainers
|
|
, _cleanupInterval = r ^. #cleanupInterval
|
|
, _port = r ^. #port
|
|
}
|
|
|
|
fromRawLanguage :: DefaultLanguage -> RawLanguage -> Language
|
|
fromRawLanguage d r =
|
|
Language
|
|
{ _name = r ^. #name
|
|
, _runtime = fromMaybe (d ^. #runtime) (r ^. #runtime)
|
|
, _memory = fromMaybe (d ^. #memory) (r ^. #memory)
|
|
, _cpus = fromMaybe (d ^. #cpus) (r ^. #cpus)
|
|
, _timeout = fromMaybe (d ^. #timeout) (r ^. #timeout)
|
|
, _concurrent = fromMaybe (d ^. #concurrent) (r ^. #concurrent)
|
|
, _retries = fromMaybe (d ^. #retries) (r ^. #retries)
|
|
, _outputLimit = fromMaybe (d ^. #outputLimit) (r ^. #outputLimit)
|
|
}
|