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 | ||
