Separate lib and exe; add languageDir setting

This commit is contained in:
1computer1 2019-07-23 01:24:02 -04:00
parent abbce96d0a
commit 8eb44f2544
6 changed files with 38 additions and 16 deletions

View File

@ -1,13 +1,10 @@
module Main where
import qualified Data.Text as T
import Options.Applicative
import Network.Wai.Handler.Warp (run)
import Myriad.Core
import Myriad.Docker
import Myriad.Server
import Myriad
data Args = Args
{ configInput :: T.Text
@ -26,10 +23,4 @@ parseArgs = execParser $ info (helper <*> args) (fullDesc <> progDesc "Run the M
main :: IO ()
main = do
Args { configInput } <- parseArgs
env <- initEnv configInput
runMyriadT env do
buildAllImages
startCleanup
logInfo ["Finished Docker-related setup"]
logInfo ["Starting server"]
run (fromIntegral . port . config $ env) $ app env
runMyriadServer configInput

View File

@ -24,6 +24,7 @@ let Config : Type =
, prepareContainers : Bool -- Whether to setup all containers on startup
, cleanupInterval : Natural -- The interval in minutes to kill containers periodically
, port : Natural -- Port to run on
, languagesDir : Text -- Where the languages are stored
}
-- Write your config here!
@ -35,5 +36,6 @@ let config : Config =
, prepareContainers = False
, cleanupInterval = 30
, port = 8081
, languagesDir = "./languages"
}
in config

View File

@ -20,12 +20,12 @@ dependencies:
- bytestring
- containers
- dhall
- filepath
- lifted-base
- lifted-async
- monad-control
- monad-logger
- mtl
- optparse-applicative
- servant
- servant-server
- snowflake
@ -66,11 +66,17 @@ default-extensions:
- TypeFamilies
- ViewPatterns
library:
source-dirs: src
executable:
main: Main.hs
source-dirs: src
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
- -Wall
dependencies:
- myriad
- optparse-applicative

21
src/Myriad.hs Normal file
View File

@ -0,0 +1,21 @@
module Myriad
( runMyriadServer
) where
import qualified Data.Text as T
import Network.Wai.Handler.Warp (run)
import Myriad.Core
import Myriad.Docker
import Myriad.Server
runMyriadServer :: T.Text -> IO ()
runMyriadServer configInput = do
env <- initEnv configInput
runMyriadT env do
buildAllImages
startCleanup
logInfo ["Finished Docker-related setup"]
logInfo ["Starting server"]
run (fromIntegral . port . config $ env) $ app env

View File

@ -61,6 +61,7 @@ data MyriadConfig = MyriadConfig
, prepareContainers :: Bool
, cleanupInterval :: Natural
, port :: Natural
, languagesDir :: T.Text
} deriving (Show, Generic)
instance Interpret MyriadConfig

View File

@ -20,17 +20,18 @@ import Control.Concurrent.Lifted (fork, threadDelay)
import Control.Concurrent.MVar.Lifted
import Control.Concurrent.QSem.Lifted
import Control.Exception.Lifted
import System.FilePath ((</>))
import System.Process.Typed
import Myriad.Core
buildImage :: Myriadic m => LanguageConfig -> m ()
buildImage lang@LanguageConfig { name, concurrent } = do
MyriadConfig { prepareContainers, languagesDir } <- asks config
logInfo ["Building image ", cs $ imageName lang]
exec_ ["docker build -t ", imageName lang, " ./languages/", cs name]
exec_ ["docker build -t ", imageName lang, " ", cs languagesDir </> cs name]
setupQSems
logInfo ["Built image ", cs $ imageName lang]
MyriadConfig { prepareContainers } <- asks config
when_ prepareContainers $ setupContainer lang
where
setupQSems :: Myriadic m => m ()