From a3fa7db77828374b9de2c57adad2c26a667234bf Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Mon, 30 Mar 2020 09:00:51 -0700
Subject: Parse args for --port

---
 Run/Que.hs | 45 +++++++++++++++++++++++++++++++++++++--------
 1 file changed, 37 insertions(+), 8 deletions(-)

(limited to 'Run')

diff --git a/Run/Que.hs b/Run/Que.hs
index f1d0e28..40ce5b3 100644
--- a/Run/Que.hs
+++ b/Run/Que.hs
@@ -23,31 +23,48 @@ import qualified Data.ByteString.Builder.Extra as Builder
 import qualified Data.ByteString.Lazy          as BSL
 import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as HashMap
-import qualified Data.Text.Lazy                as Text
+import qualified Data.Text.Encoding            as Encoding
 import           Data.Text.Lazy                 ( Text
                                                 , fromStrict
                                                 )
-import qualified Data.Text.Encoding            as Encoding
+import qualified Data.Text.Lazy                as Text
 import           GHC.Base                       ( String )
 import qualified Network.Wai                   as Wai
 import qualified Network.Wai.Handler.Warp      as Warp
 import           Network.Wai.Middleware.RequestLogger
                                                 ( logStdoutDev )
+import qualified System.Console.GetOpt         as Opt
+import qualified System.Environment            as Environment
 import qualified Web.Scotty.Trans              as Scotty
 
 main :: IO ()
 main = Exception.bracket startup shutdown run
  where
-  run :: Wai.Application -> IO ()
-  run waiapp = Warp.run 8081 waiapp
-  -- | TODO: startup/shutdown ekg server, katip scribes
-  startup :: IO Wai.Application
+  run (p, waiapp) =
+    putText ("que-server starting on port " <> show p) >> Warp.run p waiapp
   startup = do
-    sync <- STM.newTVarIO <| AppState { ques = HashMap.empty }
+    opts <- Environment.getArgs /> getOpts
+    sync <- STM.newTVarIO opts
     let runActionToIO m = runReaderT (runApp m) sync
-    Scotty.scottyAppT runActionToIO routes
+    waiapp <- Scotty.scottyAppT runActionToIO routes
+    return (port opts, waiapp)
   shutdown :: a -> IO a
   shutdown = pure . identity
+  getOpts args = case Opt.getOpt Opt.Permute options args of
+    ([]  , [], _) -> Exception.throw ErrorParsingOptions
+    (opts, _ , _) -> smoosh initialAppState opts
+  options =
+    [ Opt.Option
+        ['p']
+        ["port"]
+        (Opt.ReqArg (\n m -> m { port = read n :: Warp.Port }) "PORT")
+        "port to run on "
+    ]
+
+data Error = ErrorParsingOptions
+  deriving (Show)
+
+instance Exception.Exception Error
 
 routes :: Scotty.ScottyT Text App ()
 routes = do
@@ -123,8 +140,20 @@ newtype App a = App
 
 data AppState = AppState
   { ques :: HashMap Namespace Quebase
+  , port :: Warp.Port
   }
 
+initialAppState :: AppState
+initialAppState = AppState { port = 80, ques = mempty }
+
+-- | Resolve a list of 'AppState' transitions into one.
+smoosh
+  :: AppState -- ^ Initial app state to start with
+  -> [AppState -> AppState] -- ^ List of functions to apply in order
+  -> AppState
+smoosh = foldr identity
+-- there's gotta be a standard name for this
+
 -- | A synonym for 'lift' in order to be explicit about when we are
 -- operating at the 'App' layer.
 app :: MonadTrans t => App a -> t App a
-- 
cgit v1.2.3