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