hw-polysemy 0.2.14.12 → 0.3.0.0
raw patch · 14 files changed
+28/−597 lines, 14 filesdep +hw-preludedep ~Win32PVP ok
version bump matches the API change (PVP)
Dependencies added: hw-prelude
Dependency ranges changed: Win32
API changes (from Hackage documentation)
Files
- core/HaskellWorks/Control/Monad.hs +0/−32
- core/HaskellWorks/Data/String.hs +0/−8
- core/HaskellWorks/Error.hs +0/−28
- core/HaskellWorks/Error/Types.hs +0/−18
- core/HaskellWorks/IO/Network.hs +0/−9
- core/HaskellWorks/IO/Network/NamedPipe.hs +0/−24
- core/HaskellWorks/IO/Network/Port.hs +0/−57
- core/HaskellWorks/IO/Network/Socket.hs +0/−73
- core/HaskellWorks/IO/Process.hs +0/−34
- core/HaskellWorks/IO/Win32/NamedPipe.hsc +0/−71
- core/HaskellWorks/Prelude.hs +0/−205
- core/HaskellWorks/Unsafe.hs +0/−6
- hw-polysemy.cabal +10/−21
- test/HaskellWorks/Polysemy/TestContainers/LocalStackSpec.hs +18/−11
− core/HaskellWorks/Control/Monad.hs
@@ -1,32 +0,0 @@-module HaskellWorks.Control.Monad- ( repeatNUntilM_,- repeatNWhileM_,- ) where--import HaskellWorks.Prelude---- | Repeat an action n times until the action returns True.-repeatNUntilM_ :: ()- => Monad m- => Int- -> (Int -> m Bool)- -> m ()-repeatNUntilM_ n action = go 0- where- go i =- when (i < n) $ do- shouldTerminate <- action i- unless shouldTerminate $ go (i + 1)---- | Repeat an action n times while the action returns True.-repeatNWhileM_ :: ()- => Monad m- => Int- -> (Int -> m Bool)- -> m ()-repeatNWhileM_ n action = go 0- where- go i =- when (i < n) $ do- shouldContinue <- action i- when shouldContinue $ go (i + 1)
− core/HaskellWorks/Data/String.hs
@@ -1,8 +0,0 @@-module HaskellWorks.Data.String- ( unlines- , unwords- , words- , lines- ) where--import Data.String
− core/HaskellWorks/Error.hs
@@ -1,28 +0,0 @@-module HaskellWorks.Error- ( onLeft,- onNothing,- onLeftM,- onNothingM,- ) where--import HaskellWorks.Polysemy.Prelude--onLeft :: forall e a m. ()- => Monad m- => (e -> m a) -> Either e a -> m a-onLeft f = either f pure--onNothing :: forall a m. ()- => Monad m- => m a -> Maybe a -> m a-onNothing h = maybe h return--onLeftM :: forall e a m. ()- => Monad m- => (e -> m a) -> m (Either e a) -> m a-onLeftM f action = onLeft f =<< action--onNothingM :: forall a m. ()- => Monad m- => m a -> m (Maybe a) -> m a-onNothingM h f = onNothing h =<< f
− core/HaskellWorks/Error/Types.hs
@@ -1,18 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module HaskellWorks.Error.Types- ( GenericError(..),- TimedOut(..),- ) where--import HaskellWorks.Polysemy.Prelude--newtype GenericError = GenericError- { message :: Text- }- deriving (Generic, Eq, Show)--newtype TimedOut = TimedOut- { message :: Text- }- deriving (Generic, Eq, Show)
− core/HaskellWorks/IO/Network.hs
@@ -1,9 +0,0 @@-module HaskellWorks.IO.Network- ( doesNamedPipeExist,- randomPort,- reserveRandomPort,- portInUse,- ) where--import HaskellWorks.IO.Network.NamedPipe-import HaskellWorks.IO.Network.Port
− core/HaskellWorks/IO/Network/NamedPipe.hs
@@ -1,24 +0,0 @@-{-# LANGUAGE CPP #-}--{-# OPTIONS_GHC -Wno-unused-imports #-}-{-# OPTIONS_GHC -Wno-unused-matches #-}--module HaskellWorks.IO.Network.NamedPipe- ( doesNamedPipeExist- ) where--import Data.Bool-import Prelude (error)-import System.IO (FilePath, IO)--#ifdef mingw32_HOST_OS-import qualified HaskellWorks.IO.Win32.NamedPipe as W32-#endif--doesNamedPipeExist :: FilePath -> IO Bool-doesNamedPipeExist path =-#ifdef mingw32_HOST_OS- W32.waitNamedPipe path 1-#else- error "doesNamedPipeExist may only be called on Windows"-#endif
− core/HaskellWorks/IO/Network/Port.hs
@@ -1,57 +0,0 @@-{-# LANGUAGE TypeApplications #-}--module HaskellWorks.IO.Network.Port- ( randomPort,- reserveRandomPort,- portInUse,- ) where--import Control.Exception-import Control.Monad (Monad (..), MonadFail (..))-import Control.Monad.IO.Class-import Control.Monad.Trans.Resource-import Data.Bool-import Data.Either-import Data.Function-import Network.Socket---- | Return a random available port on a specified host address-randomPort :: ()- => MonadIO m- => MonadFail m- => HostAddress- -> m PortNumber-randomPort hostAddress = do- sock <- liftIO $ socket AF_INET Stream defaultProtocol- -- Allow the port to be reused immediately after the socket is closed- liftIO $ setSocketOption sock ReuseAddr 1- liftIO $ bind sock $ SockAddrInet defaultPort hostAddress- SockAddrInet port _ <- liftIO $ getSocketName sock- liftIO $ close sock- return port--reserveRandomPort :: ()- => MonadFail m- => MonadResource m- => HostAddress- -> m (ReleaseKey, PortNumber)-reserveRandomPort hostAddress = do- sock <- liftIO $ socket AF_INET Stream defaultProtocol- liftIO $ setSocketOption sock ReuseAddr 1- liftIO $ bind sock $ SockAddrInet defaultPort hostAddress- SockAddrInet port _ <- liftIO $ getSocketName sock- releaseKey <- register $ close sock- return (releaseKey, port)---- | Check if a port is in use on a specified host address-portInUse :: ()- => MonadIO m- => HostAddress- -> PortNumber- -> m Bool-portInUse hostAddress pn = do- sock <- liftIO $ socket AF_INET Stream defaultProtocol- liftIO $ setSocketOption sock ReuseAddr 1- result <- liftIO $ try @SomeException $ bind sock (SockAddrInet pn hostAddress)- liftIO $ close sock- return $ either (const False) (const True) result
− core/HaskellWorks/IO/Network/Socket.hs
@@ -1,73 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--module HaskellWorks.IO.Network.Socket- ( doesSocketExist,- isPortOpen,- canConnect,- listenOn,- allocateRandomPorts,- ) where--import Control.Exception (IOException, handle)-import Control.Monad-import Data.Bool-import Data.Function-import Data.Functor-import Data.Int-import Data.Maybe-import Network.Socket (Family (AF_INET), SockAddr (..), Socket,- SocketType (Stream))-import Prelude (fromIntegral)-import System.IO (FilePath, IO)-import Text.Show (show)--import qualified Network.Socket as IO-import qualified System.Directory as IO-import qualified UnliftIO.Exception as IO---- | Check if a TCP port is open-isPortOpen :: Int -> IO Bool-isPortOpen port = do- socketAddressInfos <- IO.getAddrInfo Nothing (Just "127.0.0.1") (Just (show port))- case socketAddressInfos of- socketAddressInfo:_ ->- handle (return . const @Bool @IOException False) $- canConnect (IO.addrAddress socketAddressInfo) $> True- [] -> return False---- | Check if it is possible to connect to a socket address-canConnect :: SockAddr -> IO ()-canConnect sockAddr = IO.bracket (IO.socket AF_INET Stream 6) IO.close' $ \sock -> do- IO.connect sock sockAddr---- | Open a socket at the specified port for listening-listenOn :: Int -> IO Socket-listenOn n = do- sock <- IO.socket AF_INET Stream 0- sockAddrInfo:_ <- IO.getAddrInfo Nothing (Just "127.0.0.1") (Just (show n))- IO.setSocketOption sock IO.ReuseAddr 1- IO.bind sock (IO.addrAddress sockAddrInfo)- IO.listen sock 2- return sock--doesSocketExist :: FilePath -> IO Bool-doesSocketExist = IO.doesFileExist-{-# INLINE doesSocketExist #-}---- | Allocate the specified number of random ports-allocateRandomPorts :: Int -> IO [Int]-allocateRandomPorts n = do- let hints = IO.defaultHints- { IO.addrFlags = [IO.AI_PASSIVE]- , IO.addrSocketType = IO.Stream- }-- -- Create n sockets with randomly bound ports, grab the port numbers and close those ports- addr:_ <- IO.getAddrInfo (Just hints) (Just "127.0.0.1") (Just "0")- socks <- forM [1..n] $ \_ -> IO.socket (IO.addrFamily addr) (IO.addrSocketType addr) (IO.addrProtocol addr)- forM_ socks $ \sock -> IO.bind sock (IO.addrAddress addr)- ports <- forM socks IO.socketPort- forM_ socks IO.close-- return $ fmap fromIntegral ports
− core/HaskellWorks/IO/Process.hs
@@ -1,34 +0,0 @@-module HaskellWorks.IO.Process- ( maybeWaitForProcess,- waitSecondsForProcess,- ) where--import Control.Concurrent as IO-import Control.Concurrent.Async as IO-import qualified Control.Exception as IO-import Data.Maybe-import System.Exit-import System.IO--import Control.Applicative-import Data.Function-import Data.Functor-import HaskellWorks.Error.Types-import HaskellWorks.Prelude-import qualified System.Process as IO-import System.Process--maybeWaitForProcess :: ()- => ProcessHandle- -> IO (Maybe ExitCode)-maybeWaitForProcess hProcess =- IO.catch (fmap Just (IO.waitForProcess hProcess)) $ \(_ :: AsyncCancelled) -> pure Nothing--waitSecondsForProcess :: ()- => Int- -> ProcessHandle- -> IO (Either TimedOut (Maybe ExitCode))-waitSecondsForProcess seconds hProcess =- IO.race- (IO.threadDelay (seconds * 1000000) >> pure (TimedOut "Timed out waiting for process"))- (maybeWaitForProcess hProcess)
− core/HaskellWorks/IO/Win32/NamedPipe.hsc
@@ -1,71 +0,0 @@-#include <fcntl.h>-#include <windows.h>--{-# LANGUAGE CPP #-}-{-# LANGUAGE MultiWayIf #-}---- | For full details on the Windows named pipes API see--- <https://docs.microsoft.com/en-us/windows/desktop/ipc/named-pipes>----module HaskellWorks.IO.Win32.NamedPipe- ( -- ** waiting for named pipe instances- waitNamedPipe,-- TimeOut,- nMPWAIT_USE_DEFAULT_WAIT,- nMPWAIT_WAIT_FOREVER,- ) where--import Control.Applicative (pure)-import Data.Bool (Bool (..), otherwise)-import Data.Eq ((==))-import Data.Function (($))-import Data.String (String)-import Foreign.C.String (withCString)-import System.IO (IO)-import System.Win32.File-import System.Win32.Types hiding (try)---- | Timeout in milliseconds.------ * 'nMPWAIT_USE_DEFAULT_WAIT' indicates that the timeout value passed to--- 'createNamedPipe' should be used.--- * 'nMPWAIT_WAIT_FOREVER' - 'waitNamedPipe' will block forever, until a named--- pipe instance is available.----type TimeOut = DWORD-#{enum TimeOut,- , nMPWAIT_USE_DEFAULT_WAIT = NMPWAIT_USE_DEFAULT_WAIT- , nMPWAIT_WAIT_FOREVER = NMPWAIT_WAIT_FOREVER- }---- | Wait until a named pipe instance is available. If there is no instance at--- hand before the timeout, it will error with 'ERROR_SEM_TIMEOUT', i.e.--- @invalid argument (The semaphore timeout period has expired)@------ It returns 'True' if there is an available instance, subsequent 'createFile'--- might still fail, if another thread will take turn and connect before, or if--- the other end shuts down the name pipe.------ It returns 'False' if timeout fired.----waitNamedPipe :: String -- ^ pipe name- -> TimeOut -- ^ nTimeOut- -> IO Bool-waitNamedPipe name timeout =- withCString name $ \ c_name -> do- r <- c_WaitNamedPipe c_name timeout- e <- getLastError- if | r -> pure r- | e == eRROR_SEM_TIMEOUT -> pure False- | otherwise -> failWith "waitNamedPipe" e----- 'c_WaitNamedPipe' is a blocking call, hence the _safe_ import.-foreign import ccall safe "windows.h WaitNamedPipeA"- c_WaitNamedPipe :: LPCSTR -- lpNamedPipeName- -> DWORD -- nTimeOut- -> IO BOOL--eRROR_SEM_TIMEOUT :: ErrCode-eRROR_SEM_TIMEOUT = #const ERROR_SEM_TIMEOUT
− core/HaskellWorks/Prelude.hs
@@ -1,205 +0,0 @@-module HaskellWorks.Prelude- ( Bool(..),- Char(..),- Maybe(..),- Either(..),-- String,- Text,- ByteString,- Int,- Int8,- Int16,- Int32,- Int64,- Integer,- Word,- Word8,- Word16,- Word32,- Word64,- Float,- Double,- FilePath,- Void,-- Eq(..),- Ord(..),- Num(..),- Show(..),- IsString(..),- tshow,-- bool,- const,-- absurd,- vacuous,-- either,- lefts,- rights,- isLeft,- isRight,- fromLeft,- fromRight,-- maybe,- isJust,- isNothing,- fromMaybe,- listToMaybe,- maybeToList,- catMaybes,- mapMaybe,-- fst,- flip,- snd,- id,- seq,- curry,- uncurry,- ($!),- ($),- (&),- not,- otherwise,- (&&),- (||),- (.),- (</>),-- void,- mapM_,- forM,- forM_,- sequence_,- (=<<),- (>=>),- (<=<),- forever,- join,- msum,- mfilter,- filterM,- foldM,- foldM_,- replicateM,- replicateM_,- guard,- when,- unless,- liftM,- liftM2,- liftM3,- liftM4,- liftM5,- ap,- (<$!>),-- (<$>),-- (<**>),- liftA,- liftA3,- optional,- asum,-- for_,-- zip,- zip3,- zipWith,- zipWith3,- unzip,- unzip3,-- Fractional(..),- Floating(..),- Integral(..),- Read(..),- Real(..),- RealFrac(..),- RealFloat(..),- Ratio(..),- Rational,- fromIntegral,- realToFrac,- even,- odd,- numericEnumFrom,- numericEnumFromThen,- numericEnumFromTo,- numericEnumFromThenTo,- integralEnumFrom,- integralEnumFromThen,- integralEnumFromTo,- integralEnumFromThenTo,- numerator,- denominator,- (%),-- Monad(..),- MonadFail(..),- MonadPlus(..),- Applicative(..),- Alternative(..),- Contravariant(..),- Divisible(..),- Functor(..),- Bifunctor(..),- Semigroup(..),- Monoid(..),- Foldable(..),- Traversable(..),-- IO,-- CallStack,- HasCallStack,- withFrozenCallStack,-- Generic,-- IOException,- IOError,- SomeException(..),- ) where--import Control.Applicative-import Control.Exception-import Control.Monad-import Data.Bifunctor-import Data.Bool-import Data.ByteString (ByteString)-import Data.Char-import Data.Either-import Data.Eq-import Data.Foldable-import Data.Function-import Data.Functor.Contravariant-import Data.Functor.Contravariant.Divisible-import Data.Int-import Data.Maybe-import Data.Monoid-import Data.Ord-import Data.Semigroup-import Data.String-import Data.Text (Text)-import Data.Traversable-import Data.Tuple-import Data.Void-import Data.Word-import GHC.Base-import GHC.Generics-import GHC.Num-import GHC.Real-import GHC.Stack-import Prelude-import System.FilePath--import qualified Data.Text as T--tshow :: Show a => a -> Text-tshow = T.pack . show
− core/HaskellWorks/Unsafe.hs
@@ -1,6 +0,0 @@-module HaskellWorks.Unsafe- ( error- , undefined- ) where--import Prelude
hw-polysemy.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: hw-polysemy-version: 0.2.14.12+version: 0.3.0.0 synopsis: Opinionated polysemy library description: Opinionated polysemy library. license: Apache-2.0@@ -35,6 +35,7 @@ common ghc-prim { build-depends: ghc-prim < 0.12 } common hedgehog { build-depends: hedgehog < 1.6 } common http-conduit { build-depends: http-conduit >= 2.3 && < 2.4 }+common hw-prelude { build-depends: hw-prelude >= 0.0.0.1 && < 0.1 } common lens { build-depends: lens < 5.4 } common mtl { build-depends: mtl < 2.4 } common network { build-depends: network < 3.3 }@@ -60,7 +61,7 @@ common Win32 if os(windows)- build-depends: Win32 >= 2.5.4.1+ build-depends: Win32 >= 2.5.4.1 && < 3 common hw-polysemy { build-depends: hw-polysemy } common hw-polysemy-amazonka { build-depends: hw-polysemy:amazonka }@@ -106,6 +107,7 @@ generic-lens, ghc-prim, hedgehog,+ hw-prelude, lens, mtl, network,@@ -124,19 +126,7 @@ yaml, visibility: public - if os(windows)- exposed-modules: HaskellWorks.IO.Win32.NamedPipe-- exposed-modules: HaskellWorks.Control.Monad- HaskellWorks.Data.String- HaskellWorks.Error- HaskellWorks.Error.Types- HaskellWorks.IO.Network- HaskellWorks.IO.Network.NamedPipe- HaskellWorks.IO.Network.Port- HaskellWorks.IO.Network.Socket- HaskellWorks.IO.Process- HaskellWorks.Polysemy+ exposed-modules: HaskellWorks.Polysemy HaskellWorks.Polysemy.Cabal HaskellWorks.Polysemy.Cabal.Types HaskellWorks.Polysemy.Control.Concurrent@@ -167,8 +157,6 @@ HaskellWorks.Polysemy.System.IO HaskellWorks.Polysemy.System.IO.Temp HaskellWorks.Polysemy.System.Process- HaskellWorks.Prelude- HaskellWorks.Unsafe hs-source-dirs: core default-language: Haskell2010 @@ -186,6 +174,7 @@ generic-lens, ghc-prim, hedgehog,+ hw-prelude, hw-polysemy-core, lens, mtl,@@ -226,6 +215,7 @@ binary, generic-lens, hw-polysemy-core,+ hw-prelude, lens, polysemy-log, polysemy-time,@@ -247,6 +237,7 @@ hw-polysemy-amazonka, hw-polysemy-core, hw-polysemy-hedgehog,+ hw-prelude, lens, resourcet, resourcet,@@ -265,10 +256,7 @@ import: base, project-config, hw-polysemy-core, hw-polysemy-hedgehog,- reexported-modules: HaskellWorks.IO.Network,- HaskellWorks.IO.Network.NamedPipe,- HaskellWorks.IO.Network.Port,- HaskellWorks.Polysemy,+ reexported-modules: HaskellWorks.Polysemy, HaskellWorks.Polysemy.Cabal, HaskellWorks.Polysemy.Cabal.Types, HaskellWorks.Polysemy.Control.Concurrent,@@ -317,6 +305,7 @@ hw-polysemy-core, hw-polysemy-testcontainers-localstack, hw-polysemy,+ hw-prelude, lens, polysemy-log, polysemy,
test/HaskellWorks/Polysemy/TestContainers/LocalStackSpec.hs view
@@ -20,22 +20,29 @@ import HaskellWorks.Polysemy.Hedgehog import HaskellWorks.Prelude import Polysemy+import qualified System.Info as OS import qualified TestContainers.Tasty as TC {- HLINT ignore "Use camelCase" -} +isWindows :: Bool+isWindows = OS.os == "mingw32"+ tasty_local_stack :: Tasty.TestTree tasty_local_stack =- TC.withContainers (setupContainers' "localstack/localstack-pro:3.7.2") $ \getContainer ->- H.testProperty "Local stack test" $ propertyOnce $ runLocalTestEnv getContainer $ do- container <- embed getContainer- ep <- getLocalStackEndpoint container- jotYamlM_ $ inspectContainer container- jotShow_ ep- listBucketsReq <- pure AWS.newListBuckets+ if isWindows+ then Tasty.testGroup "LocalStackSpec skipped on Windows" []+ else+ TC.withContainers (setupContainers' "localstack/localstack-pro:3.7.2") $ \getContainer ->+ H.testProperty "Local stack test" $ propertyOnce $ runLocalTestEnv getContainer $ do+ container <- embed getContainer+ ep <- getLocalStackEndpoint container+ jotYamlM_ $ inspectContainer container+ jotShow_ ep+ listBucketsReq <- pure AWS.newListBuckets - listBucketResp <- sendAws listBucketsReq- & jotShowDataLog @AwsLogEntry- & trapFail+ listBucketResp <- sendAws listBucketsReq+ & jotShowDataLog @AwsLogEntry+ & trapFail - jotShow_ listBucketResp+ jotShow_ listBucketResp