diff options
Diffstat (limited to 'server/src')
-rw-r--r-- | server/src/Main.hs | 6 | ||||
-rw-r--r-- | server/src/Thermoprint/Server.hs | 38 |
2 files changed, 44 insertions, 0 deletions
diff --git a/server/src/Main.hs b/server/src/Main.hs new file mode 100644 index 0000000..e392fe1 --- /dev/null +++ b/server/src/Main.hs | |||
@@ -0,0 +1,6 @@ | |||
1 | module Main (main) where | ||
2 | |||
3 | import Thermoprint.Server | ||
4 | |||
5 | main :: IO () | ||
6 | main = thermoprintServer def | ||
diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs new file mode 100644 index 0000000..bba067d --- /dev/null +++ b/server/src/Thermoprint/Server.hs | |||
@@ -0,0 +1,38 @@ | |||
1 | module Thermoprint.Server | ||
2 | ( thermoprintServer | ||
3 | , module Data.Default | ||
4 | ) where | ||
5 | |||
6 | import Data.Default | ||
7 | import qualified Config.Dyre as Dyre | ||
8 | |||
9 | import System.IO (hPutStrLn, stderr) | ||
10 | import System.Exit (exitFailure) | ||
11 | |||
12 | import Control.Monad ((<=<)) | ||
13 | |||
14 | data Config = Config { dyreError :: Maybe String | ||
15 | } | ||
16 | |||
17 | instance Default Config where | ||
18 | def = Config { dyreError = Nothing | ||
19 | } | ||
20 | |||
21 | thermoprintServer :: Config -> IO () | ||
22 | thermoprintServer = Dyre.wrapMain $ Dyre.defaultParams | ||
23 | { Dyre.projectName = "thermoprint-server" | ||
24 | , Dyre.realMain = realMain <=< handleDyreErrors | ||
25 | , Dyre.showError = (\cfg msg -> cfg { dyreError = Just msg }) | ||
26 | } | ||
27 | |||
28 | handleDyreErrors :: Config -> IO Config | ||
29 | handleDyreErrors cfg | ||
30 | | Just msg <- dyreError cfg = do | ||
31 | hPutStrLn stderr msg | ||
32 | exitFailure | ||
33 | return undefined | ||
34 | | otherwise = return cfg | ||
35 | |||
36 | |||
37 | realMain :: Config -> IO () | ||
38 | realMain _ = undefined | ||