diff --git a/myriad.cabal b/myriad.cabal index 55d7d4f..19f4372 100644 --- a/myriad.cabal +++ b/myriad.cabal @@ -23,33 +23,25 @@ source-repository head common shared default-language: Haskell2010 default-extensions: - BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric - DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies - GADTs GeneralizedNewtypeDeriving - KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PatternSynonyms - PolyKinds - RankNTypes - ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators - ViewPatterns build-depends: aeson , async diff --git a/src/Myriad.hs b/src/Myriad.hs index 439f46f..dc7c156 100644 --- a/src/Myriad.hs +++ b/src/Myriad.hs @@ -16,7 +16,7 @@ import Myriad.Server runMyriadServer :: FilePath -> FilePath -> IO () runMyriadServer configPath languagesDir = do env <- initEnv configPath languagesDir - runMyriadT env do + runMyriadT env $ do buildAllImages startCleanup logInfo ["Finished Docker-related setup"] diff --git a/src/Myriad/Docker.hs b/src/Myriad/Docker.hs index 9e9d3bb..f93802b 100644 --- a/src/Myriad/Docker.hs +++ b/src/Myriad/Docker.hs @@ -62,12 +62,12 @@ buildAllImages = do startCleanup :: Myriad () startCleanup = do Config { cleanupInterval } <- asks config - when_ (cleanupInterval > 0) do + when_ (cleanupInterval > 0) $ do let t = fromIntegral cleanupInterval * 60000000 fork $ timer t where timer :: Int -> Myriad () - timer t = forever do + timer t = forever $ do threadDelay t n <- killContainers logInfo ["Cleaned up ", cs $ show n, " containers"] @@ -133,11 +133,11 @@ killContainer lang = do killContainers :: Myriad [ContainerName] killContainers = do containers <- asks containers >>= readMVar - xs <- forConcurrently (M.toList containers) \(k, v) -> (v,) <$> killContainer k + xs <- forConcurrently (M.toList containers) $ \(k, v) -> (v,) <$> killContainer k pure . map fst $ filter snd xs evalCode :: Language -> Int -> String -> Myriad EvalResult -evalCode lang@Language { name, timeout, retries } numRetries code = withContainer \cnt -> do +evalCode lang@Language { name, timeout, retries } numRetries code = withContainer $ \cnt -> do doneRef <- newMVar False -- For keeping track of if the evaluation is done, i.e. succeeded or timed out. void . fork $ timer doneRef -- `race` could not have been used here since some evals can't be cancelled. snowflakeGen <- asks snowflakeGen @@ -171,7 +171,7 @@ evalCode lang@Language { name, timeout, retries } numRetries code = withContaine Env { containerSems, evalSems } <- ask csem <- (M.! name) <$> readMVar containerSems esem <- (M.! name) <$> readMVar evalSems - bracket_ (waitQSem esem) (signalQSem esem) do + bracket_ (waitQSem esem) (signalQSem esem) $ do cnt <- bracket_ (waitQSem csem) (signalQSem csem) $ setupContainer lang f cnt @@ -179,7 +179,7 @@ evalCode lang@Language { name, timeout, retries } numRetries code = withContaine timer doneRef = do threadDelay $ fromIntegral timeout * 1000000 done <- readMVar doneRef - unless_ done do + unless_ done $ do writeMVar doneRef True killContainer name diff --git a/src/Myriad/Server.hs b/src/Myriad/Server.hs index e497dda..ddf09af 100644 --- a/src/Myriad/Server.hs +++ b/src/Myriad/Server.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} - module Myriad.Server ( app ) where