{-# LANGUAGE RecordWildCards #-} module Thermoprint.Server ( thermoprintServer , module Data.Default.Class ) where import Data.Default.Class import qualified Config.Dyre as Dyre import System.IO (hPutStrLn, stderr) import System.Exit (exitFailure) import Control.Monad ((<=<)) import qualified Network.Wai.Handler.Warp as Warp import Network.Wai (Application) import Servant.Server import Thermoprint.API data Config = Config { dyreError :: Maybe String , warpSettings :: Warp.Settings } instance Default Config where def = Config { dyreError = Nothing , warpSettings = Warp.defaultSettings } thermoprintServer :: Config -> IO () thermoprintServer = Dyre.wrapMain $ Dyre.defaultParams { Dyre.projectName = "thermoprint-server" , Dyre.realMain = realMain <=< handleDyreErrors , Dyre.showError = (\cfg msg -> cfg { dyreError = Just msg }) } handleDyreErrors :: Config -> IO Config handleDyreErrors cfg | Just msg <- dyreError cfg = do hPutStrLn stderr msg exitFailure return undefined | otherwise = return cfg realMain :: Config -> IO () realMain cfg@(Config{..}) = Warp.runSettings warpSettings $ serve thermoprintAPI thermoprintServer' thermoprintServer :: Server ThermoprintAPI thermoprintServer = undefined