diff --git a/hedgehog-extras/hedgehog-extras.haddock b/hedgehog-extras/hedgehog-extras.haddock index c5b9675d..15d4285d 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 b3e2ac7f..a08e1841 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 37534933..4b4f3b9f 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 57ca2cb5..d0bd1f43 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 427da7bc..1ed7d08e 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 ff15f5c8..bfed5481 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 1a73e6ec..6ba39ff2 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 f6d6c4dc..29ed0316 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.Socket.html b/hedgehog-extras/src/Hedgehog.Extras.Stock.IO.Network.Socket.html index 191d8e9e..39aae6ad 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 737c6b5e..86a41962 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 4b2cc648..c2faaec9 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 eaada664..29779c16 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 fe3a2cd3..8fd868bd 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 37cc24df..e1dde915 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 abf5781e..11bdea76 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,25 @@ $ String "Workspace: " forall a. Semigroup a => a -> a -> a <> String -ws +ws forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO 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 @@ -260,7 +260,7 @@ H.evalIO forall a b. (a -> b) -> a -> b $ String -> IO () IO.removeDirectoryRecursive String -ws +ws -- | Create a workspace directory which will exist for at least the duration of -- the supplied block. @@ -272,17 +272,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 +295,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 +588,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 +610,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 +633,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 +659,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 +685,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 +714,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,61 +756,61 @@ "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 = m (Maybe a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +nothingFailM m (Maybe a) +f = m (Maybe a) +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 = m (Either e a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +leftFailM m (Either e a) +f = m (Either e a) +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 @@ -819,38 +819,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 @@ -858,21 +858,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 @@ -885,47 +885,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 @@ -935,35 +935,35 @@ "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 = m (Result a) -f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +jsonErrorFailM m (Result a) +f = m (Result a) +f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *) a. (MonadTest m, HasCallStack) => Result a -> m a @@ -972,50 +972,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 () @@ -1025,28 +1025,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 @@ -1054,17 +1054,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 @@ -1073,53 +1073,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 @@ -1127,39 +1127,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 @@ -1170,14 +1170,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 @@ -1186,30 +1186,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 @@ -1220,14 +1220,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 @@ -1239,32 +1239,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 @@ -1275,17 +1275,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 @@ -1297,31 +1297,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 @@ -1332,56 +1332,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 @@ -1389,80 +1389,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) => @@ -1470,14 +1470,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 @@ -1486,136 +1486,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 @@ -1625,20 +1625,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 167caea5..4ebf925a 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Concurrent.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Concurrent.html @@ -12,10 +12,10 @@ import qualified Hedgehog as H -- Delay the thread by 'n' milliseconds. -threadDelay :: (MonadTest m, MonadIO m) => Int -> m () +threadDelay :: (MonadTest m, MonadIO m) => Int -> m () threadDelay :: forall (m :: * -> *). (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) => @@ -23,5 +23,5 @@ H.evalIO forall a b. (a -> b) -> a -> b $ Int -> IO () IO.threadDelay Int -n +n \ 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 a3b75704..1bfa9318 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.File.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.File.html @@ -84,12 +84,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 :: * -> *). @@ -99,7 +99,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 @@ -107,18 +107,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 () @@ -127,22 +127,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 :: * -> *). @@ -152,7 +152,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 @@ -161,27 +161,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 () @@ -190,17 +190,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 :: * -> *). @@ -211,29 +211,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 :: * -> *). @@ -244,29 +244,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 :: * -> *). @@ -277,12 +277,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. @@ -291,24 +291,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 () @@ -320,23 +320,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 () @@ -348,24 +348,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 () @@ -377,24 +377,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 () @@ -406,23 +406,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 () @@ -434,23 +434,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 () @@ -462,23 +462,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 () @@ -490,23 +490,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 () @@ -518,23 +518,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 () @@ -546,22 +546,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. -readJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either String Value) +readJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either String Value) readJsonFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either FilePath Value) -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 () @@ -573,7 +573,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 @@ -582,15 +582,15 @@ J.eitherDecode @Value 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. -readJsonFileOk :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value +readJsonFileOk :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value readJsonFileOk :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value -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. @@ -601,40 +601,40 @@ (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either FilePath Value) readJsonFile FilePath -filePath +filePath -rewriteLbsJson :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString +rewriteLbsJson :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString rewriteLbsJson :: forall (m :: * -> *). (MonadTest m, HasCallStack) => (Value -> Value) -> ByteString -> m ByteString -rewriteLbsJson Value -> Value -f ByteString -lbs = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteLbsJson Value -> Value +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 Value -iv -> forall (m :: * -> *) a. Monad m => a -> m a +lbs of + Right Value +iv -> forall (m :: * -> *) a. Monad m => a -> m a return (forall a. ToJSON a => a -> ByteString J.encode (Value -> Value -f Value -iv)) - Left FilePath -msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a +f Value +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 :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m () +rewriteJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m () rewriteJsonFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m () -rewriteJsonFile FilePath -filePath Value -> Value -f = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteJsonFile FilePath +filePath Value -> Value +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 () @@ -646,32 +646,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 (m :: * -> *). (MonadTest m, HasCallStack) => (Value -> Value) -> ByteString -> m ByteString rewriteLbsJson Value -> Value -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 :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m () +copyRewriteJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m () copyRewriteJsonFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m () -copyRewriteJsonFile FilePath -src FilePath -dst Value -> Value -f = forall a. HasCallStack => (HasCallStack => a) -> a +copyRewriteJsonFile FilePath +src FilePath +dst Value -> Value +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 () @@ -683,34 +683,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 (m :: * -> *). (MonadTest m, HasCallStack) => (Value -> Value) -> ByteString -> m ByteString rewriteLbsJson Value -> Value -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 :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either Y.ParseException Value) +readYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either Y.ParseException Value) readYamlFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either ParseException Value) -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 () @@ -722,7 +722,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 @@ -733,15 +733,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 :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value +readYamlFileOk :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value readYamlFileOk :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value -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. @@ -752,42 +752,42 @@ (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either ParseException Value) readYamlFile FilePath -filePath +filePath -rewriteLbsYaml :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString +rewriteLbsYaml :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString rewriteLbsYaml :: forall (m :: * -> *). (MonadTest m, HasCallStack) => (Value -> Value) -> ByteString -> m ByteString -rewriteLbsYaml Value -> Value -f ByteString -lbs = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteLbsYaml Value -> Value +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 Value -iv -> forall (m :: * -> *) a. Monad m => a -> m a +lbs) of + Right Value +iv -> forall (m :: * -> *) a. Monad m => a -> m a return (forall a. ToJSON a => a -> ByteString J.encode (Value -> Value -f Value -iv)) - Left ParseException -msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a +f Value +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 :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m () +rewriteYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m () rewriteYamlFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m () -rewriteYamlFile FilePath -filePath Value -> Value -f = forall a. HasCallStack => (HasCallStack => a) -> a +rewriteYamlFile FilePath +filePath Value -> Value +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 () @@ -799,32 +799,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 (m :: * -> *). (MonadTest m, HasCallStack) => (Value -> Value) -> ByteString -> m ByteString rewriteLbsYaml Value -> Value -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 :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m () +copyRewriteYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m () copyRewriteYamlFile :: forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m () -copyRewriteYamlFile FilePath -src FilePath -dst Value -> Value -f = forall a. HasCallStack => (HasCallStack => a) -> a +copyRewriteYamlFile FilePath +src FilePath +dst Value -> Value +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 () @@ -836,44 +836,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 (m :: * -> *). (MonadTest m, HasCallStack) => (Value -> Value) -> ByteString -> m ByteString rewriteLbsYaml Value -> Value -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 :: * -> *). @@ -885,231 +885,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 (m :: * -> *). + Either FilePath Value +jsonResult <- forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either FilePath Value) readJsonFile 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 (m :: * -> *). + Either FilePath Value +result <- forall (m :: * -> *). (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either FilePath Value) readJsonFile 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 => @@ -1117,29 +1117,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 @@ -1149,7 +1149,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 @@ -1163,39 +1163,39 @@ 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" \ 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 2f68e71d..85022900 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Golden.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Golden.html @@ -1,339 +1,333 @@ -
module Hedgehog.Extras.Test.Golden
-  ( diffVsGoldenFile,
-    diffFileVsGoldenFile,
-  ) where
-
-import           Control.Applicative
-import           Control.Exception (bracket_)
-import           Control.Monad
-import           Control.Monad.IO.Class (MonadIO (liftIO))
-import           Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff)
-import           Data.Algorithm.DiffOutput (ppDiff)
-import           Data.Bool
-import           Data.Eq
-import           Data.Function
-import           Data.Maybe
-import           Data.Monoid
-import           Data.String
-import           GHC.Stack (HasCallStack, callStack)
-import           Hedgehog (MonadTest)
-import           Hedgehog.Extras.Test.Base (failMessage)
-import           System.FilePath (takeDirectory)
-import           System.IO (FilePath, IO)
-
-import qualified Control.Concurrent.QSem as IO
-import qualified Data.List as List
-import qualified GHC.Stack as GHC
-import qualified Hedgehog.Extras.Test as H
-import qualified Hedgehog.Internal.Property as H
-import qualified System.Directory as IO
-import qualified System.Environment as IO
-import qualified System.IO as IO
-import qualified System.IO.Unsafe as IO
-
-sem :: IO.QSem
-sem :: QSem
+
{-# LANGUAGE MultiWayIf #-}
+
+module Hedgehog.Extras.Test.Golden
+  ( diffVsGoldenFile,
+    diffFileVsGoldenFile,
+  ) where
+
+import           Control.Applicative
+import           Control.Exception (bracket_)
+import           Control.Monad
+import           Control.Monad.IO.Class (MonadIO (liftIO))
+import           Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff)
+import           Data.Algorithm.DiffOutput (ppDiff)
+import           Data.Bool
+import           Data.Eq
+import           Data.Function
+import           Data.Maybe
+import           Data.Monoid
+import           Data.String
+import           GHC.Stack (HasCallStack, callStack)
+import           Hedgehog (MonadTest)
+import           Hedgehog.Extras.Test.Base (failMessage)
+import           System.FilePath (takeDirectory)
+import           System.IO (FilePath, IO)
+
+import qualified Control.Concurrent.QSem as IO
+import qualified Data.List as List
+import qualified GHC.Stack as GHC
+import qualified Hedgehog.Extras.Test as H
+import qualified Hedgehog.Internal.Property as H
+import qualified System.Directory as IO
+import qualified System.Environment as IO
+import qualified System.IO as IO
+import qualified System.IO.Unsafe as IO
+
+sem :: IO.QSem
+sem :: QSem
 sem = forall a. IO a -> a
 IO.unsafePerformIO forall a b. (a -> b) -> a -> b
 $ Int -> IO QSem
 IO.newQSem Int
 1
-{-# NOINLINE sem #-}
-
-semBracket :: IO a -> IO a
-semBracket :: forall a. IO a -> IO a
+{-# NOINLINE sem #-}
+
+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 ()
 IO.waitQSem QSem
 sem) (QSem -> IO ()
 IO.signalQSem QSem
 sem)
-
--- | The file to log whenever a golden file is referenced.
-mGoldenFileLogFile :: Maybe FilePath
-mGoldenFileLogFile :: Maybe String
+
+-- | The file to log whenever a golden file is referenced.
+mGoldenFileLogFile :: Maybe FilePath
+mGoldenFileLogFile :: Maybe String
 mGoldenFileLogFile = forall a. IO a -> a
 IO.unsafePerformIO forall a b. (a -> b) -> a -> b
 $
-  String -> IO (Maybe String)
+  String -> IO (Maybe String)
 IO.lookupEnv String
 "GOLDEN_FILE_LOG_FILE"
-
--- | Whether the test should create the golden files if the file does ont exist.
-createGoldenFiles :: Bool
-createGoldenFiles :: Bool
+
+-- | Whether the test should create the golden files if the files do not exist.
+createGoldenFiles :: Bool
+createGoldenFiles :: Bool
 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
+  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"
-
--- | Whether the test should create the golden files if the file does ont exist.
-recreateGoldenFiles :: Bool
-recreateGoldenFiles :: Bool
+
+-- | Whether the test should recreate the golden files if the files already exist.
+recreateGoldenFiles :: Bool
+recreateGoldenFiles :: Bool
 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
+  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
-  => FilePath
-  -> String
-  -> m ()
-writeGoldenFile :: forall (m :: * -> *).
+
+writeGoldenFile :: ()
+  => MonadIO m
+  => MonadTest m
+  => FilePath
+  -> String
+  -> m ()
+writeGoldenFile :: forall (m :: * -> *).
 (MonadIO m, MonadTest m) =>
 String -> String -> m ()
-writeGoldenFile String
-goldenFile String
-actualContent = do
-  forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
+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
-  forall (m :: * -> *).
+goldenFile
+  forall (m :: * -> *).
 (MonadTest m, MonadIO m, HasCallStack) =>
 String -> m ()
 H.createDirectoryIfMissing_ (String -> String
 takeDirectory String
-goldenFile)
-  forall (m :: * -> *).
+goldenFile)
+  forall (m :: * -> *).
 (MonadTest m, MonadIO m, HasCallStack) =>
 String -> String -> m ()
 H.writeFile String
-goldenFile String
-actualContent
-
-reportGoldenFileMissing :: ()
-  => MonadIO m
-  => MonadTest m
-  => FilePath
-  -> m ()
-reportGoldenFileMissing :: forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m ()
-reportGoldenFileMissing String
-goldenFile = do
-  forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
+goldenFile String
+actualContent
+
+reportGoldenFileMissing :: ()
+  => MonadIO m
+  => MonadTest m
+  => FilePath
+  -> m ()
+reportGoldenFileMissing :: forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m ()
+reportGoldenFileMissing String
+goldenFile = do
+  forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
 H.note_ forall a b. (a -> b) -> a -> b
 $ [String] -> String
 unlines
-    [ String
+    [ 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
+    , String
 "To create golden file, run with CREATE_GOLDEN_FILES=1."
-    , String
+    , String
 "To recreate golden file, run with RECREATE_GOLDEN_FILES=1."
-    ]
-  forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
+    ]
+  forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
 H.failure
-
-checkAgainstGoldenFile :: ()
-  => MonadIO m
-  => MonadTest m
-  => FilePath
-  -> [String]
-  -> m ()
-checkAgainstGoldenFile :: forall (m :: * -> *).
+
+checkAgainstGoldenFile :: ()
+  => MonadIO m
+  => MonadTest m
+  => FilePath
+  -> [String]
+  -> 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
-  case [Diff [String]]
-difference of
-    []       -> forall (f :: * -> *) a. Applicative f => a -> f a
+actualLines [String]
+referenceLines
+  case [Diff [String]]
+difference of
+    []       -> forall (f :: * -> *) a. Applicative f => a -> f a
 pure ()
-    [Both{}] -> forall (f :: * -> *) a. Applicative f => a -> f a
+    [Both{}] -> forall (f :: * -> *) a. Applicative f => a -> f a
 pure ()
-    [Diff [String]]
+    [Diff [String]]
 _        -> do
-      forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
+      forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
 H.note_ forall a b. (a -> b) -> a -> b
 $ [String] -> String
 unlines
-        [ String
+        [ String
 "Golden test failed against golden file: " forall a. Semigroup a => a -> a -> a
 <> String
-goldenFile
-        , String
+goldenFile
+        , String
 "To recreate golden file, run with RECREATE_GOLDEN_FILES=1."
-        ]
-      forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
+        ]
+      forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
 failMessage HasCallStack => CallStack
 callStack forall a b. (a -> b) -> a -> b
 $ [Diff [String]] -> String
 ppDiff [Diff [String]]
-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
--- RECREATE_GOLDEN_FILES is set to "1", then should the golden file exist it would
--- be recreated. If GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file
--- path will be logged to the specified file.
---
--- Set the environment variable when you intend to generate or re-generate the golden
--- file for example when running the test for the first time or if the golden file
--- genuinely needs to change.
---
--- To re-generate a golden file you must also delete the golden file because golden
--- files are never overwritten.
---
--- TODO: Improve the help output by saying the difference of
--- each input.
-diffVsGoldenFile
-  :: HasCallStack
-  => (MonadIO m, MonadTest m)
-  => String   -- ^ Actual content
-  -> FilePath -- ^ Reference file
-  -> m ()
-diffVsGoldenFile :: forall (m :: * -> *).
+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
+-- RECREATE_GOLDEN_FILES is set to "1", then should the golden file exist it would
+-- be recreated. If GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file
+-- path will be logged to the specified file.
+--
+-- Set the environment variable when you intend to generate or re-generate the golden
+-- file for example when running the test for the first time or if the golden file
+-- genuinely needs to change.
+--
+-- To re-generate a golden file you must also delete the golden file because golden
+-- files are never overwritten.
+--
+-- TODO: Improve the help output by saying the difference of
+-- each input.
+diffVsGoldenFile
+  :: HasCallStack
+  => (MonadIO m, MonadTest m)
+  => String   -- ^ Actual content
+  -> FilePath -- ^ Reference file
+  -> 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.
+  forall (t :: * -> *) (m :: * -> *) a b.
 (Foldable t, Monad m) =>
 t a -> (a -> m b) -> m ()
 forM_ Maybe String
 mGoldenFileLogFile forall a b. (a -> b) -> a -> b
-$ \String
-logFile ->
-    forall (m :: * -> *) a. MonadIO m => IO a -> m a
+$ \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
-
-  if Bool
-recreateGoldenFiles
-    then forall (m :: * -> *).
+goldenFile
+
+  if
+    | Bool
+recreateGoldenFiles -> forall (m :: * -> *).
 (MonadIO m, MonadTest m) =>
 String -> String -> m ()
 writeGoldenFile String
-goldenFile String
-actualContent
-    else if Bool
-createGoldenFiles
-      then if Bool
-fileExists
-        then forall (m :: * -> *).
+goldenFile String
+actualContent
+    | Bool
+fileExists          -> forall (m :: * -> *).
 (MonadIO m, MonadTest m) =>
 String -> [String] -> m ()
 checkAgainstGoldenFile String
-goldenFile [String]
-actualLines
-        else forall (m :: * -> *).
+goldenFile [String]
+actualLines
+    | Bool
+createGoldenFiles   -> forall (m :: * -> *).
 (MonadIO m, MonadTest m) =>
 String -> String -> m ()
 writeGoldenFile String
-goldenFile String
-actualContent
-      else if Bool
-fileExists
-        then forall (m :: * -> *).
-(MonadIO m, MonadTest m) =>
-String -> [String] -> m ()
-checkAgainstGoldenFile String
-goldenFile [String]
-actualLines
-        else forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m ()
+goldenFile String
+actualContent
+    | Bool
+otherwise           -> forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m ()
 reportGoldenFileMissing String
-goldenFile
-  where
-    actualLines :: [String]
-actualLines = String -> [String]
+goldenFile
+
+  where
+    actualLines :: [String]
+actualLines = String -> [String]
 List.lines String
-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
--- GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file path will be
--- logged to the specified file.
---
--- Set the environment variable when you intend to generate or re-generate the golden
--- file for example when running the test for the first time or if the golden file
--- genuinely needs to change.
---
--- To re-generate a golden file you must also delete the golden file because golden
--- files are never overwritten.
-diffFileVsGoldenFile
-  :: HasCallStack
-  => (MonadIO m, MonadTest m)
-  => FilePath -- ^ Actual file
-  -> FilePath -- ^ Reference file
-  -> m ()
-diffFileVsGoldenFile :: forall (m :: * -> *).
+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
+-- GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file path will be
+-- logged to the specified file.
+--
+-- Set the environment variable when you intend to generate or re-generate the golden
+-- file for example when running the test for the first time or if the golden file
+-- genuinely needs to change.
+--
+-- To re-generate a golden file you must also delete the golden file because golden
+-- files are never overwritten.
+diffFileVsGoldenFile
+  :: HasCallStack
+  => (MonadIO m, MonadTest m)
+  => FilePath -- ^ Actual file
+  -> FilePath -- ^ Reference file
+  -> 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
-  forall (m :: * -> *).
+actualFile
+  forall (m :: * -> *).
 (HasCallStack, MonadIO m, MonadTest m) =>
 String -> String -> m ()
 diffVsGoldenFile String
-contents String
-referenceFile
-

\ No newline at end of file
+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 522e57ec..d8ed6432 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 c07c2cdb..765ae1e3 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 7c9e4c70..23a361bc 100644 --- a/hedgehog-extras/src/Hedgehog.Extras.Test.Process.html +++ b/hedgehog-extras/src/Hedgehog.Extras.Test.Process.html @@ -66,12 +66,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 @@ -83,7 +83,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. @@ -113,40 +113,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 @@ -154,21 +154,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] @@ -185,30 +185,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 () @@ -218,70 +218,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) => @@ -289,18 +289,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. @@ -311,7 +311,7 @@ (MonadTest m, MonadIO m, HasCallStack) => ProcessHandle -> m (Maybe Pid) getPid ProcessHandle -hProcess +hProcess -- | Create a process returning its stdout. -- @@ -322,12 +322,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] @@ -337,32 +337,32 @@ 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 - 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] @@ -370,34 +370,34 @@ <>) 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 [[Char]] -args - (ExitCode -exitResult, [Char] -stdout, [Char] -stderr) <- forall (m :: * -> *) a. +args + (ExitCode +exitResult, [Char] +stdout, [Char] +stderr) <- 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] "" 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] @@ -408,27 +408,27 @@ , [Char] "━━━━ command ━━━━" , [Char] -pkgBin forall a. Semigroup a => a -> a -> a +pkgBin forall a. Semigroup a => a -> a -> a <> [Char] " " forall a. Semigroup a => a -> a -> a <> [[Char]] -> [Char] L.unwords (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ShowS argQuote [[Char]] -arguments) +arguments) , [Char] "━━━━ stdout ━━━━" , [Char] -stdout +stdout , [Char] "━━━━ stderr ━━━━" , [Char] -stderr +stderr , [Char] "━━━━ exit code ━━━━" , forall a. Show a => a -> [Char] show @Int Int -exitCode +exitCode ] forall (m :: * -> *) a. MonadTest m => CallStack -> [Char] -> m a H.failMessage HasCallStack => CallStack @@ -437,64 +437,64 @@ ExitCode IO.ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a return [Char] -stdout +stdout -- | 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 -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 - 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 @@ -502,27 +502,27 @@ "Command: " 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 [[Char]] -arguments - (ExitCode -exitResult, [Char] -stdout, [Char] -stderr) <- forall (m :: * -> *) a. +arguments + (ExitCode +exitResult, [Char] +stdout, [Char] +stderr) <- 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] "" 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] @@ -533,43 +533,43 @@ , [Char] "━━━━ command ━━━━" , [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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ShowS argQuote [[Char]] -arguments) +arguments) , [Char] "━━━━ stdout ━━━━" , [Char] -stdout +stdout , [Char] "━━━━ stderr ━━━━" , [Char] -stderr +stderr , [Char] "━━━━ exit code ━━━━" , forall a. Show a => a -> [Char] show @Int Int -exitCode +exitCode ] ExitCode IO.ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a return [Char] -stdout +stdout -- | 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. @@ -578,18 +578,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. @@ -598,33 +598,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 () @@ -634,79 +634,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 @@ -717,27 +717,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 @@ -745,36 +745,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 @@ -787,15 +787,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) => @@ -806,8 +806,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 @@ -815,46 +815,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 @@ -864,64 +864,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