Added options parser

app/Main.hs

@@ -1,13 +1,30 @@
 module Main (main) where
 
 import qualified Data.ByteString.Char8 as BS
-import Data.Yaml
+import Data.Yaml (encode)
+import Options.Applicative
 import Server
 import Server.Config
-import System.Environment
 
 main :: IO ()
-main = getArgs >>= \case
-  [] -> runServer
-  ["default"] -> putStrLn . BS.unpack . encode $ defaultConfig
-  xs -> error . show $ xs
+main =
+  execParser (info (getOptions <**> helper) fullDesc) >>= \case
+    PrintDefaultConfig -> putStrLn . BS.unpack . encode $ defaultConfig
+    RunServer config -> runServer config
+
+data Run
+  = PrintDefaultConfig
+  | RunServer FilePath
+
+getOptions :: Parser Run
+getOptions =
+  subparser
+    ( command "default" (info (pure PrintDefaultConfig <**> helper) fullDesc)
+    )
+    <|> ( RunServer
+            <$> strOption
+              ( long "config"
+                  <> help "Path to yaml config file."
+                  <> value "config.yaml"
+              )
+        )

package.yaml

@@ -66,6 +66,7 @@ executables:
     - sc-build
     - bytestring
     - yaml
+    - optparse-applicative
   sc-build-migrations:
     main:                Main.hs
     source-dirs:         migrations

src/Server.hs

@@ -161,9 +161,9 @@ instance MonadError ServerError (ServerM schema) where
 server :: ServerT API (ServerM Schema)
 server = (webhookInstallation :<|> webhookPushEvent) :<|> getSubmissionR :<|> retestSubmission :<|> getResults
 
-runServer :: IO ()
-runServer = do
-  c@Config {..} <- getConfig
+runServer :: FilePath -> IO ()
+runServer config = do
+  c@Config {..} <- getConfig config
   print c
   pem <- BS.readFile appPkPemPath
   appPkPem <- case readRsaPem pem of

src/Server/Config.hs

@@ -71,8 +71,8 @@ defaultConfig =
       githubContext = "MY CI NAME"
     }
 
-getConfig :: IO Config
-getConfig = decodeFileThrow "config.yaml"
+getConfig :: FilePath -> IO Config
+getConfig = decodeFileThrow
 
 -- getConfig :: IO Config
 -- getConfig =