summaryrefslogtreecommitdiff
path: root/Run/Que.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Run/Que.hs')
-rw-r--r--Run/Que.hs45
1 files changed, 37 insertions, 8 deletions
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