blob: 9b8d7194f9fe4239072436f6259bac8288e42538 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
{-# 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
|