redone backend handling and config parsing

app/Main.hs

@@ -9,8 +9,11 @@ module Main where
 -- 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
 
 #ifdef HTTP_SUPPORT
 import qualified Network.Wai.Handler.Warp as HTTP
@@ -29,21 +32,51 @@ import qualified Network.Wai.Handler.FastCGI as FastCGI
 import qualified Network.Wai.Handler.CGI as CGI
 #endif
 
--- we should add support for multiple backends (so we should fork them and
--- then wait till all of them terminated)
+-- 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
-#ifdef HTTP_SUPPORT
-  HTTP.runSettings HTTP.defaultSettings $ waiApplication serverState
-#endif
-#ifdef HTTPS_SUPPORT
-  HTTPS.runTLS HTTPS.defaultTlsSettings HTTP.defaultSettings $ waiApplication serverState
-#endif
-#ifdef FASTCGI_SUPPORT
-  FastCGI.run $ waiApplication serverState
-#endif
-#ifdef CGI_SUPPORT
-  CGI.run $ waiApplication serverState
-#endif
-  return ()
+  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 [])