Switch que-server to envy

1 files changed, 36 insertions, 48 deletions

diff --git a/Run/Que/Server.hs b/Run/Que/Server.hs
index 5973ec2..45ad1bc 100644
--- a/Run/Que/Server.hs
+++ b/Run/Que/Server.hs
@@ -2,11 +2,14 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 -- | Interprocess communication
 --
 -- : exe que-server
+--
 -- : dep async
+-- : dep envy
 -- : dep protolude
 -- : dep scotty
 -- : dep stm
@@ -41,38 +44,45 @@ import qualified Network.Wai                   as Wai
 import qualified Network.Wai.Handler.Warp      as Warp
 import           Network.Wai.Middleware.RequestLogger
                                                 ( logStdout )
-import qualified System.Console.GetOpt         as Opt
-import qualified System.Environment            as Environment
+import qualified System.Envy                   as Envy
+import qualified System.Exit                   as Exit
 import qualified Web.Scotty.Trans              as Scotty
 
 main :: IO ()
-main = Exception.bracket startup shutdown run
+main = Exception.bracket startup shutdown <| uncurry Warp.run
  where
-  run (p, waiapp) =
-    putText ("que-server starting on port " <> show p) >> Warp.run p waiapp
-  startup = do
-    opts <- Environment.getArgs /> getOpts
-    sync <- STM.newTVarIO opts
-    let runActionToIO m = runReaderT (runApp m) sync
-    waiapp <- Scotty.scottyAppT runActionToIO routes
-    return (port opts, waiapp)
+  startup = Envy.decodeEnv >>= \case
+    Left  e -> Exit.die e
+    Right c -> do
+      sync <- STM.newTVarIO initialAppState
+      let runActionToIO m = runReaderT (runApp m) sync
+      waiapp <- Scotty.scottyAppT runActionToIO routes
+      putText <| "port:" <> (show <| quePort c)
+      return (quePort c, 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
+
+newtype App a = App
+  { runApp :: ReaderT (STM.TVar AppState) IO a
+  }
+  deriving (Applicative, Functor, Monad, MonadIO, MonadReader
+    (STM.TVar AppState))
+
+data AppState = AppState
+  { ques :: HashMap Namespace Quebase
+  }
+
+initialAppState :: AppState
+initialAppState = AppState { ques = mempty }
+
+data Config = Config
+  { quePort :: Warp.Port -- ^ QUE_PORT
+  } deriving (Generic, Show)
+
+instance Envy.DefConfig Config where
+  defConfig = Config 3000
+
+instance Envy.FromEnv Config
 
 routes :: Scotty.ScottyT Text App ()
 routes = do
@@ -191,28 +201,6 @@ extract = do
   path <- Scotty.param "2"
   return (ns, path)
 
-newtype App a = App
-  { runApp :: ReaderT (STM.TVar AppState) IO a
-  }
-  deriving (Applicative, Functor, Monad, MonadIO, MonadReader
-    (STM.TVar AppState))
-
-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