From bad3985ed93ab548a21cdacd4d448c7fb96a2756 Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Fri, 12 Jul 2019 21:39:58 +0700
Subject: [PATCH] Use config path from command line if specified

---
 qs-tunnel.cabal |  1 +
 src/Main.hs     | 23 ++++++++++++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/qs-tunnel.cabal b/qs-tunnel.cabal
index 243a3ba..2aa8b41 100644
--- a/qs-tunnel.cabal
+++ b/qs-tunnel.cabal
@@ -27,3 +27,4 @@ executable qs-tunnel
                      , bytestring
                      , time
                      , hslogger
+                     , optparse-applicative
diff --git a/src/Main.hs b/src/Main.hs
index 5f82d4d..6fee6ce 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -15,6 +15,7 @@ import           Data.Time.Clock
 import           ATrade.QuoteSource.Client
 import           ATrade.QuoteSource.Server
 
+import           Control.Applicative
 import           Control.Concurrent
 import           Control.Monad
 import           Control.Monad.Loops
@@ -27,6 +28,13 @@ import           System.Log.Logger
 import           System.ZMQ4
 import           System.ZMQ4.ZAP
 
+import           Options.Applicative
+
+data CommandLineConfig = CommandLineConfig
+  {
+    clConfigPath :: Maybe FilePath
+  } deriving (Show, Eq)
+
 data UpstreamConfig = UpstreamConfig
   {
     ucEndpoint        :: T.Text,
@@ -72,14 +80,26 @@ initLogging = do
   updateGlobalLogger rootLoggerName (setLevel DEBUG)
   updateGlobalLogger rootLoggerName (setHandlers [handler])
 
+parseCommandLineConfig :: Parser CommandLineConfig
+parseCommandLineConfig = CommandLineConfig
+  <$> (optional $ strOption (long "config" <> short 'c' <> help "Config to use"))
+
 main :: IO ()
 main = do
+  cfg <- execParser opts
   initLogging
   infoM "main" "Starting"
-  eConf <- eitherDecode . BL.fromStrict <$> B.readFile "qs-tunnel.conf"
+  eConf <- eitherDecode . BL.fromStrict <$> B.readFile (configPath cfg)
   case eConf of
     Left errMsg -> error errMsg
     Right conf  -> runWithConfig conf
+  where
+    configPath cfg = case clConfigPath cfg of
+      Just path -> path
+      Nothing   -> "qs-tunnel.conf"
+    opts = info (parseCommandLineConfig <**> helper)
+       ( fullDesc
+      <> progDesc "Quotesource tunnel" )
 
 runWithConfig conf = do
   withContext $ \ctx ->
@@ -126,6 +146,7 @@ runWithConfig conf = do
                     writeIORef lastHeartbeat now
                     sendMulti downstream $ x :| xs
                   _ -> return ()
+        forever $ threadDelay 100000
   where
     notTimeout ref conf = do
       now <- getCurrentTime