freckle-app 1.27.0.0 → 1.27.0.1

raw patch · 34 files changed

+285/−240 lines, 34 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−1
• freckle-app.cabal +1/−1
• library/Freckle/App.hs +12/−11
• library/Freckle/App/Async.hs +32/−17
• library/Freckle/App/Bugsnag.hs +10/−8
• library/Freckle/App/Bugsnag/MetaData.hs +2/−2
• library/Freckle/App/Bugsnag/SqlError.hs +8/−8
• library/Freckle/App/Csv.hs +9/−3
• library/Freckle/App/Database.hs +31/−28
• library/Freckle/App/Faktory/ProducerPool.hs +4/−3
• library/Freckle/App/GlobalCache.hs +1/−1
• library/Freckle/App/Json/Empty.hs +1/−1
• library/Freckle/App/Random.hs +11/−8
• library/Freckle/App/Scientist.hs +8/−7
• library/Freckle/App/Test.hs +27/−24
• library/Freckle/App/Test/DocTest.hs +2/−2
• library/Freckle/App/Test/Hspec/Runner.hs +3/−3
• library/Freckle/App/Test/Properties/JSON.hs +1/−1
• library/Freckle/App/Test/Properties/PathPiece.hs +1/−1
• library/Freckle/App/Test/Properties/PersistValue.hs +1/−1
• library/Freckle/App/Test/Yesod.hs +18/−16
• library/Freckle/App/TextualEnum.hs +6/−6
• library/Freckle/App/Yesod.hs +9/−6
• library/Network/Wai/Middleware/Cors.hs +3/−4
• library/Yesod/Core/Lens.hs +3/−2
• package.yaml +1/−1
• tests/Freckle/App/AsyncSpec.hs +2/−2
• tests/Freckle/App/Bugsnag/MetaDataSpec.hs +3/−3
• tests/Freckle/App/CsvSpec.hs +9/−9
• tests/Freckle/App/Test/Properties/JSONSpec.hs +5/−5
• tests/Freckle/App/Test/Properties/PathPieceSpec.hs +3/−3
• tests/Freckle/App/Test/Properties/PersistValueSpec.hs +3/−3
• tests/Freckle/App/TextualEnumSpec.hs +32/−31
• tests/Freckle/App/WaiSpec.hs +18/−18

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.27.0.0...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.27.0.1...main)++## [v1.27.0.1](https://github.com/freckle/freckle-app/compare/freckle-app-v1.27.0.0...freckle-app-v1.27.0.1)++- Apply new formatting conventions.  ## [v1.27.0.0](https://github.com/freckle/freckle-app/compare/freckle-app-v1.26.2.0...freckle-app-v1.27.0.0) 

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               freckle-app-version:            1.27.0.0+version:            1.27.0.1 license:            MIT license-file:       LICENSE maintainer:         Freckle Education

@@ -197,7 +197,8 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)  runApp-  :: (forall b. (app -> IO b) -> IO b)+  :: forall app a+   . (forall b. (app -> IO b) -> IO b)   -> AppT app IO a   -> IO a runApp loadApp action = do@@ -217,16 +218,16 @@   { unAppT :: ReaderT app (ResourceT m) a   }   deriving newtype-    ( Functor-    , Applicative+    ( Applicative+    , Functor     , Monad-    , MonadIO-    , MonadUnliftIO-    , MonadThrow     , MonadCatch+    , MonadIO     , MonadMask-    , MonadResource     , MonadReader app+    , MonadResource+    , MonadThrow+    , MonadUnliftIO     )   deriving (MonadLogger, MonadLoggerIO) via WithLogger app (ResourceT m) @@ -239,20 +240,20 @@   primitive = lift . primitive   {-# INLINE primitive #-} -instance (MonadUnliftIO m, HasTracer app) => MonadHttp (AppT app m) where+instance (HasTracer app, MonadUnliftIO m) => MonadHttp (AppT app m) where   httpLbs req = inSpan (httpSpanName req) (httpSpanArguments req) $ do     resp <- liftIO . httpLbs =<< injectContext req     resp <$ addCurrentSpanAttributes (httpResponseAttributes resp) -instance (Monad m, HasTracer app) => MonadTracer (AppT app m) where+instance (HasTracer app, Monad m) => MonadTracer (AppT app m) where   getTracer = view tracerL  instance-  (MonadUnliftIO m, HasSqlPool app, HasStatsClient app, HasTracer app)+  (HasSqlPool app, HasStatsClient app, HasTracer app, MonadUnliftIO m)   => MonadSqlTx (ReaderT SqlBackend (AppT app m)) (AppT app m)   where   runSqlTx = runDB -runAppT :: MonadUnliftIO m => AppT app m a -> app -> m a+runAppT :: forall m app a. MonadUnliftIO m => AppT app m a -> app -> m a runAppT action app =   runResourceT $ runReaderT (unAppT action) app

@@ -44,14 +44,15 @@ import UnliftIO.Concurrent (threadDelay)  -- | 'UnliftIO.Async.async' but passing the thread context along-async :: (MonadMask m, MonadUnliftIO m) => m a -> m (Async a)+async :: forall m a. (MonadMask m, MonadUnliftIO m) => m a -> m (Async a) async f = do   context <- getThreadContext   UnliftIO.async $ withThreadContext context f  -- | 'UnliftIO.Async.pooledMapConcurrentlyN' but passing the thread context along pooledMapConcurrentlyN-  :: (MonadUnliftIO m, MonadMask m, Traversable t)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t)   => Int -> (a -> m b) -> t a -> m (t b) pooledMapConcurrentlyN n f xs = do   context <- getThreadContext@@ -59,14 +60,16 @@  -- | 'UnliftIO.Async.pooledMapConcurrently' but passing the thread context along pooledMapConcurrently-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => (a -> m b) -> t a -> m (t b)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => (a -> m b) -> t a -> m (t b) pooledMapConcurrently f xs = do   context <- getThreadContext   UnliftIO.pooledMapConcurrently (withThreadContext context . f) xs  -- | 'UnliftIO.Async.pooledMapConcurrentlyN_' but passing the thread context along pooledMapConcurrentlyN_-  :: (MonadUnliftIO m, MonadMask m, Traversable t)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t)   => Int -> (a -> m b) -> t a -> m () pooledMapConcurrentlyN_ n f xs = do   context <- getThreadContext@@ -74,62 +77,72 @@  -- | 'UnliftIO.Async.pooledMapConcurrently_' but passing the thread context along pooledMapConcurrently_-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => (a -> m b) -> t a -> m ()+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => (a -> m b) -> t a -> m () pooledMapConcurrently_ f xs = do   context <- getThreadContext   UnliftIO.pooledMapConcurrently_ (withThreadContext context . f) xs  -- | 'UnliftIO.Async.pooledForConcurrentlyN' but passing the thread context along pooledForConcurrentlyN-  :: (MonadUnliftIO m, MonadMask m, Traversable t)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t)   => Int -> t a -> (a -> m b) -> m (t b) pooledForConcurrentlyN n = flip $ pooledMapConcurrentlyN n  -- | 'UnliftIO.Async.pooledForConcurrently' but passing the thread context along pooledForConcurrently-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => t a -> (a -> m b) -> m (t b)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => t a -> (a -> m b) -> m (t b) pooledForConcurrently = flip pooledMapConcurrently  -- | 'UnliftIO.Async.pooledForConcurrentlyN_' but passing the thread context along pooledForConcurrentlyN_-  :: (MonadUnliftIO m, MonadMask m, Traversable t)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t)   => Int -> t a -> (a -> m b) -> m () pooledForConcurrentlyN_ n = flip $ pooledMapConcurrentlyN_ n  -- | 'UnliftIO.Async.pooledForConcurrently_' but passing the thread context along pooledForConcurrently_-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => t a -> (a -> m b) -> m ()+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => t a -> (a -> m b) -> m () pooledForConcurrently_ = flip pooledMapConcurrently_  -- | 'UnliftIO.Async.mapConcurrently' but passing the thread context along mapConcurrently-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => (a -> m b) -> t a -> m (t b)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => (a -> m b) -> t a -> m (t b) mapConcurrently f xs = do   context <- getThreadContext   UnliftIO.mapConcurrently (withThreadContext context . f) xs  -- | 'UnliftIO.Async.forConcurrently' but passing the thread context along forConcurrently-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => t a -> (a -> m b) -> m (t b)+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => t a -> (a -> m b) -> m (t b) forConcurrently = flip mapConcurrently  -- | 'UnliftIO.Async.mapConcurrently_' but passing the thread context along mapConcurrently_-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => (a -> m b) -> t a -> m ()+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => (a -> m b) -> t a -> m () mapConcurrently_ f xs = do   context <- getThreadContext   UnliftIO.mapConcurrently_ (withThreadContext context . f) xs  -- | 'UnliftIO.Async.forConcurrently_' but passing the thread context along forConcurrently_-  :: (MonadUnliftIO m, MonadMask m, Traversable t) => t a -> (a -> m b) -> m ()+  :: forall m t a b+   . (MonadMask m, MonadUnliftIO m, Traversable t) => t a -> (a -> m b) -> m () forConcurrently_ = flip mapConcurrently_  -- | Run a list of actions concurrently, combining the results monoidally -- -- The forked threads will have the current thread context copied to them. foldConcurrently-  :: (MonadUnliftIO m, MonadMask m, Monoid a, Foldable t) => t (m a) -> m a+  :: forall m a t+   . (Foldable t, MonadMask m, MonadUnliftIO m, Monoid a) => t (m a) -> m a foldConcurrently xs = do   context <- getThreadContext   runConc $ foldMap (conc . withThreadContext context) xs@@ -142,7 +155,8 @@ --   and your error handler -- - Blocks forever after spawning your thread. immortalCreate-  :: (MonadMask m, MonadUnliftIO m)+  :: forall m a+   . (MonadMask m, MonadUnliftIO m)   => (Either SomeException () -> m ())   -- ^ How to handle unexpected finish   -> m ()@@ -162,7 +176,7 @@  -- | 'immortalCreate' with logging of unexpected finishes immortalCreateLogged-  :: (MonadMask m, MonadUnliftIO m, MonadLogger m) => m () -> m a+  :: forall m a. (MonadLogger m, MonadMask m, MonadUnliftIO m) => m () -> m a immortalCreateLogged = immortalCreate $ either logEx pure  where   logEx ex = logError $ "Unexpected Finish" :# ["exception" .= displayException ex]@@ -178,7 +192,8 @@     <$> liftIO Blammo.myThreadContext     <*> OpenTelemetry.lookupContext -withThreadContext :: (MonadIO m, MonadMask m) => ThreadContext -> m a -> m a+withThreadContext+  :: forall m a. (MonadIO m, MonadMask m) => ThreadContext -> m a -> m a withThreadContext ThreadContext {blammoContext, openTelemetryContext} continue =   Blammo.withThreadContext (KeyMap.toList blammoContext) $ do     traverse_ @Maybe OpenTelemetry.attachContext openTelemetryContext

@@ -63,11 +63,12 @@ -- The notification is made asynchronously via a simple @'async'@. This is -- best-effort and we don't care to keep track of the spawned threads. notifyBugsnag-  :: ( MonadMask m-     , MonadUnliftIO m-     , MonadReader env m+  :: forall m env e+   . ( Base.Exception e      , HasBugsnagSettings env-     , Base.Exception e+     , MonadMask m+     , MonadReader env m+     , MonadUnliftIO m      )   => e   -> m ()@@ -75,11 +76,12 @@  -- | 'notifyBugsnag' with a 'BeforeNotify' notifyBugsnagWith-  :: ( MonadMask m-     , MonadUnliftIO m-     , MonadReader env m+  :: forall m env e+   . ( Base.Exception e      , HasBugsnagSettings env-     , Base.Exception e+     , MonadMask m+     , MonadReader env m+     , MonadUnliftIO m      )   => BeforeNotify   -> e

@@ -36,12 +36,12 @@ -- Using this (and then 'mergeMetaData') will unify exception metadata with -- metrics tags and the logging context. collectMetaData-  :: (MonadIO m, MonadReader env m, HasStatsClient env) => m MetaData+  :: forall m env. (HasStatsClient env, MonadIO m, MonadReader env m) => m MetaData collectMetaData =   (<>) <$> collectMetaDataFromStatsClient <*> collectMetaDataFromThreadContext  collectMetaDataFromStatsClient-  :: (MonadReader env m, HasStatsClient env) => m MetaData+  :: forall env m. (HasStatsClient env, MonadReader env m) => m MetaData collectMetaDataFromStatsClient = view $ statsClientL . tagsL . to toMetaData  where   toMetaData = metaData "tags" . map (bimap (fromString . unpack) String)

@@ -38,14 +38,14 @@     ex       { exception_errorClass = decodeUtf8 $ "SqlError-" <> sqlState       , exception_message =-          Just $-            decodeUtf8 $-              sqlErrorMsg-                <> ": "-                <> sqlErrorDetail-                <> " ("-                <> sqlErrorHint-                <> ")"+          Just+            $ decodeUtf8+            $ sqlErrorMsg+              <> ": "+              <> sqlErrorDetail+              <> " ("+              <> sqlErrorHint+              <> ")"       }  sqlErrorGroupingHash :: SqlError -> Maybe Text

@@ -74,7 +74,11 @@  class ValidateHeader a where   validateHeader-    :: (Bind m, Monad m) => proxy a -> Header -> ValidateT (NESeq String) m ()+    :: forall m proxy+     . (Bind m, Monad m)+    => proxy a+    -> Header+    -> ValidateT (NESeq String) m ()  hasHeader :: Monad m => Header -> Name -> ValidateT (NESeq String) m () hasHeader h name@@ -237,7 +241,8 @@         lift $ refute $ Seq.fromList $ CsvMissingColumn . pack <$> toList errs  parseRow-  :: MonadValidate (Seq (CsvException err)) m+  :: forall err m a+   . MonadValidate (Seq (CsvException err)) m   => Int   -> CsvI.Parser a   -> ConduitT ByteString a m ()@@ -252,7 +257,8 @@   handleRows = foldM handleRow rowNumber  handleRow-  :: MonadValidate (Seq (CsvException err)) m+  :: forall err m a i+   . MonadValidate (Seq (CsvException err)) m   => Int   -> Either String a   -> ConduitT i a m Int

@@ -95,7 +95,7 @@ -- -- Prefer 'withPostgresPool', which closes the pool with -- 'destroyAllResources' once the given action completes.-makePostgresPool :: (MonadUnliftIO m, MonadLoggerIO m) => m SqlPool+makePostgresPool :: (MonadLoggerIO m, MonadUnliftIO m) => m SqlPool makePostgresPool = do   conf <- liftIO $ do     postgresPasswordSource <- Env.parse id envPostgresPasswordSource@@ -104,7 +104,7 @@  -- | Create a PostgreSQL pool, closing it once the given action completes withPostgresPool-  :: (MonadUnliftIO m, MonadLoggerIO m) => (SqlPool -> m a) -> m a+  :: forall m a. (MonadLoggerIO m, MonadUnliftIO m) => (SqlPool -> m a) -> m a withPostgresPool = bracket makePostgresPool (liftIO . destroyAllResources)  -- | Run a Database action with connection stats and tracing@@ -114,12 +114,13 @@ -- functions that call those, for as far as you require to get to a useful -- source location). runDB-  :: ( MonadUnliftIO m-     , MonadTracer m-     , MonadReader app m+  :: forall m app a+   . ( HasCallStack      , HasSqlPool app      , HasStatsClient app-     , HasCallStack+     , MonadReader app m+     , MonadTracer m+     , MonadUnliftIO m      )   => SqlPersistT m a   -> m a@@ -158,18 +159,19 @@             Stats.decGauge gauge             runOnException hooks conn mi e         }-  Stats.withGauge Stats.dbEnqueuedAndProcessing $-    inSpan "runDB" (clientSpanArguments {Trace.attributes = dbAttributes}) $-      runSqlPoolWithExtensibleHooks-        (inSpan "runSqlPool" defaultSpanArguments action)-        pool-        Nothing-        hooks'+  Stats.withGauge Stats.dbEnqueuedAndProcessing+    $ inSpan "runDB" (clientSpanArguments {Trace.attributes = dbAttributes})+    $ runSqlPoolWithExtensibleHooks+      (inSpan "runSqlPool" defaultSpanArguments action)+      pool+      Nothing+      hooks'  where   dbAttributes = HashMap.fromList [("service.name", "database")]  runDBSimple-  :: (HasSqlPool app, MonadUnliftIO m, MonadReader app m)+  :: forall app m a+   . (HasSqlPool app, MonadReader app m, MonadUnliftIO m)   => SqlPersistT m a   -> m a runDBSimple action = do@@ -186,17 +188,17 @@   , pccStatementTimeout :: PostgresStatementTimeout   , pccSchema :: Maybe String   }-  deriving stock (Show, Eq)+  deriving stock (Eq, Show)  data PostgresPasswordSource   = PostgresPasswordSourceIamAuth   | PostgresPasswordSourceEnv-  deriving stock (Show, Eq)+  deriving stock (Eq, Show)  data PostgresPassword   = PostgresPasswordIamAuth   | PostgresPasswordStatic String-  deriving stock (Show, Eq)+  deriving stock (Eq, Show)  type PostgresStatementTimeout = Timeout @@ -245,7 +247,7 @@   , aitCreatedAt :: UTCTime   , aitPostgresConnectionConf :: PostgresConnectionConf   }-  deriving stock (Show, Eq)+  deriving stock (Eq, Show)  createAuroraIamToken :: MonadIO m => PostgresConnectionConf -> m AuroraIamToken createAuroraIamToken aitPostgresConnectionConf@PostgresConnectionConf {..} = do@@ -272,7 +274,7 @@ -- The IAM auth token lasts 15 minutes, but we refresh it every minute just to -- be super safe. spawnIamTokenRefreshThread-  :: (MonadUnliftIO m, MonadLogger m)+  :: (MonadLogger m, MonadUnliftIO m)   => PostgresConnectionConf   -> m (IORef AuroraIamToken) spawnIamTokenRefreshThread conf = do@@ -288,8 +290,8 @@    onFinishCallback = \case     Left ex ->-      logError $-        "Error refreshing IAM auth token"+      logError+        $ "Error refreshing IAM auth token"           :# ["exception" .= displayException ex]     Right () -> pure () @@ -303,8 +305,8 @@ setStartupOptions PostgresConnectionConf {..} conn = do   let timeoutMillis = postgresStatementTimeoutMilliseconds pccStatementTimeout   liftIO $ do-    void $-      execute+    void+      $ execute         conn         [sql| SET statement_timeout = ? |]         (Only timeoutMillis)@@ -315,7 +317,7 @@ -- Prefer 'withPostgresPoolWith', which closes the pool with -- 'destroyAllResources' once the given action completes. makePostgresPoolWith-  :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConnectionConf -> m SqlPool+  :: (MonadLoggerIO m, MonadUnliftIO m) => PostgresConnectionConf -> m SqlPool makePostgresPoolWith conf@PostgresConnectionConf {..} = case pccPassword of   PostgresPasswordIamAuth -> makePostgresPoolWithIamAuth conf   PostgresPasswordStatic password ->@@ -327,7 +329,8 @@ -- | Create a PostgreSQL pool for the given connection configuration, closing -- it once the given action completes withPostgresPoolWith-  :: (MonadUnliftIO m, MonadLoggerIO m)+  :: forall m a+   . (MonadLoggerIO m, MonadUnliftIO m)   => PostgresConnectionConf   -> (SqlPool -> m a)   -> m a@@ -336,7 +339,7 @@  -- | Creates a PostgreSQL pool using IAM auth for the password makePostgresPoolWithIamAuth-  :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConnectionConf -> m SqlPool+  :: (MonadLoggerIO m, MonadUnliftIO m) => PostgresConnectionConf -> m SqlPool makePostgresPoolWithIamAuth conf@PostgresConnectionConf {..} = do   tokenIORef <- spawnIamTokenRefreshThread conf   createSqlPool (mkConn tokenIORef) pccPoolSize@@ -350,8 +353,8 @@  postgresConnectionString :: PostgresConnectionConf -> String -> ByteString postgresConnectionString PostgresConnectionConf {..} password =-  BS8.pack $-    unwords+  BS8.pack+    $ unwords       [ "host=" <> pccHost       , "port=" <> show pccPort       , "user=" <> pccUser

@@ -55,8 +55,8 @@   :: Env.Parser Env.Error FaktoryProducerPoolConfig envFaktoryProducerPoolConfig = do   poolSize <- Env.var Env.auto "FAKTORY_PRODUCER_POOL_SIZE" $ Env.def 10-  pure $-    defaultFaktoryProducerPoolConfig {faktoryProducerPoolConfigSize = poolSize}+  pure+    $ defaultFaktoryProducerPoolConfig {faktoryProducerPoolConfigSize = poolSize}  type FaktoryProducerPool = Pool Faktory.Producer @@ -68,7 +68,8 @@  -- | Create a Faktory producer pool, closing it once the given action completes withFaktoryProducerPool-  :: MonadUnliftIO m+  :: forall m a+   . MonadUnliftIO m   => Faktory.Settings   -> FaktoryProducerPoolConfig   -> (FaktoryProducerPool -> m a)

@@ -77,7 +77,7 @@ -- To avoid garbage collection issues, we can leverage a "System.Mem.Weak" to -- add a finalizer. When that 'MVar' gets garbage collected we can clear the -- global 'IORef'. This maintains the status quo, with minimal plumbing.-withGlobalCacheCleanup :: GlobalCache a -> IO b -> IO ()+withGlobalCacheCleanup :: forall a b. GlobalCache a -> IO b -> IO () withGlobalCacheCleanup (GlobalCache var) action = do   cleanup <- newMVar ()   void $ mkWeakMVar cleanup $ writeIORef var Nothing

@@ -29,7 +29,7 @@ -- (One would expect to be able to use () for this, but Aeson encodes unit -- as an empty list, not as an object.) data Empty = Empty-  deriving (ToJSON, FromJSON) via (Autodocodec Empty)+  deriving (FromJSON, ToJSON) via (Autodocodec Empty) #if MIN_VERSION_autodocodec_openapi3(0,3,0)   deriving ToSchema via (AutodocodecOpenApi Empty) #else

@@ -14,7 +14,6 @@ import Control.Monad.State.Strict (execStateT, get, put) import Data.Functor ((<&>)) import Data.STRef (newSTRef, readSTRef, writeSTRef)- import Data.Set qualified as Set  -- | A possibly-empty contiguous range of integers@@ -54,7 +53,8 @@ -- e.g. @smallRandomSubsetOfLargeIntegerRange 10 (inclusiveRange 30 70)@ -- may produce something like @fromList [32,34,45,54,56,58,62,63,64,65]@. smallRandomSubsetOfLargeIntegerRange-  :: (MonadRandom m, Random i, Integral i)+  :: forall m i+   . (Integral i, MonadRandom m, Random i)   => Natural   -- ^ How many items are wanted   -> Range i@@ -62,10 +62,11 @@ smallRandomSubsetOfLargeIntegerRange n = \case   RangeEmpty -> pure Set.empty   RangeNonEmpty r ->-    fmap gaps $-      flip execStateT (RangeWithGaps r Set.empty) $-        for_ [1 .. n] $ \_ -> do-          get >>= (lift . randomlyRemove) >>= put+    fmap gaps+      $ flip execStateT (RangeWithGaps r Set.empty)+      $ for_ [1 .. n]+      $ \_ -> do+        get >>= (lift . randomlyRemove) >>= put  data RangeWithGaps i = RangeWithGaps   { rangeWithoutGaps :: NonEmptyRange i@@ -80,7 +81,8 @@ -- -- If every item in the range has already been removed, this does nothing. randomlyRemove-  :: (MonadRandom m, Random i, Integral i) => RangeWithGaps i -> m (RangeWithGaps i)+  :: forall m i+   . (Integral i, MonadRandom m, Random i) => RangeWithGaps i -> m (RangeWithGaps i) randomlyRemove rg =   randomFromRangeWithGaps rg <&> \case     Nothing -> rg@@ -91,7 +93,8 @@ -- This selects uniformly at random an item from the range that is not -- present in the 'gaps' set. randomFromRangeWithGaps-  :: (MonadRandom m, Random i, Integral i)+  :: forall m i+   . (Integral i, MonadRandom m, Random i)   => RangeWithGaps i   -> m (Maybe i) randomFromRangeWithGaps rg =

@@ -14,7 +14,8 @@ -- * Experiments are labeled "science.${name}" -- * Results are tagged with "variant:${name}" experimentPublishDatadog-  :: (MonadReader env m, MonadUnliftIO m, HasStatsClient env)+  :: forall env m c a b+   . (HasStatsClient env, MonadReader env m, MonadUnliftIO m)   => Result c a b   -> m () experimentPublishDatadog result = for_ (resultDetails result) $ \details -> do@@ -22,11 +23,11 @@     statName = "science." <> resultDetailsExperimentName details     ResultControl {..} = resultDetailsControl details -  Stats.tagged [("variant", resultControlName)] $-    Stats.gauge statName $-      durationToSeconds resultControlDuration+  Stats.tagged [("variant", resultControlName)]+    $ Stats.gauge statName+    $ durationToSeconds resultControlDuration    for_ (resultDetailsCandidates details) $ \ResultCandidate {..} ->-    Stats.tagged [("variant", "candidate-" <> resultCandidateName)] $-      Stats.gauge statName $-        durationToSeconds resultCandidateDuration+    Stats.tagged [("variant", "candidate-" <> resultCandidateName)]+      $ Stats.gauge statName+      $ durationToSeconds resultCandidateDuration

@@ -22,21 +22,6 @@  import Freckle.App.Prelude -import Data.Pool as X-import Test.Hspec as X-  ( Expectation-  , Spec-  , beforeAll-  , beforeWith-  , context-  , describe-  , example-  , fit-  , it-  , xit-  )-import Test.Hspec.Expectations.Lifted as X hiding (expectationFailure)- import Blammo.Logging (MonadLogger, MonadLoggerIO) import Blammo.Logging.Setup (WithLogger (..)) import Blammo.Logging.ThreadContext (MonadMask)@@ -50,6 +35,7 @@ import Control.Monad.Reader import Control.Monad.Trans.Control import Data.List (intercalate)+import Data.Pool as X import Database.Persist.Sql (SqlPersistT, runSqlPool) import Freckle.App.Database   ( HasSqlPool (..)@@ -61,8 +47,21 @@ import Freckle.App.Exception.MonadThrow qualified as MonadThrow import Freckle.App.OpenTelemetry import Test.HUnit.Lang (FailureReason (..), HUnitFailure (..))+import Test.Hspec as X+  ( Expectation+  , Spec+  , beforeAll+  , beforeWith+  , context+  , describe+  , example+  , fit+  , it+  , xit+  ) import Test.Hspec qualified as Hspec hiding (expectationFailure) import Test.Hspec.Core.Spec (Arg, Example, SpecWith, evaluateExample)+import Test.Hspec.Expectations.Lifted as X hiding (expectationFailure) import Test.Hspec.Expectations.Lifted qualified as Hspec (expectationFailure) import UnliftIO.Exception qualified as UnliftIO @@ -77,16 +76,16 @@   }   deriving newtype     ( Applicative+    , Fail.MonadFail     , Functor     , Monad     , MonadBase IO     , MonadBaseControl IO     , MonadCatch     , MonadIO-    , MonadUnliftIO     , MonadReader app     , MonadThrow-    , Fail.MonadFail+    , MonadUnliftIO     )   deriving     (MonadLogger, MonadLoggerIO)@@ -140,7 +139,7 @@ -- -- This can be used to avoid ambiguity errors when your expectation uses only -- polymorphic functions like 'runDB' or lifted 'shouldBe' et-al.-appExample :: AppExample app a -> AppExample app a+appExample :: forall app a. AppExample app a -> AppExample app a appExample = id  -- | Spec before helper@@ -156,10 +155,11 @@ withApp run = beforeAll Dotenv.loadTest . Hspec.aroundAll run  -- | Run the given SQL action before every spec item-beforeSql :: HasSqlPool app => SqlPersistT IO a -> SpecWith app -> SpecWith app+beforeSql+  :: forall app a. HasSqlPool app => SqlPersistT IO a -> SpecWith app -> SpecWith app beforeSql f = beforeWith $ \app -> app <$ runSqlPool f (getSqlPool app) -expectationFailure :: (MonadIO m, HasCallStack) => String -> m a+expectationFailure :: forall m a. (HasCallStack, MonadIO m) => String -> m a expectationFailure msg = Hspec.expectationFailure msg >> error "unreachable"  pending :: MonadIO m => m ()@@ -171,7 +171,7 @@ -- | Unwraps 'Just', or throws an assertion failure if the 'Maybe' is 'Nothing' -- -- Like @(\``shouldSatisfy`\` 'isJust')@, but returns the 'Just' value.-expectJust :: (HasCallStack, MonadIO m) => Maybe a -> m a+expectJust :: forall m a. (HasCallStack, MonadIO m) => Maybe a -> m a expectJust = \case   Nothing -> expectationFailure "expected Just, but got Nothing"   Just a -> pure a@@ -179,7 +179,8 @@ -- | Unwraps 'Right', or throws an assertion failure if the 'Either' is 'Left' -- -- Like @(\``shouldSatisfy`\` 'isRight')@, but returns the 'Right' value.-expectRight :: (HasCallStack, MonadIO m, Show a) => Either a b -> m b+expectRight+  :: forall m a b. (HasCallStack, MonadIO m, Show a) => Either a b -> m b expectRight = \case   Left a -> expectationFailure $ "expected Right, but got " <> show a   Right b -> pure b@@ -192,7 +193,8 @@ -- assertions. -- -- This can be useful with @lens@, for example: @b <- expect (preview _Left) a@-expect :: (HasCallStack, MonadIO m, Show a) => (a -> Maybe b) -> a -> m b+expect+  :: forall m a b. (HasCallStack, MonadIO m, Show a) => (a -> Maybe b) -> a -> m b expect f a = case f a of   Nothing -> expectationFailure $ "predicate failed on: " <> show a   Just b -> pure b@@ -202,7 +204,8 @@ -- This can be useful when you have additional information that was generated during -- the execution of a test that would be helpful in understanding why the test failed. withFailureDetail-  :: (HasCallStack, MonadUnliftIO m) => (HasCallStack => m a) -> String -> m a+  :: forall m a+   . (HasCallStack, MonadUnliftIO m) => (HasCallStack => m a) -> String -> m a withFailureDetail action message =   catch action $ \(HUnitFailure l r) ->     throwM $ HUnitFailure l $ case r of

@@ -37,8 +37,8 @@   }  instance FromJSON PackageYaml where-  parseJSON = withObject "PackageYaml" $-    \o -> PackageYaml <$> o .: "default-extensions" <*> o .: "name"+  parseJSON = withObject "PackageYaml"+    $ \o -> PackageYaml <$> o .: "default-extensions" <*> o .: "name"  -- Parse @default-extensions@ and @name& out of @package.yaml@ --

@@ -6,6 +6,7 @@   ) where  import Freckle.App.Prelude+import Prelude qualified as Unsafe (read)  import Control.Concurrent (getNumCapabilities, setNumCapabilities) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)@@ -29,7 +30,6 @@   , hspecWithResult   , readConfig   )-import Prelude qualified as Unsafe (read)  run :: String -> Spec -> IO () run = runWith defaultConfig@@ -46,8 +46,8 @@   -- Run unreliable tests first, so local dev errors are reported for reliable   -- specs at the end   putStrLn "Running UNRELIABLE tests; failures here should not fail the build"-  void $-    runner ("unreliable-" <> name) id+  void+    $ runner ("unreliable-" <> name) id       =<< load         args         (skip reliableTests config)

@@ -7,5 +7,5 @@ import Data.Aeson  -- | Check that @fromJSON (toJSON value)@ is @value@-prop_roundTripJSON :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+prop_roundTripJSON :: (Eq a, FromJSON a, ToJSON a) => a -> Bool prop_roundTripJSON a = fromJSON (toJSON a) == Success a

@@ -7,5 +7,5 @@ import Web.PathPieces  -- | Check that @fromPathPiece (toPathPiece value)@ is @value@-prop_roundTripPathPiece :: (PathPiece a, Eq a) => a -> Bool+prop_roundTripPathPiece :: (Eq a, PathPiece a) => a -> Bool prop_roundTripPathPiece a = fromPathPiece (toPathPiece a) == Just a

@@ -7,5 +7,5 @@ import Database.Persist (PersistField (..))  -- | Check that @'fromPersistValue' ('toPersistValue' value)@ is @value@-prop_roundTripPersistValue :: (PersistField a, Eq a) => a -> Bool+prop_roundTripPersistValue :: (Eq a, PersistField a) => a -> Bool prop_roundTripPersistValue a = fromPersistValue (toPersistValue a) == Right a

@@ -164,22 +164,23 @@  -- | Get the body of the most recent response and decode it as JSON getJsonBody-  :: forall a m site. (MonadYesodExample site m, FromJSON a, HasCallStack) => m a+  :: forall a m site. (FromJSON a, HasCallStack, MonadYesodExample site m) => m a getJsonBody = liftYesodExample Yesod.Test.requireJSONResponse  -- | Get the body of the most recent response and decode it as CSV getCsvBody   :: forall a m site-   . (MonadYesodExample site m, CSV.FromNamedRecord a, HasCallStack)+   . (CSV.FromNamedRecord a, HasCallStack, MonadYesodExample site m)   => m [a] getCsvBody =-  liftYesodExample $-    withResponse $ \(SResponse _status _headers body) ->+  liftYesodExample+    $ withResponse+    $ \(SResponse _status _headers body) ->       -- todo - check the response header first       case fmap (V.toList . snd) (CSV.decodeByName body) of         Left err ->-          failure $-            T.concat+          failure+            $ T.concat               [ "Failed to parse CSV response; error: "               , T.pack err               , "CSV: "@@ -193,7 +194,7 @@  -- | Get the body of the most recent response as a byte string getRawBody-  :: forall m site. (MonadYesodExample site m, HasCallStack) => m BSL.ByteString+  :: forall m site. (HasCallStack, MonadYesodExample site m) => m BSL.ByteString getRawBody =   fmap simpleBody . maybe (expectationFailure "Test response had no body") pure     =<< getResponse@@ -237,15 +238,15 @@ -- If the status code doesn't match, a portion of the body is also -- printed to aid in debugging. statusIs-  :: forall m site. (MonadYesodExample site m, HasCallStack) => Int -> m ()+  :: forall m site. (HasCallStack, MonadYesodExample site m) => Int -> m () statusIs = liftYesodExample . Yesod.Test.statusIs -statusIs2XX :: MonadYesodExample site m => m ()+statusIs2XX :: forall site m. MonadYesodExample site m => m () statusIs2XX = liftYesodExample $ withResponse $ \response -> do   let status = simpleStatus response   unless (statusIsSuccessful status) $ do-    expectationFailure $-      "Response status " <> show status <> " should have been 2xx"+    expectationFailure+      $ "Response status " <> show status <> " should have been 2xx"  -- | Assert that the given header field's value satisfied some predicate assertHeaderSatisfies@@ -264,8 +265,8 @@   case lookup header $ simpleHeaders res of     Just value | predicate value -> pure ()     Just value ->-      expectationFailure $-        concat+      expectationFailure+        $ concat           [ "Expected header "           , show header           , " "@@ -274,8 +275,8 @@           , show value           ]     Nothing ->-      expectationFailure $-        concat+      expectationFailure+        $ concat           [ "Expected header "           , show header           , predicateDesc@@ -285,7 +286,8 @@ -- | Assert that the given header field's value contains --   some particular byte string within it assertHeaderContains-  :: MonadYesodExample site m+  :: forall site m+   . MonadYesodExample site m   => CI ByteString   -- ^ Field name   -> ByteString

@@ -43,38 +43,38 @@ -- N.B. This should not be used for "enormous" enumerations. It's primary purpose -- is to provide standard instances for discriminated-union-defined enums. newtype TextualEnum a = TextualEnum {enumValue :: a}-  deriving newtype (Eq, Show, Ord, Generic)+  deriving newtype (Eq, Generic, Ord, Show)  -- | All values of a 'TextualEnum' enums :: (Bounded a, Enum a) => NonEmpty (TextualEnum a) enums = fmap TextualEnum $ minBound NE.:| drop 1 [minBound .. maxBound]  -- | Parse a 'TextualEnum' from 'Text'-fromText :: (EnumValue a, Bounded a, Enum a) => Text -> Maybe (TextualEnum a)+fromText :: (Bounded a, Enum a, EnumValue a) => Text -> Maybe (TextualEnum a) fromText txt = find ((== txt) . toText . enumValue) enums  instance EnumValue a => ToJSON (TextualEnum a) where   toJSON = toJSON . toText . enumValue   toEncoding = toEncoding . toText . enumValue -instance (EnumValue a, Bounded a, Enum a) => FromJSON (TextualEnum a) where+instance (Bounded a, Enum a, EnumValue a) => FromJSON (TextualEnum a) where   parseJSON = withText "TextualEnum" $ maybe mzero pure . fromText  instance (Bounded a, Enum a) => Arbitrary (TextualEnum a) where   arbitrary = elements $ toList enums -instance (EnumValue a, Bounded a, Enum a) => PathPiece (TextualEnum a) where+instance (Bounded a, Enum a, EnumValue a) => PathPiece (TextualEnum a) where   toPathPiece = toPathPiece . toText . enumValue   fromPathPiece = fromText  instance EnumValue a => CSV.ToField (TextualEnum a) where   toField = CSV.toField . toText . enumValue -instance (EnumValue a, Bounded a, Enum a) => CSV.FromField (TextualEnum a) where+instance (Bounded a, Enum a, EnumValue a) => CSV.FromField (TextualEnum a) where   parseField = maybe mzero pure . fromText . T.decodeUtf8  instance-  (Bounded a, Enum a, EnumValue a, Typeable a, EnumName a)+  (Bounded a, Enum a, EnumName a, EnumValue a, Typeable a)   => ToSchema (TextualEnum a)   where   declareNamedSchema = pure . NamedSchema (Just $ enumName $ Proxy @a) . enumOptions

@@ -26,14 +26,16 @@ -- -- Also logs and increments a metric. respondQueryCanceled-  :: HasStatsClient (HandlerData site site)+  :: forall site res+   . HasStatsClient (HandlerData site site)   => HandlerFor site res   -> HandlerFor site res respondQueryCanceled = respondQueryCanceledHeaders []  -- | 'respondQueryCanceledHeaders' but adding headers to the 503 response respondQueryCanceledHeaders-  :: HasStatsClient (HandlerData site site)+  :: forall site res+   . HasStatsClient (HandlerData site site)   => ResponseHeaders   -> HandlerFor site res   -> HandlerFor site res@@ -43,12 +45,13 @@     Stats.increment "query_canceled"     sendWaiResponse $ W.responseLBS status503 headers "Query canceled" -logExceptionsMiddleware :: (MonadUnliftIO m, MonadLogger m) => m a -> m a+logExceptionsMiddleware+  :: forall m a. (MonadLogger m, MonadUnliftIO m) => m a -> m a logExceptionsMiddleware f =   f `withException` \ex ->-    unless (isHandlerContents ex) $-      logErrorNS "yesod" $-        annotatedExceptionMessageFrom (const "Handler exception") ex+    unless (isHandlerContents ex)+      $ logErrorNS "yesod"+      $ annotatedExceptionMessageFrom (const "Handler exception") ex  isHandlerContents :: AnnotatedException SomeException -> Bool isHandlerContents = isJust . fromException @HandlerContents . exception

@@ -27,11 +27,10 @@ handleOptions validateOrigin extraExposedHeaders app req sendResponse =   case (requestMethod req, lookup "Origin" (requestHeaders req)) of     ("OPTIONS", Just origin) ->-      sendResponse $-        responseLBS+      sendResponse+        $ responseLBS           status200-          ( toHeaders $ corsResponseHeaders validateOrigin extraExposedHeaders origin-          )+          (toHeaders $ corsResponseHeaders validateOrigin extraExposedHeaders origin)           mempty     _ -> app req sendResponse  where

@@ -8,8 +8,9 @@ import Control.Lens (Lens', lens) import Yesod.Core.Types (HandlerData, RunHandlerEnv, handlerEnv, rheSite) -envL :: Lens' (HandlerData child site) (RunHandlerEnv child site)+envL+  :: forall child site. Lens' (HandlerData child site) (RunHandlerEnv child site) envL = lens handlerEnv $ \x y -> x {handlerEnv = y} -siteL :: Lens' (RunHandlerEnv child site) site+siteL :: forall child site. Lens' (RunHandlerEnv child site) site siteL = lens rheSite $ \x y -> x {rheSite = y}

@@ -1,5 +1,5 @@ name: freckle-app-version: 1.27.0.0+version: 1.27.0.1  maintainer: Freckle Education category: Utils

@@ -18,8 +18,8 @@   describe "async" $ do     it @(IO ()) "preserves Blammo context" $ do       let kvs = ["a" .= ("xyz" :: Text)]-      Blammo.withThreadContext kvs $-        (wait =<< async Blammo.myThreadContext)+      Blammo.withThreadContext kvs+        $ (wait =<< async Blammo.myThreadContext)           `shouldReturn` KeyMap.fromList kvs     it @(IO ()) "preserves OpenTelemetry context" $ do       k <- OpenTelemetry.newKey "a"

@@ -3,7 +3,6 @@   ) where  import Freckle.App.Prelude-import Freckle.App.Test  import Blammo.Logging.ThreadContext qualified as Blammo import Data.Aeson@@ -12,6 +11,7 @@ import Freckle.App.Bugsnag.MetaData import Freckle.App.Stats import Freckle.App.Stats qualified as Stats+import Freckle.App.Test  spec :: Spec spec = do@@ -71,8 +71,8 @@ runMergeMetaData mExisting incoming = MetaData <$> event_metaData event  where   event =-    runBeforeNotify (mergeMetaData incoming) someException $-      defaultEvent {event_metaData = unMetaData <$> mExisting}+    runBeforeNotify (mergeMetaData incoming) someException+      $ defaultEvent {event_metaData = unMetaData <$> mExisting}  someException :: SomeException someException = undefined

@@ -19,7 +19,7 @@   { someInt :: Int   , someText :: Text   }-  deriving stock (Eq, Show, Generic)+  deriving stock (Eq, Generic, Show)  data FooError = BadFoo   deriving stock (Eq, Show)@@ -51,20 +51,20 @@       header = ["someInt", "someText"]       rows :: [Foo]       rows = [Foo 123 "this is some text", Foo 456 "this is more text"]-    it "should parse records as expected" $-      decode HasHeader content+    it "should parse records as expected"+      $ decode HasHeader content         `shouldBe` Right (V.fromList rows) -    it "should parse named records as expected" $-      decodeByName content+    it "should parse named records as expected"+      $ decodeByName content         `shouldBe` Right (V.fromList header, V.fromList rows) -    it "should serialize records as expected" $-      encode rows+    it "should serialize records as expected"+      $ encode rows         `shouldBe` contentRows -    it "should serialize named records as expected" $-      encodeDefaultOrderedByName rows+    it "should serialize named records as expected"+      $ encodeDefaultOrderedByName rows         `shouldBe` content    for_ [CustomParser, FromNamedRecordParser] $ \testType -> do

@@ -12,8 +12,8 @@ data MyCustomType   = A   | B (Maybe String)-  deriving stock (Show, Eq, Generic)-  deriving anyclass (ToJSON, FromJSON)+  deriving stock (Eq, Generic, Show)+  deriving anyclass (FromJSON, ToJSON)  instance Arbitrary MyCustomType where   arbitrary = oneof [pure A, B <$> arbitrary]@@ -23,6 +23,6 @@   describe "prop_roundTripJSON" $ do     it "round trips for Integer" $ property $ prop_roundTripJSON @Integer     it "round trips for Bool" $ property $ prop_roundTripJSON @Bool-    it "round trips for some custom type" $-      property $-        prop_roundTripJSON @MyCustomType+    it "round trips for some custom type"+      $ property+      $ prop_roundTripJSON @MyCustomType

@@ -13,6 +13,6 @@   describe "pathPieceInstancesRoundTrip" $ do     it "round trips for Integer" $ property $ prop_roundTripPathPiece @Integer     it "round trips for Bool" $ property $ prop_roundTripPathPiece @Bool-    it "round trips for Maybe String" $-      property $-        prop_roundTripPathPiece @(Maybe String)+    it "round trips for Maybe String"+      $ property+      $ prop_roundTripPathPiece @(Maybe String)

@@ -13,6 +13,6 @@   describe "persistFieldInstancesRoundTrip" $ do     it "round trips for Integer" $ property $ prop_roundTripPersistValue @Int     it "round trips for Bool" $ property $ prop_roundTripPersistValue @Bool-    it "round trips for Maybe String" $-      property $-        prop_roundTripPersistValue @(Maybe String)+    it "round trips for Maybe String"+      $ property+      $ prop_roundTripPersistValue @(Maybe String)

@@ -23,15 +23,15 @@   | Yellow   deriving stock (Bounded, Enum, Eq, Show)   deriving-    ( CSV.ToField+    ( Arbitrary     , CSV.FromField-    , JSON.ToJSON+    , CSV.ToField     , JSON.FromJSON+    , JSON.ToJSON+    , Path.PathPiece     , Servant.FromHttpApiData     , Servant.ToHttpApiData-    , Path.PathPiece     , Sql.PersistField-    , Arbitrary     )     via TextualEnum PrimaryColor @@ -56,40 +56,41 @@ spec :: Spec spec = do   describe "TextualEnum" $ do-    describe "JSON" $-      it "round trips" $-        property $-          prop_roundTripJSON @PrimaryColor+    describe "JSON"+      $ it "round trips"+      $ property+      $ prop_roundTripJSON @PrimaryColor -    describe "PathPiece" $-      it "round trips" $-        property $-          prop_roundTripPathPiece @PrimaryColor+    describe "PathPiece"+      $ it "round trips"+      $ property+      $ prop_roundTripPathPiece @PrimaryColor -    describe "HttpApiData" $-      it "round trips" $-        property $-          \(e :: PrimaryColor) -> Servant.parseUrlPiece (Servant.toUrlPiece e) == Right e+    describe "HttpApiData"+      $ it "round trips"+      $ property+      $ \(e :: PrimaryColor) -> Servant.parseUrlPiece (Servant.toUrlPiece e) == Right e -    describe "PersistValue" $-      it "round trips" $-        property $-          prop_roundTripPersistValue @PrimaryColor+    describe "PersistValue"+      $ it "round trips"+      $ property+      $ prop_roundTripPersistValue @PrimaryColor -    describe "CSV" $-      it "round trips" $-        property $ \(e :: PrimaryColor) ->-          CSV.runParser (CSV.parseField $ CSV.toField e) == Right e+    describe "CSV"+      $ it "round trips"+      $ property+      $ \(e :: PrimaryColor) ->+        CSV.runParser (CSV.parseField $ CSV.toField e) == Right e      describe "prop_roundTripEnumText" $ do-      it "holds for a well defined toText" $-        property $-          prop_roundTripEnumText @PrimaryColor+      it "holds for a well defined toText"+        $ property+        $ prop_roundTripEnumText @PrimaryColor -      it "does not hold when toText doesn't map to distinct values" $-        any (not . prop_roundTripEnumText @BadExample) enums+      it "does not hold when toText doesn't map to distinct values"+        $ any (not . prop_roundTripEnumText @BadExample) enums      describe "enums" $ do-      it "returns all values" $-        enums @PrimaryColor+      it "returns all values"+        $ enums @PrimaryColor           `shouldBe` fmap TextualEnum (Red :| [Blue, Yellow])

@@ -46,22 +46,22 @@      it "adds CORS headers to responses for non-OPTIONS" $ runTestSession $ do       response <--        request $-          setMethod "GET" $-            setOriginHeader-              "unimportant"-              defaultRequest+        request+          $ setMethod "GET"+          $ setOriginHeader+            "unimportant"+            defaultRequest        assertAccessControlHeaders "BADORIGIN" response       assertBody "Test" response      it "responds itself, with CORS headers, for OPTIONS" $ runTestSession $ do       response <--        request $-          setMethod "OPTIONS" $-            setOriginHeader-              "unimportant"-              defaultRequest+        request+          $ setMethod "OPTIONS"+          $ setOriginHeader+            "unimportant"+            defaultRequest        assertAccessControlHeaders "BADORIGIN" response       assertBody mempty response@@ -84,14 +84,14 @@       assertBody "Test" responseA       assertBody "Test" responseB -    it "adds extra Exposed-Headers" $-      runTestSessionWith (const False) ["X-Foo"] $-        do-          response <- request $ setOriginHeader "unimportant" defaultRequest-          assertHeader-            "Access-Control-Expose-Headers"-            "Set-Cookie, Content-Disposition, Link, X-Foo"-            response+    it "adds extra Exposed-Headers"+      $ runTestSessionWith (const False) ["X-Foo"]+      $ do+        response <- request $ setOriginHeader "unimportant" defaultRequest+        assertHeader+          "Access-Control-Expose-Headers"+          "Set-Cookie, Content-Disposition, Link, X-Foo"+          response    describe "denyFrameEmbeddingMiddleware" $ do     let