diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2018-04-12 14:34:05 +0200 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2018-04-12 15:12:11 +0200 |
| commit | e8e0cb7f36641ffb7901178bc54fef98eba9215c (patch) | |
| tree | 2c51a3d2f98232fae2cdedb8b96368802b125411 /server/test | |
| parent | 2ab4ee48a15da128536b27c77a224c08cd2e9b78 (diff) | |
| download | thermoprint-e8e0cb7f36641ffb7901178bc54fef98eba9215c.tar thermoprint-e8e0cb7f36641ffb7901178bc54fef98eba9215c.tar.gz thermoprint-e8e0cb7f36641ffb7901178bc54fef98eba9215c.tar.bz2 thermoprint-e8e0cb7f36641ffb7901178bc54fef98eba9215c.tar.xz thermoprint-e8e0cb7f36641ffb7901178bc54fef98eba9215c.zip | |
Fix build
Diffstat (limited to 'server/test')
| -rw-r--r-- | server/test/Thermoprint/ServerSpec.hs | 6 |
1 files changed, 3 insertions, 3 deletions
diff --git a/server/test/Thermoprint/ServerSpec.hs b/server/test/Thermoprint/ServerSpec.hs index 334f785..d1dadba 100644 --- a/server/test/Thermoprint/ServerSpec.hs +++ b/server/test/Thermoprint/ServerSpec.hs | |||
| @@ -85,13 +85,13 @@ setup startup = withSystemTempFile "thermoprint.sqlite" $ \fp h -> hClose h >> d | |||
| 85 | runSqlite = runStderrLoggingT . filterLogger (const (> LevelDebug)) . withSqlitePool (T.pack fp) 1 . runReaderT | 85 | runSqlite = runStderrLoggingT . filterLogger (const (> LevelDebug)) . withSqlitePool (T.pack fp) 1 . runReaderT |
| 86 | 86 | ||
| 87 | printers = [ ( pure $ S.PM tPM | 87 | printers = [ ( pure $ S.PM tPM |
| 88 | , S.QMConfig ((join . lift $ takeTMVar (manage tManager) <* signalTSem (ran tManager)) >> return 0) (Nat $ liftIO . runIdentityT) | 88 | , S.QMConfig ((join . lift $ takeTMVar (manage tManager) <* signalTSem (ran tManager)) >> return 0) (NT $ liftIO . runIdentityT) |
| 89 | ) | 89 | ) |
| 90 | ] | 90 | ] |
| 91 | 91 | ||
| 92 | tPM :: MonadIO m => Printout -> m (Maybe PrintingError) | 92 | tPM :: MonadIO m => Printout -> m (Maybe PrintingError) |
| 93 | tPM printout = liftIO . atomically $ putTMVar (outputChan tPrinter) printout >> tryTakeTMVar (failSwitch tPrinter) | 93 | tPM printout = liftIO . atomically $ putTMVar (outputChan tPrinter) printout >> tryTakeTMVar (failSwitch tPrinter) |
| 94 | RunningServer <$> forkFinally (S.thermoprintServer False (Nat runSqlite) $ def' `S.withPrinters` printers) (putMVar term) <*> pure term <*> pure startSem <*> pure tPrinter <*> pure tManager | 94 | RunningServer <$> forkFinally (S.thermoprintServer False (NT runSqlite) $ def' `S.withPrinters` printers) (putMVar term) <*> pure term <*> pure startSem <*> pure tPrinter <*> pure tManager |
| 95 | where | 95 | where |
| 96 | def' :: MonadIO m => S.Config m | 96 | def' :: MonadIO m => S.Config m |
| 97 | def' = S.def { S.warpSettings = setBeforeMainLoop (signalQSem startup) $ defaultSettings } | 97 | def' = S.def { S.warpSettings = setBeforeMainLoop (signalQSem startup) $ defaultSettings } |
| @@ -158,7 +158,7 @@ spec = withSetup $ do | |||
| 158 | where | 158 | where |
| 159 | Client{..} = mkClient' $ BaseUrl Http "localhost" 3000 "" | 159 | Client{..} = mkClient' $ BaseUrl Http "localhost" 3000 "" |
| 160 | is404 :: ServantError -> Bool | 160 | is404 :: ServantError -> Bool |
| 161 | is404 e@(FailureResponse {}) = statusCode (responseStatus e) == 404 | 161 | is404 (FailureResponse e) = statusCode (responseStatusCode e) == 404 |
| 162 | is404 _ = False | 162 | is404 _ = False |
| 163 | 163 | ||
| 164 | 164 | ||
