diff --git a/hedgehog-extras/hedgehog-extras.haddock b/hedgehog-extras/hedgehog-extras.haddock index 16eb9bf5..de6e0a6d 100644 Binary files a/hedgehog-extras/hedgehog-extras.haddock and b/hedgehog-extras/hedgehog-extras.haddock differ diff --git a/hedgehog-extras/src/Hedgehog.Extras.Aeson.html b/hedgehog-extras/src/Hedgehog.Extras.Aeson.html index 0529b992..0675d6cf 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Aeson.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Aeson.html @@ -41,21 +41,21 @@ strictComparison = Bool False -goldenTestJsonValue :: forall a. () - => Eq a - => FromJSON a - => Show a - => ToJSON a +goldenTestJsonValue :: forall a. () + => Eq a + => FromJSON a + => Show a + => ToJSON a => HasCallStack - => a + => a -> FilePath -> Property goldenTestJsonValue :: forall a. (Eq a, FromJSON a, Show a, ToJSON a, HasCallStack) => a -> FilePath -> Property -goldenTestJsonValue a -x FilePath -path = forall a. HasCallStack => (HasCallStack => a) -> a +goldenTestJsonValue a +x FilePath +path = forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b $ TestLimit -> Property -> Property withTests TestLimit @@ -63,11 +63,11 @@ . HasCallStack => PropertyT IO () -> Property property forall a b. (a -> b) -> a -> b $ do - ByteString -bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + ByteString +bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (FilePath -> IO ByteString LBS.readFile FilePath -path) +path) forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool writeNewGoldFiles forall a b. (a -> b) -> a -> b @@ -75,30 +75,30 @@ liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> ByteString -> IO () LBS.writeFile (FilePath -path forall a. Semigroup a => a -> a -> a +path forall a. Semigroup a => a -> a -> a <> FilePath ".gold") forall a b. (a -> b) -> a -> b $ forall a. ToJSON a => a -> ByteString encode a -x +x forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool strictComparison forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. ToJSON a => a -> ByteString encode (forall a. FromJSON a => ByteString -> Either FilePath a -eitherDecode @a ByteString -bs) forall (m :: * -> *) a. +eitherDecode @a ByteString +bs) forall (m :: * -> *) a. (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () === forall a b. b -> Either a b Right ByteString -bs +bs case forall a. FromJSON a => ByteString -> Either FilePath a eitherDecode ByteString -bs of - Left FilePath -err -> forall (m :: * -> *) a. +bs of + Left FilePath +err -> forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Maybe Diff -> FilePath -> m a H.failWith forall a. Maybe a @@ -107,31 +107,31 @@ "could not decode: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -err - Right a -x' -> a -x forall (m :: * -> *) a. +err + Right a +x' -> a +x forall (m :: * -> *) a. (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () === a -x' +x' goldenTestJsonValuePretty - :: forall a. () - => Eq a - => FromJSON a + :: forall a. () + => Eq a + => FromJSON a => HasCallStack - => Show a - => ToJSON a - => a + => Show a + => ToJSON a + => a -> FilePath -> Property goldenTestJsonValuePretty :: forall a. (Eq a, FromJSON a, HasCallStack, Show a, ToJSON a) => a -> FilePath -> Property -goldenTestJsonValuePretty a -x FilePath -path = +goldenTestJsonValuePretty a +x FilePath +path = forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b @@ -143,17 +143,17 @@ property forall a b. (a -> b) -> a -> b $ do - ByteString -bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + ByteString +bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (FilePath -> IO ByteString LBS.readFile FilePath -path) +path) -- Sort keys by their order of appearance in the argument list -- of `keyOrder`. Keys not in the argument list are moved to the -- end, while their order is preserved. let - defConfig' :: Config -defConfig' = Config + defConfig' :: Config +defConfig' = Config { confIndent :: Indent confIndent = Int -> Indent Spaces Int @@ -177,32 +177,32 @@ liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> ByteString -> IO () LBS.writeFile (FilePath -path forall a. Semigroup a => a -> a -> a +path forall a. Semigroup a => a -> a -> a <> FilePath ".gold") forall a b. (a -> b) -> a -> b $ forall a. ToJSON a => Config -> a -> ByteString encodePretty' Config -defConfig' a -x +defConfig' a +x forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool strictComparison forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall a. ToJSON a => Config -> a -> ByteString encodePretty' Config -defConfig') (forall a. FromJSON a => ByteString -> Either FilePath a -eitherDecode @a ByteString -bs) forall (m :: * -> *) a. +defConfig') (forall a. FromJSON a => ByteString -> Either FilePath a +eitherDecode @a ByteString +bs) forall (m :: * -> *) a. (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () === forall a b. b -> Either a b Right ByteString -bs +bs case forall a. FromJSON a => ByteString -> Either FilePath a eitherDecode ByteString -bs of - Left FilePath -err -> forall (m :: * -> *) a. +bs of + Left FilePath +err -> forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Maybe Diff -> FilePath -> m a H.failWith forall a. Maybe a @@ -211,12 +211,12 @@ "could not decode: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -err - Right a -x' -> a -x forall (m :: * -> *) a. +err + Right a +x' -> a +x forall (m :: * -> *) a. (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () === a -x' +x' \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Internal.Cli.html b/hedgehog-extras/src/Hedgehog.Extras.Internal.Cli.html index beaa4e03..0ada0bb2 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Internal.Cli.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Internal.Cli.html @@ -15,92 +15,92 @@ -- Note, this function does not cover all the edge cases for shell processing, so avoid use in production code. argQuote :: String -> String argQuote :: String -> String -argQuote String -arg = if Char +argQuote String +arg = if Char ' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `L.elem` String -arg Bool -> Bool -> Bool +arg Bool -> Bool -> Bool || Char '"' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `L.elem` String -arg Bool -> Bool -> Bool +arg Bool -> Bool -> Bool || Char '$' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `L.elem` String -arg +arg then String "\"" forall a. Semigroup a => a -> a -> a <> String -> String -escape String -arg forall a. Semigroup a => a -> a -> a +escape String +arg forall a. Semigroup a => a -> a -> a <> String "\"" else String -arg - where escape :: String -> String - escape :: String -> String -escape (Char -'"':String -xs) = Char +arg + where escape :: String -> String + escape :: String -> String +escape (Char +'"':String +xs) = Char '\\'forall a. a -> [a] -> [a] :Char '"'forall a. a -> [a] -> [a] :String -> String -escape String -xs - escape (Char -'\\':String -xs) = Char +escape String +xs + escape (Char +'\\':String +xs) = Char '\\'forall a. a -> [a] -> [a] :Char '\\'forall a. a -> [a] -> [a] :String -> String -escape String -xs - escape (Char -'\n':String -xs) = Char +escape String +xs + escape (Char +'\n':String +xs) = Char '\\'forall a. a -> [a] -> [a] :Char 'n'forall a. a -> [a] -> [a] :String -> String -escape String -xs - escape (Char -'\r':String -xs) = Char +escape String +xs + escape (Char +'\r':String +xs) = Char '\\'forall a. a -> [a] -> [a] :Char 'r'forall a. a -> [a] -> [a] :String -> String -escape String -xs - escape (Char -'\t':String -xs) = Char +escape String +xs + escape (Char +'\t':String +xs) = Char '\\'forall a. a -> [a] -> [a] :Char 't'forall a. a -> [a] -> [a] :String -> String -escape String -xs - escape (Char -'$':String -xs) = Char +escape String +xs + escape (Char +'$':String +xs) = Char '\\'forall a. a -> [a] -> [a] :Char '$'forall a. a -> [a] -> [a] :String -> String -escape String -xs - escape (Char -x:String -xs) = Char -xforall a. a -> [a] -> [a] +escape String +xs + escape (Char +x:String +xs) = Char +xforall a. a -> [a] -> [a] :String -> String -escape String -xs - escape String +escape String +xs + escape String "" = String "" \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Internal.Plan.html b/hedgehog-extras/src/Hedgehog.Extras.Internal.Plan.html index d0d3b21c..fa5798ff 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Internal.Plan.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Internal.Plan.html @@ -15,7 +15,7 @@ import GHC.Generics import Text.Show -data Component = Component +data Component = Component { Component -> Maybe Text componentName :: Maybe Text , Component -> Maybe Text @@ -27,13 +27,13 @@ (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Component x -> Component $cfrom :: forall x. Component -> Rep Component x -Generic, Component -> Component -> Bool +Generic, Component -> Component -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Component -> Component -> Bool $c/= :: Component -> Component -> Bool == :: Component -> Component -> Bool $c== :: Component -> Component -> Bool -Eq, Int -> Component -> ShowS +Eq, Int -> Component -> ShowS [Component] -> ShowS Component -> String forall a. @@ -46,7 +46,7 @@ $cshowsPrec :: Int -> Component -> ShowS Show) -newtype Plan = Plan +newtype Plan = Plan { Plan -> [Component] installPlan :: [Component] } @@ -56,13 +56,13 @@ (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Plan x -> Plan $cfrom :: forall x. Plan -> Rep Plan x -Generic, Plan -> Plan -> Bool +Generic, Plan -> Plan -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Plan -> Plan -> Bool $c/= :: Plan -> Plan -> Bool == :: Plan -> Plan -> Bool $c== :: Plan -> Plan -> Bool -Eq, Int -> Plan -> ShowS +Eq, Int -> Plan -> ShowS [Plan] -> ShowS Plan -> String forall a. @@ -75,36 +75,36 @@ $cshowsPrec :: Int -> Plan -> ShowS Show) -instance FromJSON Plan where - parseJSON :: Value -> Parser Plan +instance FromJSON Plan where + parseJSON :: Value -> Parser Plan parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a withObject String "Plan" forall a b. (a -> b) -> a -> b -$ \Object -v -> [Component] -> Plan +$ \Object +v -> [Component] -> Plan Plan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object -v forall a. FromJSON a => Object -> Key -> Parser a +v forall a. FromJSON a => Object -> Key -> Parser a .: Key "install-plan" -instance FromJSON Component where - parseJSON :: Value -> Parser Component -parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a +instance FromJSON Component where + parseJSON :: Value -> Parser Component +parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a withObject String "Plan" forall a b. (a -> b) -> a -> b -$ \Object -v -> Maybe Text -> Maybe Text -> Component +$ \Object +v -> Maybe Text -> Maybe Text -> Component Component forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object -v forall a. FromJSON a => Object -> Key -> Parser (Maybe a) +v forall a. FromJSON a => Object -> Key -> Parser (Maybe a) .:? Key "component-name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object -v forall a. FromJSON a => Object -> Key -> Parser (Maybe a) +v forall a. FromJSON a => Object -> Key -> Parser (Maybe a) .:? Key "bin-file" \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Internal.Test.Integration.html b/hedgehog-extras/src/Hedgehog.Extras.Internal.Test.Integration.html index 54e1954e..ce13b5c1 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Internal.Test.Integration.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Internal.Test.Integration.html @@ -18,7 +18,7 @@ import qualified Control.Concurrent.STM as STM import qualified Hedgehog as H -newtype IntegrationState = IntegrationState +newtype IntegrationState = IntegrationState { IntegrationState -> TVar [Integration ()] integrationStateFinals :: STM.TVar [Integration ()] } deriving (forall x. Rep IntegrationState x -> IntegrationState @@ -29,7 +29,7 @@ $cfrom :: forall x. IntegrationState -> Rep IntegrationState x Generic) -type Integration a = H.PropertyT (ReaderT IntegrationState (ResourceT IO)) a +type Integration a = H.PropertyT (ReaderT IntegrationState (ResourceT IO)) a newIntegrationStateIO :: IO IntegrationState newIntegrationStateIO :: IO IntegrationState @@ -38,23 +38,23 @@ <$> forall a. a -> IO (TVar a) STM.newTVarIO [] -newIntegrationStateM :: MonadIO m => m IntegrationState +newIntegrationStateM :: MonadIO m => m IntegrationState newIntegrationStateM :: forall (m :: * -> *). MonadIO m => m IntegrationState newIntegrationStateM = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO IntegrationState newIntegrationStateIO -runIntegrationReaderT :: MonadIO m => ReaderT IntegrationState m a -> m a +runIntegrationReaderT :: MonadIO m => ReaderT IntegrationState m a -> m a runIntegrationReaderT :: forall (m :: * -> *) a. MonadIO m => ReaderT IntegrationState m a -> m a -runIntegrationReaderT ReaderT IntegrationState m a -f = do - IntegrationState -s <- forall (m :: * -> *). MonadIO m => m IntegrationState +runIntegrationReaderT ReaderT IntegrationState m a +f = do + IntegrationState +s <- forall (m :: * -> *). MonadIO m => m IntegrationState newIntegrationStateM forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT ReaderT IntegrationState m a -f IntegrationState -s +f IntegrationState +s \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.Aeson.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.Aeson.html index 33c33a7a..0b09293b 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.Aeson.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.Aeson.html @@ -12,31 +12,31 @@ -- All other JSON values are preserved. rewriteObject :: (KeyMap Value -> KeyMap Value) -> Value -> Value rewriteObject :: (KeyMap Value -> KeyMap Value) -> Value -> Value -rewriteObject KeyMap Value -> KeyMap Value -f (Object KeyMap Value -hm) = KeyMap Value -> Value +rewriteObject KeyMap Value -> KeyMap Value +f (Object KeyMap Value +hm) = KeyMap Value -> Value Object (KeyMap Value -> KeyMap Value -f KeyMap Value -hm) +f KeyMap Value +hm) rewriteObject KeyMap Value -> KeyMap Value -_ Value -v = Value -v +_ Value +v = Value +v -- | Rewrite each element of a JSON array using the function 'f'. -- -- All other JSON values are preserved. rewriteArrayElements :: (Value -> Value) -> Value -> Value rewriteArrayElements :: (Value -> Value) -> Value -> Value -rewriteArrayElements Value -> Value -f (Array Array -hm) = Array -> Value +rewriteArrayElements Value -> Value +f (Array Array +hm) = Array -> Value Array (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Value -> Value -f Array -hm) +f Array +hm) rewriteArrayElements Value -> Value -_ Value -v = Value -v +_ Value +v = Value +v \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.File.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.File.html index c5807f2c..a6552e32 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.File.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.File.html @@ -13,12 +13,12 @@ -- | Determine if the given string is found in the given file. fileContains :: String -> FilePath -> IO Bool fileContains :: String -> String -> IO Bool -fileContains String -text String -path = (String -text forall a. Eq a => [a] -> [a] -> Bool +fileContains String +text String +path = (String +text forall a. Eq a => [a] -> [a] -> Bool `L.isInfixOf`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> IO String IO.readFile String -path +path \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.NamedPipe.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.NamedPipe.html index afd82d58..3a75a1bd 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.NamedPipe.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.NamedPipe.html @@ -17,8 +17,8 @@ doesNamedPipeExist :: FilePath -> IO Bool doesNamedPipeExist :: FilePath -> IO Bool -doesNamedPipeExist FilePath -path = +doesNamedPipeExist FilePath +path = #ifdef mingw32_HOST_OS W32.waitNamedPipe path 1 #else diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Port.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Port.html index 35232047..9e7bb17b 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Port.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Port.html @@ -16,18 +16,18 @@ import Network.Socket -- | Return a random available port on a specified host address -randomPort :: () - => MonadIO m - => MonadFail m +randomPort :: () + => MonadIO m + => MonadFail m => HostAddress - -> m PortNumber + -> m PortNumber randomPort :: forall (m :: * -> *). (MonadIO m, MonadFail m) => HostAddress -> m PortNumber -randomPort HostAddress -hostAddress = do - Socket -sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a +randomPort HostAddress +hostAddress = do + Socket +sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Family -> SocketType -> ProtocolNumber -> IO Socket socket Family @@ -39,46 +39,46 @@ liftIO forall a b. (a -> b) -> a -> b $ Socket -> SocketOption -> Int -> IO () setSocketOption Socket -sock SocketOption +sock SocketOption ReuseAddr Int 1 forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Socket -> SockAddr -> IO () bind Socket -sock forall a b. (a -> b) -> a -> b +sock forall a b. (a -> b) -> a -> b $ PortNumber -> HostAddress -> SockAddr SockAddrInet PortNumber defaultPort HostAddress -hostAddress - SockAddrInet PortNumber -port HostAddress +hostAddress + SockAddrInet PortNumber +port HostAddress _ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Socket -> IO SockAddr getSocketName Socket -sock +sock forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Socket -> IO () close Socket -sock +sock forall (m :: * -> *) a. Monad m => a -> m a return PortNumber -port +port -reserveRandomPort :: () - => MonadFail m - => MonadResource m +reserveRandomPort :: () + => MonadFail m + => MonadResource m => HostAddress - -> m (ReleaseKey, PortNumber) + -> m (ReleaseKey, PortNumber) reserveRandomPort :: forall (m :: * -> *). (MonadFail m, MonadResource m) => HostAddress -> m (ReleaseKey, PortNumber) -reserveRandomPort HostAddress -hostAddress = do - Socket -sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a +reserveRandomPort HostAddress +hostAddress = do + Socket +sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Family -> SocketType -> ProtocolNumber -> IO Socket socket Family @@ -89,50 +89,50 @@ liftIO forall a b. (a -> b) -> a -> b $ Socket -> SocketOption -> Int -> IO () setSocketOption Socket -sock SocketOption +sock SocketOption ReuseAddr Int 1 forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Socket -> SockAddr -> IO () bind Socket -sock forall a b. (a -> b) -> a -> b +sock forall a b. (a -> b) -> a -> b $ PortNumber -> HostAddress -> SockAddr SockAddrInet PortNumber defaultPort HostAddress -hostAddress - SockAddrInet PortNumber -port HostAddress +hostAddress + SockAddrInet PortNumber +port HostAddress _ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Socket -> IO SockAddr getSocketName Socket -sock - ReleaseKey -releaseKey <- forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey +sock + ReleaseKey +releaseKey <- forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey register forall a b. (a -> b) -> a -> b $ Socket -> IO () close Socket -sock +sock forall (m :: * -> *) a. Monad m => a -> m a return (ReleaseKey -releaseKey, PortNumber -port) +releaseKey, PortNumber +port) -- | Check if a port is in use on a specified host address -portInUse :: () - => MonadIO m +portInUse :: () + => MonadIO m => HostAddress -> PortNumber - -> m Bool + -> m Bool portInUse :: forall (m :: * -> *). MonadIO m => HostAddress -> PortNumber -> m Bool -portInUse HostAddress -hostAddress PortNumber -pn = do - Socket -sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a +portInUse HostAddress +hostAddress PortNumber +pn = do + Socket +sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Family -> SocketType -> ProtocolNumber -> IO Socket socket Family @@ -143,25 +143,25 @@ liftIO forall a b. (a -> b) -> a -> b $ Socket -> SocketOption -> Int -> IO () setSocketOption Socket -sock SocketOption +sock SocketOption ReuseAddr Int 1 - Either SomeException () -result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + Either SomeException () +result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall e a. Exception e => IO a -> IO (Either e a) try @SomeException forall a b. (a -> b) -> a -> b $ Socket -> SockAddr -> IO () bind Socket -sock (PortNumber -> HostAddress -> SockAddr +sock (PortNumber -> HostAddress -> SockAddr SockAddrInet PortNumber -pn HostAddress -hostAddress) +pn HostAddress +hostAddress) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Socket -> IO () close Socket -sock +sock forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c @@ -170,5 +170,5 @@ False) (forall a b. a -> b -> a const Bool True) Either SomeException () -result +result \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Socket.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Socket.html index ea2794ef..cf34161a 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Socket.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Socket.html @@ -28,21 +28,21 @@ -- | Check if a TCP port is open isPortOpen :: Int -> IO Bool isPortOpen :: Int -> IO Bool -isPortOpen Int -port = do - [AddrInfo] -socketAddressInfos <- Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo] +isPortOpen Int +port = do + [AddrInfo] +socketAddressInfos <- Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo] IO.getAddrInfo forall a. Maybe a Nothing (forall a. a -> Maybe a Just HostName "127.0.0.1") (forall a. a -> Maybe a Just (forall a. Show a => a -> HostName show Int -port)) +port)) case [AddrInfo] -socketAddressInfos of - AddrInfo -socketAddressInfo:[AddrInfo] +socketAddressInfos of + AddrInfo +socketAddressInfo:[AddrInfo] _ -> forall e a. Exception e => (e -> IO a) -> IO a -> IO a handle (forall (m :: * -> *) a. Monad m => a -> m a @@ -54,7 +54,7 @@ SockAddr -> IO () canConnect (AddrInfo -> SockAddr IO.addrAddress AddrInfo -socketAddressInfo) forall (f :: * -> *) a b. Functor f => f a -> b -> f b +socketAddressInfo) forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> Bool True [] -> forall (m :: * -> *) a. Monad m => a -> m a @@ -64,8 +64,8 @@ -- | Check if it is possible to connect to a socket address canConnect :: SockAddr -> IO () canConnect :: SockAddr -> IO () -canConnect SockAddr -sockAddr = forall (m :: * -> *) a b c. +canConnect SockAddr +sockAddr = forall (m :: * -> *) a b c. MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c IO.bracket (Family -> SocketType -> ProtocolNumber -> IO Socket @@ -74,26 +74,26 @@ Stream ProtocolNumber 6) Socket -> IO () IO.close' forall a b. (a -> b) -> a -> b -$ \Socket -sock -> do +$ \Socket +sock -> do Socket -> SockAddr -> IO () IO.connect Socket -sock SockAddr -sockAddr +sock SockAddr +sockAddr -- | Open a socket at the specified port for listening listenOn :: Int -> IO Socket listenOn :: Int -> IO Socket -listenOn Int -n = do - Socket -sock <- Family -> SocketType -> ProtocolNumber -> IO Socket +listenOn Int +n = do + Socket +sock <- Family -> SocketType -> ProtocolNumber -> IO Socket IO.socket Family AF_INET SocketType Stream ProtocolNumber 0 - AddrInfo -sockAddrInfo:[AddrInfo] + AddrInfo +sockAddrInfo:[AddrInfo] _ <- Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo] IO.getAddrInfo forall a. Maybe a Nothing (forall a. a -> Maybe a @@ -101,24 +101,24 @@ "127.0.0.1") (forall a. a -> Maybe a Just (forall a. Show a => a -> HostName show Int -n)) +n)) Socket -> SocketOption -> Int -> IO () IO.setSocketOption Socket -sock SocketOption +sock SocketOption IO.ReuseAddr Int 1 Socket -> SockAddr -> IO () IO.bind Socket -sock (AddrInfo -> SockAddr +sock (AddrInfo -> SockAddr IO.addrAddress AddrInfo -sockAddrInfo) +sockAddrInfo) Socket -> Int -> IO () IO.listen Socket -sock Int +sock Int 2 forall (m :: * -> *) a. Monad m => a -> m a return Socket -sock +sock doesSocketExist :: FilePath -> IO Bool doesSocketExist :: HostName -> IO Bool @@ -129,10 +129,10 @@ -- | Allocate the specified number of random ports allocateRandomPorts :: Int -> IO [Int] allocateRandomPorts :: Int -> IO [Int] -allocateRandomPorts Int -n = do - let hints :: AddrInfo -hints = AddrInfo +allocateRandomPorts Int +n = do + let hints :: AddrInfo +hints = AddrInfo IO.defaultHints { addrFlags :: [AddrInfoFlag] IO.addrFlags = [AddrInfoFlag @@ -143,55 +143,55 @@ } -- Create n sockets with randomly bound ports, grab the port numbers and close those ports - AddrInfo -addr:[AddrInfo] + AddrInfo +addr:[AddrInfo] _ <- Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo] IO.getAddrInfo (forall a. a -> Maybe a Just AddrInfo -hints) (forall a. a -> Maybe a +hints) (forall a. a -> Maybe a Just HostName "127.0.0.1") (forall a. a -> Maybe a Just HostName "0") - [Socket] -socks <- forall (t :: * -> *) (m :: * -> *) a b. + [Socket] +socks <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM [Int 1..Int -n] forall a b. (a -> b) -> a -> b +n] forall a b. (a -> b) -> a -> b $ \Int _ -> Family -> SocketType -> ProtocolNumber -> IO Socket IO.socket (AddrInfo -> Family IO.addrFamily AddrInfo -addr) (AddrInfo -> SocketType +addr) (AddrInfo -> SocketType IO.addrSocketType AddrInfo -addr) (AddrInfo -> ProtocolNumber +addr) (AddrInfo -> ProtocolNumber IO.addrProtocol AddrInfo -addr) +addr) forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [Socket] -socks forall a b. (a -> b) -> a -> b -$ \Socket -sock -> Socket -> SockAddr -> IO () +socks forall a b. (a -> b) -> a -> b +$ \Socket +sock -> Socket -> SockAddr -> IO () IO.bind Socket -sock (AddrInfo -> SockAddr +sock (AddrInfo -> SockAddr IO.addrAddress AddrInfo -addr) - [PortNumber] -ports <- forall (t :: * -> *) (m :: * -> *) a b. +addr) + [PortNumber] +ports <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM [Socket] -socks Socket -> IO PortNumber +socks Socket -> IO PortNumber IO.socketPort forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [Socket] -socks Socket -> IO () +socks Socket -> IO () IO.close forall (m :: * -> *) a. Monad m => a -> m a @@ -199,5 +199,5 @@ $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (Integral a, Num b) => a -> b fromIntegral [PortNumber] -ports +ports \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Sprocket.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Sprocket.html index 5c48a8c0..61824231 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Sprocket.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Sprocket.html @@ -25,7 +25,7 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Socket as IO -- | Socket emulation. On Posix it represents a socket. On Windows it represents a named pipe. -data Sprocket = Sprocket +data Sprocket = Sprocket { Sprocket -> FilePath sprocketBase :: String , Sprocket -> FilePath @@ -36,13 +36,13 @@ (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Sprocket x -> Sprocket $cfrom :: forall x. Sprocket -> Rep Sprocket x -Generic, Sprocket -> Sprocket -> Bool +Generic, Sprocket -> Sprocket -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Sprocket -> Sprocket -> Bool $c/= :: Sprocket -> Sprocket -> Bool == :: Sprocket -> Sprocket -> Bool $c== :: Sprocket -> Sprocket -> Bool -Eq, Int -> Sprocket -> ShowS +Eq, Int -> Sprocket -> ShowS [Sprocket] -> ShowS Sprocket -> FilePath forall a. @@ -58,47 +58,47 @@ -- | Test if the sprocket exists doesSprocketExist :: Sprocket -> IO Bool doesSprocketExist :: Sprocket -> IO Bool -doesSprocketExist Sprocket -socket = if Bool +doesSprocketExist Sprocket +socket = if Bool isWin32 then FilePath -> IO Bool IO.doesNamedPipeExist (Sprocket -> FilePath sprocketSystemName Sprocket -socket) +socket) else FilePath -> IO Bool IO.doesSocketExist (Sprocket -> FilePath sprocketSystemName Sprocket -socket) +socket) -- | Use this to query the OS about the sprocket sprocketSystemName :: Sprocket -> FilePath sprocketSystemName :: Sprocket -> FilePath -sprocketSystemName sprocket :: Sprocket -sprocket@(Sprocket FilePath -base FilePath -name) = if Bool +sprocketSystemName sprocket :: Sprocket +sprocket@(Sprocket FilePath +base FilePath +name) = if Bool isWin32 then Sprocket -> FilePath sprocketNamedPipeName Sprocket -sprocket +sprocket else FilePath -base FilePath -> ShowS +base FilePath -> ShowS </> FilePath -name +name -- | Use this when needing to pass a sprocket into a command line argument. sprocketArgumentName :: Sprocket -> FilePath sprocketArgumentName :: Sprocket -> FilePath -sprocketArgumentName sprocket :: Sprocket -sprocket@(Sprocket FilePath -_ FilePath -name) = if Bool +sprocketArgumentName sprocket :: Sprocket +sprocket@(Sprocket FilePath +_ FilePath +name) = if Bool isWin32 then Sprocket -> FilePath sprocketNamedPipeName Sprocket -sprocket +sprocket else FilePath -name +name maxSprocketArgumentNameLength :: Int maxSprocketArgumentNameLength :: Int @@ -113,41 +113,41 @@ sprocketNamedPipeName :: Sprocket -> FilePath sprocketNamedPipeName :: Sprocket -> FilePath sprocketNamedPipeName (Sprocket FilePath -_ FilePath -name) = FilePath +_ FilePath +name) = FilePath "\\\\.\\pipe" forall a. Semigroup a => a -> a -> a <> ShowS -dedupBackslash (FilePath +dedupBackslash (FilePath "\\" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Char -> Char -slackToBack FilePath -name) - where slackToBack :: Char -> Char - slackToBack :: Char -> Char -slackToBack Char -c = if Char -c forall a. Eq a => a -> a -> Bool +slackToBack FilePath +name) + where slackToBack :: Char -> Char + slackToBack :: Char -> Char +slackToBack Char +c = if Char +c forall a. Eq a => a -> a -> Bool == Char '/' then Char '\\' else Char -c - dedupBackslash :: String -> String - dedupBackslash :: ShowS -dedupBackslash (Char +c + dedupBackslash :: String -> String + dedupBackslash :: ShowS +dedupBackslash (Char '\\':Char -'\\':FilePath -xs) = ShowS -dedupBackslash (Char +'\\':FilePath +xs) = ShowS +dedupBackslash (Char '\\'forall a. a -> [a] -> [a] :FilePath -xs) - dedupBackslash (Char -x:FilePath -xs) = Char -xforall a. a -> [a] -> [a] +xs) + dedupBackslash (Char +x:FilePath +xs) = Char +xforall a. a -> [a] -> [a] :ShowS -dedupBackslash FilePath -xs - dedupBackslash [] = [] +dedupBackslash FilePath +xs + dedupBackslash [] = [] \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Process.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Process.html index 1ebcf4b8..461a2efc 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Process.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Process.html @@ -26,19 +26,19 @@ import qualified Control.Concurrent.Async as IO import qualified System.Process as IO -data TimedOut = TimedOut deriving (forall x. Rep TimedOut x -> TimedOut +data TimedOut = TimedOut deriving (forall x. Rep TimedOut x -> TimedOut forall x. TimedOut -> Rep TimedOut x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep TimedOut x -> TimedOut $cfrom :: forall x. TimedOut -> Rep TimedOut x -Generic, TimedOut -> TimedOut -> Bool +Generic, TimedOut -> TimedOut -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: TimedOut -> TimedOut -> Bool $c/= :: TimedOut -> TimedOut -> Bool == :: TimedOut -> TimedOut -> Bool $c== :: TimedOut -> TimedOut -> Bool -Eq, Int -> TimedOut -> ShowS +Eq, Int -> TimedOut -> ShowS [TimedOut] -> ShowS TimedOut -> String forall a. @@ -55,14 +55,14 @@ :: ProcessHandle -> IO (Maybe ExitCode) maybeWaitForProcess :: ProcessHandle -> IO (Maybe ExitCode) -maybeWaitForProcess ProcessHandle -hProcess = +maybeWaitForProcess ProcessHandle +hProcess = forall e a. Exception e => IO a -> (e -> IO a) -> IO a catch (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. a -> Maybe a Just (ProcessHandle -> IO ExitCode IO.waitForProcess ProcessHandle -hProcess)) forall a b. (a -> b) -> a -> b +hProcess)) forall a b. (a -> b) -> a -> b $ \(AsyncCancelled _ :: AsyncCancelled) -> forall (m :: * -> *) a. Monad m => a -> m a return forall a. Maybe a @@ -73,13 +73,13 @@ -> ProcessHandle -> IO (Either TimedOut (Maybe ExitCode)) waitSecondsForProcess :: Int -> ProcessHandle -> IO (Either TimedOut (Maybe ExitCode)) -waitSecondsForProcess Int -seconds ProcessHandle -hProcess = forall a b. IO a -> IO b -> IO (Either a b) +waitSecondsForProcess Int +seconds ProcessHandle +hProcess = forall a b. IO a -> IO b -> IO (Either a b) IO.race (Int -> IO () IO.threadDelay (Int -seconds forall a. Num a => a -> a -> a +seconds forall a. Num a => a -> a -> a * Int 1000000) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall (m :: * -> *) a. Monad m => a -> m a @@ -87,5 +87,5 @@ TimedOut) (ProcessHandle -> IO (Maybe ExitCode) maybeWaitForProcess ProcessHandle -hProcess) +hProcess) \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.Monad.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.Monad.html index 65096f00..b3832fdc 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.Monad.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.Monad.html @@ -6,7 +6,7 @@ import Control.Monad -- | Force the evaluation of the return value in a monadic computation. -forceM :: (Monad m, NFData a) => m a -> m a +forceM :: (Monad m, NFData a) => m a -> m a forceM :: forall (m :: * -> *) a. (Monad m, NFData a) => m a -> m a forceM = (forall a. NFData a => a -> a force forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.String.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.String.html index 6ab66813..0941bd23 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.String.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.String.html @@ -61,12 +61,12 @@ -- | Trim leading and trailing whitespace and read the string into a value. Report the read value in the test -- annotations. -readNoteM :: (Read a, Show a, H.MonadTest m, MonadCatch m, HasCallStack) => String -> m a +readNoteM :: (Read a, Show a, H.MonadTest m, MonadCatch m, HasCallStack) => String -> m a readNoteM :: forall a (m :: * -> *). (Read a, Show a, MonadTest m, MonadCatch m, HasCallStack) => String -> m a -readNoteM String -inputStr = +readNoteM String +inputStr = forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b @@ -87,12 +87,12 @@ <> String ": " forall a. Semigroup a => a -> a -> a <> String -inputStr) +inputStr) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Read a => String -> Either String a readEither forall a b. (a -> b) -> a -> b $ String -> String strip String -inputStr +inputStr \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Stock.Time.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.Time.html index 2ea774b0..e31ba66f 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Stock.Time.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Stock.Time.html @@ -17,12 +17,12 @@ -- | Show 'UTCTime' in seconds since epoch showUTCTimeSeconds :: UTCTime -> String showUTCTimeSeconds :: UTCTime -> String -showUTCTimeSeconds UTCTime -time = forall a. Show a => a -> String +showUTCTimeSeconds UTCTime +time = forall a. Show a => a -> String show @Int64 (forall a b. (RealFrac a, Integral b) => a -> b floor (UTCTime -> POSIXTime DTC.utcTimeToPOSIXSeconds UTCTime -time)) +time)) -- | Format the given time as an ISO 8601 date-time string formatIso8601 :: UTCTime -> String diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.Base.html b/hedgehog-extras/src/Hedgehog.Extras.Test.Base.html index 4ec9c724..8fb7c6e0 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Base.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Base.html @@ -152,14 +152,14 @@ H.runIntegrationReaderT -- | Takes a 'CallStack' so the error can be rendered at the appropriate call site. -failWithCustom :: MonadTest m => CallStack -> Maybe Diff -> String -> m a +failWithCustom :: MonadTest m => CallStack -> Maybe Diff -> String -> m a failWithCustom :: forall (m :: * -> *) a. MonadTest m => CallStack -> Maybe Diff -> String -> m a -failWithCustom CallStack -cs Maybe Diff -mdiff String -msg = forall (m :: * -> *) a. MonadTest m => Test a -> m a +failWithCustom CallStack +cs Maybe Diff +mdiff String +msg = forall (m :: * -> *) a. MonadTest m => Test a -> m a liftTest forall a b. (a -> b) -> a -> b $ forall a. (Either Failure a, Journal) -> Test a mkTest (forall a b. a -> Either a b @@ -167,20 +167,20 @@ $ Maybe Span -> String -> Maybe Diff -> Failure H.Failure (CallStack -> Maybe Span getCaller CallStack -cs) String -msg Maybe Diff -mdiff, forall a. Monoid a => a +cs) String +msg Maybe Diff +mdiff, forall a. Monoid a => a mempty) -- | Takes a 'CallStack' so the error can be rendered at the appropriate call site. -failMessage :: MonadTest m => CallStack -> String -> m a +failMessage :: MonadTest m => CallStack -> String -> m a failMessage :: forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a -failMessage CallStack -cs = forall (m :: * -> *) a. +failMessage CallStack +cs = forall (m :: * -> *) a. MonadTest m => CallStack -> Maybe Diff -> String -> m a failWithCustom CallStack -cs forall a. Maybe a +cs forall a. Maybe a Nothing -- | Create a workspace directory which will exist for at least the duration of @@ -191,39 +191,39 @@ -- -- The directory will be deleted if the block succeeds, but left behind if -- the block fails. -workspace :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (FilePath -> m ()) -> m () +workspace :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (FilePath -> m ()) -> m () workspace :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => String -> (String -> m ()) -> m () -workspace String -prefixPath String -> m () -f = forall a. HasCallStack => (HasCallStack => a) -> a +workspace String +prefixPath String -> m () +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - String -systemTemp <- forall (m :: * -> *) a. + String +systemTemp <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO IO String IO.getCanonicalTemporaryDirectory - Maybe String -maybeKeepWorkspace <- forall (m :: * -> *) a. + Maybe String +maybeKeepWorkspace <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ String -> IO (Maybe String) IO.lookupEnv String "KEEP_WORKSPACE" - String -ws <- forall (m :: * -> *) a. + String +ws <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ String -> String -> IO String IO.createTempDirectory String -systemTemp forall a b. (a -> b) -> a -> b +systemTemp forall a b. (a -> b) -> a -> b $ String -prefixPath forall a. Semigroup a => a -> a -> a +prefixPath forall a. Semigroup a => a -> a -> a <> String "-test" forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () @@ -231,25 +231,27 @@ $ String "Workspace: " forall a. Semigroup a => a -> a -> a <> String -ws - forall (m :: * -> *) a. MonadIO m => IO a -> m a -liftIO forall a b. (a -> b) -> a -> b +ws + forall (m :: * -> *) a. +(MonadTest m, MonadIO m, HasCallStack) => +IO a -> m a +H.evalIO forall a b. (a -> b) -> a -> b $ String -> String -> IO () IO.writeFile (String -ws String -> String -> String +ws String -> String -> String </> String "module") HasCallStack => String callerModuleName String -> m () -f String -ws +f String +ws forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (String IO.os forall a. Eq a => a -> a -> Bool /= String "mingw32" Bool -> Bool -> Bool && Maybe String -maybeKeepWorkspace forall a. Eq a => a -> a -> Bool +maybeKeepWorkspace forall a. Eq a => a -> a -> Bool /= forall a. a -> Maybe a Just String "1") forall a b. (a -> b) -> a -> b @@ -259,8 +261,8 @@ IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ String -> IO () -IO.removeDirectoryRecursive String -ws +IO.removePathForcibly String +ws -- | Create a workspace directory which will exist for at least the duration of -- the supplied block. @@ -272,17 +274,17 @@ -- the block fails. -- -- The 'prefix' argument should not contain directory delimeters. -moduleWorkspace :: (MonadTest m, MonadIO m, HasCallStack) => String -> (FilePath -> m ()) -> m () +moduleWorkspace :: (MonadTest m, MonadIO m, HasCallStack) => String -> (FilePath -> m ()) -> m () moduleWorkspace :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => String -> (String -> m ()) -> m () -moduleWorkspace String -prefix String -> m () -f = forall a. HasCallStack => (HasCallStack => a) -> a +moduleWorkspace String +prefix String -> m () +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - let srcModule :: String -srcModule = forall b a. b -> (a -> b) -> Maybe a -> b + let srcModule :: String +srcModule = forall b a. b -> (a -> b) -> Maybe a -> b maybe String "UnknownModule" (SrcLoc -> String GHC.srcLocModule forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -295,292 +297,292 @@ (MonadTest m, MonadIO m, HasCallStack) => String -> (String -> m ()) -> m () workspace (String -prefix forall a. Semigroup a => a -> a -> a +prefix forall a. Semigroup a => a -> a -> a <> String "-" forall a. Semigroup a => a -> a -> a <> String -srcModule) String -> m () -f +srcModule) String -> m () +f -- | Annotate the given string at the context supplied by the callstack. -noteWithCallstack :: MonadTest m => CallStack -> String -> m () +noteWithCallstack :: MonadTest m => CallStack -> String -> m () noteWithCallstack :: forall (m :: * -> *). MonadTest m => CallStack -> String -> m () -noteWithCallstack CallStack -cs String -a = forall (m :: * -> *). MonadTest m => Log -> m () +noteWithCallstack CallStack +cs String +a = forall (m :: * -> *). MonadTest m => Log -> m () H.writeLog forall a b. (a -> b) -> a -> b $ Maybe Span -> String -> Log H.Annotation (CallStack -> Maybe Span getCaller CallStack -cs) String -a +cs) String +a -- | Annotate with the given string. -note :: (MonadTest m, HasCallStack) => String -> m String +note :: (MonadTest m, HasCallStack) => String -> m String note :: forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m String -note String -a = forall a. HasCallStack => (HasCallStack => a) -> a +note String +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !String -b <- forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a + !String +b <- forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a H.eval String -a +a forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack String -b +b forall (m :: * -> *) a. Monad m => a -> m a return String -b +b -- | Annotate the given string returning unit. -note_ :: (MonadTest m, HasCallStack) => String -> m () +note_ :: (MonadTest m, HasCallStack) => String -> m () note_ :: forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () -note_ String -a = forall a. HasCallStack => (HasCallStack => a) -> a +note_ String +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack String -a +a -- | Annotate the given string in a monadic context. -noteM :: (MonadTest m, MonadCatch m, HasCallStack) => m String -> m String +noteM :: (MonadTest m, MonadCatch m, HasCallStack) => m String -> m String noteM :: forall (m :: * -> *). (MonadTest m, MonadCatch m, HasCallStack) => m String -> m String -noteM m String -a = forall a. HasCallStack => (HasCallStack => a) -> a +noteM m String +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !String -b <- forall (m :: * -> *) a. + !String +b <- forall (m :: * -> *) a. (MonadTest m, MonadCatch m, HasCallStack) => m a -> m a H.evalM m String -a +a forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack String -b +b forall (m :: * -> *) a. Monad m => a -> m a return String -b +b -- | Annotate the given string in a monadic context returning unit. -noteM_ :: (MonadTest m, MonadCatch m, HasCallStack) => m String -> m () +noteM_ :: (MonadTest m, MonadCatch m, HasCallStack) => m String -> m () noteM_ :: forall (m :: * -> *). (MonadTest m, MonadCatch m, HasCallStack) => m String -> m () -noteM_ m String -a = forall a. HasCallStack => (HasCallStack => a) -> a +noteM_ m String +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !String -b <- forall (m :: * -> *) a. + !String +b <- forall (m :: * -> *) a. (MonadTest m, MonadCatch m, HasCallStack) => m a -> m a H.evalM m String -a +a forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack String -b +b forall (m :: * -> *) a. Monad m => a -> m a return () -- | Annotate the given string in IO. -noteIO :: (MonadTest m, MonadIO m, HasCallStack) => IO String -> m String +noteIO :: (MonadTest m, MonadIO m, HasCallStack) => IO String -> m String noteIO :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => IO String -> m String -noteIO IO String -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteIO IO String +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !String -a <- forall (m :: * -> *) a. + !String +a <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO IO String -f +f forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack String -a +a forall (m :: * -> *) a. Monad m => a -> m a return String -a +a -- | Annotate the given string in IO returning unit. -noteIO_ :: (MonadTest m, MonadIO m, HasCallStack) => IO String -> m () +noteIO_ :: (MonadTest m, MonadIO m, HasCallStack) => IO String -> m () noteIO_ :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => IO String -> m () -noteIO_ IO String -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteIO_ IO String +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !String -a <- forall (m :: * -> *) a. + !String +a <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO IO String -f +f forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack String -a +a forall (m :: * -> *) a. Monad m => a -> m a return () -- | Annotate the given value. -noteShow :: (MonadTest m, HasCallStack, Show a) => a -> m a +noteShow :: (MonadTest m, HasCallStack, Show a) => a -> m a noteShow :: forall (m :: * -> *) a. (MonadTest m, HasCallStack, Show a) => a -> m a -noteShow a -a = forall a. HasCallStack => (HasCallStack => a) -> a +noteShow a +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !a -b <- forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a + !a +b <- forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a H.eval a -a +a forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack (forall a. Show a => a -> String show a -b) +b) forall (m :: * -> *) a. Monad m => a -> m a return a -b +b -- | Annotate the given value returning unit. -noteShow_ :: (MonadTest m, HasCallStack, Show a) => a -> m () +noteShow_ :: (MonadTest m, HasCallStack, Show a) => a -> m () noteShow_ :: forall (m :: * -> *) a. (MonadTest m, HasCallStack, Show a) => a -> m () -noteShow_ a -a = forall a. HasCallStack => (HasCallStack => a) -> a +noteShow_ a +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack (forall a. Show a => a -> String show a -a) +a) -- | Annotate the given value in a monadic context. -noteShowM :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m a +noteShowM :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m a noteShowM :: forall (m :: * -> *) a. (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m a -noteShowM m a -a = forall a. HasCallStack => (HasCallStack => a) -> a +noteShowM m a +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !a -b <- forall (m :: * -> *) a. + !a +b <- forall (m :: * -> *) a. (MonadTest m, MonadCatch m, HasCallStack) => m a -> m a H.evalM m a -a +a forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack (forall a. Show a => a -> String show a -b) +b) forall (m :: * -> *) a. Monad m => a -> m a return a -b +b -- | Annotate the given value in a monadic context returning unit. -noteShowM_ :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m () +noteShowM_ :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m () noteShowM_ :: forall (m :: * -> *) a. (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m () -noteShowM_ m a -a = forall a. HasCallStack => (HasCallStack => a) -> a +noteShowM_ m a +a = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !a -b <- forall (m :: * -> *) a. + !a +b <- forall (m :: * -> *) a. (MonadTest m, MonadCatch m, HasCallStack) => m a -> m a H.evalM m a -a +a forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack (forall a. Show a => a -> String show a -b) +b) forall (m :: * -> *) a. Monad m => a -> m a return () -- | Annotate the given value in IO. -noteShowIO :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m a +noteShowIO :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m a noteShowIO :: forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m a -noteShowIO IO a -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteShowIO IO a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !a -a <- forall (m :: * -> *) a. + !a +a <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO IO a -f +f forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack (forall a. Show a => a -> String show a -a) +a) forall (m :: * -> *) a. Monad m => a -> m a return a -a +a -- | Annotate the given value in IO returning unit. -noteShowIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m () +noteShowIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m () noteShowIO_ :: forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m () -noteShowIO_ IO a -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteShowIO_ IO a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !a -a <- forall (m :: * -> *) a. + !a +a <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO IO a -f +f forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack (forall a. Show a => a -> String show a -a) +a) forall (m :: * -> *) a. Monad m => a -> m a return () -- | Annotate the each value in the given traversable. -noteEach :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m (f a) +noteEach :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m (f a) noteEach :: forall (m :: * -> *) a (f :: * -> *). (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m (f a) -noteEach f a -as = forall a. HasCallStack => (HasCallStack => a) -> a +noteEach f a +as = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ f a -as forall a b. (a -> b) -> a -> b +as forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -588,21 +590,21 @@ show forall (m :: * -> *) a. Monad m => a -> m a return f a -as +as -- | Annotate the each value in the given traversable returning unit. -noteEach_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m () +noteEach_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m () noteEach_ :: forall (m :: * -> *) a (f :: * -> *). (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m () -noteEach_ f a -as = forall a. HasCallStack => (HasCallStack => a) -> a +noteEach_ f a +as = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ f a -as forall a b. (a -> b) -> a -> b +as forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -610,22 +612,22 @@ show -- | Annotate the each value in the given traversable in a monadic context. -noteEachM :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m (f a) +noteEachM :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m (f a) noteEachM :: forall (m :: * -> *) a (f :: * -> *). (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m (f a) -noteEachM m (f a) -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteEachM m (f a) +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !f a -as <- m (f a) -f + !f a +as <- m (f a) +f forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ f a -as forall a b. (a -> b) -> a -> b +as forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -633,25 +635,25 @@ show forall (m :: * -> *) a. Monad m => a -> m a return f a -as +as -- | Annotate the each value in the given traversable in a monadic context returning unit. -noteEachM_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m () +noteEachM_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m () noteEachM_ :: forall (m :: * -> *) a (f :: * -> *). (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m () -noteEachM_ m (f a) -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteEachM_ m (f a) +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !f a -as <- m (f a) -f + !f a +as <- m (f a) +f forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ f a -as forall a b. (a -> b) -> a -> b +as forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -659,25 +661,25 @@ show -- | Annotate the each value in the given traversable in IO. -noteEachIO :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m (f a) +noteEachIO :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m (f a) noteEachIO :: forall (m :: * -> *) a (f :: * -> *). (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m (f a) -noteEachIO IO (f a) -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteEachIO IO (f a) +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !f a -as <- forall (m :: * -> *) a. + !f a +as <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO IO (f a) -f +f forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ f a -as forall a b. (a -> b) -> a -> b +as forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -685,28 +687,28 @@ show forall (m :: * -> *) a. Monad m => a -> m a return f a -as +as -- | Annotate the each value in the given traversable in IO returning unit. -noteEachIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m () +noteEachIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m () noteEachIO_ :: forall (m :: * -> *) a (f :: * -> *). (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m () -noteEachIO_ IO (f a) -f = forall a. HasCallStack => (HasCallStack => a) -> a +noteEachIO_ IO (f a) +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !f a -as <- forall (m :: * -> *) a. + !f a +as <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO IO (f a) -f +f forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ f a -as forall a b. (a -> b) -> a -> b +as forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadTest m => CallStack -> String -> m () noteWithCallstack HasCallStack => CallStack GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -714,41 +716,41 @@ show -- | Return the test file path after annotating it relative to the project root directory -noteTempFile :: (MonadTest m, HasCallStack) => FilePath -> FilePath -> m FilePath +noteTempFile :: (MonadTest m, HasCallStack) => FilePath -> FilePath -> m FilePath noteTempFile :: forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> String -> m String -noteTempFile String -tempDir String -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +noteTempFile String +tempDir String +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - let relPath :: String -relPath = String -tempDir String -> String -> String + let relPath :: String +relPath = String +tempDir String -> String -> String </> String -filePath +filePath forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () H.annotate String -relPath +relPath forall (m :: * -> *) a. Monad m => a -> m a return String -relPath +relPath -- | Fail when the result is Nothing. -nothingFail :: (MonadTest m, HasCallStack) => Maybe a -> m a +nothingFail :: (MonadTest m, HasCallStack) => Maybe a -> m a nothingFail :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Maybe a -> m a -nothingFail Maybe a -r = forall a. HasCallStack => (HasCallStack => a) -> a +nothingFail Maybe a +r = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ case Maybe a -r of - Just a -a -> forall (m :: * -> *) a. Monad m => a -> m a +r of + Just a +a -> forall (m :: * -> *) a. Monad m => a -> m a return a -a +a Maybe a Nothing -> forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a failMessage HasCallStack => CallStack @@ -756,65 +758,65 @@ "Expected Just" -- | Fail when the computed result is Nothing. -nothingFailM :: (MonadTest m, HasCallStack) => m (Maybe a) -> m a +nothingFailM :: (MonadTest m, HasCallStack) => m (Maybe a) -> m a nothingFailM :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m (Maybe a) -> m a -nothingFailM m (Maybe a) -f = forall a. HasCallStack => (HasCallStack => a) -> a +nothingFailM m (Maybe a) +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ m (Maybe a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Maybe a -> m a nothingFail -- | Fail when the result is Left. -leftFail :: (MonadTest m, Show e, HasCallStack) => Either e a -> m a +leftFail :: (MonadTest m, Show e, HasCallStack) => Either e a -> m a leftFail :: forall (m :: * -> *) e a. (MonadTest m, Show e, HasCallStack) => Either e a -> m a -leftFail Either e a -r = forall a. HasCallStack => (HasCallStack => a) -> a +leftFail Either e a +r = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ case Either e a -r of - Right a -a -> forall (m :: * -> *) a. Monad m => a -> m a +r of + Right a +a -> forall (m :: * -> *) a. Monad m => a -> m a return a -a - Left e -e -> forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a +a + Left e +e -> forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a failMessage HasCallStack => CallStack GHC.callStack (String "Expected Right: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show e -e) +e) -- | Fail when the computed result is Left. -leftFailM :: (MonadTest m, Show e, HasCallStack) => m (Either e a) -> m a +leftFailM :: (MonadTest m, Show e, HasCallStack) => m (Either e a) -> m a leftFailM :: forall (m :: * -> *) e a. (MonadTest m, Show e, HasCallStack) => m (Either e a) -> m a -leftFailM m (Either e a) -f = forall a. HasCallStack => (HasCallStack => a) -> a +leftFailM m (Either e a) +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ m (Either e a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *) e a. (MonadTest m, Show e, HasCallStack) => Either e a -> m a leftFail -maybeAt :: Int -> [a] -> Maybe a +maybeAt :: Int -> [a] -> Maybe a maybeAt :: forall a. Int -> [a] -> Maybe a -maybeAt Int -n [a] -xs +maybeAt Int +n [a] +xs | Int -n forall a. Ord a => a -> a -> Bool +n forall a. Ord a => a -> a -> Bool < Int 0 = forall a. Maybe a Nothing @@ -823,38 +825,38 @@ Foldable t => (a -> b -> b) -> b -> t a -> b L.foldr forall a. a -> (Int -> Maybe a) -> Int -> Maybe a -go (forall a b. a -> b -> a +go (forall a b. a -> b -> a const forall a. Maybe a Nothing) [a] -xs Int -n +xs Int +n where - go :: a -> (Int -> Maybe a) -> Int -> Maybe a - go :: forall a. a -> (Int -> Maybe a) -> Int -> Maybe a -go a -x Int -> Maybe a -r Int -k = + go :: a -> (Int -> Maybe a) -> Int -> Maybe a + go :: forall a. a -> (Int -> Maybe a) -> Int -> Maybe a +go a +x Int -> Maybe a +r Int +k = case Int -k of +k of Int 0 -> forall a. a -> Maybe a Just a -x +x Int _ -> Int -> Maybe a -r (Int -k forall a. Num a => a -> a -> a +r (Int +k forall a. Num a => a -> a -> a - Int 1) -headM :: (MonadTest m, HasCallStack) => [a] -> m a +headM :: (MonadTest m, HasCallStack) => [a] -> m a headM :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => [a] -> m a -headM (a -a:[a] +headM (a +a:[a] _) = forall (m :: * -> *) a. Monad m => a -> m a return a -a +a headM [] = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a @@ -862,21 +864,21 @@ GHC.callStack String "Cannot take head of empty list" -indexM :: (MonadTest m, HasCallStack) => Int -> [a] -> m a +indexM :: (MonadTest m, HasCallStack) => Int -> [a] -> m a indexM :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Int -> [a] -> m a -indexM Int -n [a] -xs = +indexM Int +n [a] +xs = case forall a. Int -> [a] -> Maybe a maybeAt Int -n [a] -xs of - Just a -x -> forall (f :: * -> *) a. Applicative f => a -> f a +n [a] +xs of + Just a +x -> forall (f :: * -> *) a. Applicative f => a -> f a pure a -x +x Maybe a Nothing -> forall a. HasCallStack => (HasCallStack => a) -> a @@ -889,47 +891,47 @@ "Cannot get index " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Int -n forall a. Semigroup a => a -> a -> a +n forall a. Semigroup a => a -> a -> a <> String " of list of length " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show (forall (t :: * -> *) a. Foldable t => t a -> Int L.length [a] -xs) +xs) -onLeft :: Monad m => (e -> m a) -> m (Either e a) -> m a +onLeft :: Monad m => (e -> m a) -> m (Either e a) -> m a onLeft :: forall (m :: * -> *) e a. Monad m => (e -> m a) -> m (Either e a) -> m a -onLeft e -> m a -h m (Either e a) -f = m (Either e a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +onLeft e -> m a +h m (Either e a) +f = m (Either e a) +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either e -> m a -h forall (f :: * -> *) a. Applicative f => a -> f a +h forall (f :: * -> *) a. Applicative f => a -> f a pure -onNothing :: Monad m => m a -> m (Maybe a) -> m a +onNothing :: Monad m => m a -> m (Maybe a) -> m a onNothing :: forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a -onNothing m a -h m (Maybe a) -f = m (Maybe a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +onNothing m a +h m (Maybe a) +f = m (Maybe a) +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall b a. b -> (a -> b) -> Maybe a -> b maybe m a -h forall (f :: * -> *) a. Applicative f => a -> f a +h forall (f :: * -> *) a. Applicative f => a -> f a pure -- | Index into a list. On failure, a friendly message is included in the test report. -fromJustM :: (MonadTest m, HasCallStack) => Maybe a -> m a +fromJustM :: (MonadTest m, HasCallStack) => Maybe a -> m a fromJustM :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Maybe a -> m a -fromJustM (Just a -a) = forall (m :: * -> *) a. Monad m => a -> m a +fromJustM (Just a +a) = forall (m :: * -> *) a. Monad m => a -> m a return a -a +a fromJustM Maybe a Nothing = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b @@ -939,37 +941,37 @@ "Cannot take head of empty list" -- | Fail when the result is Error. -jsonErrorFail :: (MonadTest m, HasCallStack) => Result a -> m a +jsonErrorFail :: (MonadTest m, HasCallStack) => Result a -> m a jsonErrorFail :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Result a -> m a -jsonErrorFail Result a -r = forall a. HasCallStack => (HasCallStack => a) -> a +jsonErrorFail Result a +r = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ case Result a -r of - Success a -a -> forall (m :: * -> *) a. Monad m => a -> m a +r of + Success a +a -> forall (m :: * -> *) a. Monad m => a -> m a return a -a - Error String -msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a +a + Error String +msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a failMessage HasCallStack => CallStack GHC.callStack (String "Expected Right: " forall a. Semigroup a => a -> a -> a <> String -msg) +msg) -- | Fail when the computed result is Error. -jsonErrorFailM :: (MonadTest m, HasCallStack) => m (Result a) -> m a +jsonErrorFailM :: (MonadTest m, HasCallStack) => m (Result a) -> m a jsonErrorFailM :: forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m (Result a) -> m a -jsonErrorFailM m (Result a) -f = forall a. HasCallStack => (HasCallStack => a) -> a +jsonErrorFailM m (Result a) +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ m (Result a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Result a -> m a @@ -978,50 +980,50 @@ -- | Run the operation 'f' once a second until it returns 'True' or the deadline expires. -- -- Expiration of the deadline results in an assertion failure -byDeadlineIO :: (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> IO a -> m a +byDeadlineIO :: (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> IO a -> m a byDeadlineIO :: forall (m :: * -> *) a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> IO a -> m a -byDeadlineIO NominalDiffTime -period UTCTime -deadline String -errorMessage IO a -f = forall a. HasCallStack => (HasCallStack => a) -> a +byDeadlineIO NominalDiffTime +period UTCTime +deadline String +errorMessage IO a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> m a -> m a byDeadlineM NominalDiffTime -period UTCTime -deadline String -errorMessage forall a b. (a -> b) -> a -> b +period UTCTime +deadline String +errorMessage forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO a -f +f -- | Run the operation 'f' once a second until it returns 'True' or the deadline expires. -- -- Expiration of the deadline results in an assertion failure -byDeadlineM :: forall m a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> m a -> m a +byDeadlineM :: forall m a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> m a -> m a byDeadlineM :: forall (m :: * -> *) a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> m a -> m a -byDeadlineM NominalDiffTime -period UTCTime -deadline String -errorMessage m a -f = forall a. HasCallStack => (HasCallStack => a) -> a +byDeadlineM NominalDiffTime +period UTCTime +deadline String +errorMessage m a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - UTCTime -start <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + UTCTime +start <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime - a -a <- m a -goM - UTCTime -end <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + a +a <- m a +goM + UTCTime +end <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () @@ -1031,28 +1033,28 @@ <> forall a. Show a => a -> String show (UTCTime -> UTCTime -> NominalDiffTime DTC.diffUTCTime UTCTime -end UTCTime -start) +end UTCTime +start) forall (m :: * -> *) a. Monad m => a -> m a return a -a - where goM :: m a - goM :: m a -goM = forall (m :: * -> *) a. +a + where goM :: m a + goM :: m a +goM = forall (m :: * -> *) a. MonadAssertion m => m a -> (Failure -> m a) -> m a H.catchAssertion m a -f forall a b. (a -> b) -> a -> b -$ \Failure -e -> do - UTCTime -currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a +f forall a b. (a -> b) -> a -> b +$ \Failure +e -> do + UTCTime +currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime if UTCTime -currentTime forall a. Ord a => a -> a -> Bool +currentTime forall a. Ord a => a -> a -> Bool < UTCTime -deadline +deadline then do forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b @@ -1060,17 +1062,17 @@ IO.threadDelay (forall a b. (RealFrac a, Integral b) => a -> b floor (NominalDiffTime -> Pico DTC.nominalDiffTimeToSeconds NominalDiffTime -period forall a. Num a => a -> a -> a +period forall a. Num a => a -> a -> a * Pico 1000000)) m a -goM +goM else do forall (m :: * -> *) a. (MonadTest m, Show a, HasCallStack) => a -> m () H.annotateShow UTCTime -currentTime +currentTime forall (f :: * -> *) a. Functor f => f a -> f () void forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a @@ -1079,53 +1081,53 @@ $ String "Condition not met by deadline: " forall a. Semigroup a => a -> a -> a <> String -errorMessage +errorMessage forall (m :: * -> *) a. MonadAssertion m => Failure -> m a H.throwAssertion Failure -e +e -- | Run the operation 'f' once a second until it returns 'True' or the duration expires. -- -- Expiration of the duration results in an assertion failure -byDurationIO :: (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> NominalDiffTime -> String -> IO a -> m a +byDurationIO :: (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> NominalDiffTime -> String -> IO a -> m a byDurationIO :: forall (m :: * -> *) a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> NominalDiffTime -> String -> IO a -> m a -byDurationIO NominalDiffTime -period NominalDiffTime -duration String -errorMessage IO a -f = forall a. HasCallStack => (HasCallStack => a) -> a +byDurationIO NominalDiffTime +period NominalDiffTime +duration String +errorMessage IO a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> NominalDiffTime -> String -> m a -> m a byDurationM NominalDiffTime -period NominalDiffTime -duration String -errorMessage forall a b. (a -> b) -> a -> b +period NominalDiffTime +duration String +errorMessage forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO a -f +f -- | Run the operation 'f' once a second until it returns 'True' or the duration expires. -- -- Expiration of the duration results in an assertion failure -byDurationM :: (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> NominalDiffTime -> String -> m a -> m a +byDurationM :: (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> NominalDiffTime -> String -> m a -> m a byDurationM :: forall (m :: * -> *) a. (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> NominalDiffTime -> String -> m a -> m a -byDurationM NominalDiffTime -period NominalDiffTime -duration String -errorMessage m a -f = forall a. HasCallStack => (HasCallStack => a) -> a +byDurationM NominalDiffTime +period NominalDiffTime +duration String +errorMessage m a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - UTCTime -deadline <- NominalDiffTime -> UTCTime -> UTCTime + UTCTime +deadline <- NominalDiffTime -> UTCTime -> UTCTime DTC.addUTCTime NominalDiffTime -duration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b +duration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime @@ -1133,39 +1135,39 @@ (MonadAssertion m, MonadTest m, MonadIO m, HasCallStack) => NominalDiffTime -> UTCTime -> String -> m a -> m a byDeadlineM NominalDiffTime -period UTCTime -deadline String -errorMessage m a -f +period UTCTime +deadline String +errorMessage m a +f -- | Run the operation 'f' once a second until it returns 'True' or the deadline expires. -- -- Expiration of the deadline results in an assertion failure -assertByDeadlineIO :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () +assertByDeadlineIO :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () assertByDeadlineIO :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () -assertByDeadlineIO UTCTime -deadline IO Bool -f = forall a. HasCallStack => (HasCallStack => a) -> a +assertByDeadlineIO UTCTime +deadline IO Bool +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -success <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + Bool +success <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO Bool -f +f forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool -success forall a b. (a -> b) -> a -> b +success forall a b. (a -> b) -> a -> b $ do - UTCTime -currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + UTCTime +currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime if UTCTime -currentTime forall a. Ord a => a -> a -> Bool +currentTime forall a. Ord a => a -> a -> Bool < UTCTime -deadline +deadline then do forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b @@ -1176,14 +1178,14 @@ (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () assertByDeadlineIO UTCTime -deadline IO Bool -f +deadline IO Bool +f else do forall (m :: * -> *) a. (MonadTest m, Show a, HasCallStack) => a -> m () H.annotateShow UTCTime -currentTime +currentTime forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a failMessage HasCallStack => CallStack GHC.callStack String @@ -1192,30 +1194,30 @@ -- | Run the operation 'f' once a second until it returns 'True' or the deadline expires. -- -- Expiration of the deadline results in an assertion failure -assertByDeadlineM :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () +assertByDeadlineM :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () assertByDeadlineM :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () -assertByDeadlineM UTCTime -deadline m Bool -f = forall a. HasCallStack => (HasCallStack => a) -> a +assertByDeadlineM UTCTime +deadline m Bool +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -success <- m Bool -f + Bool +success <- m Bool +f forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool -success forall a b. (a -> b) -> a -> b +success forall a b. (a -> b) -> a -> b $ do - UTCTime -currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + UTCTime +currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime if UTCTime -currentTime forall a. Ord a => a -> a -> Bool +currentTime forall a. Ord a => a -> a -> Bool < UTCTime -deadline +deadline then do forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b @@ -1226,14 +1228,14 @@ (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () assertByDeadlineM UTCTime -deadline m Bool -f +deadline m Bool +f else do forall (m :: * -> *) a. (MonadTest m, Show a, HasCallStack) => a -> m () H.annotateShow UTCTime -currentTime +currentTime forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a failMessage HasCallStack => CallStack GHC.callStack String @@ -1245,32 +1247,32 @@ -- additional annotations to be presented. -- -- Expiration of the deadline results in an assertion failure -assertByDeadlineIOFinally :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () -> m () +assertByDeadlineIOFinally :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () -> m () assertByDeadlineIOFinally :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () -> m () -assertByDeadlineIOFinally UTCTime -deadline IO Bool -f m () -g = forall a. HasCallStack => (HasCallStack => a) -> a +assertByDeadlineIOFinally UTCTime +deadline IO Bool +f m () +g = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -success <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + Bool +success <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO Bool -f +f forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool -success forall a b. (a -> b) -> a -> b +success forall a b. (a -> b) -> a -> b $ do - UTCTime -currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + UTCTime +currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime if UTCTime -currentTime forall a. Ord a => a -> a -> Bool +currentTime forall a. Ord a => a -> a -> Bool < UTCTime -deadline +deadline then do forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b @@ -1281,17 +1283,17 @@ (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> IO Bool -> m () -> m () assertByDeadlineIOFinally UTCTime -deadline IO Bool -f m () -g +deadline IO Bool +f m () +g else do forall (m :: * -> *) a. (MonadTest m, Show a, HasCallStack) => a -> m () H.annotateShow UTCTime -currentTime +currentTime m () -g +g forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a failMessage HasCallStack => CallStack GHC.callStack String @@ -1303,31 +1305,31 @@ -- additional annotations to be presented. -- -- Expiration of the deadline results in an assertion failure -assertByDeadlineMFinally :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () -> m () +assertByDeadlineMFinally :: (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () -> m () assertByDeadlineMFinally :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () -> m () -assertByDeadlineMFinally UTCTime -deadline m Bool -f m () -g = forall a. HasCallStack => (HasCallStack => a) -> a +assertByDeadlineMFinally UTCTime +deadline m Bool +f m () +g = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -success <- m Bool -f + Bool +success <- m Bool +f forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool -success forall a b. (a -> b) -> a -> b +success forall a b. (a -> b) -> a -> b $ do - UTCTime -currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + UTCTime +currentTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime DTC.getCurrentTime if UTCTime -currentTime forall a. Ord a => a -> a -> Bool +currentTime forall a. Ord a => a -> a -> Bool < UTCTime -deadline +deadline then do forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b @@ -1338,56 +1340,56 @@ (MonadTest m, MonadIO m, HasCallStack) => UTCTime -> m Bool -> m () -> m () assertByDeadlineMFinally UTCTime -deadline m Bool -f m () -g +deadline m Bool +f m () +g else do forall (m :: * -> *) a. (MonadTest m, Show a, HasCallStack) => a -> m () H.annotateShow UTCTime -currentTime +currentTime m () -g +g forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a failMessage HasCallStack => CallStack GHC.callStack String "Condition not met by deadline" -- | Run the test function against the value. Report the value on the failure. -assertWith :: (H.MonadTest m, Show p, HasCallStack) => p -> (p -> Bool) -> m () +assertWith :: (H.MonadTest m, Show p, HasCallStack) => p -> (p -> Bool) -> m () assertWith :: forall (m :: * -> *) p. (MonadTest m, Show p, HasCallStack) => p -> (p -> Bool) -> m () -assertWith p -v p -> Bool -f = forall a. HasCallStack => (HasCallStack => a) -> a +assertWith p +v p -> Bool +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) p. (MonadTest m, Show p, HasCallStack) => p -> (p -> m Bool) -> m () assertWithM p -v (forall (f :: * -> *) a. Applicative f => a -> f a +v (forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . p -> Bool -f) +f) -- | Run the test function against the value. Report the value on the failure. -assertWithM :: (H.MonadTest m, Show p, HasCallStack) => p -> (p -> m Bool) -> m () +assertWithM :: (H.MonadTest m, Show p, HasCallStack) => p -> (p -> m Bool) -> m () assertWithM :: forall (m :: * -> *) p. (MonadTest m, Show p, HasCallStack) => p -> (p -> m Bool) -> m () -assertWithM p -v p -> m Bool -f = forall a. HasCallStack => (HasCallStack => a) -> a +assertWithM p +v p -> m Bool +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -result <- p -> m Bool -f p -v + Bool +result <- p -> m Bool +f p +v if Bool -result +result then forall (m :: * -> *). MonadTest m => m () H.success else do @@ -1395,80 +1397,80 @@ (MonadTest m, HasCallStack, Show a) => a -> m () noteShow_ p -v +v forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m () H.assert Bool -result +result -- | Run the monadic action 'f' and assert the return value is 'True'. -assertM :: (MonadTest m, HasCallStack) => m Bool -> m () +assertM :: (MonadTest m, HasCallStack) => m Bool -> m () assertM :: forall (m :: * -> *). (MonadTest m, HasCallStack) => m Bool -> m () -assertM m Bool -f = forall a. HasCallStack => (HasCallStack => a) -> a +assertM m Bool +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ m Bool -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m () H.assert -- | Run the IO action 'f' and assert the return value is 'True'. -assertIO :: (MonadTest m, MonadIO m, HasCallStack) => IO Bool -> m () +assertIO :: (MonadTest m, MonadIO m, HasCallStack) => IO Bool -> m () assertIO :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => IO Bool -> m () -assertIO IO Bool -f = forall a. HasCallStack => (HasCallStack => a) -> a +assertIO IO Bool +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO (forall (m :: * -> *) a. (Monad m, NFData a) => m a -> m a forceM IO Bool -f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m () H.assert -- | Tests if @|c - v| <= r@ -assertWithinTolerance :: (Show a, Ord a, Num a, HasCallStack, H.MonadTest m) - => a -- ^ tested value @v@ - -> a -- ^ expected value @c@ - -> a -- ^ tolerance range @r@ - -> m () +assertWithinTolerance :: (Show a, Ord a, Num a, HasCallStack, H.MonadTest m) + => a -- ^ tested value @v@ + -> a -- ^ expected value @c@ + -> a -- ^ tolerance range @r@ + -> m () assertWithinTolerance :: forall a (m :: * -> *). (Show a, Ord a, Num a, HasCallStack, MonadTest m) => a -> a -> a -> m () -assertWithinTolerance a -v a -c a -r = forall a. HasCallStack => (HasCallStack => a) -> a +assertWithinTolerance a +v a +c a +r = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) a b. (MonadTest m, Show a, Show b, HasCallStack) => a -> (a -> b -> Bool) -> b -> m () H.diff a -v forall a. Ord a => a -> a -> Bool +v forall a. Ord a => a -> a -> Bool (>=) (a -c forall a. Num a => a -> a -> a +c forall a. Num a => a -> a -> a - a -r) +r) forall (m :: * -> *) a b. (MonadTest m, Show a, Show b, HasCallStack) => a -> (a -> b -> Bool) -> b -> m () H.diff a -v forall a. Ord a => a -> a -> Bool +v forall a. Ord a => a -> a -> Bool (<=) (a -c forall a. Num a => a -> a -> a +c forall a. Num a => a -> a -> a + a -r) +r) -- | Release the given release key. -release :: (MonadTest m, MonadIO m) => ReleaseKey -> m () +release :: (MonadTest m, MonadIO m) => ReleaseKey -> m () release :: forall (m :: * -> *). (MonadTest m, MonadIO m) => ReleaseKey -> m () -release ReleaseKey -k = forall a. HasCallStack => (HasCallStack => a) -> a +release ReleaseKey +k = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => @@ -1476,14 +1478,14 @@ H.evalIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadIO m => ReleaseKey -> m () IO.release ReleaseKey -k +k onFailure :: Integration () -> Integration () onFailure :: Integration () -> Integration () -onFailure Integration () -f = do - IntegrationState -s <- forall r (m :: * -> *). MonadReader r m => m r +onFailure Integration () +f = do + IntegrationState +s <- forall r (m :: * -> *). MonadReader r m => m r ask forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -1492,136 +1494,136 @@ $ forall a. TVar a -> (a -> a) -> STM () STM.modifyTVar (IntegrationState -> TVar [Integration ()] integrationStateFinals IntegrationState -s) (Integration () -fforall a. a -> [a] -> [a] +s) (Integration () +fforall a. a -> [a] -> [a] :) reportFinally :: Integration () -> Integration () reportFinally :: Integration () -> Integration () -reportFinally Integration () -f = do - Either Failure () -result <- forall (m :: * -> *) a. +reportFinally Integration () +f = do + Either Failure () +result <- forall (m :: * -> *) a. MonadAssertion m => m a -> (Failure -> m a) -> m a H.catchAssertion (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. b -> Either a b Right Integration () -f) (forall (m :: * -> *) a. Monad m => a -> m a +f) (forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. a -> Either a b Left) case Either Failure () -result of +result of Right () -> forall (m :: * -> *) a. Monad m => a -> m a return () - Left Failure -a -> forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () + Left Failure +a -> forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () note_ forall a b. (a -> b) -> a -> b $ String "Unable to run finally: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Failure -a +a -runFinallies :: Integration a -> Integration a +runFinallies :: Integration a -> Integration a runFinallies :: forall a. Integration a -> Integration a -runFinallies Integration a -f = do - Either Failure a -result <- forall (m :: * -> *) a. +runFinallies Integration a +f = do + Either Failure a +result <- forall (m :: * -> *) a. MonadAssertion m => m a -> (Failure -> m a) -> m a H.catchAssertion (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. b -> Either a b Right Integration a -f) (forall (m :: * -> *) a. Monad m => a -> m a +f) (forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. a -> Either a b Left) case Either Failure a -result of - Right a -a -> forall (m :: * -> *) a. Monad m => a -> m a +result of + Right a +a -> forall (m :: * -> *) a. Monad m => a -> m a return a -a - Left Failure -assertion -> do - IntegrationState -s <- forall r (m :: * -> *). MonadReader r m => m r +a + Left Failure +assertion -> do + IntegrationState +s <- forall r (m :: * -> *). MonadReader r m => m r ask - [Integration ()] -finals <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + [Integration ()] +finals <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. STM a -> IO a STM.atomically forall a b. (a -> b) -> a -> b $ forall a. TVar a -> a -> STM a STM.swapTVar (IntegrationState -> TVar [Integration ()] integrationStateFinals IntegrationState -s) [] +s) [] forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ Integration () -> Integration () reportFinally [Integration ()] -finals +finals forall (m :: * -> *) a. MonadAssertion m => Failure -> m a H.throwAssertion Failure -assertion +assertion -retry :: forall a. Int -> (Int -> Integration a) -> Integration a +retry :: forall a. Int -> (Int -> Integration a) -> Integration a retry :: forall a. Int -> (Int -> Integration a) -> Integration a -retry Int -n Int -> Integration a -f = Int -> Integration a -go Int +retry Int +n Int -> Integration a +f = Int -> Integration a +go Int 0 - where go :: Int -> Integration a - go :: Int -> Integration a -go Int -i = do + where go :: Int -> Integration a + go :: Int -> Integration a +go Int +i = do forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () note_ forall a b. (a -> b) -> a -> b $ String "Retry attempt " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Int -i forall a. Semigroup a => a -> a -> a +i forall a. Semigroup a => a -> a -> a <> String " of " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Int -n - Either Failure a -result <- forall (m :: * -> *) a. +n + Either Failure a +result <- forall (m :: * -> *) a. MonadAssertion m => m a -> (Failure -> m a) -> m a H.catchAssertion (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. b -> Either a b Right (Int -> Integration a -f Int -i)) (forall (m :: * -> *) a. Monad m => a -> m a +f Int +i)) (forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. a -> Either a b Left) case Either Failure a -result of - Right a -a -> forall (m :: * -> *) a. Monad m => a -> m a +result of + Right a +a -> forall (m :: * -> *) a. Monad m => a -> m a return a -a - Left Failure -assertion -> do +a + Left Failure +assertion -> do if Int -i forall a. Ord a => a -> a -> Bool +i forall a. Ord a => a -> a -> Bool < Int -n +n then Int -> Integration a -go (Int -i forall a. Num a => a -> a -> a +go (Int +i forall a. Num a => a -> a -> a + Int 1) else do @@ -1631,20 +1633,20 @@ "All " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Int -n forall a. Semigroup a => a -> a -> a +n forall a. Semigroup a => a -> a -> a <> String " attempts failed" forall (m :: * -> *) a. MonadAssertion m => Failure -> m a H.throwAssertion Failure -assertion +assertion -retry' :: forall a. Int -> Integration a -> Integration a +retry' :: forall a. Int -> Integration a -> Integration a retry' :: forall a. Int -> Integration a -> Integration a -retry' Int -n Integration a -f = forall a. Int -> (Int -> Integration a) -> Integration a +retry' Int +n Integration a +f = forall a. Int -> (Int -> Integration a) -> Integration a retry Int -n (forall a b. a -> b -> a +n (forall a b. a -> b -> a const Integration a -f) +f) \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.Concurrent.html b/hedgehog-extras/src/Hedgehog.Extras.Test.Concurrent.html index 1761de58..8de0273d 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Concurrent.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Concurrent.html @@ -95,12 +95,12 @@ import qualified Hedgehog as H -- | Delay the thread by 'n' milliseconds. -threadDelay :: (HasCallStack, MonadTest m, MonadIO m) => Int -> m () +threadDelay :: (HasCallStack, MonadTest m, MonadIO m) => Int -> m () threadDelay :: forall (m :: * -> *). (HasCallStack, MonadTest m, MonadIO m) => Int -> m () -threadDelay Int -n = forall a. HasCallStack => (HasCallStack => a) -> a +threadDelay Int +n = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => @@ -108,20 +108,20 @@ H.evalIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadBase IO m => Int -> m () IO.threadDelay Int -n +n -- | Runs an action in background, and registers its cancellation to 'MonadResource'. -asyncRegister_ :: HasCallStack - => MonadTest m - => MonadResource m - => MonadCatch m - => IO a -- ^ Action to run in background - -> m () +asyncRegister_ :: HasCallStack + => MonadTest m + => MonadResource m + => MonadCatch m + => IO a -- ^ Action to run in background + -> m () asyncRegister_ :: forall (m :: * -> *) a. (HasCallStack, MonadTest m, MonadResource m, MonadCatch m) => IO a -> m () -asyncRegister_ IO a -act = forall a. HasCallStack => (HasCallStack => a) -> a +asyncRegister_ IO a +act = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. Functor f => f a -> f () void forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -136,33 +136,33 @@ MonadBaseControl IO m => m a -> m (Async (StM m a)) async IO a -act) forall a. Async a -> IO () -cleanUp +act) forall a. Async a -> IO () +cleanUp where - cleanUp :: Async a -> IO () - cleanUp :: forall a. Async a -> IO () -cleanUp Async a -a = forall (m :: * -> *) a. MonadBase IO m => Async a -> m () + cleanUp :: Async a -> IO () + cleanUp :: forall a. Async a -> IO () +cleanUp Async a +a = forall (m :: * -> *) a. MonadBase IO m => Async a -> m () cancel Async a -a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b +a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall (f :: * -> *) a. Functor f => f a -> f () void (forall (m :: * -> *) a. MonadBase IO m => Async a -> m () link Async a -a) +a) instance MonadBase IO (ResourceT IO) where - liftBase :: forall α. IO α -> ResourceT IO α + liftBase :: forall α. IO α -> ResourceT IO α liftBase = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO instance MonadBaseControl IO (ResourceT IO) where - type StM (ResourceT IO) a = a - liftBaseWith :: forall a. (RunInBase (ResourceT IO) IO -> IO a) -> ResourceT IO a + type StM (ResourceT IO) a = a + liftBaseWith :: forall a. (RunInBase (ResourceT IO) IO -> IO a) -> ResourceT IO a liftBaseWith = forall (m :: * -> *) b. MonadUnliftIO m => ((forall a. m a -> IO a) -> IO b) -> m b UnliftIO.withRunInIO - restoreM :: forall a. StM (ResourceT IO) a -> ResourceT IO a + restoreM :: forall a. StM (ResourceT IO) a -> ResourceT IO a restoreM = forall (f :: * -> *) a. Applicative f => a -> f a pure \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.File.html b/hedgehog-extras/src/Hedgehog.Extras.Test.File.html index 4b12d4a5..1a6af656 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.File.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.File.html @@ -87,12 +87,12 @@ import qualified System.IO as IO -- | Create the 'directory' directory if it is missing. -createDirectoryIfMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath +createDirectoryIfMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath createDirectoryIfMissing :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath -createDirectoryIfMissing FilePath -directory = forall a. HasCallStack => (HasCallStack => a) -> a +createDirectoryIfMissing FilePath +directory = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). @@ -102,7 +102,7 @@ $ FilePath "Creating directory if missing: " forall a. Semigroup a => a -> a -> a <> FilePath -directory +directory forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a @@ -110,18 +110,18 @@ $ Bool -> FilePath -> IO () IO.createDirectoryIfMissing Bool True FilePath -directory +directory forall (f :: * -> *) a. Applicative f => a -> f a pure FilePath -directory +directory -- | Create the 'directory' directory if it is missing. -createDirectoryIfMissing_ :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +createDirectoryIfMissing_ :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () createDirectoryIfMissing_ :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -createDirectoryIfMissing_ FilePath -directory = forall a. HasCallStack => (HasCallStack => a) -> a +createDirectoryIfMissing_ FilePath +directory = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. Functor f => f a -> f () @@ -130,22 +130,22 @@ (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath createDirectoryIfMissing FilePath -directory +directory -- | Create the 'subdirectory' subdirectory if it is missing. The subdirectory is returned. -createSubdirectoryIfMissing :: () +createSubdirectoryIfMissing :: () => HasCallStack - => MonadTest m - => MonadIO m + => MonadTest m + => MonadIO m => FilePath -> FilePath - -> m FilePath + -> m FilePath createSubdirectoryIfMissing :: forall (m :: * -> *). (HasCallStack, MonadTest m, MonadIO m) => FilePath -> FilePath -> m FilePath -createSubdirectoryIfMissing FilePath -parent FilePath -subdirectory = forall a. HasCallStack => (HasCallStack => a) -> a +createSubdirectoryIfMissing FilePath +parent FilePath +subdirectory = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). @@ -155,7 +155,7 @@ $ FilePath "Creating subdirectory if missing: " forall a. Semigroup a => a -> a -> a <> FilePath -subdirectory +subdirectory forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a @@ -164,27 +164,27 @@ IO.createDirectoryIfMissing Bool True forall a b. (a -> b) -> a -> b $ FilePath -parent FilePath -> FilePath -> FilePath +parent FilePath -> FilePath -> FilePath </> FilePath -subdirectory +subdirectory forall (f :: * -> *) a. Applicative f => a -> f a pure FilePath -subdirectory +subdirectory -- | Create the 'subdirectory' subdirectory if it is missing. The subdirectory is returned. -createSubdirectoryIfMissing_ :: () +createSubdirectoryIfMissing_ :: () => HasCallStack - => MonadTest m - => MonadIO m + => MonadTest m + => MonadIO m => FilePath -> FilePath - -> m () + -> m () createSubdirectoryIfMissing_ :: forall (m :: * -> *). (HasCallStack, MonadTest m, MonadIO m) => FilePath -> FilePath -> m () -createSubdirectoryIfMissing_ FilePath -parent FilePath -subdirectory = forall a. HasCallStack => (HasCallStack => a) -> a +createSubdirectoryIfMissing_ FilePath +parent FilePath +subdirectory = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. Functor f => f a -> f () @@ -193,17 +193,17 @@ (HasCallStack, MonadTest m, MonadIO m) => FilePath -> FilePath -> m FilePath createSubdirectoryIfMissing FilePath -parent FilePath -subdirectory +parent FilePath +subdirectory -- | Copy the contents of the 'src' file to the 'dst' file. -copyFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () +copyFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () copyFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () -copyFile FilePath -src FilePath -dst = forall a. HasCallStack => (HasCallStack => a) -> a +copyFile FilePath +src FilePath +dst = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). @@ -214,29 +214,29 @@ "Copying from " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -src forall a. Semigroup a => a -> a -> a +src forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -dst +dst forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> FilePath -> IO () IO.copyFile FilePath -src FilePath -dst +src FilePath +dst -- | Rename the 'src' file to 'dst'. -renameFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () +renameFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () renameFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () -renameFile FilePath -src FilePath -dst = forall a. HasCallStack => (HasCallStack => a) -> a +renameFile FilePath +src FilePath +dst = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). @@ -247,29 +247,29 @@ "Renaming from " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -src forall a. Semigroup a => a -> a -> a +src forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -dst +dst forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> FilePath -> IO () IO.renameFile FilePath -src FilePath -dst +src FilePath +dst -- | Create a symbolic link from 'dst' to 'src'. -createFileLink :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () +createFileLink :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () createFileLink :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () -createFileLink FilePath -src FilePath -dst = forall a. HasCallStack => (HasCallStack => a) -> a +createFileLink FilePath +src FilePath +dst = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). @@ -280,12 +280,12 @@ "Creating link from " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -dst forall a. Semigroup a => a -> a -> a +dst forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show FilePath -src +src if Bool isWin32 then forall (m :: * -> *) a. @@ -294,24 +294,24 @@ H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> FilePath -> IO () IO.copyFile FilePath -src FilePath -dst +src FilePath +dst else forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> FilePath -> IO () IO.createFileLink FilePath -src FilePath -dst +src FilePath +dst -- | List 'p' directory. -listDirectory :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m [FilePath] +listDirectory :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m [FilePath] listDirectory :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m [FilePath] -listDirectory FilePath -p = forall a. HasCallStack => (HasCallStack => a) -> a +listDirectory FilePath +p = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -323,23 +323,23 @@ $ FilePath "Listing directory: " forall a. Semigroup a => a -> a -> a <> FilePath -p +p forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO [FilePath] IO.listDirectory FilePath -p +p -- | Append 'contents' to the 'filePath' file. -appendFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> m () +appendFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> m () appendFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () -appendFile FilePath -filePath FilePath -contents = forall a. HasCallStack => (HasCallStack => a) -> a +appendFile FilePath +filePath FilePath +contents = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -351,24 +351,24 @@ $ FilePath "Writing file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> FilePath -> IO () IO.appendFile FilePath -filePath FilePath -contents +filePath FilePath +contents -- | Write 'contents' to the 'filePath' file. -writeFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> m () +writeFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> m () writeFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () -writeFile FilePath -filePath FilePath -contents = forall a. HasCallStack => (HasCallStack => a) -> a +writeFile FilePath +filePath FilePath +contents = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -380,24 +380,24 @@ $ FilePath "Writing file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> FilePath -> IO () IO.writeFile FilePath -filePath FilePath -contents +filePath FilePath +contents -- | Open a handle to the 'filePath' file. -openFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> IOMode -> m Handle +openFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> IOMode -> m Handle openFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> IOMode -> m Handle -openFile FilePath -filePath IOMode -mode = forall a. HasCallStack => (HasCallStack => a) -> a +openFile FilePath +filePath IOMode +mode = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -409,23 +409,23 @@ $ FilePath "Opening file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IOMode -> IO Handle IO.openFile FilePath -filePath IOMode -mode +filePath IOMode +mode -- | Read the contents of the 'filePath' file. -readFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m String +readFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m String readFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath -readFile FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +readFile FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -437,23 +437,23 @@ $ FilePath "Reading file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO FilePath IO.readFile FilePath -filePath +filePath -- | Write 'contents' to the 'filePath' file. -lbsWriteFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> LBS.ByteString -> m () +lbsWriteFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> LBS.ByteString -> m () lbsWriteFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> ByteString -> m () -lbsWriteFile FilePath -filePath ByteString -contents = forall a. HasCallStack => (HasCallStack => a) -> a +lbsWriteFile FilePath +filePath ByteString +contents = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -465,23 +465,23 @@ $ FilePath "Writing file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> ByteString -> IO () LBS.writeFile FilePath -filePath ByteString -contents +filePath ByteString +contents -- | Read the contents of the 'filePath' file. -lbsReadFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m LBS.ByteString +lbsReadFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m LBS.ByteString lbsReadFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ByteString -lbsReadFile FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +lbsReadFile FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -493,23 +493,23 @@ $ FilePath "Reading file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO ByteString LBS.readFile FilePath -filePath +filePath -- | Write 'contents' to the 'filePath' file. -textWriteFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> Text -> m () +textWriteFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> Text -> m () textWriteFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> Text -> m () -textWriteFile FilePath -filePath Text -contents = forall a. HasCallStack => (HasCallStack => a) -> a +textWriteFile FilePath +filePath Text +contents = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -521,23 +521,23 @@ $ FilePath "Writing file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> Text -> IO () T.writeFile FilePath -filePath Text -contents +filePath Text +contents -- | Read the contents of the 'filePath' file. -textReadFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Text +textReadFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Text textReadFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Text -textReadFile FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +textReadFile FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -549,22 +549,22 @@ $ FilePath "Reading file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Text T.readFile FilePath -filePath +filePath -- | Read the 'filePath' file as JSON. Use @readJsonFile \@'Value'@ to decode into 'Value'. -readJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m (Either String a) +readJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m (Either String a) readJsonFile :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m (Either FilePath a) -readJsonFile FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +readJsonFile FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -576,7 +576,7 @@ $ FilePath "Reading JSON file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a @@ -585,16 +585,16 @@ J.eitherDecode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FilePath -> IO ByteString LBS.readFile FilePath -filePath +filePath -- | Read the 'filePath' file as JSON. Same as 'readJsonFile' but fails on error. Use -- @readJsonFileOk \@'Value'@ to decode into 'Value'. -readJsonFileOk :: forall a m.(MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m a +readJsonFileOk :: forall a m.(MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m a readJsonFileOk :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m a -readJsonFileOk FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +readJsonFileOk FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) e a. @@ -605,40 +605,40 @@ (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m (Either FilePath a) readJsonFile FilePath -filePath +filePath -rewriteLbsJson :: forall a m. (MonadTest m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => (a -> a) -> LBS.ByteString -> m LBS.ByteString +rewriteLbsJson :: forall a m. (MonadTest m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => (a -> a) -> LBS.ByteString -> m LBS.ByteString rewriteLbsJson :: forall a (m :: * -> *). (MonadTest m, FromJSON a, ToJSON a, HasCallStack) => (a -> a) -> ByteString -> m ByteString -rewriteLbsJson a -> a -f ByteString -lbs = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteLbsJson a -> a +f ByteString +lbs = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do case forall a. FromJSON a => ByteString -> Either FilePath a J.eitherDecode ByteString -lbs of - Right a -iv -> forall (m :: * -> *) a. Monad m => a -> m a +lbs of + Right a +iv -> forall (m :: * -> *) a. Monad m => a -> m a return (forall a. ToJSON a => a -> ByteString J.encode (a -> a -f a -iv)) - Left FilePath -msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a +f a +iv)) + Left FilePath +msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a H.failMessage HasCallStack => CallStack GHC.callStack FilePath -msg +msg -- | Rewrite the 'filePath' JSON file using the function 'f'. -rewriteJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () +rewriteJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () rewriteJsonFile :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () -rewriteJsonFile FilePath -filePath a -> a -f = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteJsonFile FilePath +filePath a -> a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -650,32 +650,32 @@ $ FilePath "Rewriting JSON file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ByteString lbsReadFile FilePath -filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a (m :: * -> *). (MonadTest m, FromJSON a, ToJSON a, HasCallStack) => (a -> a) -> ByteString -> m ByteString rewriteLbsJson a -> a -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> ByteString -> m () lbsWriteFile FilePath -filePath +filePath -- | Rewrite the 'filePath' JSON file using the function 'f'. -copyRewriteJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () +copyRewriteJsonFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () copyRewriteJsonFile :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () -copyRewriteJsonFile FilePath -src FilePath -dst a -> a -f = forall a. HasCallStack => (HasCallStack => a) -> a +copyRewriteJsonFile FilePath +src FilePath +dst a -> a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -687,34 +687,34 @@ $ FilePath "Rewriting JSON from file: " forall a. Semigroup a => a -> a -> a <> FilePath -src forall a. Semigroup a => a -> a -> a +src forall a. Semigroup a => a -> a -> a <> FilePath " to file " forall a. Semigroup a => a -> a -> a <> FilePath -dst +dst forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ByteString lbsReadFile FilePath -src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a (m :: * -> *). (MonadTest m, FromJSON a, ToJSON a, HasCallStack) => (a -> a) -> ByteString -> m ByteString rewriteLbsJson a -> a -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> ByteString -> m () lbsWriteFile FilePath -dst +dst -- | Read the 'filePath' file as YAML. -readYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m (Either Y.ParseException a) +readYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m (Either Y.ParseException a) readYamlFile :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m (Either ParseException a) -readYamlFile FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +readYamlFile FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -726,7 +726,7 @@ $ FilePath "Reading YAML file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a @@ -737,15 +737,15 @@ LBS.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FilePath -> IO ByteString LBS.readFile FilePath -filePath +filePath -- | Read the 'filePath' file as YAML. Same as 'readYamlFile' but fails on error. -readYamlFileOk :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m a +readYamlFileOk :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, HasCallStack) => FilePath -> m a readYamlFileOk :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m a -readYamlFileOk FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +readYamlFileOk FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) e a. @@ -756,42 +756,42 @@ (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m (Either ParseException a) readYamlFile FilePath -filePath +filePath -rewriteLbsYaml :: forall a m. (MonadTest m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => (a -> a) -> LBS.ByteString -> m LBS.ByteString +rewriteLbsYaml :: forall a m. (MonadTest m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => (a -> a) -> LBS.ByteString -> m LBS.ByteString rewriteLbsYaml :: forall a (m :: * -> *). (MonadTest m, FromJSON a, ToJSON a, HasCallStack) => (a -> a) -> ByteString -> m ByteString -rewriteLbsYaml a -> a -f ByteString -lbs = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteLbsYaml a -> a +f ByteString +lbs = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do case forall a. FromJSON a => ByteString -> Either ParseException a Y.decodeEither' (ByteString -> ByteString LBS.toStrict ByteString -lbs) of - Right a -iv -> forall (m :: * -> *) a. Monad m => a -> m a +lbs) of + Right a +iv -> forall (m :: * -> *) a. Monad m => a -> m a return (forall a. ToJSON a => a -> ByteString J.encode (a -> a -f a -iv)) - Left ParseException -msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a +f a +iv)) + Left ParseException +msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a H.failMessage HasCallStack => CallStack GHC.callStack (forall a. Show a => a -> FilePath show ParseException -msg) +msg) -- | Rewrite the 'filePath' YAML file using the function 'f'. -rewriteYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () +rewriteYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () rewriteYamlFile :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, ToJSON a, HasCallStack) => FilePath -> (a -> a) -> m () -rewriteYamlFile FilePath -filePath a -> a -f = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteYamlFile FilePath +filePath a -> a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -803,32 +803,32 @@ $ FilePath "Rewriting YAML file: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath +filePath forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ByteString lbsReadFile FilePath -filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a (m :: * -> *). (MonadTest m, FromJSON a, ToJSON a, HasCallStack) => (a -> a) -> ByteString -> m ByteString rewriteLbsYaml a -> a -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> ByteString -> m () lbsWriteFile FilePath -filePath +filePath -- | Rewrite the 'filePath' YAML file using the function 'f'. -copyRewriteYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () +copyRewriteYamlFile :: forall a m. (MonadTest m, MonadIO m, Y.FromJSON a, Y.ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () copyRewriteYamlFile :: forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, ToJSON a, HasCallStack) => FilePath -> FilePath -> (a -> a) -> m () -copyRewriteYamlFile FilePath -src FilePath -dst a -> a -f = forall a. HasCallStack => (HasCallStack => a) -> a +copyRewriteYamlFile FilePath +src FilePath +dst a -> a +f = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -840,44 +840,44 @@ $ FilePath "Rewriting YAML from file: " forall a. Semigroup a => a -> a -> a <> FilePath -src forall a. Semigroup a => a -> a -> a +src forall a. Semigroup a => a -> a -> a <> FilePath " to file " forall a. Semigroup a => a -> a -> a <> FilePath -dst +dst forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ByteString lbsReadFile FilePath -src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a (m :: * -> *). (MonadTest m, FromJSON a, ToJSON a, HasCallStack) => (a -> a) -> ByteString -> m ByteString rewriteLbsYaml a -> a -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> ByteString -> m () lbsWriteFile FilePath -dst +dst -- | Annotate the contents of the 'filePath' file. -cat :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +cat :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () cat :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -cat FilePath -filePath = forall a. HasCallStack => (HasCallStack => a) -> a +cat FilePath +filePath = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - !FilePath -contents <- forall (m :: * -> *) a. (Monad m, NFData a) => m a -> m a + !FilePath +contents <- forall (m :: * -> *) a. (Monad m, NFData a) => m a -> m a forceM forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath readFile FilePath -filePath +filePath forall (f :: * -> *) a. Functor f => f a -> f () void forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). @@ -889,231 +889,231 @@ [ FilePath "━━━━ File: " forall a. Semigroup a => a -> a -> a <> FilePath -filePath forall a. Semigroup a => a -> a -> a +filePath forall a. Semigroup a => a -> a -> a <> FilePath " ━━━━" , FilePath -contents +contents ] forall (m :: * -> *) a. Monad m => a -> m a return () -- | Assert the 'filePath' can be parsed as JSON. -assertIsJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertIsJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertIsJsonFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -assertIsJsonFile FilePath -fp = forall a. HasCallStack => (HasCallStack => a) -> a +assertIsJsonFile FilePath +fp = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Either FilePath Value -jsonResult <- forall a (m :: * -> *). + Either FilePath Value +jsonResult <- forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m (Either FilePath a) readJsonFile @Value FilePath -fp +fp case Either FilePath Value -jsonResult of +jsonResult of Right Value _ -> forall (m :: * -> *) a. Monad m => a -> m a return () - Left FilePath -msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a + Left FilePath +msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a H.failMessage HasCallStack => CallStack GHC.callStack FilePath -msg +msg -- | Assert the 'filePath' can be parsed as YAML. -assertIsYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertIsYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertIsYamlFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -assertIsYamlFile FilePath -fp = forall a. HasCallStack => (HasCallStack => a) -> a +assertIsYamlFile FilePath +fp = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Either FilePath Value -result <- forall a (m :: * -> *). + Either FilePath Value +result <- forall a (m :: * -> *). (MonadTest m, MonadIO m, FromJSON a, HasCallStack) => FilePath -> m (Either FilePath a) readJsonFile @Value FilePath -fp +fp case Either FilePath Value -result of +result of Right Value _ -> forall (m :: * -> *) a. Monad m => a -> m a return () - Left FilePath -msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a + Left FilePath +msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a H.failMessage HasCallStack => CallStack GHC.callStack FilePath -msg +msg -- | Asserts that the given file exists. -assertFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertFileExists :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -assertFileExists FilePath -file = forall a. HasCallStack => (HasCallStack => a) -> a +assertFileExists FilePath +file = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -exists <- forall (m :: * -> *) a. + Bool +exists <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool IO.doesFileExist FilePath -file +file forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool -exists forall a b. (a -> b) -> a -> b +exists forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadTest m => CallStack -> Maybe Diff -> FilePath -> m a H.failWithCustom HasCallStack => CallStack GHC.callStack forall a. Maybe a Nothing (FilePath -file forall a. Semigroup a => a -> a -> a +file forall a. Semigroup a => a -> a -> a <> FilePath " has not been successfully created.") -- | Asserts that all of the given files exist. -assertFilesExist :: (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m () +assertFilesExist :: (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m () assertFilesExist :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m () -assertFilesExist [FilePath] -files = forall a. HasCallStack => (HasCallStack => a) -> a +assertFilesExist [FilePath] +files = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ [FilePath] -files forall (m :: * -> *). +files forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertFileExists -- | Asserts that the given file is missing. -assertFileMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertFileMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertFileMissing :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -assertFileMissing FilePath -file = forall a. HasCallStack => (HasCallStack => a) -> a +assertFileMissing FilePath +file = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -exists <- forall (m :: * -> *) a. + Bool +exists <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool IO.doesFileExist FilePath -file +file forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool -exists forall a b. (a -> b) -> a -> b +exists forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadTest m => CallStack -> Maybe Diff -> FilePath -> m a H.failWithCustom HasCallStack => CallStack GHC.callStack forall a. Maybe a Nothing (FilePath -file forall a. Semigroup a => a -> a -> a +file forall a. Semigroup a => a -> a -> a <> FilePath " should not have been created.") -- | Asserts that all of the given files are missing. -assertFilesMissing :: (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m () +assertFilesMissing :: (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m () assertFilesMissing :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m () -assertFilesMissing [FilePath] -files = forall a. HasCallStack => (HasCallStack => a) -> a +assertFilesMissing [FilePath] +files = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ [FilePath] -files forall (m :: * -> *). +files forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertFileMissing -- | Assert the file contains the given number of occurrences of the given string -assertFileOccurences :: (MonadTest m, MonadIO m, HasCallStack) => Int -> String -> FilePath -> m () +assertFileOccurences :: (MonadTest m, MonadIO m, HasCallStack) => Int -> String -> FilePath -> m () assertFileOccurences :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => Int -> FilePath -> FilePath -> m () -assertFileOccurences Int -n FilePath -s FilePath -fp = forall a. HasCallStack => (HasCallStack => a) -> a +assertFileOccurences Int +n FilePath +s FilePath +fp = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - FilePath -contents <- forall (m :: * -> *). + FilePath +contents <- forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath readFile FilePath -fp +fp forall (t :: * -> *) a. Foldable t => t a -> Int L.length (forall a. (a -> Bool) -> [a] -> [a] L.filter (FilePath -s forall a. Eq a => [a] -> [a] -> Bool +s forall a. Eq a => [a] -> [a] -> Bool `L.isInfixOf`) (FilePath -> [FilePath] L.lines FilePath -contents)) forall (m :: * -> *) a. +contents)) forall (m :: * -> *) a. (MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () H.=== Int -n +n -- | Assert the file contains the given number of occurrences of the given string -assertFileLines :: (MonadTest m, MonadIO m, HasCallStack) => (Int -> Bool) -> FilePath -> m () +assertFileLines :: (MonadTest m, MonadIO m, HasCallStack) => (Int -> Bool) -> FilePath -> m () assertFileLines :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => (Int -> Bool) -> FilePath -> m () -assertFileLines Int -> Bool -p FilePath -fp = forall a. HasCallStack => (HasCallStack => a) -> a +assertFileLines Int -> Bool +p FilePath +fp = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - FilePath -contents <- forall (m :: * -> *). + FilePath +contents <- forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath readFile FilePath -fp +fp - let lines :: [FilePath] -lines = FilePath -> [FilePath] + let lines :: [FilePath] +lines = FilePath -> [FilePath] L.lines FilePath -contents +contents - let len :: Int -len = case forall a. [a] -> [a] + let len :: Int +len = case forall a. [a] -> [a] L.reverse [FilePath] -lines of +lines of FilePath -"":[FilePath] -xs -> forall (t :: * -> *) a. Foldable t => t a -> Int +"":[FilePath] +xs -> forall (t :: * -> *) a. Foldable t => t a -> Int L.length [FilePath] -xs - [FilePath] -xs -> forall (t :: * -> *) a. Foldable t => t a -> Int +xs + [FilePath] +xs -> forall (t :: * -> *) a. Foldable t => t a -> Int L.length [FilePath] -xs +xs forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (Int -> Bool -p Int -len) forall a b. (a -> b) -> a -> b +p Int +len) forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) a. MonadTest m => @@ -1121,29 +1121,29 @@ H.failWithCustom HasCallStack => CallStack GHC.callStack forall a. Maybe a Nothing (FilePath -fp forall a. Semigroup a => a -> a -> a +fp forall a. Semigroup a => a -> a -> a <> FilePath " has an unexpected number of lines") -- | Assert the file contains the given number of occurrences of the given string -assertEndsWithSingleNewline :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertEndsWithSingleNewline :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertEndsWithSingleNewline :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -assertEndsWithSingleNewline FilePath -fp = forall a. HasCallStack => (HasCallStack => a) -> a +assertEndsWithSingleNewline FilePath +fp = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - FilePath -contents <- forall (m :: * -> *). + FilePath +contents <- forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath readFile FilePath -fp +fp case forall a. [a] -> [a] L.reverse FilePath -contents of +contents of Char '\n':Char '\n':FilePath @@ -1153,7 +1153,7 @@ H.failWithCustom HasCallStack => CallStack GHC.callStack forall a. Maybe a Nothing (FilePath -fp forall a. Semigroup a => a -> a -> a +fp forall a. Semigroup a => a -> a -> a <> FilePath " ends with too many newlines.") Char @@ -1167,62 +1167,62 @@ H.failWithCustom HasCallStack => CallStack GHC.callStack forall a. Maybe a Nothing (FilePath -fp forall a. Semigroup a => a -> a -> a +fp forall a. Semigroup a => a -> a -> a <> FilePath " must end with newline.") -- | Write 'contents' to the 'filePath' file. -appendFileTimeDelta :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> UTCTime -> m () +appendFileTimeDelta :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> UTCTime -> m () appendFileTimeDelta :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> UTCTime -> m () -appendFileTimeDelta FilePath -filePath UTCTime -offsetTime = forall a. HasCallStack => (HasCallStack => a) -> a +appendFileTimeDelta FilePath +filePath UTCTime +offsetTime = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - UTCTime -baseTime <- forall (m :: * -> *) a. + UTCTime +baseTime <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m a H.noteShowIO IO UTCTime DTC.getCurrentTime - let delay :: NominalDiffTime -delay = UTCTime -> UTCTime -> NominalDiffTime + let delay :: NominalDiffTime +delay = UTCTime -> UTCTime -> NominalDiffTime DTC.diffUTCTime UTCTime -baseTime UTCTime -offsetTime +baseTime UTCTime +offsetTime forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () appendFile FilePath -filePath forall a b. (a -> b) -> a -> b +filePath forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> FilePath show @DTC.NominalDiffTime NominalDiffTime -delay forall a. Semigroup a => a -> a -> a +delay forall a. Semigroup a => a -> a -> a <> FilePath "\n" -- | Asserts that the given directory exists. -assertDirectoryExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertDirectoryExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertDirectoryExists :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -assertDirectoryExists FilePath -dir = forall a. HasCallStack => (HasCallStack => a) -> a +assertDirectoryExists FilePath +dir = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -exists <- forall (m :: * -> *) a. + Bool +exists <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool IO.doesDirectoryExist FilePath -dir +dir forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool -exists forall a b. (a -> b) -> a -> b +exists forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadTest m => CallStack -> Maybe Diff -> FilePath -> m a @@ -1231,30 +1231,30 @@ Nothing (FilePath "Directory '" forall a. Semigroup a => a -> a -> a <> FilePath -dir forall a. Semigroup a => a -> a -> a +dir forall a. Semigroup a => a -> a -> a <> FilePath "' does not exist on the file system.") -- | Asserts that the given directory is missing. -assertDirectoryMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertDirectoryMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertDirectoryMissing :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () -assertDirectoryMissing FilePath -dir = forall a. HasCallStack => (HasCallStack => a) -> a +assertDirectoryMissing FilePath +dir = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Bool -exists <- forall (m :: * -> *) a. + Bool +exists <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool IO.doesDirectoryExist FilePath -dir +dir forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool -exists forall a b. (a -> b) -> a -> b +exists forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadTest m => CallStack -> Maybe Diff -> FilePath -> m a @@ -1263,7 +1263,7 @@ Nothing (FilePath "Directory '" forall a. Semigroup a => a -> a -> a <> FilePath -dir forall a. Semigroup a => a -> a -> a +dir forall a. Semigroup a => a -> a -> a <> FilePath "' does exist on the file system.") \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.Golden.html b/hedgehog-extras/src/Hedgehog.Extras.Test.Golden.html index 83df9b19..b28c0d99 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Golden.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Golden.html @@ -42,7 +42,7 @@ 1 {-# NOINLINE sem #-} -semBracket :: IO a -> IO a +semBracket :: IO a -> IO a semBracket :: forall a. IO a -> IO a semBracket = forall a b c. IO a -> IO b -> IO c -> IO c bracket_ (QSem -> IO () @@ -67,14 +67,14 @@ createGoldenFiles = forall a. IO a -> a IO.unsafePerformIO forall a b. (a -> b) -> a -> b $ do - Maybe String -value <- String -> IO (Maybe String) + Maybe String +value <- String -> IO (Maybe String) IO.lookupEnv String "CREATE_GOLDEN_FILES" forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Maybe String -value forall a. Eq a => a -> a -> Bool +value forall a. Eq a => a -> a -> Bool == forall a. a -> Maybe a Just String "1" @@ -85,57 +85,57 @@ recreateGoldenFiles = forall a. IO a -> a IO.unsafePerformIO forall a b. (a -> b) -> a -> b $ do - Maybe String -value <- String -> IO (Maybe String) + Maybe String +value <- String -> IO (Maybe String) IO.lookupEnv String "RECREATE_GOLDEN_FILES" forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Maybe String -value forall a. Eq a => a -> a -> Bool +value forall a. Eq a => a -> a -> Bool == forall a. a -> Maybe a Just String "1" -writeGoldenFile :: () - => MonadIO m - => MonadTest m +writeGoldenFile :: () + => MonadIO m + => MonadTest m => FilePath -> String - -> m () + -> m () writeGoldenFile :: forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> String -> m () -writeGoldenFile String -goldenFile String -actualContent = do +writeGoldenFile String +goldenFile String +actualContent = do forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () H.note_ forall a b. (a -> b) -> a -> b $ String "Creating golden file " forall a. Semigroup a => a -> a -> a <> String -goldenFile +goldenFile forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => String -> m () H.createDirectoryIfMissing_ (String -> String takeDirectory String -goldenFile) +goldenFile) forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => String -> String -> m () H.writeFile String -goldenFile String -actualContent +goldenFile String +actualContent -reportGoldenFileMissing :: () - => MonadIO m - => MonadTest m +reportGoldenFileMissing :: () + => MonadIO m + => MonadTest m => FilePath - -> m () + -> m () reportGoldenFileMissing :: forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m () -reportGoldenFileMissing String -goldenFile = do +reportGoldenFileMissing String +goldenFile = do forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () H.note_ forall a b. (a -> b) -> a -> b $ [String] -> String @@ -143,7 +143,7 @@ [ String "Golden file " forall a. Semigroup a => a -> a -> a <> String -goldenFile forall a. Semigroup a => a -> a -> a +goldenFile forall a. Semigroup a => a -> a -> a <> String " does not exist." , String @@ -154,33 +154,33 @@ forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a H.failure -checkAgainstGoldenFile :: () - => MonadIO m - => MonadTest m +checkAgainstGoldenFile :: () + => MonadIO m + => MonadTest m => FilePath -> [String] - -> m () + -> m () checkAgainstGoldenFile :: forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> [String] -> m () -checkAgainstGoldenFile String -goldenFile [String] -actualLines = do - [String] -referenceLines <- String -> [String] +checkAgainstGoldenFile String +goldenFile [String] +actualLines = do + [String] +referenceLines <- String -> [String] List.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => String -> m String H.readFile String -goldenFile - let difference :: [Diff [String]] -difference = forall a. Eq a => [a] -> [a] -> [Diff [a]] +goldenFile + let difference :: [Diff [String]] +difference = forall a. Eq a => [a] -> [a] -> [Diff [a]] getGroupedDiff [String] -actualLines [String] -referenceLines +actualLines [String] +referenceLines case [Diff [String]] -difference of +difference of [] -> forall (f :: * -> *) a. Applicative f => a -> f a pure () [Both{}] -> forall (f :: * -> *) a. Applicative f => a -> f a @@ -194,7 +194,7 @@ [ String "Golden test failed against golden file: " forall a. Semigroup a => a -> a -> a <> String -goldenFile +goldenFile , String "To recreate golden file, run with RECREATE_GOLDEN_FILES=1." ] @@ -203,7 +203,7 @@ callStack forall a b. (a -> b) -> a -> b $ [Diff [String]] -> String ppDiff [Diff [String]] -difference +difference -- | Diff contents against the golden file. If CREATE_GOLDEN_FILES environment is -- set to "1", then should the golden file not exist it would be created. If @@ -220,18 +220,18 @@ -- -- TODO: Improve the help output by saying the difference of -- each input. -diffVsGoldenFile +diffVsGoldenFile :: HasCallStack - => (MonadIO m, MonadTest m) + => (MonadIO m, MonadTest m) => String -- ^ Actual content -> FilePath -- ^ Reference file - -> m () + -> m () diffVsGoldenFile :: forall (m :: * -> *). (HasCallStack, MonadIO m, MonadTest m) => String -> String -> m () -diffVsGoldenFile String -actualContent String -goldenFile = forall a. HasCallStack => (HasCallStack => a) -> a +diffVsGoldenFile String +actualContent String +goldenFile = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (t :: * -> *) (m :: * -> *) a b. @@ -239,26 +239,26 @@ t a -> (a -> m b) -> m () forM_ Maybe String mGoldenFileLogFile forall a b. (a -> b) -> a -> b -$ \String -logFile -> +$ \String +logFile -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. IO a -> IO a semBracket forall a b. (a -> b) -> a -> b $ String -> String -> IO () IO.appendFile String -logFile forall a b. (a -> b) -> a -> b +logFile forall a b. (a -> b) -> a -> b $ String -goldenFile forall a. Semigroup a => a -> a -> a +goldenFile forall a. Semigroup a => a -> a -> a <> String "\n" - Bool -fileExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + Bool +fileExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ String -> IO Bool IO.doesFileExist String -goldenFile +goldenFile if | Bool @@ -266,32 +266,32 @@ (MonadIO m, MonadTest m) => String -> String -> m () writeGoldenFile String -goldenFile String -actualContent +goldenFile String +actualContent | Bool -fileExists -> forall (m :: * -> *). +fileExists -> forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> [String] -> m () checkAgainstGoldenFile String -goldenFile [String] -actualLines +goldenFile [String] +actualLines | Bool createGoldenFiles -> forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> String -> m () writeGoldenFile String -goldenFile String -actualContent +goldenFile String +actualContent | Bool otherwise -> forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m () reportGoldenFileMissing String -goldenFile +goldenFile where - actualLines :: [String] -actualLines = String -> [String] + actualLines :: [String] +actualLines = String -> [String] List.lines String -actualContent +actualContent -- | Diff file against the golden file. If CREATE_GOLDEN_FILES environment is -- set to "1", then should the gold file not exist it would be created. If @@ -304,30 +304,30 @@ -- -- To re-generate a golden file you must also delete the golden file because golden -- files are never overwritten. -diffFileVsGoldenFile +diffFileVsGoldenFile :: HasCallStack - => (MonadIO m, MonadTest m) + => (MonadIO m, MonadTest m) => FilePath -- ^ Actual file -> FilePath -- ^ Reference file - -> m () + -> m () diffFileVsGoldenFile :: forall (m :: * -> *). (HasCallStack, MonadIO m, MonadTest m) => String -> String -> m () -diffFileVsGoldenFile String -actualFile String -referenceFile = forall a. HasCallStack => (HasCallStack => a) -> a +diffFileVsGoldenFile String +actualFile String +referenceFile = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - String -contents <- forall (m :: * -> *). + String +contents <- forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => String -> m String H.readFile String -actualFile +actualFile forall (m :: * -> *). (HasCallStack, MonadIO m, MonadTest m) => String -> String -> m () diffVsGoldenFile String -contents String -referenceFile +contents String +referenceFile \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.MonadAssertion.html b/hedgehog-extras/src/Hedgehog.Extras.Test.MonadAssertion.html index 9183b1cd..ba0bd0d8 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.MonadAssertion.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.MonadAssertion.html @@ -17,24 +17,24 @@ import qualified Hedgehog as H import qualified Hedgehog.Internal.Property as H -class Monad m => MonadAssertion m where - throwAssertion :: H.Failure -> m a - catchAssertion :: m a -> (H.Failure -> m a) -> m a +class Monad m => MonadAssertion m where + throwAssertion :: H.Failure -> m a + catchAssertion :: m a -> (H.Failure -> m a) -> m a -instance Monad m => MonadAssertion (H.TestT m) where - throwAssertion :: forall a. Failure -> TestT m a -throwAssertion Failure -f = forall (m :: * -> *) a. MonadTest m => Test a -> m a +instance Monad m => MonadAssertion (H.TestT m) where + throwAssertion :: forall a. Failure -> TestT m a +throwAssertion Failure +f = forall (m :: * -> *) a. MonadTest m => Test a -> m a H.liftTest forall a b. (a -> b) -> a -> b $ forall a. (Either Failure a, Journal) -> Test a H.mkTest (forall a b. a -> Either a b Left Failure -f, forall a. Monoid a => a +f, forall a. Monoid a => a mempty) - catchAssertion :: forall a. TestT m a -> (Failure -> TestT m a) -> TestT m a -catchAssertion TestT m a -g Failure -> TestT m a -h = forall (m :: * -> *) a. + catchAssertion :: forall a. TestT m a -> (Failure -> TestT m a) -> TestT m a +catchAssertion TestT m a +g Failure -> TestT m a +h = forall (m :: * -> *) a. ExceptT Failure (WriterT Journal m) a -> TestT m a H.TestT forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) e a e'. @@ -43,39 +43,39 @@ E.catchE (forall (m :: * -> *) a. TestT m a -> ExceptT Failure (WriterT Journal m) a H.unTest TestT m a -g) (forall (m :: * -> *) a. +g) (forall (m :: * -> *) a. TestT m a -> ExceptT Failure (WriterT Journal m) a H.unTest forall b c a. (b -> c) -> (a -> b) -> a -> c . Failure -> TestT m a -h) +h) -instance MonadAssertion m => MonadAssertion (IO.ResourceT m) where - throwAssertion :: forall a. Failure -> ResourceT m a -throwAssertion = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. +instance MonadAssertion m => MonadAssertion (IO.ResourceT m) where + throwAssertion :: forall a. Failure -> ResourceT m a +throwAssertion = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) a. MonadAssertion m => Failure -> m a throwAssertion - catchAssertion :: forall a. + catchAssertion :: forall a. ResourceT m a -> (Failure -> ResourceT m a) -> ResourceT m a -catchAssertion ResourceT m a -r Failure -> ResourceT m a -h = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a +catchAssertion ResourceT m a +r Failure -> ResourceT m a +h = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a IO.ResourceT forall a b. (a -> b) -> a -> b -$ \IORef ReleaseMap -i -> forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a +$ \IORef ReleaseMap +i -> forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a IO.unResourceT ResourceT m a -r IORef ReleaseMap -i forall (m :: * -> *) a. +r IORef ReleaseMap +i forall (m :: * -> *) a. MonadAssertion m => m a -> (Failure -> m a) -> m a -`catchAssertion` \Failure -e -> forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a +`catchAssertion` \Failure +e -> forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a IO.unResourceT (Failure -> ResourceT m a -h Failure -e) IORef ReleaseMap -i +h Failure +e) IORef ReleaseMap +i -deriving instance Monad m => MonadAssertion (H.PropertyT m) +deriving instance Monad m => MonadAssertion (H.PropertyT m) \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.Network.html b/hedgehog-extras/src/Hedgehog.Extras.Test.Network.html index 8fcb6af2..881ab3d4 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Network.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Network.html @@ -47,7 +47,7 @@ import qualified System.FilePath as FP -- | Test if a file exists -doesFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool +doesFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool doesFileExists :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool @@ -61,12 +61,12 @@ IO.doesFileExist -- | Test if a port is open -isPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m Bool +isPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m Bool isPortOpen :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => Int -> m Bool -isPortOpen Int -port = forall a. HasCallStack => (HasCallStack => a) -> a +isPortOpen Int +port = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). @@ -77,17 +77,17 @@ "Port: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show Int -port +port forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ Int -> IO Bool IO.isPortOpen Int -port +port -- | Test if a socket file exists -doesSocketExist :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool +doesSocketExist :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool doesSocketExist :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool @@ -101,7 +101,7 @@ IO.doesSocketExist -- | Assert that a port is open -assertPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m () +assertPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m () assertPortOpen :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => Int -> m () @@ -115,7 +115,7 @@ isPortOpen -- | Assert that a socket file exists is open -assertSocketExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () +assertSocketExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () assertSocketExists :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m () @@ -129,16 +129,16 @@ doesSocketExist -- | Test if the sprocket exists -doesSprocketExist :: (MonadTest m, MonadIO m, HasCallStack) => Sprocket -> m Bool +doesSprocketExist :: (MonadTest m, MonadIO m, HasCallStack) => Sprocket -> m Bool doesSprocketExist :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => Sprocket -> m Bool -doesSprocketExist Sprocket -socket = forall a. HasCallStack => (HasCallStack => a) -> a +doesSprocketExist Sprocket +socket = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Either IOException Bool -waitResult <- forall (m :: * -> *) a. + Either IOException Bool +waitResult <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -149,19 +149,19 @@ then FilePath -> IO Bool IO.doesNamedPipeExist (Sprocket -> FilePath sprocketSystemName Sprocket -socket) +socket) else FilePath -> IO Bool IO.doesSocketExist (Sprocket -> FilePath sprocketSystemName Sprocket -socket) +socket) case Either IOException Bool -waitResult of - Right Bool -result -> forall (m :: * -> *) a. Monad m => a -> m a +waitResult of + Right Bool +result -> forall (m :: * -> *) a. Monad m => a -> m a return Bool -result - Left (IOException -e :: IOException) -> do +result + Left (IOException +e :: IOException) -> do forall (m :: * -> *). (MonadTest m, HasCallStack) => FilePath -> m () @@ -170,19 +170,19 @@ "Error: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show IOException -e +e forall (m :: * -> *) a. Monad m => a -> m a return Bool False -- | Download from a URl to a file -downloadToFile :: (MonadTest m, MonadIO m, HasCallStack) => String -> FilePath -> m () +downloadToFile :: (MonadTest m, MonadIO m, HasCallStack) => String -> FilePath -> m () downloadToFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () -downloadToFile FilePath -url FilePath -path = forall a. HasCallStack => (HasCallStack => a) -> a +downloadToFile FilePath +url FilePath +path = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). @@ -192,89 +192,89 @@ $ FilePath "Downloading " forall a. Semigroup a => a -> a -> a <> FilePath -url forall a. Semigroup a => a -> a -> a +url forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> FilePath -path +path forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadIO m => FilePath -> m ByteString HTTP.simpleHttp FilePath -url forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +url forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= FilePath -> ByteString -> IO () LBS.writeFile FilePath -path +path tarErrors :: TAR.Entries (Either TAR.FormatError TAR.TarBombError) -> [Either TAR.FormatError TAR.TarBombError] tarErrors :: Entries (Either FormatError TarBombError) -> [Either FormatError TarBombError] -tarErrors Entries (Either FormatError TarBombError) -entries = forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a +tarErrors Entries (Either FormatError TarBombError) +entries = forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a TAR.foldEntries (forall a b c. (a -> b -> c) -> b -> a -> c flip forall a b. a -> b -> a const) forall a. a -> a id (:) Entries (Either FormatError TarBombError) -entries [] +entries [] -- | Download a github commit to a temporary directory, extract it and return the path to the extracted directory. -- -- If the file is already downloaded, it will not be downloaded again. -- If the file is already extracted, it will not be extracted again. -downloadAndExtractGithubCommitToTemp :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> String -> m FilePath +downloadAndExtractGithubCommitToTemp :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> String -> m FilePath downloadAndExtractGithubCommitToTemp :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> FilePath -> m FilePath -downloadAndExtractGithubCommitToTemp FilePath -dir FilePath -repository FilePath -commit = forall a. HasCallStack => (HasCallStack => a) -> a +downloadAndExtractGithubCommitToTemp FilePath +dir FilePath +repository FilePath +commit = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - let url :: FilePath -url = FilePath + let url :: FilePath +url = FilePath "https://github.com/" forall a. Semigroup a => a -> a -> a <> FilePath -repository forall a. Semigroup a => a -> a -> a +repository forall a. Semigroup a => a -> a -> a <> FilePath "/archive/" forall a. Semigroup a => a -> a -> a <> FilePath -commit forall a. Semigroup a => a -> a -> a +commit forall a. Semigroup a => a -> a -> a <> FilePath ".tar.gz" - let topDir :: FilePath -topDir = FilePath -> FilePath + let topDir :: FilePath +topDir = FilePath -> FilePath FP.takeFileName FilePath -repository forall a. Semigroup a => a -> a -> a +repository forall a. Semigroup a => a -> a -> a <> FilePath "-" forall a. Semigroup a => a -> a -> a <> FilePath -commit - let tarPath :: FilePath -tarPath = FilePath -dir FilePath -> FilePath -> FilePath +commit + let tarPath :: FilePath +tarPath = FilePath +dir FilePath -> FilePath -> FilePath </> FilePath -topDir forall a. Semigroup a => a -> a -> a +topDir forall a. Semigroup a => a -> a -> a <> FilePath ".tar.gz" - let dest :: FilePath -dest = FilePath -dir FilePath -> FilePath -> FilePath + let dest :: FilePath +dest = FilePath +dir FilePath -> FilePath -> FilePath </> FilePath -topDir +topDir - Bool -tarFileExists <- forall (m :: * -> *) a. + Bool +tarFileExists <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool IO.doesFileExist FilePath -tarPath +tarPath if Bool -tarFileExists +tarFileExists then forall (m :: * -> *). (MonadTest m, HasCallStack) => FilePath -> m () @@ -282,11 +282,11 @@ $ FilePath "Already downloaded " forall a. Semigroup a => a -> a -> a <> FilePath -url forall a. Semigroup a => a -> a -> a +url forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> FilePath -tarPath +tarPath else do forall (m :: * -> *). (MonadTest m, HasCallStack) => @@ -295,32 +295,32 @@ $ FilePath "Downloading " forall a. Semigroup a => a -> a -> a <> FilePath -url forall a. Semigroup a => a -> a -> a +url forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> FilePath -tarPath +tarPath forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadIO m => FilePath -> m ByteString HTTP.simpleHttp FilePath -url forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +url forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= FilePath -> ByteString -> IO () LBS.writeFile FilePath -tarPath +tarPath - Bool -destExists <- forall (m :: * -> *) a. + Bool +destExists <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool IO.doesDirectoryExist FilePath -dest +dest if Bool -destExists +destExists then forall (m :: * -> *). (MonadTest m, HasCallStack) => FilePath -> m () @@ -328,11 +328,11 @@ $ FilePath "Already extracted " forall a. Semigroup a => a -> a -> a <> FilePath -tarPath forall a. Semigroup a => a -> a -> a +tarPath forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> FilePath -dest +dest else do forall (m :: * -> *). (MonadTest m, HasCallStack) => @@ -341,13 +341,13 @@ $ FilePath "Extracting " forall a. Semigroup a => a -> a -> a <> FilePath -tarPath forall a. Semigroup a => a -> a -> a +tarPath forall a. Semigroup a => a -> a -> a <> FilePath " to " forall a. Semigroup a => a -> a -> a <> FilePath -dest - [Either FormatError TarBombError] -errors <- forall (m :: * -> *) a. +dest + [Either FormatError TarBombError] +errors <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b @@ -356,19 +356,19 @@ tarErrors forall b c a. (b -> c) -> (a -> b) -> a -> c . forall e. FilePath -> Entries e -> Entries (Either e TarBombError) TAR.checkTarbomb FilePath -topDir forall b c a. (b -> c) -> (a -> b) -> a -> c +topDir forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Entries FormatError TAR.read forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString GZ.decompress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FilePath -> IO ByteString LBS.readFile FilePath -tarPath +tarPath forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (forall (t :: * -> *) a. Foldable t => t a -> Bool List.null [Either FormatError TarBombError] -errors) forall a b. (a -> b) -> a -> b +errors) forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). (MonadTest m, HasCallStack) => @@ -378,7 +378,7 @@ "Errors: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> FilePath show [Either FormatError TarBombError] -errors +errors forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a H.failure @@ -388,14 +388,14 @@ H.evalIO forall a b. (a -> b) -> a -> b $ forall e. Exception e => FilePath -> Entries e -> IO () TAR.unpack FilePath -dir forall b c a. (b -> c) -> (a -> b) -> a -> c +dir forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Entries FormatError TAR.read forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString GZ.decompress forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< FilePath -> IO ByteString LBS.readFile FilePath -tarPath +tarPath forall (f :: * -> *) a. Functor f => f a -> f () void forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -405,11 +405,11 @@ H.assertIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool H.doesDirectoryExist FilePath -dest +dest forall (m :: * -> *). (MonadTest m, HasCallStack) => FilePath -> m FilePath H.note FilePath -dest +dest \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.Process.html b/hedgehog-extras/src/Hedgehog.Extras.Test.Process.html index cc0aee31..8978a388 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Process.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Process.html @@ -68,12 +68,12 @@ import qualified System.Process as IO -- | Configuration for starting a new process. This is a subset of 'IO.CreateProcess'. -data ExecConfig = ExecConfig +data ExecConfig = ExecConfig { ExecConfig -> Last [([Char], [Char])] execConfigEnv :: Last [(String, String)] , ExecConfig -> Last [Char] execConfigCwd :: Last FilePath - } deriving (ExecConfig -> ExecConfig -> Bool + } deriving (ExecConfig -> ExecConfig -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ExecConfig -> ExecConfig -> Bool $c/= :: ExecConfig -> ExecConfig -> Bool @@ -85,7 +85,7 @@ (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep ExecConfig x -> ExecConfig $cfrom :: forall x. ExecConfig -> Rep ExecConfig x -Generic, Int -> ExecConfig -> ShowS +Generic, Int -> ExecConfig -> ShowS [ExecConfig] -> ShowS ExecConfig -> [Char] forall a. @@ -115,40 +115,40 @@ findDefaultPlanJsonFile = IO [Char] IO.getCurrentDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= [Char] -> IO [Char] -go - where go :: FilePath -> IO FilePath - go :: [Char] -> IO [Char] -go [Char] -d = do - let file :: [Char] -file = [Char] -d [Char] -> ShowS +go + where go :: FilePath -> IO FilePath + go :: [Char] -> IO [Char] +go [Char] +d = do + let file :: [Char] +file = [Char] +d [Char] -> ShowS </> [Char] "dist-newstyle/cache/plan.json" - Bool -exists <- [Char] -> IO Bool + Bool +exists <- [Char] -> IO Bool IO.doesFileExist [Char] -file +file if Bool -exists +exists then forall (m :: * -> *) a. Monad m => a -> m a return [Char] -file +file else do - let parent :: [Char] -parent = ShowS + let parent :: [Char] +parent = ShowS takeDirectory [Char] -d +d if [Char] -parent forall a. Eq a => a -> a -> Bool +parent forall a. Eq a => a -> a -> Bool == [Char] -d +d then forall (m :: * -> *) a. Monad m => a -> m a return [Char] "dist-newstyle/cache/plan.json" else [Char] -> IO [Char] -go [Char] -parent +go [Char] +parent -- | Discover the location of the plan.json file. planJsonFile :: String @@ -156,21 +156,21 @@ planJsonFile = forall a. IO a -> a IO.unsafePerformIO forall a b. (a -> b) -> a -> b $ do - Maybe [Char] -maybeBuildDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + Maybe [Char] +maybeBuildDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ [Char] -> IO (Maybe [Char]) IO.lookupEnv [Char] "CABAL_BUILDDIR" case Maybe [Char] -maybeBuildDir of - Just [Char] -buildDir -> forall (m :: * -> *) a. Monad m => a -> m a +maybeBuildDir of + Just [Char] +buildDir -> forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ [Char] ".." [Char] -> ShowS </> [Char] -buildDir [Char] -> ShowS +buildDir [Char] -> ShowS </> [Char] "cache/plan.json" Maybe [Char] @@ -187,30 +187,30 @@ addExeSuffix :: String -> String addExeSuffix :: ShowS -addExeSuffix [Char] -s = if [Char] +addExeSuffix [Char] +s = if [Char] ".exe" forall a. Eq a => [a] -> [a] -> Bool `L.isSuffixOf` [Char] -s +s then [Char] -s +s else [Char] -s forall a. Semigroup a => a -> a -> a +s forall a. Semigroup a => a -> a -> a <> [Char] exeSuffix -- | Create a process returning handles to stdin, stdout, and stderr as well as the process handle. -createProcess - :: (MonadTest m, MonadResource m, HasCallStack) +createProcess + :: (MonadTest m, MonadResource m, HasCallStack) => CreateProcess - -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle, ReleaseKey) + -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle, ReleaseKey) createProcess :: forall (m :: * -> *). (MonadTest m, MonadResource m, HasCallStack) => CreateProcess -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle, ReleaseKey) -createProcess CreateProcess -cp = forall a. HasCallStack => (HasCallStack => a) -> a +createProcess CreateProcess +cp = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () @@ -220,70 +220,70 @@ <> forall a. Show a => a -> [Char] show (CreateProcess -> Maybe [Char] IO.cwd CreateProcess -cp) +cp) case CreateProcess -> CmdSpec IO.cmdspec CreateProcess -cp of - RawCommand [Char] -cmd [[Char]] -args -> forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () +cp of + RawCommand [Char] +cmd [[Char]] +args -> forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () H.annotate forall a b. (a -> b) -> a -> b $ [Char] "Command line: " forall a. Semigroup a => a -> a -> a <> [Char] -cmd forall a. Semigroup a => a -> a -> a +cmd forall a. Semigroup a => a -> a -> a <> [Char] " " forall a. Semigroup a => a -> a -> a <> [[Char]] -> [Char] L.unwords [[Char]] -args - ShellCommand [Char] -cmd -> forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () +args + ShellCommand [Char] +cmd -> forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () H.annotate forall a b. (a -> b) -> a -> b $ [Char] "Command line: " forall a. Semigroup a => a -> a -> a <> [Char] -cmd - (Maybe Handle -mhStdin, Maybe Handle -mhStdout, Maybe Handle -mhStderr, ProcessHandle -hProcess) <- forall (m :: * -> *) a. +cmd + (Maybe Handle +mhStdin, Maybe Handle +mhStdout, Maybe Handle +mhStderr, ProcessHandle +hProcess) <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) IO.createProcess CreateProcess -cp - ReleaseKey -releaseKey <- forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey +cp + ReleaseKey +releaseKey <- forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey register forall a b. (a -> b) -> a -> b $ (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO () IO.cleanupProcess (Maybe Handle -mhStdin, Maybe Handle -mhStdout, Maybe Handle -mhStderr, ProcessHandle -hProcess) +mhStdin, Maybe Handle +mhStdout, Maybe Handle +mhStderr, ProcessHandle +hProcess) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Handle -mhStdin, Maybe Handle -mhStdout, Maybe Handle -mhStderr, ProcessHandle -hProcess, ReleaseKey -releaseKey) +mhStdin, Maybe Handle +mhStdout, Maybe Handle +mhStderr, ProcessHandle +hProcess, ReleaseKey +releaseKey) -- | Get the process ID. -getPid - :: (MonadTest m, MonadIO m, HasCallStack) +getPid + :: (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle - -> m (Maybe Pid) + -> m (Maybe Pid) getPid :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle -> m (Maybe Pid) -getPid ProcessHandle -hProcess = forall a. HasCallStack => (HasCallStack => a) -> a +getPid ProcessHandle +hProcess = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => @@ -291,18 +291,18 @@ H.evalIO forall a b. (a -> b) -> a -> b $ ProcessHandle -> IO (Maybe Pid) IO.getPid ProcessHandle -hProcess +hProcess -- | Get the process ID. -getPidOk - :: (MonadTest m, MonadIO m, HasCallStack) +getPidOk + :: (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle - -> m Pid + -> m Pid getPidOk :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle -> m Pid -getPidOk ProcessHandle -hProcess = forall a. HasCallStack => (HasCallStack => a) -> a +getPidOk ProcessHandle +hProcess = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. @@ -313,7 +313,7 @@ (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle -> m (Maybe Pid) getPid ProcessHandle -hProcess +hProcess -- | Create a process returning its stdout. -- @@ -324,12 +324,12 @@ -- -- When running outside a nix environment, the `pkgBin` describes the name of the binary -- to launch via cabal exec. -execFlex - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) +execFlex + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => String -> String -> [String] - -> m String + -> m String execFlex :: forall (m :: * -> *). (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => [Char] -> [Char] -> [[Char]] -> m [Char] @@ -339,39 +339,39 @@ execFlex' ExecConfig defaultExecConfig -execFlex' - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) +execFlex' + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> String -> String -> [String] - -> m String + -> m String execFlex' :: forall (m :: * -> *). (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [Char] -> [[Char]] -> m [Char] -execFlex' ExecConfig -execConfig [Char] -pkgBin [Char] -envBin [[Char]] -arguments = forall a. HasCallStack => (HasCallStack => a) -> a +execFlex' ExecConfig +execConfig [Char] +pkgBin [Char] +envBin [[Char]] +arguments = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - (ExitCode -exitResult, [Char] -stdout, [Char] -stderr) <- forall (m :: * -> *). + (ExitCode +exitResult, [Char] +stdout, [Char] +stderr) <- forall (m :: * -> *). (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [Char] -> [[Char]] -> m (ExitCode, [Char], [Char]) execFlexAny' ExecConfig -execConfig [Char] -pkgBin [Char] -envBin [[Char]] -arguments +execConfig [Char] +pkgBin [Char] +envBin [[Char]] +arguments case ExitCode -exitResult of - IO.ExitFailure Int -exitCode -> do +exitResult of + IO.ExitFailure Int +exitCode -> do forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () H.annotate forall a b. (a -> b) -> a -> b $ [[Char]] -> [Char] @@ -381,19 +381,19 @@ "Process exited with non-zero exit-code: " forall a. [a] -> [a] -> [a] ++ forall a. Show a => a -> [Char] show @Int Int -exitCode ] +exitCode ] forall a. [a] -> [a] -> [a] ++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool L.null [Char] -stdout then [] else [[Char] +stdout then [] else [[Char] "━━━━ stdout ━━━━" , [Char] -stdout]) +stdout]) forall a. [a] -> [a] -> [a] ++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool L.null [Char] -stderr then [] else [[Char] +stderr then [] else [[Char] "━━━━ stderr ━━━━" , [Char] -stderr]) +stderr]) forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a H.failMessage HasCallStack => CallStack GHC.callStack [Char] @@ -401,38 +401,38 @@ ExitCode IO.ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a return [Char] -stdout +stdout -- | Run a process, returning its exit code, its stdout, and its stderr. -- Contrary to @execFlex'@, this function doesn't fail if the call fails. -- So, if you want to test something negative, this is the function to use. -execFlexAny' - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) +execFlexAny' + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> String -- ^ @pkgBin@: name of the binary to launch via 'cabal exec' -> String -- ^ @envBin@: environment variable defining the binary to launch the process, when in Nix -> [String] - -> m (ExitCode, String, String) -- ^ exit code, stdout, stderr + -> m (ExitCode, String, String) -- ^ exit code, stdout, stderr execFlexAny' :: forall (m :: * -> *). (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [Char] -> [[Char]] -> m (ExitCode, [Char], [Char]) -execFlexAny' ExecConfig -execConfig [Char] -pkgBin [Char] -envBin [[Char]] -arguments = forall a. HasCallStack => (HasCallStack => a) -> a +execFlexAny' ExecConfig +execConfig [Char] +pkgBin [Char] +envBin [[Char]] +arguments = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - CreateProcess -cp <- forall (m :: * -> *). + CreateProcess +cp <- forall (m :: * -> *). (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [Char] -> [[Char]] -> m CreateProcess procFlex' ExecConfig -execConfig [Char] -pkgBin [Char] -envBin [[Char]] -arguments +execConfig [Char] +pkgBin [Char] +envBin [[Char]] +arguments forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () H.annotate forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Char] @@ -440,85 +440,85 @@ <>) forall a b. (a -> b) -> a -> b $ case CreateProcess -> CmdSpec IO.cmdspec CreateProcess -cp of - IO.ShellCommand [Char] -cmd -> [Char] -cmd - IO.RawCommand [Char] -cmd [[Char]] -args -> [Char] -cmd forall a. Semigroup a => a -> a -> a +cp of + IO.ShellCommand [Char] +cmd -> [Char] +cmd + IO.RawCommand [Char] +cmd [[Char]] +args -> [Char] +cmd forall a. Semigroup a => a -> a -> a <> [Char] " " forall a. Semigroup a => a -> a -> a <> [[Char]] -> [Char] L.unwords (ShowS argQuote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [[Char]] -args) +args) forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ CreateProcess -> [Char] -> IO (ExitCode, [Char], [Char]) IO.readCreateProcessWithExitCode CreateProcess -cp [Char] +cp [Char] "" -- | Execute a process, returning '()'. -exec_ - :: (MonadTest m, MonadIO m, HasCallStack) +exec_ + :: (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> String -> [String] - -> m () + -> m () exec_ :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [[Char]] -> m () -exec_ ExecConfig -execConfig [Char] -bin [[Char]] -arguments = forall (f :: * -> *) a. Functor f => f a -> f () +exec_ ExecConfig +execConfig [Char] +bin [[Char]] +arguments = forall (f :: * -> *) a. Functor f => f a -> f () void forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [[Char]] -> m [Char] exec ExecConfig -execConfig [Char] -bin [[Char]] -arguments +execConfig [Char] +bin [[Char]] +arguments -- | Execute a process, returning the stdout. Fail if the call returns -- with a non-zero exit code. For a version that doesn't fail upon receiving -- a non-zero exit code, see 'execAny'. -exec - :: (MonadTest m, MonadIO m, HasCallStack) +exec + :: (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> String -> [String] - -> m String + -> m String exec :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [[Char]] -> m [Char] -exec ExecConfig -execConfig [Char] -bin [[Char]] -arguments = forall a. HasCallStack => (HasCallStack => a) -> a +exec ExecConfig +execConfig [Char] +bin [[Char]] +arguments = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - (ExitCode -exitResult, [Char] -stdout, [Char] -stderr) <- forall (m :: * -> *). + (ExitCode +exitResult, [Char] +stdout, [Char] +stderr) <- forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [[Char]] -> m (ExitCode, [Char], [Char]) execAny ExecConfig -execConfig [Char] -bin [[Char]] -arguments +execConfig [Char] +bin [[Char]] +arguments case ExitCode -exitResult of - IO.ExitFailure Int -exitCode -> forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a +exitResult of + IO.ExitFailure Int +exitCode -> forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a H.failMessage HasCallStack => CallStack GHC.callStack forall b c a. (b -> c) -> (a -> b) -> a -> c . [[Char]] -> [Char] @@ -528,57 +528,57 @@ "Process exited with non-zero exit-code: " forall a. [a] -> [a] -> [a] ++ forall a. Show a => a -> [Char] show @Int Int -exitCode ] +exitCode ] forall a. [a] -> [a] -> [a] ++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool L.null [Char] -stdout then [] else [[Char] +stdout then [] else [[Char] "━━━━ stdout ━━━━" , [Char] -stdout]) +stdout]) forall a. [a] -> [a] -> [a] ++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool L.null [Char] -stderr then [] else [[Char] +stderr then [] else [[Char] "━━━━ stderr ━━━━" , [Char] -stderr]) +stderr]) ExitCode IO.ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a return [Char] -stdout +stdout -- | Execute a process, returning the error code, the stdout, and the stderr. -execAny - :: (MonadTest m, MonadIO m, HasCallStack) +execAny + :: (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> String -- ^ The binary to launch -> [String] -- ^ The binary's arguments - -> m (ExitCode, String, String) -- ^ exit code, stdout, stderr + -> m (ExitCode, String, String) -- ^ exit code, stdout, stderr execAny :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [[Char]] -> m (ExitCode, [Char], [Char]) -execAny ExecConfig -execConfig [Char] -bin [[Char]] -arguments = forall a. HasCallStack => (HasCallStack => a) -> a +execAny ExecConfig +execConfig [Char] +bin [[Char]] +arguments = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - let cp :: CreateProcess -cp = ([Char] -> [[Char]] -> CreateProcess + let cp :: CreateProcess +cp = ([Char] -> [[Char]] -> CreateProcess IO.proc [Char] -bin [[Char]] -arguments) +bin [[Char]] +arguments) { env :: Maybe [([Char], [Char])] IO.env = forall a. Last a -> Maybe a getLast forall a b. (a -> b) -> a -> b $ ExecConfig -> Last [([Char], [Char])] execConfigEnv ExecConfig -execConfig +execConfig , cwd :: Maybe [Char] IO.cwd = forall a. Last a -> Maybe a getLast forall a b. (a -> b) -> a -> b $ ExecConfig -> Last [Char] execConfigCwd ExecConfig -execConfig +execConfig } forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () H.annotate forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -586,33 +586,33 @@ "━━━━ command ━━━━\n" forall a. Semigroup a => a -> a -> a <>) forall a b. (a -> b) -> a -> b $ [Char] -bin forall a. Semigroup a => a -> a -> a +bin forall a. Semigroup a => a -> a -> a <> [Char] " " forall a. Semigroup a => a -> a -> a <> [[Char]] -> [Char] L.unwords (ShowS argQuote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [[Char]] -arguments) +arguments) forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ CreateProcess -> [Char] -> IO (ExitCode, [Char], [Char]) IO.readCreateProcessWithExitCode CreateProcess -cp [Char] +cp [Char] "" -- | Wait for process to exit. -waitForProcess - :: (MonadTest m, MonadIO m, HasCallStack) +waitForProcess + :: (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle - -> m ExitCode + -> m ExitCode waitForProcess :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle -> m ExitCode -waitForProcess ProcessHandle -hProcess = forall a. HasCallStack => (HasCallStack => a) -> a +waitForProcess ProcessHandle +hProcess = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. @@ -621,18 +621,18 @@ H.evalIO forall a b. (a -> b) -> a -> b $ ProcessHandle -> IO ExitCode IO.waitForProcess ProcessHandle -hProcess +hProcess -- | Wait for process to exit or return 'Nothing' if interrupted by an asynchronous exception. -maybeWaitForProcess - :: (MonadTest m, MonadIO m, HasCallStack) +maybeWaitForProcess + :: (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle - -> m (Maybe ExitCode) + -> m (Maybe ExitCode) maybeWaitForProcess :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle -> m (Maybe ExitCode) -maybeWaitForProcess ProcessHandle -hProcess = forall a. HasCallStack => (HasCallStack => a) -> a +maybeWaitForProcess ProcessHandle +hProcess = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. @@ -641,33 +641,33 @@ H.evalIO forall a b. (a -> b) -> a -> b $ ProcessHandle -> IO (Maybe ExitCode) IO.maybeWaitForProcess ProcessHandle -hProcess +hProcess -- | Wait a maximum of 'seconds' secons for process to exit. -waitSecondsForProcess - :: (MonadTest m, MonadIO m, HasCallStack) +waitSecondsForProcess + :: (MonadTest m, MonadIO m, HasCallStack) => Int -> ProcessHandle - -> m (Either TimedOut ExitCode) + -> m (Either TimedOut ExitCode) waitSecondsForProcess :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => Int -> ProcessHandle -> m (Either TimedOut ExitCode) -waitSecondsForProcess Int -seconds ProcessHandle -hProcess = forall a. HasCallStack => (HasCallStack => a) -> a +waitSecondsForProcess Int +seconds ProcessHandle +hProcess = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Either TimedOut (Maybe ExitCode) -result <- forall (m :: * -> *) a. + Either TimedOut (Maybe ExitCode) +result <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall a b. (a -> b) -> a -> b $ Int -> ProcessHandle -> IO (Either TimedOut (Maybe ExitCode)) IO.waitSecondsForProcess Int -seconds ProcessHandle -hProcess +seconds ProcessHandle +hProcess case Either TimedOut (Maybe ExitCode) -result of +result of Left TimedOut TimedOut -> do forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () @@ -677,79 +677,79 @@ return (forall a b. a -> Either a b Left TimedOut TimedOut) - Right Maybe ExitCode -maybeExitCode -> do + Right Maybe ExitCode +maybeExitCode -> do case Maybe ExitCode -maybeExitCode of +maybeExitCode of Maybe ExitCode Nothing -> forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a H.failMessage HasCallStack => CallStack GHC.callStack [Char] "No exit code for process" - Just ExitCode -exitCode -> do + Just ExitCode +exitCode -> do forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m () H.annotate forall a b. (a -> b) -> a -> b $ [Char] "Process exited " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> [Char] show ExitCode -exitCode +exitCode forall (m :: * -> *) a. Monad m => a -> m a return (forall a b. b -> Either a b Right ExitCode -exitCode) +exitCode) -- | Compute the path to the binary given a package name or an environment variable override. -binFlex - :: (MonadTest m, MonadIO m) +binFlex + :: (MonadTest m, MonadIO m) => String -- ^ Package name -> String -- ^ Environment variable pointing to the binary to run - -> m FilePath + -> m FilePath -- ^ Path to executable binFlex :: forall (m :: * -> *). (MonadTest m, MonadIO m) => [Char] -> [Char] -> m [Char] -binFlex [Char] -pkg [Char] -binaryEnv = do - Maybe [Char] -maybeEnvBin <- forall (m :: * -> *) a. MonadIO m => IO a -> m a +binFlex [Char] +pkg [Char] +binaryEnv = do + Maybe [Char] +maybeEnvBin <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ [Char] -> IO (Maybe [Char]) IO.lookupEnv [Char] -binaryEnv +binaryEnv case Maybe [Char] -maybeEnvBin of - Just [Char] -envBin -> forall (m :: * -> *) a. Monad m => a -> m a +maybeEnvBin of + Just [Char] +envBin -> forall (m :: * -> *) a. Monad m => a -> m a return [Char] -envBin +envBin Maybe [Char] Nothing -> forall (m :: * -> *). (MonadTest m, MonadIO m) => [Char] -> m [Char] binDist [Char] -pkg +pkg -- | Consult the "plan.json" generated by cabal to get the path to the executable corresponding. -- to a haskell package. It is assumed that the project has already been configured and the -- executable has been built. -binDist - :: (MonadTest m, MonadIO m) +binDist + :: (MonadTest m, MonadIO m) => String -- ^ Package name - -> m FilePath + -> m FilePath -- ^ Path to executable binDist :: forall (m :: * -> *). (MonadTest m, MonadIO m) => [Char] -> m [Char] -binDist [Char] -pkg = do - ByteString -contents <- forall (m :: * -> *) a. +binDist [Char] +pkg = do + ByteString +contents <- forall (m :: * -> *) a. (MonadTest m, MonadIO m, HasCallStack) => IO a -> m a H.evalIO forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -760,27 +760,27 @@ case forall a. FromJSON a => ByteString -> Either [Char] a eitherDecode ByteString -contents of - Right Plan -plan -> case forall a. (a -> Bool) -> [a] -> [a] +contents of + Right Plan +plan -> case forall a. (a -> Bool) -> [a] -> [a] L.filter Component -> Bool -matching (Plan -plan forall a b. a -> (a -> b) -> b +matching (Plan +plan forall a b. a -> (a -> b) -> b & Plan -> [Component] installPlan) of - (Component -component:[Component] + (Component +component:[Component] _) -> case Component -component forall a b. a -> (a -> b) -> b +component forall a b. a -> (a -> b) -> b & Component -> Maybe Text binFile of - Just Text -bin -> forall (m :: * -> *) a. Monad m => a -> m a + Just Text +bin -> forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ ShowS addExeSuffix (Text -> [Char] T.unpack Text -bin) +bin) Maybe Text Nothing -> forall a. HasCallStack => [Char] -> a error forall a b. (a -> b) -> a -> b @@ -788,36 +788,36 @@ "missing bin-file in: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> [Char] show Component -component +component [] -> forall a. HasCallStack => [Char] -> a error forall a b. (a -> b) -> a -> b $ [Char] "Cannot find exe:" forall a. Semigroup a => a -> a -> a <> [Char] -pkg forall a. Semigroup a => a -> a -> a +pkg forall a. Semigroup a => a -> a -> a <> [Char] " in plan" - Left [Char] -message -> forall a. HasCallStack => [Char] -> a + Left [Char] +message -> forall a. HasCallStack => [Char] -> a error forall a b. (a -> b) -> a -> b $ [Char] "Cannot decode plan: " forall a. Semigroup a => a -> a -> a <> [Char] -message - where matching :: Component -> Bool - matching :: Component -> Bool -matching Component -component = case Component -> Maybe Text +message + where matching :: Component -> Bool + matching :: Component -> Bool +matching Component +component = case Component -> Maybe Text componentName Component -component of - Just Text -name -> Text -name forall a. Eq a => a -> a -> Bool +component of + Just Text +name -> Text +name forall a. Eq a => a -> a -> Bool == Text "exe:" forall a. Semigroup a => a -> a -> a <> [Char] -> Text T.pack [Char] -pkg +pkg Maybe Text Nothing -> Bool False @@ -830,15 +830,15 @@ -- the environment variable is not defined, it will be found instead by consulting the -- "plan.json" generated by cabal. It is assumed that the project has already been -- configured and the executable has been built. -procFlex - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) +procFlex + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => String -- ^ Cabal package name corresponding to the executable -> String -- ^ Environment variable pointing to the binary to run -> [String] -- ^ Arguments to the CLI command - -> m CreateProcess + -> m CreateProcess -- ^ Captured stdout procFlex :: forall (m :: * -> *). (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => @@ -849,8 +849,8 @@ procFlex' ExecConfig defaultExecConfig -procFlex' - :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) +procFlex' + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> String -- ^ Cabal package name corresponding to the executable @@ -858,46 +858,46 @@ -- ^ Environment variable pointing to the binary to run -> [String] -- ^ Arguments to the CLI command - -> m CreateProcess + -> m CreateProcess -- ^ Captured stdout procFlex' :: forall (m :: * -> *). (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => ExecConfig -> [Char] -> [Char] -> [[Char]] -> m CreateProcess -procFlex' ExecConfig -execConfig [Char] -pkg [Char] -binaryEnv [[Char]] -arguments = forall a. HasCallStack => (HasCallStack => a) -> a +procFlex' ExecConfig +execConfig [Char] +pkg [Char] +binaryEnv [[Char]] +arguments = forall a. HasCallStack => (HasCallStack => a) -> a GHC.withFrozenCallStack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) a. (MonadTest m, MonadCatch m, HasCallStack) => m a -> m a H.evalM forall a b. (a -> b) -> a -> b $ do - [Char] -bin <- forall (m :: * -> *). + [Char] +bin <- forall (m :: * -> *). (MonadTest m, MonadIO m) => [Char] -> [Char] -> m [Char] binFlex [Char] -pkg [Char] -binaryEnv +pkg [Char] +binaryEnv forall (m :: * -> *) a. Monad m => a -> m a return ([Char] -> [[Char]] -> CreateProcess IO.proc [Char] -bin [[Char]] -arguments) +bin [[Char]] +arguments) { env :: Maybe [([Char], [Char])] IO.env = forall a. Last a -> Maybe a getLast forall a b. (a -> b) -> a -> b $ ExecConfig -> Last [([Char], [Char])] execConfigEnv ExecConfig -execConfig +execConfig , cwd :: Maybe [Char] IO.cwd = forall a. Last a -> Maybe a getLast forall a b. (a -> b) -> a -> b $ ExecConfig -> Last [Char] execConfigCwd ExecConfig -execConfig +execConfig -- this allows sending signals to the created processes, without killing the test-suite process , create_group :: Bool IO.create_group = Bool @@ -907,64 +907,64 @@ -- | Compute the project base. This will be based on either the "CARDANO_NODE_SRC" -- environment variable or the first parent directory that contains the `cabal.project`. -- Both should point to the root directory of the Github project checkout. -getProjectBase - :: (MonadTest m, MonadIO m) - => m String +getProjectBase + :: (MonadTest m, MonadIO m) + => m String getProjectBase :: forall (m :: * -> *). (MonadTest m, MonadIO m) => m [Char] getProjectBase = do let - findUp :: [Char] -> m [Char] -findUp [Char] -dir = do - Bool -atBase <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + findUp :: [Char] -> m [Char] +findUp [Char] +dir = do + Bool +atBase <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ [Char] -> IO Bool IO.doesFileExist ([Char] -dir [Char] -> ShowS +dir [Char] -> ShowS </> [Char] "cabal.project") if Bool -atBase +atBase then forall (m :: * -> *) a. Monad m => a -> m a return [Char] -dir +dir else do - let up :: [Char] -up = [Char] -dir [Char] -> ShowS + let up :: [Char] +up = [Char] +dir [Char] -> ShowS </> [Char] ".." - Bool -upExist <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + Bool +upExist <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ [Char] -> IO Bool IO.doesDirectoryExist [Char] -up +up if Bool -upExist +upExist then [Char] -> m [Char] -findUp [Char] -up +findUp [Char] +up else forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] "Could not detect project base directory (containing cabal.project)" - Maybe [Char] -maybeNodeSrc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a + Maybe [Char] +maybeNodeSrc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ [Char] -> IO (Maybe [Char]) IO.lookupEnv [Char] "CARDANO_NODE_SRC" case Maybe [Char] -maybeNodeSrc of - Just [Char] -path -> forall (m :: * -> *) a. Monad m => a -> m a +maybeNodeSrc of + Just [Char] +path -> forall (m :: * -> *) a. Monad m => a -> m a return [Char] -path +path Maybe [Char] Nothing -> forall {m :: * -> *}. MonadIO m => [Char] -> m [Char] -findUp [Char] +findUp [Char] "." \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.TestWatchdog.html b/hedgehog-extras/src/Hedgehog.Extras.Test.TestWatchdog.html index 7247e822..7fd26b40 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.TestWatchdog.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.TestWatchdog.html @@ -85,121 +85,121 @@ kickChan :: TChan WatchdogCommand -- ^ a queue of watchdog commands } -instance Show Watchdog where - show :: Watchdog -> String +instance Show Watchdog where + show :: Watchdog -> String show Watchdog{watchdogConfig :: Watchdog -> WatchdogConfig -watchdogConfig=WatchdogConfig{Int +watchdogConfig=WatchdogConfig{Int watchdogTimeout :: Int watchdogTimeout :: WatchdogConfig -> Int -watchdogTimeout}, UTCTime +watchdogTimeout}, UTCTime startTime :: UTCTime startTime :: Watchdog -> UTCTime -startTime, ThreadId +startTime, ThreadId watchedThreadId :: ThreadId watchedThreadId :: Watchdog -> ThreadId -watchedThreadId} = forall a. Monoid a => [a] -> a +watchedThreadId} = forall a. Monoid a => [a] -> a mconcat [ String "Watchdog with timeout ", forall a. Show a => a -> String show Int -watchdogTimeout +watchdogTimeout , String ", started at ", forall a. Show a => a -> String show UTCTime -startTime +startTime , String ", watching thread ID ", forall a. Show a => a -> String show ThreadId -watchedThreadId +watchedThreadId ] -- | Create manually a new watchdog, providing the target thread ID. After all watchdog timeouts expire, -- the target thread will get 'WatchdogException' thrown to it asynchronously (using 'throwTo'). -makeWatchdog :: MonadBase IO m +makeWatchdog :: MonadBase IO m => WatchdogConfig -> ThreadId -- ^ thread id which will get killed after all kicks expire - -> m Watchdog + -> m Watchdog makeWatchdog :: forall (m :: * -> *). MonadBase IO m => WatchdogConfig -> ThreadId -> m Watchdog -makeWatchdog WatchdogConfig -config ThreadId -watchedThreadId' = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α +makeWatchdog WatchdogConfig +config ThreadId +watchedThreadId' = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α liftBase forall a b. (a -> b) -> a -> b $ do - Watchdog -watchdog <- WatchdogConfig + Watchdog +watchdog <- WatchdogConfig -> ThreadId -> UTCTime -> TChan WatchdogCommand -> Watchdog Watchdog WatchdogConfig -config ThreadId -watchedThreadId' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b +config ThreadId +watchedThreadId' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO UTCTime getCurrentTime forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. IO (TChan a) newTChanIO forall (m :: * -> *). MonadIO m => Watchdog -> m () kickWatchdog Watchdog -watchdog +watchdog forall (f :: * -> *) a. Applicative f => a -> f a pure Watchdog -watchdog +watchdog -- | Run watchdog in a loop in the current thread. Usually this function should be used with 'H.withAsync' -- to run it in the background. -runWatchdog :: MonadBase IO m +runWatchdog :: MonadBase IO m => Watchdog - -> m () + -> m () runWatchdog :: forall (m :: * -> *). MonadBase IO m => Watchdog -> m () -runWatchdog w :: Watchdog -w@Watchdog{ThreadId +runWatchdog w :: Watchdog +w@Watchdog{ThreadId watchedThreadId :: ThreadId watchedThreadId :: Watchdog -> ThreadId -watchedThreadId, UTCTime +watchedThreadId, UTCTime startTime :: UTCTime startTime :: Watchdog -> UTCTime -startTime, TChan WatchdogCommand +startTime, TChan WatchdogCommand kickChan :: TChan WatchdogCommand kickChan :: Watchdog -> TChan WatchdogCommand -kickChan} = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α +kickChan} = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α liftBase forall a b. (a -> b) -> a -> b $ do forall a. STM a -> IO a atomically (forall a. TChan a -> STM (Maybe a) tryReadTChan TChan WatchdogCommand -kickChan) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +kickChan) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Just WatchdogCommand PoisonPill -> -- deactivate watchdog forall (f :: * -> *) a. Applicative f => a -> f a pure () - Just (Kick Int -timeout) -> do + Just (Kick Int +timeout) -> do -- got a kick, wait for another period Int -> IO () threadDelay forall a b. (a -> b) -> a -> b $ Int -timeout forall a. Num a => a -> a -> a +timeout forall a. Num a => a -> a -> a * Int 1_000_000 forall (m :: * -> *). MonadBase IO m => Watchdog -> m () runWatchdog Watchdog -w +w Maybe WatchdogCommand Nothing -> do -- we are out of scheduled timeouts, kill the monitored thread - UTCTime -currentTime <- IO UTCTime + UTCTime +currentTime <- IO UTCTime getCurrentTime forall e. Exception e => ThreadId -> e -> IO () throwTo ThreadId -watchedThreadId forall b c a. (b -> c) -> (a -> b) -> a -> c +watchedThreadId forall b c a. (b -> c) -> (a -> b) -> a -> c . NominalDiffTime -> WatchdogException WatchdogException forall a b. (a -> b) -> a -> b $ UTCTime -> UTCTime -> NominalDiffTime diffUTCTime UTCTime -currentTime UTCTime -startTime +currentTime UTCTime +startTime -- | Watchdog command data WatchdogCommand @@ -208,104 +208,104 @@ -- | Enqueue a kick for the watchdog. It will extend the timeout by another one defined in the watchdog -- configuration. -kickWatchdog :: MonadIO m => Watchdog -> m () +kickWatchdog :: MonadIO m => Watchdog -> m () kickWatchdog :: forall (m :: * -> *). MonadIO m => Watchdog -> m () kickWatchdog Watchdog{watchdogConfig :: Watchdog -> WatchdogConfig -watchdogConfig=WatchdogConfig{Int +watchdogConfig=WatchdogConfig{Int watchdogTimeout :: Int watchdogTimeout :: WatchdogConfig -> Int -watchdogTimeout}, TChan WatchdogCommand +watchdogTimeout}, TChan WatchdogCommand kickChan :: TChan WatchdogCommand kickChan :: Watchdog -> TChan WatchdogCommand -kickChan} = forall (m :: * -> *) a. MonadIO m => IO a -> m a +kickChan} = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. STM a -> IO a atomically forall a b. (a -> b) -> a -> b $ forall a. TChan a -> a -> STM () writeTChan TChan WatchdogCommand -kickChan (Int -> WatchdogCommand +kickChan (Int -> WatchdogCommand Kick Int -watchdogTimeout) +watchdogTimeout) -- | Enqueue a poison pill for the watchdog. It will stop the watchdog after all timeouts. -poisonWatchdog :: MonadIO m => Watchdog -> m () +poisonWatchdog :: MonadIO m => Watchdog -> m () poisonWatchdog :: forall (m :: * -> *). MonadIO m => Watchdog -> m () -poisonWatchdog Watchdog{TChan WatchdogCommand +poisonWatchdog Watchdog{TChan WatchdogCommand kickChan :: TChan WatchdogCommand kickChan :: Watchdog -> TChan WatchdogCommand -kickChan} = forall (m :: * -> *) a. MonadIO m => IO a -> m a +kickChan} = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. STM a -> IO a atomically forall a b. (a -> b) -> a -> b $ forall a. TChan a -> a -> STM () writeTChan TChan WatchdogCommand -kickChan WatchdogCommand +kickChan WatchdogCommand PoisonPill -- | Execute a test case with a watchdog. -runWithWatchdog :: HasCallStack - => MonadBaseControl IO m +runWithWatchdog :: HasCallStack + => MonadBaseControl IO m => WatchdogConfig -- ^ configuration - -> (HasCallStack => Watchdog -> m a) -- ^ a test case to be wrapped in watchdog - -> m a + -> (HasCallStack => Watchdog -> m a) -- ^ a test case to be wrapped in watchdog + -> m a runWithWatchdog :: forall (m :: * -> *) a. (HasCallStack, MonadBaseControl IO m) => WatchdogConfig -> (HasCallStack => Watchdog -> m a) -> m a -runWithWatchdog WatchdogConfig -config HasCallStack => Watchdog -> m a -testCase = do - ThreadId -watchedThreadId <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α +runWithWatchdog WatchdogConfig +config HasCallStack => Watchdog -> m a +testCase = do + ThreadId +watchedThreadId <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α liftBase IO ThreadId myThreadId - Watchdog -watchdog <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α + Watchdog +watchdog <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α liftBase forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadBase IO m => WatchdogConfig -> ThreadId -> m Watchdog makeWatchdog WatchdogConfig -config ThreadId -watchedThreadId +config ThreadId +watchedThreadId forall (m :: * -> *) a b. MonadBaseControl IO m => m a -> (Async (StM m a) -> m b) -> m b H.withAsync (forall (m :: * -> *). MonadBase IO m => Watchdog -> m () runWatchdog Watchdog -watchdog) forall a b. (a -> b) -> a -> b +watchdog) forall a b. (a -> b) -> a -> b $ \Async (StM m ()) _ -> HasCallStack => Watchdog -> m a -testCase Watchdog -watchdog +testCase Watchdog +watchdog -- | Execute a test case with a watchdog. -runWithWatchdog_ :: HasCallStack - => MonadBaseControl IO m +runWithWatchdog_ :: HasCallStack + => MonadBaseControl IO m => WatchdogConfig -- ^ configuration - -> (HasCallStack => m a) -- ^ a test case to be wrapped in watchdog - -> m a + -> (HasCallStack => m a) -- ^ a test case to be wrapped in watchdog + -> m a runWithWatchdog_ :: forall (m :: * -> *) a. (HasCallStack, MonadBaseControl IO m) => WatchdogConfig -> (HasCallStack => m a) -> m a -runWithWatchdog_ WatchdogConfig -config HasCallStack => m a -testCase = forall (m :: * -> *) a. +runWithWatchdog_ WatchdogConfig +config HasCallStack => m a +testCase = forall (m :: * -> *) a. (HasCallStack, MonadBaseControl IO m) => WatchdogConfig -> (HasCallStack => Watchdog -> m a) -> m a runWithWatchdog WatchdogConfig -config (forall a b. a -> b -> a +config (forall a b. a -> b -> a const HasCallStack => m a -testCase) +testCase) -- | Execute a test case with watchdog with default config. -runWithDefaultWatchdog :: HasCallStack - => MonadBaseControl IO m - => (HasCallStack => Watchdog -> m a) -- ^ a test case to be wrapped in watchdog - -> m a +runWithDefaultWatchdog :: HasCallStack + => MonadBaseControl IO m + => (HasCallStack => Watchdog -> m a) -- ^ a test case to be wrapped in watchdog + -> m a runWithDefaultWatchdog :: forall (m :: * -> *) a. (HasCallStack, MonadBaseControl IO m) => (HasCallStack => Watchdog -> m a) -> m a @@ -316,31 +316,31 @@ defaultWatchdogConfig -- | Execute a test case with watchdog with default config. -runWithDefaultWatchdog_ :: HasCallStack - => MonadBaseControl IO m - => (HasCallStack => m a) -- ^ a test case to be wrapped in watchdog - -> m a +runWithDefaultWatchdog_ :: HasCallStack + => MonadBaseControl IO m + => (HasCallStack => m a) -- ^ a test case to be wrapped in watchdog + -> m a runWithDefaultWatchdog_ :: forall (m :: * -> *) a. (HasCallStack, MonadBaseControl IO m) => (HasCallStack => m a) -> m a -runWithDefaultWatchdog_ HasCallStack => m a -testCase = forall (m :: * -> *) a. +runWithDefaultWatchdog_ HasCallStack => m a +testCase = forall (m :: * -> *) a. (HasCallStack, MonadBaseControl IO m) => (HasCallStack => Watchdog -> m a) -> m a runWithDefaultWatchdog (forall a b. a -> b -> a const HasCallStack => m a -testCase) +testCase) -- | An exception thrown to the test case thread. newtype WatchdogException = WatchdogException { WatchdogException -> NominalDiffTime timeElapsed :: NominalDiffTime } -instance Show WatchdogException where - show :: WatchdogException -> String -show WatchdogException{NominalDiffTime +instance Show WatchdogException where + show :: WatchdogException -> String +show WatchdogException{NominalDiffTime timeElapsed :: NominalDiffTime timeElapsed :: WatchdogException -> NominalDiffTime -timeElapsed} = +timeElapsed} = String "WatchdogException: Test watchdog killed test case thread after " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String @@ -348,9 +348,9 @@ round forall a b. (a -> b) -> a -> b $ NominalDiffTime -> Pico nominalDiffTimeToSeconds NominalDiffTime -timeElapsed) forall a. Semigroup a => a -> a -> a +timeElapsed) forall a. Semigroup a => a -> a -> a <> String " seconds." -instance Exception WatchdogException +instance Exception WatchdogException \ No newline at end of file diff --git a/hedgehog-extras/src/Hedgehog.Extras.Test.Tripwire.html b/hedgehog-extras/src/Hedgehog.Extras.Test.Tripwire.html index 2f5dd714..c45029bf 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Tripwire.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Tripwire.html @@ -54,24 +54,24 @@ tripSite :: MVar CallStack -- ^ call stack of the trip site } -instance Show Tripwire where - show :: Tripwire -> String -show Tripwire{String +instance Show Tripwire where + show :: Tripwire -> String +show Tripwire{String tripwireId :: String tripwireId :: Tripwire -> String -tripwireId} = String +tripwireId} = String "Tripwire " forall a. Semigroup a => a -> a -> a <> String -tripwireId +tripwireId -- | Creates a new tripwire -makeTripwire :: MonadIO m => m Tripwire +makeTripwire :: MonadIO m => m Tripwire makeTripwire :: forall (m :: * -> *). MonadIO m => m Tripwire makeTripwire = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ do - Int -id' <- forall a b. IORef a -> (a -> (a, b)) -> IO b + Int +id' <- forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' IORef Int tripwireCounter (forall (m :: * -> *) a. Monad m => m (m a) -> m a join (,) forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -81,47 +81,47 @@ String -> MVar CallStack -> Tripwire Tripwire (forall a. Show a => a -> String show Int -id') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b +id') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. IO (MVar a) newEmptyMVar -- | Creates a new tripwire with a label, which is visible when 'show'ed: @Tripwire mylabel@ -makeTripwireWithLabel :: MonadIO m +makeTripwireWithLabel :: MonadIO m => String - -> m Tripwire + -> m Tripwire makeTripwireWithLabel :: forall (m :: * -> *). MonadIO m => String -> m Tripwire -makeTripwireWithLabel String -label = forall (m :: * -> *) a. MonadIO m => IO a -> m a +makeTripwireWithLabel String +label = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ do String -> MVar CallStack -> Tripwire Tripwire String -label forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b +label forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. IO (MVar a) newEmptyMVar -- | Triggers the tripwire and registers the place of the first trigger. Idempotent. -- Prints the information in the test log about tripping the tripwire. -trip :: HasCallStack - => MonadIO m - => MonadTest m +trip :: HasCallStack + => MonadIO m + => MonadTest m => Tripwire - -> m () + -> m () trip :: forall (m :: * -> *). (HasCallStack, MonadIO m, MonadTest m) => Tripwire -> m () -trip t :: Tripwire -t@Tripwire{MVar CallStack +trip t :: Tripwire +t@Tripwire{MVar CallStack tripSite :: MVar CallStack tripSite :: Tripwire -> MVar CallStack -tripSite} = forall a. HasCallStack => (HasCallStack => a) -> a +tripSite} = forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () H.note_ forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Tripwire -t forall a. Semigroup a => a -> a -> a +t forall a. Semigroup a => a -> a -> a <> String " has been tripped" forall (f :: * -> *) a. Functor f => f a -> f () @@ -130,20 +130,20 @@ liftIO forall a b. (a -> b) -> a -> b $ forall a. MVar a -> a -> IO Bool tryPutMVar MVar CallStack -tripSite HasCallStack => CallStack +tripSite HasCallStack => CallStack callStack -- | Triggers the tripwire and registers the place of the first trigger. Idempotent. A silent variant of -- 'trip' which does not require 'MonadTest', but also does not log the information about tripping. -trip_ :: HasCallStack - => MonadIO m +trip_ :: HasCallStack + => MonadIO m => Tripwire - -> m () + -> m () trip_ :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Tripwire -> m () -trip_ Tripwire{MVar CallStack +trip_ Tripwire{MVar CallStack tripSite :: MVar CallStack tripSite :: Tripwire -> MVar CallStack -tripSite} = forall a. HasCallStack => (HasCallStack => a) -> a +tripSite} = forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b $ do forall (f :: * -> *) a. Functor f => f a -> f () @@ -152,119 +152,119 @@ liftIO forall a b. (a -> b) -> a -> b $ forall a. MVar a -> a -> IO Bool tryPutMVar MVar CallStack -tripSite HasCallStack => CallStack +tripSite HasCallStack => CallStack callStack -- | Restore tripwire to initial non triggered state -resetTripwire :: MonadIO m +resetTripwire :: MonadIO m => Tripwire - -> m () + -> m () resetTripwire :: forall (m :: * -> *). MonadIO m => Tripwire -> m () -resetTripwire Tripwire{MVar CallStack +resetTripwire Tripwire{MVar CallStack tripSite :: MVar CallStack tripSite :: Tripwire -> MVar CallStack -tripSite} = forall (m :: * -> *) a. MonadIO m => IO a -> m a +tripSite} = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. Functor f => f a -> f () void forall a b. (a -> b) -> a -> b $ forall a. MVar a -> IO (Maybe a) tryTakeMVar MVar CallStack -tripSite +tripSite -- | Return the call stack, where the tripwire was tripped - if it was tripped. -getTripSite :: MonadIO m +getTripSite :: MonadIO m => Tripwire - -> m (Maybe CallStack) + -> m (Maybe CallStack) getTripSite :: forall (m :: * -> *). MonadIO m => Tripwire -> m (Maybe CallStack) -getTripSite Tripwire{MVar CallStack +getTripSite Tripwire{MVar CallStack tripSite :: MVar CallStack tripSite :: Tripwire -> MVar CallStack -tripSite} = forall (m :: * -> *) a. MonadIO m => IO a -> m a +tripSite} = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. MVar a -> IO (Maybe a) tryReadMVar MVar CallStack -tripSite +tripSite -- | Check if the tripwire was tripped. -isTripped :: MonadIO m +isTripped :: MonadIO m => Tripwire - -> m Bool + -> m Bool isTripped :: forall (m :: * -> *). MonadIO m => Tripwire -> m Bool -isTripped Tripwire{MVar CallStack +isTripped Tripwire{MVar CallStack tripSite :: MVar CallStack tripSite :: Tripwire -> MVar CallStack -tripSite} = forall (m :: * -> *) a. MonadIO m => IO a -> m a +tripSite} = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ Bool -> Bool not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. MVar a -> IO Bool isEmptyMVar MVar CallStack -tripSite +tripSite -- | Fails the test if the tripwire was triggered. Prints the call stack where the tripwire was triggered. -assertNotTripped :: HasCallStack - => MonadTest m - => MonadIO m +assertNotTripped :: HasCallStack + => MonadTest m + => MonadIO m => Tripwire - -> m () + -> m () assertNotTripped :: forall (m :: * -> *). (HasCallStack, MonadTest m, MonadIO m) => Tripwire -> m () -assertNotTripped Tripwire -tripwire = forall a. HasCallStack => (HasCallStack => a) -> a +assertNotTripped Tripwire +tripwire = forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Maybe CallStack -mTripSite <- forall (m :: * -> *). MonadIO m => Tripwire -> m (Maybe CallStack) + Maybe CallStack +mTripSite <- forall (m :: * -> *). MonadIO m => Tripwire -> m (Maybe CallStack) getTripSite Tripwire -tripwire +tripwire forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ Maybe CallStack -mTripSite forall a b. (a -> b) -> a -> b -$ \CallStack -cs -> do +mTripSite forall a b. (a -> b) -> a -> b +$ \CallStack +cs -> do forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () H.note_ forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Tripwire -tripwire forall a. Semigroup a => a -> a -> a +tripwire forall a. Semigroup a => a -> a -> a <> String " has been tripped at: " forall a. Semigroup a => a -> a -> a <> CallStack -> String prettyCallStack CallStack -cs +cs forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a H.failure -- | Fails the test if the tripwire was not triggered yet. -assertTripped :: HasCallStack - => MonadTest m - => MonadIO m +assertTripped :: HasCallStack + => MonadTest m + => MonadIO m => Tripwire - -> m () + -> m () assertTripped :: forall (m :: * -> *). (HasCallStack, MonadTest m, MonadIO m) => Tripwire -> m () -assertTripped Tripwire -tripwire = forall a. HasCallStack => (HasCallStack => a) -> a +assertTripped Tripwire +tripwire = forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b $ do - Maybe CallStack -mTripSite <- forall (m :: * -> *). MonadIO m => Tripwire -> m (Maybe CallStack) + Maybe CallStack +mTripSite <- forall (m :: * -> *). MonadIO m => Tripwire -> m (Maybe CallStack) getTripSite Tripwire -tripwire +tripwire forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (forall a. Maybe a -> Bool isNothing Maybe CallStack -mTripSite) forall a b. (a -> b) -> a -> b +mTripSite) forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m () H.note_ forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Tripwire -tripwire forall a. Semigroup a => a -> a -> a +tripwire forall a. Semigroup a => a -> a -> a <> String " was not tripped" forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a