on master help sign in
Added options parser
commitb20ee0b7de28ca261a76f1e5a7ed4c7743137ab2 authoriko <ilyakooo0@gmail.com> dateTue 25 Feb 2020, 14:30 (7 years ago) parent1c8ce3a
4 files changed+29−11
app/Main.hs+23−6 package.yaml+1 src/Server.hs+3−3 src/Server/Config.hs+2−2
app/Main.hs+23−6
@@ -1,13 +1,30 @@
11module Main (main) where
22
33import qualified Data.ByteString.Char8 as BS
4−import Data.Yaml
4+import Data.Yaml (encode)
5+import Options.Applicative
56import Server
67import Server.Config
7−import System.Environment
88
99main :: IO ()
10−main = getArgs >>= \case
11− [] -> runServer
12− ["default"] -> putStrLn . BS.unpack . encode $ defaultConfig
13− xs -> error . show $ xs
10+main =
11+ execParser (info (getOptions <**> helper) fullDesc) >>= \case
12+ PrintDefaultConfig -> putStrLn . BS.unpack . encode $ defaultConfig
13+ RunServer config -> runServer config
14+
15+data Run
16+ = PrintDefaultConfig
17+ | RunServer FilePath
18+
19+getOptions :: Parser Run
20+getOptions =
21+ subparser
22+ ( command "default" (info (pure PrintDefaultConfig <**> helper) fullDesc)
23+ )
24+ <|> ( RunServer
25+ <$> strOption
26+ ( long "config"
27+ <> help "Path to yaml config file."
28+ <> value "config.yaml"
29+ )
30+ )
package.yaml+1
@@ -66,6 +66,7 @@ executables:
6666 - sc-build
6767 - bytestring
6868 - yaml
69+ - optparse-applicative
6970 sc-build-migrations:
7071 main: Main.hs
7172 source-dirs: migrations
src/Server.hs+3−3
@@ -161,9 +161,9 @@ instance MonadError ServerError (ServerM schema) where
161161server :: ServerT API (ServerM Schema)
162162server = (webhookInstallation :<|> webhookPushEvent) :<|> getSubmissionR :<|> retestSubmission :<|> getResults
163163
164−runServer :: IO ()
165−runServer = do
166− c@Config {..} <- getConfig
164+runServer :: FilePath -> IO ()
165+runServer config = do
166+ c@Config {..} <- getConfig config
167167 print c
168168 pem <- BS.readFile appPkPemPath
169169 appPkPem <- case readRsaPem pem of
src/Server/Config.hs+2−2
@@ -71,8 +71,8 @@ defaultConfig =
7171 githubContext = "MY CI NAME"
7272 }
7373
74−getConfig :: IO Config
75−getConfig = decodeFileThrow "config.yaml"
74+getConfig :: FilePath -> IO Config
75+getConfig = decodeFileThrow
7676
7777-- getConfig :: IO Config
7878-- getConfig =