style/refactor

This commit is contained in:
1computer1 2020-06-16 22:37:38 -04:00
parent 3a10e3e72c
commit e2942e38b9
5 changed files with 43 additions and 37 deletions

View File

@ -8,8 +8,8 @@ import Data.String.Conversions
import Network.Wai.Handler.Warp
import Myriad.Core
import Myriad.Config
import Myriad.Core
import Myriad.Docker
import Myriad.Server

View File

@ -6,9 +6,9 @@ module Myriad.Config
) where
import qualified Data.ByteString.Lazy as BL
import Data.Maybe
import Data.Maybe
import qualified Data.Text as T
import Data.YAML
import Data.YAML
type LanguageName = T.Text
@ -29,26 +29,36 @@ data Language = Language
, retries :: Int
} deriving (Show)
readConfig :: FilePath -> IO Config
readConfig = fmap fromRawConfig . readRawConfig
readRawConfig :: FilePath -> IO RawConfig
readRawConfig f = do
x <- BL.readFile f
case decode1 x of
Left (pos, e) -> error $ prettyPosWithSource pos x e
Right y -> pure y
fromRawConfig :: RawConfig -> Config
fromRawConfig (r@RawConfig { rawLanguages, rawDefaultLanguage }) =
fromRawConfig r =
Config
{ languages = map f rawLanguages
{ languages = map (fromRawLanguage $ rawDefaultLanguage r) $ rawLanguages r
, buildConcurrently = rawBuildConcurrently r
, prepareContainers = rawPrepareContainers r
, cleanupInterval = rawCleanupInterval r
, port = rawPort r
}
where
f :: RawLanguage -> Language
f l =
Language
{ name = rawName l
, memory = fromMaybe (defMemory rawDefaultLanguage) (rawMemory l)
, cpus = fromMaybe (defCpus rawDefaultLanguage) (rawCpus l)
, timeout = fromMaybe (defTimeout rawDefaultLanguage) (rawTimeout l)
, concurrent = fromMaybe (defConcurrent rawDefaultLanguage) (rawConcurrent l)
, retries = fromMaybe (defRetries rawDefaultLanguage) (rawRetries l)
}
fromRawLanguage :: DefaultLanguage -> RawLanguage -> Language
fromRawLanguage d l =
Language
{ name = rawName l
, memory = fromMaybe (defMemory d) (rawMemory l)
, cpus = fromMaybe (defCpus d) (rawCpus l)
, timeout = fromMaybe (defTimeout d) (rawTimeout l)
, concurrent = fromMaybe (defConcurrent d) (rawConcurrent l)
, retries = fromMaybe (defRetries d) (rawRetries l)
}
data RawConfig = RawConfig
{ rawLanguages :: [RawLanguage]
@ -101,13 +111,3 @@ instance FromYAML RawLanguage where
<*> m .:? "timeout"
<*> m .:? "concurrent"
<*> m .:? "retries"
readConfig :: FilePath -> IO Config
readConfig = fmap fromRawConfig . readRawConfig
readRawConfig :: FilePath -> IO RawConfig
readRawConfig f = do
x <- BL.readFile f
case decode1 x of
Left (pos, e) -> error $ prettyPosWithSource pos x e
Right y -> pure y

View File

@ -27,7 +27,7 @@ import Control.Monad.Writer
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as M
import Data.Snowflake
import Data.Snowflake
import qualified Data.Text as T
import Control.Concurrent.MVar.Lifted

View File

@ -12,8 +12,8 @@ module Myriad.Docker
import Control.Monad.Reader
import qualified Data.Map.Strict as M
import Data.Snowflake
import Data.String.Conversions
import Data.Snowflake
import Data.String.Conversions
import Control.Concurrent.Async.Lifted
import Control.Concurrent.Lifted (fork, threadDelay)
@ -23,8 +23,8 @@ import Control.Exception.Lifted
import System.FilePath ((</>))
import System.Process.Typed
import Myriad.Core
import Myriad.Config
import Myriad.Core
type Myriad = MyriadT IO

View File

@ -7,25 +7,31 @@ module Myriad.Server
import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson
import Data.List (find)
import Data.Aeson
import Data.List (find)
import qualified Data.Map as M
import Data.String.Conversions
import Data.String.Conversions
import qualified Data.Text as T
import GHC.Generics
import GHC.Generics
import Control.Concurrent.Async.Lifted
import Control.Concurrent.MVar.Lifted
import Servant
import Myriad.Core
import Myriad.Config
import Myriad.Core
import Myriad.Docker
type Myriad = MyriadT Handler
data EvalRequest = EvalRequest { language :: T.Text, code :: String } deriving (Generic, FromJSON)
data EvalResponse = EvalResponse { result :: T.Text } deriving (Generic, ToJSON)
data EvalRequest = EvalRequest
{ language :: T.Text
, code :: String
} deriving (Generic, FromJSON)
data EvalResponse = EvalResponse
{ result :: T.Text
} deriving (Generic, ToJSON)
type API
= "languages" :> Get '[JSON] [T.Text]