Separate lib and exe; add languageDir setting
This commit is contained in:
parent
abbce96d0a
commit
8eb44f2544
6 changed files with 38 additions and 16 deletions
|
@ -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
|
|
@ -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
|
||||
|
|
10
package.yaml
10
package.yaml
|
@ -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
21
src/Myriad.hs
Normal 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
|
|
@ -61,6 +61,7 @@ data MyriadConfig = MyriadConfig
|
|||
, prepareContainers :: Bool
|
||||
, cleanupInterval :: Natural
|
||||
, port :: Natural
|
||||
, languagesDir :: T.Text
|
||||
} deriving (Show, Generic)
|
||||
|
||||
instance Interpret MyriadConfig
|
||||
|
|
|
@ -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 ()
|
||||
|
|
Loading…
Reference in a new issue