SunRed/myriad
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

style/refactor

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Myriad.hs
View file

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

40
src/Myriad/Config.hs
View file

@ -29,25 +29,35 @@ data Language = Language
, retries :: Int , retries :: Int
} deriving (Show) } 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 :: RawConfig -> Config
fromRawConfig (r@RawConfig { rawLanguages, rawDefaultLanguage }) = fromRawConfig r =
Config Config
{ languages = map f rawLanguages { languages = map (fromRawLanguage $ rawDefaultLanguage r) $ rawLanguages r
, buildConcurrently = rawBuildConcurrently r , buildConcurrently = rawBuildConcurrently r
, prepareContainers = rawPrepareContainers r , prepareContainers = rawPrepareContainers r
, cleanupInterval = rawCleanupInterval r , cleanupInterval = rawCleanupInterval r
, port = rawPort r , port = rawPort r
} }
where
f :: RawLanguage -> Language fromRawLanguage :: DefaultLanguage -> RawLanguage -> Language
f l = fromRawLanguage d l =
Language Language
{ name = rawName l { name = rawName l
, memory = fromMaybe (defMemory rawDefaultLanguage) (rawMemory l) , memory = fromMaybe (defMemory d) (rawMemory l)
, cpus = fromMaybe (defCpus rawDefaultLanguage) (rawCpus l) , cpus = fromMaybe (defCpus d) (rawCpus l)
, timeout = fromMaybe (defTimeout rawDefaultLanguage) (rawTimeout l) , timeout = fromMaybe (defTimeout d) (rawTimeout l)
, concurrent = fromMaybe (defConcurrent rawDefaultLanguage) (rawConcurrent l) , concurrent = fromMaybe (defConcurrent d) (rawConcurrent l)
, retries = fromMaybe (defRetries rawDefaultLanguage) (rawRetries l) , retries = fromMaybe (defRetries d) (rawRetries l)
} }
data RawConfig = RawConfig data RawConfig = RawConfig
@ -101,13 +111,3 @@ instance FromYAML RawLanguage where
<*> m .:? "timeout" <*> m .:? "timeout"
<*> m .:? "concurrent" <*> m .:? "concurrent"
<*> m .:? "retries" <*> 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

2
src/Myriad/Docker.hs
View file

@ -23,8 +23,8 @@ import Control.Exception.Lifted
import System.FilePath ((</>)) import System.FilePath ((</>))
import System.Process.Typed import System.Process.Typed
import Myriad.Core
import Myriad.Config import Myriad.Config
import Myriad.Core
type Myriad = MyriadT IO type Myriad = MyriadT IO

12
src/Myriad/Server.hs
View file

@ -18,14 +18,20 @@ import Control.Concurrent.Async.Lifted
import Control.Concurrent.MVar.Lifted import Control.Concurrent.MVar.Lifted
import Servant import Servant
import Myriad.Core
import Myriad.Config import Myriad.Config
import Myriad.Core
import Myriad.Docker import Myriad.Docker
type Myriad = MyriadT Handler type Myriad = MyriadT Handler
data EvalRequest = EvalRequest { language :: T.Text, code :: String } deriving (Generic, FromJSON) data EvalRequest = EvalRequest
data EvalResponse = EvalResponse { result :: T.Text } deriving (Generic, ToJSON) { language :: T.Text
, code :: String
} deriving (Generic, FromJSON)
data EvalResponse = EvalResponse
{ result :: T.Text
} deriving (Generic, ToJSON)
type API type API
= "languages" :> Get '[JSON] [T.Text] = "languages" :> Get '[JSON] [T.Text]