65 lines
2.9 KiB
Haskell
65 lines
2.9 KiB
Haskell
module Main where
|
|
|
|
-- TODO:
|
|
-- We need some logic to compile with different backends. Right now we only
|
|
-- support warp. But a (fast) cgi backend would be nice too.
|
|
|
|
-- TODO:
|
|
-- We need some way too configure things, like the port we run on.
|
|
-- see Network.Wai.Handler.Warp.Settings and Network.Wai.Handler.Warp.runSettings
|
|
|
|
import Control.Concurrent.MVar
|
|
import qualified Network.Wai as Wai
|
|
import WaiApp
|
|
import Control.Concurrent
|
|
import Backend.Backend
|
|
import Options.Applicative
|
|
|
|
-- maybe we should use Control.Concurrent.ParallelIO but right
|
|
-- now we just rely that the backends fork and don't block
|
|
main :: IO ()
|
|
main = do
|
|
options <- execParser commandLineParser
|
|
serverState <- newMVar newServerState
|
|
let backs = zipWith (runBackend $ waiApplication serverState) options backends
|
|
waitFor' <- sequence backs
|
|
let waitFor = concat waitFor'
|
|
blockBackends waitFor
|
|
|
|
blockBackends :: [MVar ()] -> IO ()
|
|
blockBackends = mapM_ takeMVar
|
|
|
|
runBackend :: Wai.Application -> Either (Maybe String) Bool -> Backend -> IO [MVar ()]
|
|
runBackend app (Left (Just conf)) (BackendWithConfig b _ _) = b app conf
|
|
runBackend _ (Left Nothing) (BackendWithConfig _ _ _) = return []
|
|
runBackend app (Right True) (BackendWithoutConfig b _ _) = b app
|
|
runBackend _ (Right False) (BackendWithoutConfig _ _ _) = return []
|
|
runBackend _ _ _ = error "Backend and parser type don't match! THIS IS A BUG"
|
|
|
|
commandLineParser :: ParserInfo [Either (Maybe String) Bool]
|
|
commandLineParser = info (combineParser ( fmap backendToParser backends) <**> helper)
|
|
( fullDesc
|
|
<> progDesc "a small tickLeiste Server to play Splittermond with your crew" )
|
|
|
|
backendToParser :: Backend -> ParserType
|
|
backendToParser (BackendWithConfig _ name desc) = Left $ optional (strOption (long name <> help desc <> metavar "ConfigFile"))
|
|
backendToParser (BackendWithoutConfig _ name desc) = Right $ switch (long name <> help desc)
|
|
|
|
type ParserType = Either (Parser (Maybe String)) (Parser Bool)
|
|
|
|
combineParser :: [ParserType] -> Parser [Either (Maybe String) Bool]
|
|
combineParser = combineApplicativeList . fmap swapFunctorEither
|
|
|
|
-- TODO swap is a bad name, as the reversal of those operations is unclear
|
|
-- at best (and that means impossible, if you want it to do something sensible)
|
|
-- TODO this feels like the Left and the Right case could be handled
|
|
-- in one case, but I don't know how to write that
|
|
-- (except with ||| from the Arrow lib but that feels like a stupid dependency
|
|
-- for one line) But Maybe there is a better solution using Arrow altogether
|
|
-- (optparse has arrow instances)
|
|
swapFunctorEither :: Functor f => Either (f a) (f b) -> f (Either a b)
|
|
swapFunctorEither (Left p) = fmap Left p
|
|
swapFunctorEither (Right p) = fmap Right p
|
|
|
|
combineApplicativeList :: Applicative f => [f a] -> f [a]
|
|
combineApplicativeList = foldr ((<*>) . fmap (:)) (pure [])
|