diff options
Diffstat (limited to 'Run')
| -rw-r--r-- | Run/Que.hs | 45 |
1 files changed, 37 insertions, 8 deletions
@@ -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 |