diff options
author | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-07-17 19:21:56 +0200 |
---|---|---|
committer | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-07-17 19:21:56 +0200 |
commit | 2b9ceaead3f3cd80e973cccecb9a3eebc51154f7 (patch) | |
tree | df2378943480647606b6a06f62c0f4b8b2ab406d /server/src/Thermoprint/Server.hs | |
parent | ac4cf4a0a494eafe55364f816569c517684fdf32 (diff) | |
download | thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.gz thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.bz2 thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.xz thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.zip |
Fixes for GHC 8.0.1
Diffstat (limited to 'server/src/Thermoprint/Server.hs')
-rw-r--r-- | server/src/Thermoprint/Server.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs index 07462da..15fb651 100644 --- a/server/src/Thermoprint/Server.hs +++ b/server/src/Thermoprint/Server.hs | |||
@@ -13,7 +13,7 @@ module Thermoprint.Server | |||
13 | , Config(..), QMConfig(..) | 13 | , Config(..), QMConfig(..) |
14 | , withPrinters | 14 | , withPrinters |
15 | , module Data.Default.Class | 15 | , module Data.Default.Class |
16 | , module Servant.Server.Internal.Enter | 16 | , module Servant.Utils.Enter |
17 | , module Thermoprint.Server.Printer | 17 | , module Thermoprint.Server.Printer |
18 | , module Thermoprint.Server.Queue | 18 | , module Thermoprint.Server.Queue |
19 | , module Thermoprint.Server.Queue.Utils | 19 | , module Thermoprint.Server.Queue.Utils |
@@ -62,7 +62,7 @@ import qualified Network.Wai.Handler.Warp as Warp | |||
62 | import Network.Wai (Application) | 62 | import Network.Wai (Application) |
63 | 63 | ||
64 | import Servant.Server (serve) | 64 | import Servant.Server (serve) |
65 | import Servant.Server.Internal.Enter (enter, (:~>)(..)) | 65 | import Servant.Utils.Enter (enter, (:~>)(..)) |
66 | import Servant.API | 66 | import Servant.API |
67 | import Servant.Utils.Links | 67 | import Servant.Utils.Links |
68 | import Network.URI | 68 | import Network.URI |
@@ -137,16 +137,16 @@ thermoprintServer :: ( MonadLoggerIO m | |||
137 | -> (m :~> IO) -- ^ 'dyre' controls the base of the monad-transformer-stack ('IO') but we let the user specify much of the rest of it (we handle 'ResourceT' ourselves, since we need it to fork properly). Therefore we require a specification of how to collapse the stack. | 137 | -> (m :~> IO) -- ^ 'dyre' controls the base of the monad-transformer-stack ('IO') but we let the user specify much of the rest of it (we handle 'ResourceT' ourselves, since we need it to fork properly). Therefore we require a specification of how to collapse the stack. |
138 | -> ResourceT m (Config (ResourceT m)) -> IO () | 138 | -> ResourceT m (Config (ResourceT m)) -> IO () |
139 | -- ^ Run the server | 139 | -- ^ Run the server |
140 | thermoprintServer dyre io = do | 140 | thermoprintServer dyre io cfg = do |
141 | cfgDir <- lookupEnv "THERMOPRINT_CONFIG" | 141 | cfgDir <- lookupEnv "THERMOPRINT_CONFIG" |
142 | cacheDir <- lookupEnv "THERMOPRINT_CACHE" | 142 | cacheDir <- lookupEnv "THERMOPRINT_CACHE" |
143 | Dyre.wrapMain $ Dyre.defaultParams | 143 | flip Dyre.wrapMain cfg $ Dyre.defaultParams |
144 | { Dyre.projectName = "thermoprint-server" | 144 | { Dyre.projectName = "thermoprint-server" |
145 | , Dyre.realMain = realMain | 145 | , Dyre.realMain = realMain |
146 | , Dyre.showError = flip (\msg -> fmap (\cfg -> cfg { dyreError = Just msg })) | 146 | , Dyre.showError = flip (\msg -> fmap (\cfg -> cfg { dyreError = Just msg })) |
147 | , Dyre.configCheck = dyre | 147 | , Dyre.configCheck = dyre |
148 | , Dyre.configDir = cfgDir | 148 | , Dyre.configDir = return <$> cfgDir |
149 | , Dyre.cacheDir = cacheDir | 149 | , Dyre.cacheDir = return <$> cacheDir |
150 | } | 150 | } |
151 | where | 151 | where |
152 | realMain cfg = unNat (io . Nat runResourceT) $ do | 152 | realMain cfg = unNat (io . Nat runResourceT) $ do |
@@ -164,6 +164,6 @@ thermoprintServer dyre io = do | |||
164 | nChan <- liftIO $ newBroadcastTChanIO | 164 | nChan <- liftIO $ newBroadcastTChanIO |
165 | let | 165 | let |
166 | printerUrl :: API.PrinterId -> URI | 166 | printerUrl :: API.PrinterId -> URI |
167 | printerUrl = safeLink thermoprintAPI (Proxy :: Proxy ("jobs" :> QueryParam "printer" API.PrinterId :> Get '[JSON] (Seq (API.JobId, UTCTime, JobStatus)))) | 167 | printerUrl = safeLink thermoprintAPI (Proxy :: Proxy ("jobs" :> QueryParam "printer" API.PrinterId :> Get '[JSON] (Seq (API.JobId, UTCTime, JobStatus)))) . Just |
168 | mapM_ (fork tMgr . uncurry (notifyOnChange nChan ((==) `on` fromZipper)) . bimap printerUrl queue) $ Map.toList printers | 168 | mapM_ (fork tMgr . uncurry (notifyOnChange nChan ((==) `on` fromZipper)) . bimap printerUrl queue) $ Map.toList printers |
169 | liftIO . Warp.runSettings warpSettings . withPush nChan . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat printers nChan | 169 | liftIO . Warp.runSettings warpSettings . withPush nChan . serve thermoprintAPI . flip enter API.thermoprintServer =<< handlerNat printers nChan |