diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-20 09:59:06 +0000 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-20 09:59:06 +0000 |
commit | e13e08c31a2816a15ab10c078fd3adeb7abb83d7 (patch) | |
tree | 4ce2a5063ab9c44ec3af64709ed150a592009eef /server/src | |
parent | 299a1b0beda2027747820390b939da96534e345d (diff) | |
download | thermoprint-e13e08c31a2816a15ab10c078fd3adeb7abb83d7.tar thermoprint-e13e08c31a2816a15ab10c078fd3adeb7abb83d7.tar.gz thermoprint-e13e08c31a2816a15ab10c078fd3adeb7abb83d7.tar.bz2 thermoprint-e13e08c31a2816a15ab10c078fd3adeb7abb83d7.tar.xz thermoprint-e13e08c31a2816a15ab10c078fd3adeb7abb83d7.zip |
Skeleton & buildsystem for thermoprint-server
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 | ||