packages feed

hw-polysemy 0.1.1.0 → 0.2.0.0

raw patch · 50 files changed

+4364/−1414 lines, 50 filesdep +Diffdep +directorydep +process

Dependencies added: Diff, directory, process, stm, time

Files

+ core/HaskellWorks/Polysemy.hs view
@@ -0,0 +1,1 @@+module HaskellWorks.Polysemy () where
+ core/HaskellWorks/Polysemy/Control/Concurrent.hs view
@@ -0,0 +1,69 @@+module HaskellWorks.Polysemy.Control.Concurrent+  ( ThreadId,+    myThreadId,+    killThread,+    getNumCapabilities,+    threadCapability,+    yield,+    threadDelay,+    isCurrentThreadBound,+    mkWeakThreadId,+  ) where++import           Control.Concurrent            (ThreadId)+import qualified Control.Concurrent            as IO+import           HaskellWorks.Polysemy.Prelude+import           Polysemy+import           System.Mem.Weak               (Weak)++myThreadId :: ()+  => Member (Embed IO) r+  => Sem r ThreadId+myThreadId =+  embed IO.myThreadId++killThread :: ()+  => Member (Embed IO) r+  => ThreadId+  -> Sem r ()+killThread tid =+  embed $ IO.killThread tid++getNumCapabilities :: ()+  => Member (Embed IO) r+  => Sem r Int+getNumCapabilities =+  embed IO.getNumCapabilities++threadCapability :: ()+  => Member (Embed IO) r+  => ThreadId+  -> Sem r (Int, Bool)+threadCapability tid =+  embed $ IO.threadCapability tid++yield :: ()+  => Member (Embed IO) r+  => Sem r ()+yield =+  embed IO.yield++threadDelay :: ()+  => Member (Embed IO) r+  => Int+  -> Sem r ()+threadDelay n =+  embed $ IO.threadDelay n++isCurrentThreadBound :: ()+  => Member (Embed IO) r+  => Sem r Bool+isCurrentThreadBound =+  embed IO.isCurrentThreadBound++mkWeakThreadId :: ()+  => Member (Embed IO) r+  => ThreadId+  -> Sem r (Weak ThreadId)+mkWeakThreadId tid =+  embed $ IO.mkWeakThreadId tid
+ core/HaskellWorks/Polysemy/Control/Concurrent/QSem.hs view
@@ -0,0 +1,44 @@+module HaskellWorks.Polysemy.Control.Concurrent.QSem+  ( QSem,++    newQSem,+    waitQSem,+    signalQSem,+    bracketQSem,+  ) where++import           Control.Concurrent.QSem       (QSem)+import qualified Control.Concurrent.QSem       as IO+import           HaskellWorks.Polysemy.Prelude+import           Polysemy+import           Polysemy.Resource++newQSem :: ()+  => Member (Embed IO) r+  => Int+  -> Sem r QSem+newQSem n = do+  embed $ IO.newQSem n++waitQSem :: ()+  => Member (Embed IO) r+  => QSem+  -> Sem r ()+waitQSem sem =+  embed $ IO.waitQSem sem++signalQSem :: ()+  => Member (Embed IO) r+  => QSem+  -> Sem r ()+signalQSem sem =+  embed $ IO.signalQSem sem++bracketQSem :: ()+  => Member (Embed IO) r+  => Member Resource r+  => QSem+  -> Sem r a+  -> Sem r a+bracketQSem sem =+  bracket_ (waitQSem sem) (signalQSem sem)
+ core/HaskellWorks/Polysemy/Control/Concurrent/STM.hs view
@@ -0,0 +1,21 @@+module HaskellWorks.Polysemy.Control.Concurrent.STM+  ( TVar,+    atomically,+    STM.orElse,+    STM.retry,+    STM.check,+    STM.throwSTM,+    STM.catchSTM,+  ) where++import           Control.Concurrent.STM        (STM, TVar)+import qualified Control.Concurrent.STM        as STM+import           HaskellWorks.Polysemy.Prelude+import           Polysemy++atomically :: ()+  => Member (Embed IO) r+  => STM a+  -> Sem r a+atomically m =+  embed $ STM.atomically m
+ core/HaskellWorks/Polysemy/Control/Concurrent/STM/TVar.hs view
@@ -0,0 +1,40 @@+module HaskellWorks.Polysemy.Control.Concurrent.STM.TVar+  ( TVar,+    STM.newTVar,+    newTVarIO,+    STM.readTVar,+    readTVarIO,+    STM.writeTVar,+    STM.modifyTVar,+    STM.modifyTVar',+    STM.stateTVar,+    STM.swapTVar,+    registerDelay,+  ) where++import           Control.Concurrent.STM        (TVar)++import qualified Control.Concurrent.STM        as STM+import           HaskellWorks.Polysemy.Prelude+import           Polysemy++newTVarIO :: ()+  => Member (Embed IO) r+  => a+  -> Sem r (TVar a)+newTVarIO a = do+  embed $ STM.newTVarIO a++readTVarIO :: ()+  => Member (Embed IO) r+  => TVar a+  -> Sem r a+readTVarIO tvar = do+  embed $ STM.readTVarIO tvar++registerDelay :: ()+  => Member (Embed IO) r+  => Int+  -> Sem r (TVar Bool)+registerDelay n = do+  embed $ STM.registerDelay n
+ core/HaskellWorks/Polysemy/Data/ByteString.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Polysemy.Data.ByteString+  ( readFile+  ) where++import           HaskellWorks.Polysemy.Data.ByteString.Strict
+ core/HaskellWorks/Polysemy/Data/ByteString/Lazy.hs view
@@ -0,0 +1,299 @@+module HaskellWorks.Polysemy.Data.ByteString.Lazy+  ( -- * Strict @ByteString@+    ByteString,++    -- * Introducing and eliminating 'ByteString's+    LBS.empty,+    LBS.singleton,+    LBS.pack,+    LBS.unpack,+    LBS.fromStrict,+    LBS.toStrict,++    -- * Basic interface+    LBS.cons,+    LBS.snoc,+    LBS.append,+    LBS.head,+    LBS.uncons,+    LBS.unsnoc,+    LBS.last,+    LBS.tail,+    LBS.init,+    LBS.null,+    LBS.length,++    -- * Transforming ByteStrings+    LBS.map,+    LBS.reverse,+    LBS.intersperse,+    LBS.intercalate,+    LBS.transpose,++    -- * Reducing 'ByteString's (folds)+    LBS.foldl,+    LBS.foldl',+    LBS.foldl1,+    LBS.foldl1',++    LBS.foldr,+    LBS.foldr',+    LBS.foldr1,+    LBS.foldr1',++    -- ** Special folds+    LBS.concat,+    LBS.concatMap,+    LBS.any,+    LBS.all,+    LBS.maximum,+    LBS.minimum,++    -- * Building ByteStrings+    -- ** Scans+    LBS.scanl,+    LBS.scanl1,+    LBS.scanr,+    LBS.scanr1,++    -- ** Accumulating maps+    LBS.mapAccumL,+    LBS.mapAccumR,++    -- ** Generating and unfolding ByteStrings+    LBS.replicate,+    LBS.unfoldr,++    -- * Substrings++    -- ** Breaking strings+    LBS.take,+    LBS.takeEnd,+    LBS.drop,+    LBS.dropEnd,+    LBS.splitAt,+    LBS.takeWhile,+    LBS.takeWhileEnd,+    LBS.dropWhile,+    LBS.dropWhileEnd,+    LBS.span,+    LBS.spanEnd,+    LBS.break,+    LBS.breakEnd,+    LBS.group,+    LBS.groupBy,+    LBS.inits,+    LBS.tails,+    LBS.initsNE,+    LBS.tailsNE,+    LBS.stripPrefix,+    LBS.stripSuffix,++    -- ** Breaking into many substrings+    LBS.split,+    LBS.splitWith,++    -- * Predicates+    LBS.isPrefixOf,+    LBS.isSuffixOf,++    -- * Searching ByteStrings++    -- ** Searching by equality+    LBS.elem,+    LBS.notElem,++    -- ** Searching with a predicate+    LBS.find,+    LBS.filter,+    LBS.partition,++    -- * Indexing ByteStrings+    LBS.index,+    LBS.indexMaybe,+    (LBS.!?),+    LBS.elemIndex,+    LBS.elemIndices,+    LBS.elemIndexEnd,+    LBS.findIndex,+    LBS.findIndices,+    LBS.findIndexEnd,+    LBS.count,++    -- * Zipping and unzipping ByteStrings+    LBS.zip,+    LBS.zipWith,+    LBS.packZipWith,+    LBS.unzip,++    -- * Low level conversions+    -- ** Copying ByteStrings+    LBS.copy,++    -- * I\/O with 'ByteString's++    -- ** Standard input and output+    getContents,+    putStr,+    interact,++    -- ** Files+    readFile,+    writeFile,+    appendFile,++    -- ** I\/O with Handles+    hGetContents,+    hGet,+    hGetNonBlocking,+    hPut,+    hPutNonBlocking,+  ) where++import qualified Control.Exception             as CE+import qualified Data.ByteString.Lazy          as LBS+import qualified Data.Text                     as T+import qualified Data.Text.Encoding            as T+import           GHC.IO.Handle                 (Handle)+import           HaskellWorks.Polysemy.Prelude++import           Polysemy+import           Polysemy.Error+import           Polysemy.Log++getContents :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r LBS.ByteString+getContents = withFrozenCallStack $ do+  debug "Call to: getContents"+  r <- embed $ CE.try @IOException LBS.getContents+  fromEither r++putStr :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => LBS.ByteString+  -> Sem r ()+putStr bs = withFrozenCallStack $ do+  debug $ "Call to: putStr " <> T.decodeUtf8 (LBS.toStrict bs)+  r <- embed $ CE.try @IOException $ LBS.putStr bs+  fromEither r++interact :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => (LBS.ByteString -> LBS.ByteString)+  -> Sem r ()+interact f = withFrozenCallStack $ do+  debug "Call to: interact"+  r <- embed $ CE.try @IOException $ LBS.interact f+  fromEither r++readFile :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r LBS.ByteString+readFile filePath = withFrozenCallStack $ do+  info $ "Reading bytestring from file: " <> T.pack filePath+  r <- embed $ CE.try @IOException $ LBS.readFile filePath+  fromEither r++writeFile :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> LBS.ByteString+  -> Sem r ()+writeFile filePath bs = withFrozenCallStack $ do+  info $ "Writing bytestring to file: " <> T.pack filePath+  r <- embed $ CE.try @IOException $ LBS.writeFile filePath bs+  fromEither r++appendFile :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> LBS.ByteString+  -> Sem r ()+appendFile filePath bs = withFrozenCallStack $ do+  info $ "Appending bytestring to file: " <> T.pack filePath+  r <- embed $ CE.try @IOException $ LBS.appendFile filePath bs+  fromEither r++hGetContents :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r LBS.ByteString+hGetContents h = withFrozenCallStack $ do+  debug "Call to: hGetContents"+  r <- embed $ CE.try @IOException $ LBS.hGetContents h+  fromEither r++hGet :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Int+  -> Sem r LBS.ByteString+hGet h n = withFrozenCallStack $ do+  debug "Call to: hGet"+  r <- embed $ CE.try @IOException $ LBS.hGet h n+  fromEither r++hGetNonBlocking :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Int+  -> Sem r LBS.ByteString+hGetNonBlocking h n = withFrozenCallStack $ do+  debug "Call to: hGetNonBlocking"+  r <- embed $ CE.try @IOException $ LBS.hGetNonBlocking h n+  fromEither r++hPut :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> LBS.ByteString+  -> Sem r ()+hPut h bs = withFrozenCallStack $ do+  debug "Call to: hPut"+  r <- embed $ CE.try @IOException $ LBS.hPut h bs+  fromEither r++hPutNonBlocking :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> LBS.ByteString+  -> Sem r LBS.ByteString+hPutNonBlocking h bs = withFrozenCallStack $ do+  debug "Call to: hPutNonBlocking"+  r <- embed $ CE.try @IOException $ LBS.hPutNonBlocking h bs+  fromEither r
+ core/HaskellWorks/Polysemy/Data/ByteString/Strict.hs view
@@ -0,0 +1,404 @@+module HaskellWorks.Polysemy.Data.ByteString.Strict+  ( -- * Strict @ByteString@+    ByteString,++    -- * Introducing and eliminating 'ByteString's+    BS.empty,+    BS.singleton,+    BS.pack,+    BS.unpack,+    BS.fromStrict,+    BS.toStrict,+    fromFilePath,+    toFilePath,++    -- * Basic interface+    BS.cons,+    BS.snoc,+    BS.append,+    BS.head,+    BS.uncons,+    BS.unsnoc,+    BS.last,+    BS.tail,+    BS.init,+    BS.null,+    BS.length,++    -- * Transforming ByteStrings+    BS.map,+    BS.reverse,+    BS.intersperse,+    BS.intercalate,+    BS.transpose,++    -- * Reducing 'ByteString's (folds)+    BS.foldl,+    BS.foldl',+    BS.foldl1,+    BS.foldl1',++    BS.foldr,+    BS.foldr',+    BS.foldr1,+    BS.foldr1',++    -- ** Special folds+    BS.concat,+    BS.concatMap,+    BS.any,+    BS.all,+    BS.maximum,+    BS.minimum,++    -- * Building ByteStrings+    -- ** Scans+    BS.scanl,+    BS.scanl1,+    BS.scanr,+    BS.scanr1,++    -- ** Accumulating maps+    BS.mapAccumL,+    BS.mapAccumR,++    -- ** Generating and unfolding ByteStrings+    BS.replicate,+    BS.unfoldr,+    BS.unfoldrN,++    -- * Substrings++    -- ** Breaking strings+    BS.take,+    BS.takeEnd,+    BS.drop,+    BS.dropEnd,+    BS.splitAt,+    BS.takeWhile,+    BS.takeWhileEnd,+    BS.dropWhile,+    BS.dropWhileEnd,+    BS.span,+    BS.spanEnd,+    BS.break,+    BS.breakEnd,+    BS.group,+    BS.groupBy,+    BS.inits,+    BS.tails,+    BS.initsNE,+    BS.tailsNE,+    BS.stripPrefix,+    BS.stripSuffix,++    -- ** Breaking into many substrings+    BS.split,+    BS.splitWith,++    -- * Predicates+    BS.isPrefixOf,+    BS.isSuffixOf,+    BS.isInfixOf,++    -- ** Encoding validation+    BS.isValidUtf8,++    -- ** Search for arbitrary substrings+    BS.breakSubstring,++    -- * Searching ByteStrings++    -- ** Searching by equality+    BS.elem,+    BS.notElem,++    -- ** Searching with a predicate+    BS.find,+    BS.filter,+    BS.partition,++    -- * Indexing ByteStrings+    BS.index,+    BS.indexMaybe,+    (BS.!?),+    BS.elemIndex,+    BS.elemIndices,+    BS.elemIndexEnd,+    BS.findIndex,+    BS.findIndices,+    BS.findIndexEnd,+    BS.count,++    -- * Zipping and unzipping ByteStrings+    BS.zip,+    BS.zipWith,+    BS.packZipWith,+    BS.unzip,++    -- * Ordered ByteStrings+    BS.sort,++    -- * Low level conversions+    -- ** Copying ByteStrings+    BS.copy,++    -- ** Packing 'CString's and pointers+    packCString,+    packCStringLen,++    -- * I\/O with 'ByteString's++    -- ** Standard input and output+    getLine,+    getContents,+    putStr,+    interact,++    -- ** Files+    readFile,+    writeFile,+    appendFile,++    -- ** I\/O with Handles+    hGetLine,+    hGetContents,+    hGet,+    hGetSome,+    hGetNonBlocking,+    hPut,+    hPutNonBlocking,+  ) where++import qualified Control.Exception             as CE+import qualified Data.ByteString               as BS+import qualified Data.Text                     as Text+import qualified Data.Text.Encoding            as Text+import           GHC.Foreign                   (CString, CStringLen)+import           GHC.IO.Handle                 (Handle)+import           HaskellWorks.Polysemy.Prelude++import           Polysemy+import           Polysemy.Error+import           Polysemy.Log++fromFilePath :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ByteString+fromFilePath filePath = withFrozenCallStack $ do+  debug $ "Call to: fromFilePath " <> Text.pack filePath+  r <- embed $ CE.try @IOException $ BS.fromFilePath filePath+  fromEither r++toFilePath :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => ByteString+  -> Sem r FilePath+toFilePath bs = withFrozenCallStack $ do+  debug $ "Call to: toFilePath " <> Text.decodeUtf8 bs+  r <- embed $ CE.try @IOException $ BS.toFilePath bs+  fromEither r++packCString :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => CString+  -> Sem r ByteString+packCString cs = withFrozenCallStack $ do+  debug $ "Call to: packCString " <> tshow cs+  r <- embed $ CE.try @IOException $ BS.packCString cs+  fromEither r++packCStringLen :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => CStringLen+  -> Sem r ByteString+packCStringLen csl = withFrozenCallStack $ do+  debug $ "Call to: packCStringLen " <> tshow csl+  r <- embed $ CE.try @IOException $ BS.packCStringLen csl+  fromEither r++getContents :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r ByteString+getContents = withFrozenCallStack $ do+  debug "Call to: getContents"+  r <- embed $ CE.try @IOException BS.getContents+  fromEither r++getLine :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r ByteString+getLine = withFrozenCallStack $ do+  debug "Call to: getLine"+  r <- embed $ CE.try @IOException BS.getLine+  fromEither r++putStr :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => ByteString+  -> Sem r ()+putStr bs = withFrozenCallStack $ do+  debug $ "Call to: putStr " <> Text.decodeUtf8 bs+  r <- embed $ CE.try @IOException $ BS.putStr bs+  fromEither r++interact :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => (ByteString -> ByteString)+  -> Sem r ()+interact f = withFrozenCallStack $ do+  debug "Call to: interact"+  r <- embed $ CE.try @IOException $ BS.interact f+  fromEither r++readFile :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ByteString+readFile filePath = withFrozenCallStack $ do+  info $ "Reading bytestring from file: " <> Text.pack filePath+  r <- embed $ CE.try @IOException $ BS.readFile filePath+  fromEither r++writeFile :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> ByteString+  -> Sem r ()+writeFile filePath bs = withFrozenCallStack $ do+  info $ "Writing bytestring to file: " <> Text.pack filePath+  r <- embed $ CE.try @IOException $ BS.writeFile filePath bs+  fromEither r++appendFile :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> ByteString+  -> Sem r ()+appendFile filePath bs = withFrozenCallStack $ do+  info $ "Appending bytestring to file: " <> Text.pack filePath+  r <- embed $ CE.try @IOException $ BS.appendFile filePath bs+  fromEither r++hGetLine :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r ByteString+hGetLine h = withFrozenCallStack $ do+  debug "Call to: hGetLine"+  r <- embed $ CE.try @IOException $ BS.hGetLine h+  fromEither r++hGetContents :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r ByteString+hGetContents h = withFrozenCallStack $ do+  debug "Call to: hGetContents"+  r <- embed $ CE.try @IOException $ BS.hGetContents h+  fromEither r++hGet :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Int+  -> Sem r ByteString+hGet h n = withFrozenCallStack $ do+  debug "Call to: hGet"+  r <- embed $ CE.try @IOException $ BS.hGet h n+  fromEither r++hGetSome :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Int+  -> Sem r ByteString+hGetSome h n = withFrozenCallStack $ do+  debug "Call to: hGetSome"+  r <- embed $ CE.try @IOException $ BS.hGetSome h n+  fromEither r++hGetNonBlocking :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Int+  -> Sem r ByteString+hGetNonBlocking h n = withFrozenCallStack $ do+  debug "Call to: hGetNonBlocking"+  r <- embed $ CE.try @IOException $ BS.hGetNonBlocking h n+  fromEither r++hPut :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> ByteString+  -> Sem r ()+hPut h bs = withFrozenCallStack $ do+  debug "Call to: hPut"+  r <- embed $ CE.try @IOException $ BS.hPut h bs+  fromEither r++hPutNonBlocking :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> ByteString+  -> Sem r ByteString+hPutNonBlocking h bs = withFrozenCallStack $ do+  debug "Call to: hPutNonBlocking"+  r <- embed $ CE.try @IOException $ BS.hPutNonBlocking h bs+  fromEither r
+ core/HaskellWorks/Polysemy/Data/Either.hs view
@@ -0,0 +1,15 @@+module HaskellWorks.Polysemy.Data.Either+  ( onLeftThrow+  ) where++import           HaskellWorks.Polysemy.Prelude++import           Polysemy+import           Polysemy.Error++onLeftThrow :: ()+  => Member (Error e) r+  => Sem r (Either e a)+  -> Sem r a+onLeftThrow f =+  f >>= either throw pure
+ core/HaskellWorks/Polysemy/Data/Text.hs view
@@ -0,0 +1,144 @@+module HaskellWorks.Polysemy.Data.Text+  ( Text++  -- * Creation and elimination+  , pack+  , unpack+  , singleton+  , empty++  -- * Basic interface+  , length+  , compareLength+  , null++  -- * Transformations+  , map+  , intercalate+  , intersperse+  , transpose+  , reverse+  , replace++  -- ** Case conversion+  -- $case+  , toCaseFold+  , toLower+  , toUpper+  , toTitle++  -- ** Justification+  , justifyLeft+  , justifyRight+  , center++  -- * Folds+  , foldl+  , foldl'+  , foldl1+  , foldl1'+  , foldr+  , foldr'+  , foldr1++  -- ** Special folds+  , concat+  , concatMap+  , any+  , all+  , maximum+  , minimum+  , isAscii++  -- * Construction++  -- ** Scans+  , scanl+  , scanl1+  , scanr+  , scanr1++  -- ** Accumulating maps+  , mapAccumL+  , mapAccumR++  -- ** Generation and unfolding+  , replicate+  , unfoldr+  , unfoldrN++  -- * Substrings++  -- ** Breaking strings+  , take+  , takeEnd+  , drop+  , dropEnd+  , takeWhile+  , takeWhileEnd+  , dropWhile+  , dropWhileEnd+  , dropAround+  , strip+  , stripStart+  , stripEnd+  , splitAt+  , breakOn+  , breakOnEnd+  , break+  , span+  , spanM+  , spanEndM+  , group+  , groupBy+  , inits+  , tails++  -- ** Breaking into many substrings+  -- $split+  , splitOn+  , split+  , chunksOf++  -- ** Breaking into lines and words+  , lines+  --, lines'+  , words+  , unlines+  , unwords++  -- * Predicates+  , isPrefixOf+  , isSuffixOf+  , isInfixOf++  -- ** View patterns+  , stripPrefix+  , stripSuffix+  , commonPrefixes++  -- * Searching+  , filter+  , breakOnAll+  , find+  , elem+  , partition++  -- , findSubstring++  -- * Indexing+  -- $index+  , index+  , findIndex+  , count++  -- * Zipping+  , zip+  , zipWith++  -- * File reading+  , readFile++  ) where++import           HaskellWorks.Polysemy.Data.Text.Strict
+ core/HaskellWorks/Polysemy/Data/Text/Lazy.hs view
@@ -0,0 +1,164 @@+module HaskellWorks.Polysemy.Data.Text.Lazy+  ( LT.Text++  -- * Creation and elimination+  , LT.pack+  , LT.unpack+  , LT.singleton+  , LT.empty++  -- * Basic interface+  , LT.length+  , LT.compareLength++  -- * Transformations+  , LT.map+  , LT.intercalate+  , LT.intersperse+  , LT.transpose+  , LT.reverse+  , LT.replace++  -- ** Case conversion+  -- $case+  , LT.toCaseFold+  , LT.toLower+  , LT.toUpper+  , LT.toTitle++  -- ** Justification+  , LT.justifyLeft+  , LT.justifyRight+  , LT.center++  -- * Folds+  , LT.foldl+  , LT.foldl'+  , LT.foldl1+  , LT.foldl1'+  , LT.foldr+  , LT.foldr1++  -- ** Special folds+  , LT.concat+  , LT.concatMap+  , LT.any+  , LT.all+  , LT.maximum+  , LT.minimum+  , LT.isAscii++  -- * Construction++  -- ** Scans+  , LT.scanl+  , LT.scanl1+  , LT.scanr+  , LT.scanr1++  -- ** Accumulating maps+  , LT.mapAccumL+  , LT.mapAccumR++  -- ** Generation and unfolding+  , LT.replicate+  , LT.unfoldr+  , LT.unfoldrN++  -- * Substrings++  -- ** Breaking strings+  , LT.take+  , LT.takeEnd+  , LT.drop+  , LT.dropEnd+  , LT.takeWhile+  , LT.takeWhileEnd+  , LT.dropWhile+  , LT.dropWhileEnd+  , LT.dropAround+  , LT.strip+  , LT.stripStart+  , LT.stripEnd+  , LT.splitAt+  , LT.breakOn+  , LT.breakOnEnd+  , LT.break+  , LT.span+  , LT.spanM+  , LT.spanEndM+  , LT.group+  , LT.groupBy+  , LT.inits+  , LT.tails++  -- ** Breaking into many substrings+  -- $split+  , LT.splitOn+  , LT.split+  , LT.chunksOf++  -- ** Breaking into lines and words+  , LT.lines+  --, LT.lines'+  , LT.words+  , LT.unlines+  , LT.unwords++  -- * Predicates+  , LT.isPrefixOf+  , LT.isSuffixOf+  , LT.isInfixOf++  -- ** View patterns+  , LT.stripPrefix+  , LT.stripSuffix+  , LT.commonPrefixes++  -- * Searching+  , LT.filter+  , LT.breakOnAll+  , LT.find+  , LT.elem+  , LT.partition++  -- , LT.findSubstring++  -- * Indexing+  -- $index+  , LT.index+  , LT.count++  -- * Zipping+  , LT.zip+  , LT.zipWith++  -- * File reading+  , readFile++  ) where++import qualified Control.Exception             as CE+import qualified Data.Text                     as T+import qualified Data.Text.Lazy                as LT+import qualified Data.Text.Lazy.IO             as LT+import qualified GHC.Stack                     as GHC+import           HaskellWorks.Polysemy.Prelude++import           Polysemy+import           Polysemy.Error+import           Polysemy.Log++-- | Read the contents of the 'filePath' file.+readFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r LT.Text+readFile filePath =+  GHC.withFrozenCallStack $ do+    info $ "Reading text file: " <> T.pack filePath+    r <- embed $ CE.try @IOException $ LT.readFile filePath+    fromEither r
+ core/HaskellWorks/Polysemy/Data/Text/Strict.hs view
@@ -0,0 +1,164 @@+module HaskellWorks.Polysemy.Data.Text.Strict+  ( T.Text++  -- * Creation and elimination+  , T.pack+  , T.unpack+  , T.singleton+  , T.empty++  -- * Basic interface+  , T.length+  , T.compareLength+  , T.null++  -- * Transformations+  , T.map+  , T.intercalate+  , T.intersperse+  , T.transpose+  , T.reverse+  , T.replace++  -- ** Case conversion+  -- $case+  , T.toCaseFold+  , T.toLower+  , T.toUpper+  , T.toTitle++  -- ** Justification+  , T.justifyLeft+  , T.justifyRight+  , T.center++  -- * Folds+  , T.foldl+  , T.foldl'+  , T.foldl1+  , T.foldl1'+  , T.foldr+  , T.foldr'+  , T.foldr1++  -- ** Special folds+  , T.concat+  , T.concatMap+  , T.any+  , T.all+  , T.maximum+  , T.minimum+  , T.isAscii++  -- * Construction++  -- ** Scans+  , T.scanl+  , T.scanl1+  , T.scanr+  , T.scanr1++  -- ** Accumulating maps+  , T.mapAccumL+  , T.mapAccumR++  -- ** Generation and unfolding+  , T.replicate+  , T.unfoldr+  , T.unfoldrN++  -- * Substrings++  -- ** Breaking strings+  , T.take+  , T.takeEnd+  , T.drop+  , T.dropEnd+  , T.takeWhile+  , T.takeWhileEnd+  , T.dropWhile+  , T.dropWhileEnd+  , T.dropAround+  , T.strip+  , T.stripStart+  , T.stripEnd+  , T.splitAt+  , T.breakOn+  , T.breakOnEnd+  , T.break+  , T.span+  , T.spanM+  , T.spanEndM+  , T.group+  , T.groupBy+  , T.inits+  , T.tails++  -- ** Breaking into many substrings+  -- $split+  , T.splitOn+  , T.split+  , T.chunksOf++  -- ** Breaking into lines and words+  , T.lines+  --, T.lines'+  , T.words+  , T.unlines+  , T.unwords++  -- * Predicates+  , T.isPrefixOf+  , T.isSuffixOf+  , T.isInfixOf++  -- ** View patterns+  , T.stripPrefix+  , T.stripSuffix+  , T.commonPrefixes++  -- * Searching+  , T.filter+  , T.breakOnAll+  , T.find+  , T.elem+  , T.partition++  -- * Indexing+  -- $index+  , T.index+  , T.findIndex+  , T.count++  -- * Zipping+  , T.zip+  , T.zipWith++  -- * File reading+  , readFile++  ) where++import qualified Control.Exception             as CE+import qualified Data.Text                     as T+import qualified Data.Text.IO                  as T+import qualified GHC.Stack                     as GHC+import           HaskellWorks.Polysemy.Prelude++import           Polysemy+import           Polysemy.Error+import           Polysemy.Log++-- | Read the contents of the 'filePath' file.+readFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r Text+readFile filePath =+  GHC.withFrozenCallStack $ do+    info $ "Reading text file: " <> T.pack filePath+    r <- embed $ CE.try @IOException $ T.readFile filePath+    fromEither r
+ core/HaskellWorks/Polysemy/Error.hs view
@@ -0,0 +1,20 @@+module HaskellWorks.Polysemy.Error+  ( onLeft+  , onNothing+  , onLeftM+  , onNothingM+  ) where++import           HaskellWorks.Polysemy.Prelude++onLeft :: Monad m => (e -> m a) -> Either e a -> m a+onLeft f = either f pure++onNothing :: Monad m => m b -> Maybe b -> m b+onNothing h = maybe h return++onLeftM :: Monad m => (e -> m a) -> m (Either e a) -> m a+onLeftM f action = onLeft f =<< action++onNothingM :: Monad m => m b -> m (Maybe b) -> m b+onNothingM h f = onNothing h =<< f
+ core/HaskellWorks/Polysemy/Prelude.hs view
@@ -0,0 +1,167 @@+module HaskellWorks.Polysemy.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+  , ($!)+  , ($)+  , (&)+  , (.)+  , (</>)++  , 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_++  , Monad(..)+  , MonadFail(..)+  , MonadPlus(..)+  , Applicative(..)+  , Alternative(..)+  , Contravariant(..)+  , Divisible(..)+  , Functor(..)+  , Bifunctor(..)+  , Semigroup(..)+  , Monoid(..)+  , Foldable(..)+  , Traversable(..)++  , IO++  , CallStack+  , HasCallStack+  , withFrozenCallStack++  , Generic++  , IOException+  , SomeException(..)+  ) where++import           Control.Applicative+import           Control.Exception+import           Control.Monad+import           Data.Bifunctor+import           Data.Bool+import           Data.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+import           Data.Traversable+import           Data.Tuple+import           Data.Void+import           Data.Word+import           GHC.Base+import           GHC.Generics+import           GHC.Num+import           GHC.Stack+import           System.FilePath+import           Text.Show++import qualified Data.Text                            as T++tshow :: Show a => a -> Text+tshow = T.pack . show
+ core/HaskellWorks/Polysemy/String.hs view
@@ -0,0 +1,20 @@+module HaskellWorks.Polysemy.String+  ( ToString(..)+  ) where+++import qualified Data.Text                     as T+import qualified Data.Text.Lazy                as LT+import           HaskellWorks.Polysemy.Prelude++class ToString a where+  toString :: a -> String++instance ToString String where+  toString = id++instance ToString Text where+  toString = T.unpack++instance ToString LT.Text where+  toString = LT.unpack
+ core/HaskellWorks/Polysemy/System/Directory.hs view
@@ -0,0 +1,693 @@+module HaskellWorks.Polysemy.System.Directory+  ( D.XdgDirectory(..),+    D.XdgDirectoryList(..),++    -- * Actions on directories+    createDirectory,+    createDirectoryIfMissing,+    removeDirectory,+    removeDirectoryRecursive,+    removePathForcibly,+    renameDirectory,+    listDirectory,+    getDirectoryContents,++    -- ** Current working directory+    getCurrentDirectory,+    setCurrentDirectory,+    withCurrentDirectory,++    -- * Pre-defined directories+    getHomeDirectory,+    getXdgDirectory,+    getXdgDirectoryList,+    getAppUserDataDirectory,+    getUserDocumentsDirectory,+    getTemporaryDirectory,++    -- * Actions on files+    removeFile,+    renameFile,+    renamePath,+    copyFile,+    copyFileWithMetadata,+    getFileSize,++    canonicalizePath,+    makeAbsolute,+    makeRelativeToCurrentDirectory,++    -- * Existence tests+    doesPathExist,+    doesFileExist,+    doesDirectoryExist,++    findExecutable,+    findExecutables,+    findExecutablesInDirectories,+    findFile,+    findFiles,+    findFileWith,+    findFilesWith,+    D.exeExtension,++    -- * Symbolic links+    createFileLink,+    createDirectoryLink,+    removeDirectoryLink,+    pathIsSymbolicLink,+    getSymbolicLinkTarget,++    -- -- * Permissions++    D.Permissions,+    D.emptyPermissions,+    D.readable,+    D.writable,+    D.executable,+    D.searchable,+    D.setOwnerReadable,+    D.setOwnerWritable,+    D.setOwnerExecutable,+    D.setOwnerSearchable,++    getPermissions,+    setPermissions,+    copyPermissions,++    -- * Timestamps+    getAccessTime,+    getModificationTime,+    setAccessTime,+    setModificationTime,++    -- -- * Deprecated+    --   isSymbolicLink,+  ) where++import qualified Control.Exception             as CE+import qualified GHC.Stack                     as GHC+import           HaskellWorks.Polysemy.Prelude++import           Data.Time.Clock               (UTCTime)+import           Polysemy+import           Polysemy.Error+import           Polysemy.Log+import           Polysemy.Resource+import qualified System.Directory              as D+import           System.Directory              (XdgDirectory (..),+                                                XdgDirectoryList (..))++createDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ()+createDirectory fp = GHC.withFrozenCallStack $ do+  info $ "Calling: createDirectory " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.createDirectory fp)++createDirectoryIfMissing :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Bool+  -> FilePath+  -> Sem r ()+createDirectoryIfMissing includeParents fp = GHC.withFrozenCallStack $ do+  info $ "Calling: createDirectoryIfMissing " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.createDirectoryIfMissing includeParents fp)++removeDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ()+removeDirectory fp = GHC.withFrozenCallStack $ do+  info $ "Calling: removeDirectory " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.removeDirectory fp)++removeDirectoryRecursive :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ()+removeDirectoryRecursive fp = GHC.withFrozenCallStack $ do+  info $ "Calling: removeDirectoryRecursive " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.removeDirectoryRecursive fp)++removePathForcibly :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ()+removePathForcibly fp = GHC.withFrozenCallStack $ do+  info $ "Calling: removePathForcibly " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.removePathForcibly fp)++renameDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+renameDirectory old new = GHC.withFrozenCallStack $ do+  info $ "Calling: renameDirectory " <> tshow old <> " " <> tshow new++  fromEither =<< embed (CE.try @IOException $ D.renameDirectory old new)++listDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r [FilePath]+listDirectory fp = GHC.withFrozenCallStack $ do+  info $ "Calling: listDirectory " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.listDirectory fp)++getDirectoryContents :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r [FilePath]+getDirectoryContents fp = GHC.withFrozenCallStack $ do+  info $ "Calling: getDirectoryContents " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.getDirectoryContents fp)++getCurrentDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r FilePath+getCurrentDirectory = GHC.withFrozenCallStack $ do+  info "Calling: getCurrentDirectory"++  fromEither =<< embed (CE.try @IOException D.getCurrentDirectory)++setCurrentDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ()+setCurrentDirectory fp = GHC.withFrozenCallStack $ do+  info $ "Calling: setCurrentDirectory " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.setCurrentDirectory fp)++withCurrentDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Resource r+  => Member Log r+  => FilePath+  -> Sem r ()+  -> Sem r ()+withCurrentDirectory fp f = GHC.withFrozenCallStack $ do+  info $ "Calling: withCurrentDirectory " <> tshow fp++  bracket getCurrentDirectory setCurrentDirectory $ const $ setCurrentDirectory fp >> f++getHomeDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r FilePath+getHomeDirectory = GHC.withFrozenCallStack $ do+  info "Calling: getHomeDirectory"++  fromEither =<< embed (CE.try @IOException D.getHomeDirectory)++getXdgDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => XdgDirectory+  -> FilePath+  -> Sem r FilePath+getXdgDirectory dir fp = GHC.withFrozenCallStack $ do+  info $ "Calling: getXdgDirectory " <> tshow dir++  fromEither =<< embed (CE.try @IOException $ D.getXdgDirectory dir fp)++getXdgDirectoryList :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => XdgDirectoryList+  -> Sem r [FilePath]+getXdgDirectoryList list = GHC.withFrozenCallStack $ do+  info $ "Calling: getXdgDirectoryList " <> tshow list++  fromEither =<< embed (CE.try @IOException $ D.getXdgDirectoryList list)++getAppUserDataDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r FilePath+getAppUserDataDirectory fp = GHC.withFrozenCallStack $ do+  info $ "Calling: getAppUserDataDirectory " <> tshow fp++  fromEither =<< embed (CE.try @IOException $ D.getAppUserDataDirectory fp)++getUserDocumentsDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r FilePath+getUserDocumentsDirectory = GHC.withFrozenCallStack $ do+  info "Calling: getUserDocumentsDirectory"++  fromEither =<< embed (CE.try @IOException D.getUserDocumentsDirectory)++getTemporaryDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r FilePath+getTemporaryDirectory = GHC.withFrozenCallStack $ do+  info "Calling: getTemporaryDirectory"++  fromEither =<< embed (CE.try @IOException D.getTemporaryDirectory)++removeFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ()+removeFile fp = GHC.withFrozenCallStack $ do+  info "Calling: removeFile"++  fromEither =<< embed (CE.try @IOException $ D.removeFile fp)++renameFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+renameFile old new = GHC.withFrozenCallStack $ do+  info "Calling: renameFile"++  fromEither =<< embed (CE.try @IOException $ D.renameFile old new)++renamePath :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+renamePath old new = GHC.withFrozenCallStack $ do+  info "Calling: renamePath"++  fromEither =<< embed (CE.try @IOException $ D.renamePath old new)++copyFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+copyFile src dst = GHC.withFrozenCallStack $ do+  info "Calling: copyFile"++  fromEither =<< embed (CE.try @IOException $ D.copyFile src dst)++copyFileWithMetadata :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+copyFileWithMetadata src dst = GHC.withFrozenCallStack $ do+  info "Calling: copyFileWithMetadata"++  fromEither =<< embed (CE.try @IOException $ D.copyFileWithMetadata src dst)++getFileSize :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r Integer+getFileSize fp = GHC.withFrozenCallStack $ do+  info "Calling: getFileSize"++  fromEither =<< embed (CE.try @IOException $ D.getFileSize fp)++canonicalizePath :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r FilePath+canonicalizePath fp = GHC.withFrozenCallStack $ do+  info "Calling: canonicalizePath"++  fromEither =<< embed (CE.try @IOException $ D.canonicalizePath fp)++makeAbsolute :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r FilePath+makeAbsolute fp = GHC.withFrozenCallStack $ do+  info "Calling: makeAbsolute"++  fromEither =<< embed (CE.try @IOException $ D.makeAbsolute fp)++makeRelativeToCurrentDirectory :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r FilePath+makeRelativeToCurrentDirectory fp = GHC.withFrozenCallStack $ do+  info "Calling: makeRelativeToCurrentDirectory"++  fromEither =<< embed (CE.try @IOException $ D.makeRelativeToCurrentDirectory fp)++doesPathExist :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r Bool+doesPathExist fp = GHC.withFrozenCallStack $ do+  info "Calling: doesPathExist"++  fromEither =<< embed (CE.try @IOException $ D.doesPathExist fp)++doesFileExist :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r Bool+doesFileExist fp = GHC.withFrozenCallStack $ do+  info "Calling: doesFileExist"++  fromEither =<< embed (CE.try @IOException $ D.doesFileExist fp)++doesDirectoryExist :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r Bool+doesDirectoryExist fp = GHC.withFrozenCallStack $ do+  info "Calling: doesDirectoryExist"++  fromEither =<< embed (CE.try @IOException $ D.doesDirectoryExist fp)++findExecutable :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => String+  -> Sem r (Maybe FilePath)+findExecutable fp = GHC.withFrozenCallStack $ do+  info "Calling: findExecutable"++  fromEither =<< embed (CE.try @IOException $ D.findExecutable fp)++findExecutables :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => String+  -> Sem r [FilePath]+findExecutables fp = GHC.withFrozenCallStack $ do+  info "Calling: findExecutables"++  fromEither =<< embed (CE.try @IOException $ D.findExecutables fp)++findExecutablesInDirectories :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => [FilePath]+  -> String+  -> Sem r [FilePath]+findExecutablesInDirectories fps fp = GHC.withFrozenCallStack $ do+  info "Calling: findExecutablesInDirectories"++  fromEither =<< embed (CE.try @IOException $ D.findExecutablesInDirectories fps fp)++findFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => [FilePath]+  -> String+  -> Sem r (Maybe FilePath)+findFile fps fp = GHC.withFrozenCallStack $ do+  info "Calling: findFile"++  fromEither =<< embed (CE.try @IOException $ D.findFile fps fp)++findFiles :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => [FilePath]+  -> String+  -> Sem r [FilePath]+findFiles fps fp = GHC.withFrozenCallStack $ do+  info "Calling: findFiles"++  fromEither =<< embed (CE.try @IOException $ D.findFiles fps fp)++findFileWith :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => (FilePath -> IO Bool)+  -> [FilePath]+  -> String+  -> Sem r (Maybe FilePath)+findFileWith p fps fp = GHC.withFrozenCallStack $ do+  info "Calling: findFileWith"++  fromEither =<< embed (CE.try @IOException $ D.findFileWith p fps fp)++findFilesWith :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => (FilePath -> IO Bool)+  -> [FilePath]+  -> String+  -> Sem r [FilePath]+findFilesWith p fps fp = GHC.withFrozenCallStack $ do+  info "Calling: findFilesWith"++  fromEither =<< embed (CE.try @IOException $ D.findFilesWith p fps fp)++createFileLink :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+createFileLink old new = GHC.withFrozenCallStack $ do+  info "Calling: createFileLink"++  fromEither =<< embed (CE.try @IOException $ D.createFileLink old new)++createDirectoryLink :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+createDirectoryLink old new = GHC.withFrozenCallStack $ do+  info "Calling: createDirectoryLink"++  fromEither =<< embed (CE.try @IOException $ D.createDirectoryLink old new)++removeDirectoryLink :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r ()+removeDirectoryLink fp = GHC.withFrozenCallStack $ do+  info "Calling: removeDirectoryLink"++  fromEither =<< embed (CE.try @IOException $ D.removeDirectoryLink fp)++pathIsSymbolicLink :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r Bool+pathIsSymbolicLink fp = GHC.withFrozenCallStack $ do+  info "Calling: pathIsSymbolicLink"++  fromEither =<< embed (CE.try @IOException $ D.pathIsSymbolicLink fp)++getSymbolicLinkTarget :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r FilePath+getSymbolicLinkTarget fp = GHC.withFrozenCallStack $ do+  info "Calling: getSymbolicLinkTarget"++  fromEither =<< embed (CE.try @IOException $ D.getSymbolicLinkTarget fp)++getPermissions :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r D.Permissions+getPermissions fp = GHC.withFrozenCallStack $ do+  info "Calling: getPermissions"++  fromEither =<< embed (CE.try @IOException $ D.getPermissions fp)++setPermissions :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> D.Permissions+  -> Sem r ()+setPermissions fp p = GHC.withFrozenCallStack $ do+  info "Calling: setPermissions"++  fromEither =<< embed (CE.try @IOException $ D.setPermissions fp p)++copyPermissions :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> FilePath+  -> Sem r ()+copyPermissions src dst = GHC.withFrozenCallStack $ do+  info "Calling: copyPermissions"++  fromEither =<< embed (CE.try @IOException $ D.copyPermissions src dst)++getAccessTime :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r UTCTime+getAccessTime fp = GHC.withFrozenCallStack $ do+  info "Calling: getAccessTime"++  fromEither =<< embed (CE.try @IOException $ D.getAccessTime fp)++getModificationTime :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r UTCTime+getModificationTime fp = GHC.withFrozenCallStack $ do+  info "Calling: getModificationTime"++  fromEither =<< embed (CE.try @IOException $ D.getModificationTime fp)++setAccessTime :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> UTCTime+  -> Sem r ()+setAccessTime fp t = GHC.withFrozenCallStack $ do+  info "Calling: setAccessTime"++  fromEither =<< embed (CE.try @IOException $ D.setAccessTime fp t)++setModificationTime :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> UTCTime+  -> Sem r ()+setModificationTime fp t = GHC.withFrozenCallStack $ do+  info "Calling: setModificationTime"++  fromEither =<< embed (CE.try @IOException $ D.setModificationTime fp t)
+ core/HaskellWorks/Polysemy/System/Environment.hs view
@@ -0,0 +1,91 @@+module HaskellWorks.Polysemy.System.Environment+  ( getArgs,+    getProgName,+    executablePath,+    getExecutablePath,+    getEnv,+    lookupEnv,+    setEnv,+    unsetEnv,+    getEnvironment,+  ) where++import qualified Control.Exception             as CE+import           HaskellWorks.Polysemy.Prelude+import           Polysemy+import           Polysemy.Error+import qualified System.Environment            as IO++getArgs :: ()+  => HasCallStack+  => Member (Embed IO) r+  => Sem r [String]+getArgs = withFrozenCallStack $+  embed IO.getArgs++getProgName :: ()+  => HasCallStack+  => Member (Embed IO) r+  => Sem r String+getProgName = withFrozenCallStack $+  embed IO.getProgName++executablePath :: ()+  => HasCallStack+  => Member (Embed IO) r+  => Maybe (Sem r (Maybe FilePath))+executablePath = withFrozenCallStack $+  embed <$> IO.executablePath++getExecutablePath :: ()+  => HasCallStack+  => Member (Embed IO) r+  => Sem r String+getExecutablePath = withFrozenCallStack $+  embed IO.getExecutablePath++getEnv :: ()+  => HasCallStack+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> Sem r String+getEnv name = withFrozenCallStack $ do+  r <- embed $ CE.try @IOException $ IO.getEnv name+  fromEither r++lookupEnv :: ()+  => HasCallStack+  => Member (Embed IO) r+  => String+  -> Sem r (Maybe String)+lookupEnv name = withFrozenCallStack $+  embed $ IO.lookupEnv name++setEnv :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => String+  -> String+  -> Sem r ()+setEnv name value = withFrozenCallStack $ do+  r <- embed $ CE.try @IOException $ IO.setEnv name value+  fromEither r++unsetEnv :: ()+  => HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => String+  -> Sem r ()+unsetEnv name = withFrozenCallStack $ do+  r <- embed $ CE.try @IOException $ IO.unsetEnv name+  fromEither r++getEnvironment :: ()+  => HasCallStack+  => Member (Embed IO) r+  => Sem r [(String, String)]+getEnvironment = withFrozenCallStack $+  embed IO.getEnvironment
+ core/HaskellWorks/Polysemy/System/IO.hs view
@@ -0,0 +1,863 @@+module HaskellWorks.Polysemy.System.IO+  ( IO.BufferMode,+    IO.FilePath,+    IO.Handle,+    IO.HandlePosn,+    IO.IO,+    IO.IOMode,+    IO.NewlineMode,+    IO.SeekMode,+    IO.TextEncoding,++    String,++    IO.stdin,+    IO.stdout,+    IO.stderr,++    withFile,+    hClose,+    openFile,+    readFile,+    appendFile,+    writeFile,+    hFileSize,+    hSetFileSize,+    hIsEOF,+    isEOF,+    hSetBuffering,+    hGetBuffering,+    hFlush,+    hGetPosn,+    hSetPosn,+    hSeek,+    hTell,+    hIsOpen,+    hIsClosed,+    hIsReadable,+    hIsWritable,+    hIsSeekable,+    hIsTerminalDevice,+    hSetEcho,+    hGetEcho,+    hShow,+    hWaitForInput,+    hReady,+    hGetChar,+    hGetLine,+    hLookAhead,+    hGetContents,+    hGetContents',+    hPutChar,+    hPutStr,+    hPutStrLn,+    hPrint,++    interact,+    putChar,+    putStr,+    putStrLn,+    print,+    getChar,+    getLine,+    getContents,+    getContents',+    readIO,+    readLn,++    withBinaryFile,+    openBinaryFile,++    hPutBuf,+    hGetBuf,+    hGetBufSome,+    hPutBufNonBlocking,+    hGetBufNonBlocking,+    openTempFile,+    openBinaryTempFile,+    openTempFileWithDefaultPermissions,+    openBinaryTempFileWithDefaultPermissions,+    hSetEncoding,+    hGetEncoding,++    IO.latin1,+    IO.utf8,+    IO.utf8_bom,+    IO.utf16,+    IO.utf16le,+    IO.utf16be,+    IO.utf32,+    IO.utf32le,+    IO.utf32be,+    IO.localeEncoding,+    IO.char8,++    mkTextEncoding,+    hSetNewlineMode,++    IO.nativeNewline,+    IO.noNewlineTranslation,+    IO.universalNewlineMode,+    IO.nativeNewlineMode,+  ) where++import qualified Control.Exception             as CE+import qualified Data.Text                     as Text+import           Foreign.Ptr                   (Ptr)+import qualified GHC.Stack                     as GHC+import           HaskellWorks.Polysemy.Prelude+import qualified System.IO                     as IO+import           System.IO                     (BufferMode, Handle, HandlePosn,+                                                IOMode, NewlineMode, SeekMode,+                                                TextEncoding)+import           Text.Read++import           Polysemy+import           Polysemy.Error+import           Polysemy.Log+import           Polysemy.Resource++-- | Open a file handle and run an action, closing the handle when done.+withFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Resource r+  => Member Log r+  => FilePath+  -> IOMode+  -> (Handle -> Sem r a)+  -> Sem r a+withFile fp mode f = GHC.withFrozenCallStack $ do+  info $ "Calling: withFile " <> tshow fp <> " " <> tshow mode++  bracket (openFile fp mode) hClose f++-- | Open a file handle and run an action, closing the handle when done.+withBinaryFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Resource r+  => Member Log r+  => FilePath+  -> IOMode+  -> (Handle -> Sem r a)+  -> Sem r a+withBinaryFile fp mode f = GHC.withFrozenCallStack $ do+  info $ "Calling: withBinaryFile " <> tshow fp <> " " <> tshow mode++  bracket (openBinaryFile fp mode) hClose f++-- | Open a file handle.+openFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> IOMode+  -> Sem r Handle+openFile fp mode = GHC.withFrozenCallStack $ do+  r <- embed $ CE.try @IOException $ IO.openFile fp mode+  case r of+    Left e  -> do+      error $ "Failed to open file: " <> Text.pack fp+      throw e+    Right h -> do+      info $ "Opened file: " <> Text.pack fp+      pure h++-- | Open a file handle.+openBinaryFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> IOMode+  -> Sem r Handle+openBinaryFile fp mode = GHC.withFrozenCallStack $ do+  r <- embed $ CE.try @IOException $ IO.openBinaryFile fp mode+  case r of+    Left e  -> do+      error $ "Failed to open file: " <> Text.pack fp+      throw e+    Right h -> do+      info $ "Opened file: " <> Text.pack fp+      pure h++-- | Close the file handle.+hClose :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r ()+hClose h = GHC.withFrozenCallStack $ do+  info $ "Closing file: " <> tshow h+  fromEither =<< embed (CE.try @IOException $ IO.hClose h)++-- | Read a file as a string.+readFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> Sem r String+readFile filePath = GHC.withFrozenCallStack $ do+  info $ "Reading string file: " <> Text.pack filePath+  fromEither =<< embed (CE.try @IOException $ IO.readFile filePath)++writeFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> String+  -> Sem r ()+writeFile fp contents = GHC.withFrozenCallStack $ do+  info $ "Write string to file: " <> Text.pack fp+  fromEither =<< embed (CE.try @IOException $ IO.writeFile fp contents)++appendFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> String+  -> Sem r ()+appendFile fp contents = GHC.withFrozenCallStack $ do+  info $ "Append string to file: " <> Text.pack fp+  fromEither =<< embed (CE.try @IOException $ IO.appendFile fp contents)++hFileSize :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Integer+hFileSize h = GHC.withFrozenCallStack $ do+  info $ "Called hFileSize: " <> tshow h+  fromEither =<< embed (CE.try @IOException $ IO.hFileSize h)++hSetFileSize :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Integer+  -> Sem r ()+hSetFileSize h n = GHC.withFrozenCallStack $ do+  info $ "Called hSetFileSize: " <> tshow h <> " " <> tshow n+  fromEither =<< embed (CE.try @IOException $ IO.hSetFileSize h n)++hIsEOF :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hIsEOF h = GHC.withFrozenCallStack $ do+  info $ "Called hIsEOF: " <> tshow h+  fromEither =<< embed (CE.try @IOException $ IO.hIsEOF h)++isEOF :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r Bool+isEOF = GHC.withFrozenCallStack $ do+  debug "Called isEOF"+  fromEither =<< embed (CE.try @IOException IO.isEOF)++hSetBuffering :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> BufferMode+  -> Sem r ()+hSetBuffering h bufferMode = GHC.withFrozenCallStack $ do+  debug "Called hSetBuffering"+  fromEither =<< embed (CE.try @IOException $ IO.hSetBuffering h bufferMode)++hGetBuffering :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r BufferMode+hGetBuffering h = GHC.withFrozenCallStack $ do+  debug "Called hGetBuffering"+  fromEither =<< embed (CE.try @IOException $ IO.hGetBuffering h)++hFlush :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r ()+hFlush h = GHC.withFrozenCallStack $ do+  debug "Called hFlush"+  fromEither =<< embed (CE.try @IOException $ IO.hFlush h)++hGetPosn :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r HandlePosn+hGetPosn h = GHC.withFrozenCallStack $ do+  debug "Called hGetPosn"+  fromEither =<< embed (CE.try @IOException $ IO.hGetPosn h)++hSetPosn :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => HandlePosn+  -> Sem r ()+hSetPosn hPosn = GHC.withFrozenCallStack $ do+  debug "Called hSetPosn"+  fromEither =<< embed (CE.try @IOException $ IO.hSetPosn hPosn)++hSeek :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> SeekMode+  -> Integer+  -> Sem r ()+hSeek h seekMode n = GHC.withFrozenCallStack $ do+  debug "Called hSeek"+  fromEither =<< embed (CE.try @IOException $ IO.hSeek h seekMode n)++hTell :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Integer+hTell h = GHC.withFrozenCallStack $ do+  debug "Called hGetBuffering"+  fromEither =<< embed (CE.try @IOException $ IO.hTell h)++hIsOpen :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hIsOpen h = GHC.withFrozenCallStack $ do+  debug "Called hIsOpen"+  fromEither =<< embed (CE.try @IOException $ IO.hIsOpen h)++hIsClosed :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hIsClosed h = GHC.withFrozenCallStack $ do+  debug "Called hIsClosed"+  fromEither =<< embed (CE.try @IOException $ IO.hIsClosed h)++hIsReadable :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hIsReadable h = GHC.withFrozenCallStack $ do+  debug "Called hIsReadable"+  fromEither =<< embed (CE.try @IOException $ IO.hIsReadable h)++hIsWritable :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hIsWritable h = GHC.withFrozenCallStack $ do+  debug "Called hIsWritable"+  fromEither =<< embed (CE.try @IOException $ IO.hIsWritable h)++hIsSeekable :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hIsSeekable h = GHC.withFrozenCallStack $ do+  debug "Called hIsSeekable"+  fromEither =<< embed (CE.try @IOException $ IO.hIsSeekable h)++hIsTerminalDevice :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hIsTerminalDevice h = GHC.withFrozenCallStack $ do+  debug "Called hIsTerminalDevice"+  fromEither =<< embed (CE.try @IOException $ IO.hIsTerminalDevice h)++hSetEcho :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Bool+  -> Sem r ()+hSetEcho h v = GHC.withFrozenCallStack $ do+  debug "Called hSetEcho"+  fromEither =<< embed (CE.try @IOException $ IO.hSetEcho h v)++hGetEcho :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hGetEcho h = GHC.withFrozenCallStack $ do+  debug "Called hGetBuffering"+  fromEither =<< embed (CE.try @IOException $ IO.hGetEcho h)++hShow :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r String+hShow h = GHC.withFrozenCallStack $ do+  debug "Called hShow"+  fromEither =<< embed (CE.try @IOException $ IO.hShow h)++hWaitForInput :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Int+  -> Sem r Bool+hWaitForInput h n = GHC.withFrozenCallStack $ do+  debug "Called hWaitForInput"+  fromEither =<< embed (CE.try @IOException $ IO.hWaitForInput h n)++hReady :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Bool+hReady h = GHC.withFrozenCallStack $ do+  debug "Called hReady"+  fromEither =<< embed (CE.try @IOException $ IO.hReady h)++hGetChar :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Char+hGetChar h = GHC.withFrozenCallStack $ do+  debug "Called hGetChar"+  fromEither =<< embed (CE.try @IOException $ IO.hGetChar h)++hGetLine :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r String+hGetLine h = GHC.withFrozenCallStack $ do+  debug "Called hGetLine"+  fromEither =<< embed (CE.try @IOException $ IO.hGetLine h)++hLookAhead :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r Char+hLookAhead h = GHC.withFrozenCallStack $ do+  debug "Called hLookAhead"+  fromEither =<< embed (CE.try @IOException $ IO.hLookAhead h)++hGetContents :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r String+hGetContents h = GHC.withFrozenCallStack $ do+  debug "Called hGetContents"+  fromEither =<< embed (CE.try @IOException $ IO.hGetContents h)++hGetContents' :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r String+hGetContents' h = GHC.withFrozenCallStack $ do+  debug "Called hGetContents'"+  fromEither =<< embed (CE.try @IOException $ IO.hGetContents' h)++hPutChar :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Char+  -> Sem r ()+hPutChar h c = GHC.withFrozenCallStack $ do+  debug "Called hPutChar"+  fromEither =<< embed (CE.try @IOException $ IO.hPutChar h c)++hPutStr :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> String+  -> Sem r ()+hPutStr h s = GHC.withFrozenCallStack $ do+  debug "Called hPutStr"+  fromEither =<< embed (CE.try @IOException $ IO.hPutStr h s)++hPutStrLn :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> String+  -> Sem r ()+hPutStrLn h s = GHC.withFrozenCallStack $ do+  debug "Called hPutStrLn"+  fromEither =<< embed (CE.try @IOException $ IO.hPutStrLn h s)++hPrint :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> String+  -> Sem r ()+hPrint h s = GHC.withFrozenCallStack $ do+  debug "Called hPrint"+  fromEither =<< embed (CE.try @IOException $ IO.hPrint h s)++interact :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => (String -> String)+  -> Sem r ()+interact f = GHC.withFrozenCallStack $ do+  debug "Called interact"+  fromEither =<< embed (CE.try @IOException $ IO.interact f)++putChar :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Char+  -> Sem r ()+putChar c = GHC.withFrozenCallStack $ do+  debug "Called putChar"+  fromEither =<< embed (CE.try @IOException $ IO.putChar c)++putStr :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => String+  -> Sem r ()+putStr s = GHC.withFrozenCallStack $ do+  debug "Called putStr"+  fromEither =<< embed (CE.try @IOException $ IO.putStr s)++putStrLn :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => String+  -> Sem r ()+putStrLn s = GHC.withFrozenCallStack $ do+  debug "Called putStrLn"+  fromEither =<< embed (CE.try @IOException $ IO.putStrLn s)++print :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => String+  -> Sem r ()+print s = GHC.withFrozenCallStack $ do+  debug "Called print"+  fromEither =<< embed (CE.try @IOException $ IO.print s)++getChar :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r Char+getChar = GHC.withFrozenCallStack $ do+  debug "Called getChar"+  fromEither =<< embed (CE.try @IOException IO.getChar)++getLine :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r String+getLine = GHC.withFrozenCallStack $ do+  debug "Called getLine"+  fromEither =<< embed (CE.try @IOException IO.getLine)++getContents :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r String+getContents = GHC.withFrozenCallStack $ do+  debug "Called getContents"+  fromEither =<< embed (CE.try @IOException IO.getContents)++getContents' :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r String+getContents' = GHC.withFrozenCallStack $ do+  debug "Called getContents'"+  fromEither =<< embed (CE.try @IOException IO.getContents')++readIO :: ()+  => GHC.HasCallStack+  => Read a+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => String+  -> Sem r a+readIO s = GHC.withFrozenCallStack $ do+  debug "Called readIO"+  fromEither =<< embed (CE.try @IOException $ IO.readIO s)++readLn :: ()+  => GHC.HasCallStack+  => Read a+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Sem r a+readLn = GHC.withFrozenCallStack $ do+  debug "Called readLn"+  fromEither =<< embed (CE.try @IOException IO.readLn)++hPutBuf :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Ptr a+  -> Int+  -> Sem r ()+hPutBuf h ptr n = GHC.withFrozenCallStack $ do+  debug "Called hPutBuf"+  fromEither =<< embed (CE.try @IOException $ IO.hPutBuf h ptr n)++hGetBuf :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Ptr a+  -> Int+  -> Sem r Int+hGetBuf h ptr n = GHC.withFrozenCallStack $ do+  debug "Called hGetBuf"+  fromEither =<< embed (CE.try @IOException $ IO.hGetBuf h ptr n)++hGetBufSome :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Ptr a+  -> Int+  -> Sem r Int+hGetBufSome h ptr n = GHC.withFrozenCallStack $ do+  debug "Called hGetBufSome"+  fromEither =<< embed (CE.try @IOException $ IO.hGetBufSome h ptr n)++hPutBufNonBlocking :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Ptr a+  -> Int+  -> Sem r Int+hPutBufNonBlocking h ptr n = GHC.withFrozenCallStack $ do+  debug "Called hPutBufNonBlocking"+  fromEither =<< embed (CE.try @IOException $ IO.hPutBufNonBlocking h ptr n)++hGetBufNonBlocking :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Ptr a+  -> Int+  -> Sem r Int+hGetBufNonBlocking h ptr n = GHC.withFrozenCallStack $ do+  debug "Called hGetBufNonBlocking"+  fromEither =<< embed (CE.try @IOException $ IO.hGetBufNonBlocking h ptr n)++openTempFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> String+  -> Sem r (FilePath, Handle)+openTempFile fp s = GHC.withFrozenCallStack $ do+  debug "Called openTempFile"+  fromEither =<< embed (CE.try @IOException $ IO.openTempFile fp s)++openBinaryTempFile :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> String+  -> Sem r (FilePath, Handle)+openBinaryTempFile fp s = GHC.withFrozenCallStack $ do+  debug "Called openBinaryTempFile"+  fromEither =<< embed (CE.try @IOException $ IO.openBinaryTempFile fp s)++openTempFileWithDefaultPermissions :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> String+  -> Sem r (FilePath, Handle)+openTempFileWithDefaultPermissions fp s = GHC.withFrozenCallStack $ do+  debug "Called openTempFileWithDefaultPermissions"+  fromEither =<< embed (CE.try @IOException $ IO.openTempFileWithDefaultPermissions fp s)++openBinaryTempFileWithDefaultPermissions :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => FilePath+  -> String+  -> Sem r (FilePath, Handle)+openBinaryTempFileWithDefaultPermissions fp s = GHC.withFrozenCallStack $ do+  debug "Called openBinaryTempFileWithDefaultPermissions"+  fromEither =<< embed (CE.try @IOException $ IO.openBinaryTempFileWithDefaultPermissions fp s)++hSetEncoding :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> TextEncoding+  -> Sem r ()+hSetEncoding h enc = GHC.withFrozenCallStack $ do+  debug "Called hSetEncoding"+  fromEither =<< embed (CE.try @IOException $ IO.hSetEncoding h enc)++hGetEncoding :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> Sem r (Maybe TextEncoding)+hGetEncoding h = GHC.withFrozenCallStack $ do+  debug "Called hGetEncoding"+  fromEither =<< embed (CE.try @IOException $ IO.hGetEncoding h)++mkTextEncoding :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => String+  -> Sem r TextEncoding+mkTextEncoding s = GHC.withFrozenCallStack $ do+  debug "Called mkTextEncoding"+  fromEither =<< embed (CE.try @IOException $ IO.mkTextEncoding s)++hSetNewlineMode :: ()+  => GHC.HasCallStack+  => Member (Error IOException) r+  => Member (Embed IO) r+  => Member Log r+  => Handle+  -> NewlineMode+  -> Sem r ()+hSetNewlineMode h nm = GHC.withFrozenCallStack $ do+  debug "Called hSetNewlineMode"+  fromEither =<< embed (CE.try @IOException $ IO.hSetNewlineMode h nm)
+ core/HaskellWorks/Polysemy/System/Process.hs view
@@ -0,0 +1,259 @@+module HaskellWorks.Polysemy.System.Process+  ( IO.CreateProcess(..),+    IO.CmdSpec(..),+    IO.StdStream(..),+    Handle,+    ProcessHandle,+    ExitCode(..),+    FD,+    Pid,+    createProcess,+    createProcess_,+    IO.shell,+    IO.proc,+    callProcess,+    callCommand,+    spawnProcess,+    spawnCommand,+    readCreateProcess,+    readProcess,+    readCreateProcessWithExitCode,+    readProcessWithExitCode,+    cleanupProcess,+    getPid,+    getCurrentPid,+    interruptProcessGroupOf,+    createPipe,+    createPipeFd,+    runProcess,+    runCommand,+    runInteractiveProcess,+    runInteractiveCommand,+    system,+    rawSystem,++  ) where++import qualified Control.Exception             as CE+import           HaskellWorks.Polysemy.Prelude+import           Polysemy+import           Polysemy.Error+import           System.Exit                   (ExitCode (..))+import           System.IO                     (Handle)+import           System.Posix.Internals        (FD)+import qualified System.Process                as IO+import           System.Process                (Pid, ProcessHandle)++createProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => IO.CreateProcess+  -> Sem r (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)+createProcess cp = do+  r <- embed $ CE.try @IOException $ IO.createProcess cp+  fromEither r++createProcess_ :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> IO.CreateProcess+  -> Sem r (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)+createProcess_ cmd cp = do+  r <- embed $ CE.try @IOException $ IO.createProcess_ cmd cp+  fromEither r++callProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> [String]+  -> Sem r ()+callProcess cmd args = do+  r <- embed $ CE.try @IOException $ IO.callProcess cmd args+  fromEither r++callCommand :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> Sem r ()+callCommand cmd = do+  r <- embed $ CE.try @IOException $ IO.callCommand cmd+  fromEither r++spawnProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> [String]+  -> Sem r ProcessHandle+spawnProcess cmd args = do+  r <- embed $ CE.try @IOException $ IO.spawnProcess cmd args+  fromEither r++spawnCommand :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> Sem r ProcessHandle+spawnCommand cmd = do+  r <- embed $ CE.try @IOException $ IO.spawnCommand cmd+  fromEither r++readCreateProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => IO.CreateProcess+  -> String+  -> Sem r String+readCreateProcess cp input = do+  r <- embed $ CE.try @IOException $ IO.readCreateProcess cp input+  fromEither r++readProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> [String]+  -> String+  -> Sem r String+readProcess cmd args input = do+  r <- embed $ CE.try @IOException $ IO.readProcess cmd args input+  fromEither r++readCreateProcessWithExitCode :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => IO.CreateProcess+  -> String+  -> Sem r (ExitCode, String, String)+readCreateProcessWithExitCode cp input = do+  r <- embed $ CE.try @IOException $ IO.readCreateProcessWithExitCode cp input+  fromEither r++readProcessWithExitCode :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> [String]+  -> String+  -> Sem r (ExitCode, String, String)+readProcessWithExitCode cmd args input = do+  r <- embed $ CE.try @IOException $ IO.readProcessWithExitCode cmd args input+  fromEither r++cleanupProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)+  -> Sem r ()+cleanupProcess (mIn, mOut, mErr, ph) = do+  r <- embed $ CE.try @IOException $ IO.cleanupProcess (mIn, mOut, mErr, ph)+  fromEither r++getPid :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => ProcessHandle+  -> Sem r (Maybe Pid)+getPid ph = do+  r <- embed $ CE.try @IOException $ IO.getPid ph+  fromEither r++getCurrentPid :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Sem r Pid+getCurrentPid = do+  r <- embed $ CE.try @IOException $ IO.getCurrentPid+  fromEither r++interruptProcessGroupOf :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => ProcessHandle+  -> Sem r ()+interruptProcessGroupOf ph = do+  r <- embed $ CE.try @IOException $ IO.interruptProcessGroupOf ph+  fromEither r++createPipe :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Sem r (Handle, Handle)+createPipe = do+  r <- embed $ CE.try @IOException $ IO.createPipe+  fromEither r++createPipeFd :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Sem r (FD, FD)+createPipeFd = do+  r <- embed $ CE.try @IOException $ IO.createPipeFd+  fromEither r++runProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => FilePath+  -> [String]+  -> Maybe FilePath+  -> Maybe [(String, String)]+  -> Maybe Handle+  -> Maybe Handle+  -> Maybe Handle+  -> Sem r ProcessHandle+runProcess cmd args mbStdIn mbEnv mbCwd mbStdOut mbStdErr = do+  r <- embed $ CE.try @IOException $ IO.runProcess cmd args mbStdIn mbEnv mbCwd mbStdOut mbStdErr+  fromEither r++runCommand :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> Sem r ProcessHandle+runCommand cmd = do+  r <- embed $ CE.try @IOException $ IO.runCommand cmd+  fromEither r++runInteractiveProcess :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => FilePath+  -> [String]+  -> Maybe FilePath+  -> Maybe [(String, String)]+  -> Sem r (Handle, Handle, Handle, ProcessHandle)+runInteractiveProcess cmd args mbCwd mbEnv = do+  r <- embed $ CE.try @IOException $ IO.runInteractiveProcess cmd args mbCwd mbEnv+  fromEither r++runInteractiveCommand :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> Sem r (Handle, Handle, Handle, ProcessHandle)+runInteractiveCommand cmd = do+  r <- embed $ CE.try @IOException $ IO.runInteractiveCommand cmd+  fromEither r++system :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> Sem r ExitCode+system cmd = do+  r <- embed $ CE.try @IOException $ IO.system cmd+  fromEither r++rawSystem :: ()+  => Member (Embed IO) r+  => Member (Error IOException) r+  => String+  -> [String]+  -> Sem r ExitCode+rawSystem cmd args = do+  r <- embed $ CE.try @IOException $ IO.rawSystem cmd args+  fromEither r
+ hedgehog/HaskellWorks/Polysemy/Hedgehog.hs view
@@ -0,0 +1,56 @@++module HaskellWorks.Polysemy.Hedgehog+  ( propertyOnce++  , Hedgehog++  , hedgehogToIntegrationFinal+  , interpretDataLogHedgehog++  , leftFail+  , leftFailM+  , catchFail++  , failure+  , failMessage+  , (===)++  , eval+  , evalIO+  , evalM+  , evalIO_+  , evalM_++  , jotShow+  , jotShow_+  , jotWithCallstack+  , jot+  , jot_+  , jotText_+  , jotM+  , jotM_+  , jotBsUtf8M+  , jotLbsUtf8M+  , jotIO+  , jotIO_+  , jotShowM+  , jotShowM_+  , jotShowIO+  , jotShowIO_+  , jotEach+  , jotEach_+  , jotEachM+  , jotEachM_+  , jotEachIO+  , jotEachIO_++  , Property++  ) where++import           HaskellWorks.Polysemy.Hedgehog.Assert+import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog+import           HaskellWorks.Polysemy.Hedgehog.Effect.Log+import           HaskellWorks.Polysemy.Hedgehog.Eval+import           HaskellWorks.Polysemy.Hedgehog.Jot+import           HaskellWorks.Polysemy.Hedgehog.Property
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Assert.hs view
@@ -0,0 +1,85 @@+module HaskellWorks.Polysemy.Hedgehog.Assert+  ( Hedgehog,+    leftFail,+    leftFailM,+    requireHead,+    catchFail,+    evalIO,+    failure,+    failMessage,++    (===),++  ) where+++import qualified GHC.Stack                                      as GHC+import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog+import           HaskellWorks.Polysemy.Prelude+import           Polysemy+import           Polysemy.Error++(===) :: ()+  => Member Hedgehog r+  => Eq a+  => Show a+  => HasCallStack+  => a+  -> a+  -> Sem r ()+(===) a b = withFrozenCallStack $ assertEquals a b++-- | Fail when the result is Left.+leftFail :: forall e r a. ()+  => Member Hedgehog r+  => Show e+  => HasCallStack+  => Either e a+  -> Sem r a+leftFail r = withFrozenCallStack $ case r of+  Right a -> pure a+  Left e  -> failMessage GHC.callStack ("Expected Right: " <> show e)++failure :: ()+  => Member Hedgehog r+  => HasCallStack+  => Sem r a+failure =+  withFrozenCallStack $ failWith Nothing ""++failMessage :: ()+  => Member Hedgehog r+  => HasCallStack+  => GHC.CallStack+  -> String+  -> Sem r a+failMessage cs =+  withFrozenCallStack $ failWithCustom cs Nothing++leftFailM :: forall e r a. ()+  => Member Hedgehog r+  => Show e+  => HasCallStack+  => Sem r (Either e a)+  -> Sem r a+leftFailM f =+  withFrozenCallStack $ f >>= leftFail++catchFail :: forall e r a.()+  => Member Hedgehog r+  => HasCallStack+  => Show e+  => Sem (Error e ': r) a+  -> Sem r a+catchFail f =+  withFrozenCallStack $ f & runError & leftFailM++requireHead :: ()+  => Member Hedgehog r+  => HasCallStack+  => [a]+  -> Sem r a+requireHead = withFrozenCallStack $+  \case+    []    -> failMessage GHC.callStack "Cannot take head of empty list"+    (x:_) -> pure x
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE GADTs           #-}+{-# LANGUAGE TemplateHaskell #-}++module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog+  ( Hedgehog++  , assertEquals+  , eval+  , evalM+  , evalIO+  , writeLog+  , failWith+  , failWithCustom++  , hedgehogToIntegrationFinal++  ) where++import qualified GHC.Stack                                               as GHC+import           HaskellWorks.Polysemy.Prelude++import qualified Hedgehog                                                as H+import qualified Hedgehog.Internal.Property                              as H++import qualified HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal as I+import           Polysemy+import           Polysemy.Final++data Hedgehog m rv where+  AssertEquals :: (GHC.HasCallStack, Eq a, Show a)+    => a+    -> a+    -> Hedgehog m ()++  Eval :: GHC.HasCallStack+    => a+    -> Hedgehog m a++  EvalM :: GHC.HasCallStack+    => m a+    -> Hedgehog m a++  EvalIO :: GHC.HasCallStack+    => IO a+    -> Hedgehog m a++  WriteLog :: ()+    => H.Log+    -> Hedgehog m ()++  FailWith :: GHC.HasCallStack+    => Maybe H.Diff+    -> String+    -> Hedgehog m a++  FailWithCustom :: ()+    => GHC.CallStack+    -> Maybe H.Diff+    -> String+    -> Hedgehog m a++makeSem ''Hedgehog++hedgehogToIntegrationFinal :: ()+  => Member (Final (H.PropertyT IO)) r+  => Sem (Hedgehog ': r) a+  -> Sem r a+hedgehogToIntegrationFinal = interpretFinal \case+  AssertEquals a b ->+    liftS $ a H.=== b+  Eval a ->+    liftS $ H.eval a+  EvalIO f ->+    liftS $ H.evalIO f+  EvalM f -> do+    g <- runS f+    pure $ H.evalM g+  FailWith mdiff msg ->+    liftS $ H.failWith mdiff msg+  FailWithCustom cs mdiff msg ->+    liftS $ I.failWithCustom cs mdiff msg+  WriteLog logValue ->+    liftS $ H.writeLog logValue
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog/Internal.hs view
@@ -0,0 +1,17 @@+module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal+  ( failWithCustom+  ) where++import           HaskellWorks.Polysemy.Prelude+import qualified Hedgehog                      as H+import qualified Hedgehog.Internal.Property    as H+import qualified Hedgehog.Internal.Source      as H++failWithCustom :: ()+  => H.MonadTest m+  => CallStack+  -> Maybe H.Diff+  -> String+  -> m a+failWithCustom cs mdiff msg =+  H.liftTest $ H.mkTest (Left $ H.Failure (H.getCaller cs) msg mdiff, mempty)
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Log.hs view
@@ -0,0 +1,26 @@+module HaskellWorks.Polysemy.Hedgehog.Effect.Log+  ( interpretDataLogHedgehog+  , getLogEntryCallStack+  ) where++import qualified Data.Text                                      as Text+import qualified GHC.Stack                                      as GHC+import           HaskellWorks.Polysemy.Prelude++import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog+import           HaskellWorks.Polysemy.Hedgehog.Jot+import           Polysemy+import           Polysemy.Log++interpretDataLogHedgehog :: ()+  => Member Hedgehog r+  => (a -> Text)+  -> (a -> GHC.CallStack)+  -> InterpreterFor (DataLog a) r+interpretDataLogHedgehog fmt cs sem = do+  interpretDataLog (\a -> jotWithCallstack (cs a) $ Text.unpack $ fmt a) sem+{-# inline interpretDataLogHedgehog #-}++getLogEntryCallStack :: LogEntry LogMessage -> GHC.CallStack+getLogEntryCallStack = \case+  LogEntry _ _ cs -> cs
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Eval.hs view
@@ -0,0 +1,28 @@+module HaskellWorks.Polysemy.Hedgehog.Eval+  ( evalIO_+  , evalM_+  , eval+  , evalM+  , evalIO++  ) where++import qualified GHC.Stack                                      as GHC+import           HaskellWorks.Polysemy.Prelude++import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog+import           Polysemy++evalIO_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => IO a+  -> Sem r ()+evalIO_ = void . evalIO++evalM_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Sem r a+  -> Sem r ()+evalM_ = void . evalM
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE MultiWayIf #-}++module HaskellWorks.Polysemy.Hedgehog.Golden+  ( diffVsGoldenFile,+    diffFileVsGoldenFile,+  ) where++import           Control.Applicative+import           Control.Monad+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                                     (callStack)+import           HaskellWorks.Polysemy.Hedgehog.Assert+import           HaskellWorks.Polysemy.Hedgehog.Jot+import           System.FilePath                               (takeDirectory)++import qualified Control.Concurrent.QSem                       as IO+import qualified Data.List                                     as List+import qualified GHC.Stack                                     as GHC+import qualified HaskellWorks.Polysemy.Control.Concurrent.QSem as PIO+import           HaskellWorks.Polysemy.Prelude+import           HaskellWorks.Polysemy.System.Directory        as PIO+import           HaskellWorks.Polysemy.System.IO               as PIO+import           Polysemy+import           Polysemy.Error+import           Polysemy.Log+import           Polysemy.Resource+import qualified System.Environment                            as IO+import qualified System.IO.Unsafe                              as IO++sem :: IO.QSem+sem = IO.unsafePerformIO $ IO.newQSem 1+{-# NOINLINE sem #-}++-- | The file to log whenever a golden file is referenced.+mGoldenFileLogFile :: Maybe FilePath+mGoldenFileLogFile = IO.unsafePerformIO $+  IO.lookupEnv "GOLDEN_FILE_LOG_FILE"++-- | Whether the test should create the golden files if the files do not exist.+createGoldenFiles :: Bool+createGoldenFiles = IO.unsafePerformIO $ do+  value <- IO.lookupEnv "CREATE_GOLDEN_FILES"+  return $ value == Just "1"++-- | Whether the test should recreate the golden files if the files already exist.+recreateGoldenFiles :: Bool+recreateGoldenFiles = IO.unsafePerformIO $ do+  value <- IO.lookupEnv "RECREATE_GOLDEN_FILES"+  return $ value == Just "1"++writeGoldenFile :: ()+  => Member Hedgehog r+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Member Log r+  => FilePath+  -> String+  -> Sem r ()+writeGoldenFile goldenFile actualContent = do+  jot_ $ "Creating golden file " <> goldenFile+  PIO.createDirectoryIfMissing True (takeDirectory goldenFile)+  PIO.writeFile goldenFile actualContent++reportGoldenFileMissing :: ()+  => Member Hedgehog r+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Member Log r+  => FilePath+  -> Sem r ()+reportGoldenFileMissing goldenFile = do+  jot_ $ unlines+    [ "Golden file " <> goldenFile <> " does not exist."+    , "To create it, run with CREATE_GOLDEN_FILES=1."+    , "To recreate it, run with RECREATE_GOLDEN_FILES=1."+    ]+  failure++checkAgainstGoldenFile :: ()+  => Member Hedgehog r+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Member Log r+  => FilePath+  -> [String]+  -> Sem r ()+checkAgainstGoldenFile goldenFile actualLines = do+  referenceLines <- List.lines <$> PIO.readFile goldenFile+  let difference = getGroupedDiff actualLines referenceLines+  case difference of+    []       -> pure ()+    [Both{}] -> pure ()+    _        -> do+      jot_ $ unlines+        [ "Golden test failed against golden file: " <> goldenFile+        , "To recreate golden file, run with RECREATE_GOLDEN_FILES=1."+        ]+      failMessage callStack $ ppDiff 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+  => Member Hedgehog r+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Member Resource r+  => Member Log r+  => String   -- ^ Actual content+  -> FilePath -- ^ Reference file+  -> Sem r ()+diffVsGoldenFile actualContent goldenFile = GHC.withFrozenCallStack $ do+  forM_ mGoldenFileLogFile $ \logFile ->+    PIO.bracketQSem sem $ PIO.appendFile logFile $ goldenFile <> "\n"++  fileExists <- PIO.doesFileExist goldenFile++  if+    | recreateGoldenFiles -> writeGoldenFile goldenFile actualContent+    | fileExists          -> checkAgainstGoldenFile goldenFile actualLines+    | createGoldenFiles   -> writeGoldenFile goldenFile actualContent+    | otherwise           -> reportGoldenFileMissing goldenFile++  where+    actualLines = List.lines 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+  => Member Hedgehog r+  => Member (Embed IO) r+  => Member (Error IOException) r+  => Member Log r+  => Member Resource r+  => FilePath -- ^ Actual file+  -> FilePath -- ^ Reference file+  -> Sem r ()+diffFileVsGoldenFile actualFile referenceFile = GHC.withFrozenCallStack $ do+  contents <- PIO.readFile actualFile+  diffVsGoldenFile contents referenceFile
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Jot.hs view
@@ -0,0 +1,284 @@+module HaskellWorks.Polysemy.Hedgehog.Jot+  ( jotShow+  , jotShow_+  , jotWithCallstack++  , jot+  , jot_+  , jotText_+  , jotM+  , jotM_+  , jotBsUtf8M+  , jotLbsUtf8M+  , jotIO+  , jotIO_+  , jotShowM+  , jotShowM_+  , jotShowIO+  , jotShowIO_+  , jotEach+  , jotEach_+  , jotEachM+  , jotEachM_+  , jotEachIO+  , jotEachIO_++  ) where+++import qualified Data.ByteString.Lazy                           as LBS+import qualified Data.Text                                      as Text+import qualified Data.Text.Encoding                             as Text+import qualified Data.Text.Lazy                                 as LT+import qualified Data.Text.Lazy.Encoding                        as LT+import qualified GHC.Stack                                      as GHC+import           HaskellWorks.Polysemy.Prelude++import qualified Hedgehog.Internal.Property                     as H+import qualified Hedgehog.Internal.Source                       as H++import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog+import           HaskellWorks.Polysemy.String+import           Polysemy++-- | Annotate the given string at the context supplied by the callstack.+jotWithCallstack :: ()+  => Member Hedgehog r+  => GHC.CallStack+  -> String+  -> Sem r ()+jotWithCallstack cs a =+  writeLog $ H.Annotation (H.getCaller cs) a++-- | Annotate with the given string.+jot :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => String+  -> Sem r String+jot a = GHC.withFrozenCallStack $ do+  !b <- eval a+  jotWithCallstack GHC.callStack b+  return b++-- | Annotate the given string returning unit.+jot_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => String+  -> Sem r ()+jot_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack a++-- | Annotate the given text returning unit.+jotText_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Text+  -> Sem r ()+jotText_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack $ Text.unpack a++-- | Annotate the given string in a monadic context.+jotM :: ()+  => ToString s+  => Member Hedgehog r+  => GHC.HasCallStack+  => Sem r s+  -> Sem r s+jotM a = GHC.withFrozenCallStack $ do+  !b <- evalM a+  jotWithCallstack GHC.callStack $ toString b+  return b++jotBsUtf8M :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Sem r ByteString+  -> Sem r ByteString+jotBsUtf8M a = GHC.withFrozenCallStack $ do+  !b <- evalM a+  jotWithCallstack GHC.callStack $ Text.unpack $ Text.decodeUtf8 b+  return b++jotLbsUtf8M :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Sem r LBS.ByteString+  -> Sem r LBS.ByteString+jotLbsUtf8M a = GHC.withFrozenCallStack $ do+  !b <- evalM a+  jotWithCallstack GHC.callStack $ LT.unpack $ LT.decodeUtf8 b+  return b++-- | Annotate the given string in a monadic context returning unit.+jotM_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Sem r String+  -> Sem r ()+jotM_ a = GHC.withFrozenCallStack $ do+  !b <- evalM a+  jotWithCallstack GHC.callStack b+  return ()++-- | Annotate the given string in IO.+jotIO :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => IO String+  -> Sem r String+jotIO f = GHC.withFrozenCallStack $ do+  !a <- evalIO f+  jotWithCallstack GHC.callStack a+  return a++-- | Annotate the given string in IO returning unit.+jotIO_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => IO String+  -> Sem r ()+jotIO_ f = GHC.withFrozenCallStack $ do+  !a <- evalIO f+  jotWithCallstack GHC.callStack a+  return ()++-- | Annotate the given value.+jotShow :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => a+  -> Sem r a+jotShow a = GHC.withFrozenCallStack $ do+  !b <- eval a+  jotWithCallstack GHC.callStack (show b)+  return b++-- | Annotate the given value returning unit.+jotShow_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => a+  -> Sem r ()+jotShow_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack (show a)++-- | Annotate the given value in a monadic context.+jotShowM :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Sem r a+  -> Sem r a+jotShowM a = GHC.withFrozenCallStack $ do+  !b <- evalM a+  jotWithCallstack GHC.callStack (show b)+  return b++-- | Annotate the given value in a monadic context returning unit.+jotShowM_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Sem r a+  -> Sem r ()+jotShowM_ a = GHC.withFrozenCallStack $ do+  !b <- evalM a+  jotWithCallstack GHC.callStack (show b)+  return ()++-- | Annotate the given value in IO.+jotShowIO :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => IO a+  -> Sem r a+jotShowIO f = GHC.withFrozenCallStack $ do+  !a <- evalIO f+  jotWithCallstack GHC.callStack (show a)+  return a++-- | Annotate the given value in IO returning unit.+jotShowIO_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => IO a+  -> Sem r ()+jotShowIO_ f = GHC.withFrozenCallStack $ do+  !a <- evalIO f+  jotWithCallstack GHC.callStack (show a)+  return ()++-- | Annotate the each value in the given traversable.+jotEach :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Traversable f+  => f a+  -> Sem r (f a)+jotEach as = GHC.withFrozenCallStack $ do+  for_ as $ jotWithCallstack GHC.callStack . show+  return as++-- | Annotate the each value in the given traversable returning unit.+jotEach_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Traversable f+  => f a+  -> Sem r ()+jotEach_ as = GHC.withFrozenCallStack $ for_ as $ jotWithCallstack GHC.callStack . show++-- | Annotate the each value in the given traversable in a monadic context.+jotEachM :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Traversable f+  => Sem r (f a)+  -> Sem r (f a)+jotEachM f = GHC.withFrozenCallStack $ do+  !as <- f+  for_ as $ jotWithCallstack GHC.callStack . show+  return as++-- | Annotate the each value in the given traversable in a monadic context returning unit.+jotEachM_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Traversable f+  => Sem r (f a)+  -> Sem r ()+jotEachM_ f = GHC.withFrozenCallStack $ do+  !as <- f+  for_ as $ jotWithCallstack GHC.callStack . show++-- | Annotate the each value in the given traversable in IO.+jotEachIO :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Traversable f+  => IO (f a)+  -> Sem r (f a)+jotEachIO f = GHC.withFrozenCallStack $ do+  !as <- evalIO f+  for_ as $ jotWithCallstack GHC.callStack . show+  return as++-- | Annotate the each value in the given traversable in IO returning unit.+jotEachIO_ :: ()+  => Member Hedgehog r+  => GHC.HasCallStack+  => Show a+  => Traversable f+  => IO (f a)+  -> Sem r ()+jotEachIO_ f = GHC.withFrozenCallStack $ do+  !as <- evalIO f+  for_ as $ jotWithCallstack GHC.callStack . show
+ hedgehog/HaskellWorks/Polysemy/Hedgehog/Property.hs view
@@ -0,0 +1,44 @@+module HaskellWorks.Polysemy.Hedgehog.Property+  ( Property+  , propertyOnce++  ) where++import qualified GHC.Stack                                      as GHC+import           HaskellWorks.Polysemy.Prelude++import           Hedgehog                                       (Property)+import qualified Hedgehog                                       as H++import           Control.Monad.IO.Class                         (liftIO)+import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog+import           HaskellWorks.Polysemy.Hedgehog.Effect.Log+import           Polysemy+import           Polysemy.Embed+import           Polysemy.Log+import           Polysemy.Time.Interpreter.Ghc++propertyOnce :: ()+  => Sem+        [ Log+        , DataLog (LogEntry LogMessage)+        , DataLog Text+        , GhcTime+        , Hedgehog+        , Embed IO+        , Embed (H.PropertyT IO)+        , Final (H.PropertyT IO)+        ] ()+  -> H.Property+propertyOnce f = f+  & interpretLogDataLog+  & setLogLevel (Just Info)+  & interpretDataLogHedgehog formatLogEntry getLogEntryCallStack+  & interpretDataLogHedgehog id (const GHC.callStack)+  & interpretTimeGhc+  & hedgehogToIntegrationFinal+  & runEmbedded liftIO+  & embedToFinal @(H.PropertyT IO)+  & runFinal+  & H.property+  & H.withTests 1
hw-polysemy.cabal view
@@ -1,6 +1,6 @@ cabal-version:          3.4 name:                   hw-polysemy-version:                0.1.1.0+version:                0.2.0.0 synopsis:               Opinionated polysemy library description:            Opinionated polysemy library. license:                Apache-2.0@@ -17,10 +17,12 @@   type:                 git   location:             https://github.com/haskell-works/hw-polysemy -common base                       { build-depends: base                       >= 4.18.2.1   && < 5      }+common base                       { build-depends: base                       >= 4.18       && < 5      }  common bytestring                 { build-depends: bytestring                                  < 0.13   } common contravariant              { build-depends: contravariant                               < 1.6    }+common Diff                       { build-depends: Diff                                        < 0.6    }+common directory                  { build-depends: directory                                   < 1.4    } common filepath                   { build-depends: filepath                                    < 1.6    } common ghc-prim                   { build-depends: ghc-prim                                    < 0.12   } common hedgehog                   { build-depends: hedgehog                                    < 1.5    }@@ -28,11 +30,16 @@ common polysemy-log               { build-depends: polysemy-log                                < 0.11   } common polysemy-plugin            { build-depends: polysemy-plugin                             < 0.5    } common polysemy-time              { build-depends: polysemy-time                               < 0.7    }+common process                    { build-depends: process                                     < 1.7    }+common stm                        { build-depends: stm                                         < 2.6    } common tasty                      { build-depends: tasty                                       < 1.6    } common tasty-hedgehog             { build-depends: tasty-hedgehog                              < 1.5    } common text                       { build-depends: text                                        < 3      }+common time                       { build-depends: time                                        < 2      }  common hw-polysemy                { build-depends: hw-polysemy                                          }+common hw-polysemy-core           { build-depends: hw-polysemy:core                                     }+common hw-polysemy-hedgehog       { build-depends: hw-polysemy:hedgehog                                 }  common project-config   import:               polysemy,@@ -48,38 +55,102 @@   ghc-options:          -Wall                         -fplugin=Polysemy.Plugin -library+library core   import:               base, project-config,                         bytestring,                         contravariant,+                        directory,                         filepath,                         ghc-prim,                         hedgehog,                         polysemy,                         polysemy-log,                         polysemy-time,+                        process,+                        stm,                         text,+                        time,+  visibility:           public   exposed-modules:      HaskellWorks.Polysemy-                        HaskellWorks.Polysemy.ByteString-                        HaskellWorks.Polysemy.ByteString.Lazy-                        HaskellWorks.Polysemy.ByteString.Strict-                        HaskellWorks.Polysemy.Data.String-                        HaskellWorks.Polysemy.Either+                        HaskellWorks.Polysemy.Control.Concurrent+                        HaskellWorks.Polysemy.Control.Concurrent.QSem+                        HaskellWorks.Polysemy.Control.Concurrent.STM+                        HaskellWorks.Polysemy.Control.Concurrent.STM.TVar+                        HaskellWorks.Polysemy.Data.ByteString+                        HaskellWorks.Polysemy.Data.ByteString.Lazy+                        HaskellWorks.Polysemy.Data.ByteString.Strict+                        HaskellWorks.Polysemy.Data.Either+                        HaskellWorks.Polysemy.Data.Text+                        HaskellWorks.Polysemy.Data.Text.Lazy+                        HaskellWorks.Polysemy.Data.Text.Strict                         HaskellWorks.Polysemy.Error-                        HaskellWorks.Polysemy.Hedgehog+                        HaskellWorks.Polysemy.Prelude+                        HaskellWorks.Polysemy.String+                        HaskellWorks.Polysemy.System.Directory+                        HaskellWorks.Polysemy.System.Environment+                        HaskellWorks.Polysemy.System.IO+                        HaskellWorks.Polysemy.System.Process+  hs-source-dirs:       core+  default-language:     GHC2021++library hedgehog+  import:               base, project-config,+                        bytestring,+                        contravariant,+                        Diff,+                        filepath,+                        ghc-prim,+                        hedgehog,+                        hw-polysemy-core,+                        polysemy,+                        polysemy-log,+                        polysemy-time,+                        text,+  visibility:           public+  exposed-modules:      HaskellWorks.Polysemy.Hedgehog                         HaskellWorks.Polysemy.Hedgehog.Assert                         HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog                         HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal                         HaskellWorks.Polysemy.Hedgehog.Effect.Log                         HaskellWorks.Polysemy.Hedgehog.Eval+                        HaskellWorks.Polysemy.Hedgehog.Golden                         HaskellWorks.Polysemy.Hedgehog.Jot                         HaskellWorks.Polysemy.Hedgehog.Property-                        HaskellWorks.Polysemy.Prelude-                        HaskellWorks.Polysemy.Text-                        HaskellWorks.Polysemy.Text.Lazy-                        HaskellWorks.Polysemy.Text.Strict-                        HaskellWorks.Polysemy.IO-  hs-source-dirs:       src+  hs-source-dirs:       hedgehog+  default-language:     GHC2021++library+  import:               base, project-config,+                        hw-polysemy-core,+                        hw-polysemy-hedgehog,+  reexported-modules:   HaskellWorks.Polysemy,+                        HaskellWorks.Polysemy.Control.Concurrent,+                        HaskellWorks.Polysemy.Control.Concurrent.QSem,+                        HaskellWorks.Polysemy.Control.Concurrent.STM,+                        HaskellWorks.Polysemy.Control.Concurrent.STM.TVar,+                        HaskellWorks.Polysemy.Data.ByteString,+                        HaskellWorks.Polysemy.Data.ByteString.Lazy,+                        HaskellWorks.Polysemy.Data.ByteString.Strict,+                        HaskellWorks.Polysemy.Data.Either,+                        HaskellWorks.Polysemy.Data.Text,+                        HaskellWorks.Polysemy.Data.Text.Lazy,+                        HaskellWorks.Polysemy.Data.Text.Strict,+                        HaskellWorks.Polysemy.Error,+                        HaskellWorks.Polysemy.Hedgehog,+                        HaskellWorks.Polysemy.Hedgehog.Assert,+                        HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog,+                        HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal,+                        HaskellWorks.Polysemy.Hedgehog.Effect.Log,+                        HaskellWorks.Polysemy.Hedgehog.Eval,+                        HaskellWorks.Polysemy.Hedgehog.Golden,+                        HaskellWorks.Polysemy.Hedgehog.Jot,+                        HaskellWorks.Polysemy.Hedgehog.Property,+                        HaskellWorks.Polysemy.Prelude,+                        HaskellWorks.Polysemy.String,+                        HaskellWorks.Polysemy.System.Directory,+                        HaskellWorks.Polysemy.System.Environment,+                        HaskellWorks.Polysemy.System.IO,+                        HaskellWorks.Polysemy.System.Process,   default-language:     GHC2021  test-suite hw-polysemy-test
− src/HaskellWorks/Polysemy.hs 
@@ -1,1 +0,0 @@-module HaskellWorks.Polysemy () where
− src/HaskellWorks/Polysemy/ByteString.hs 
@@ -1,5 +0,0 @@-module HaskellWorks.Polysemy.ByteString-  ( readFile-  ) where--import           HaskellWorks.Polysemy.ByteString.Strict
− src/HaskellWorks/Polysemy/ByteString/Lazy.hs 
@@ -1,25 +0,0 @@-module HaskellWorks.Polysemy.ByteString.Lazy-  ( readFile-  ) where--import qualified Control.Exception             as CE-import qualified Data.ByteString.Lazy          as LBS-import qualified Data.Text                     as T-import           HaskellWorks.Polysemy.Prelude--import           Polysemy-import           Polysemy.Error-import           Polysemy.Log---- | Read the contents of the 'filePath' file.-readFile :: ()-  => HasCallStack-  => Member (Error IOException) r-  => Member (Embed IO) r-  => Member Log r-  => FilePath-  -> Sem r LBS.ByteString-readFile filePath = withFrozenCallStack $ do-  info $ "Reading lazy bytestring file: " <> T.pack filePath-  r <- embed $ CE.try @IOException $ LBS.readFile filePath-  fromEither r
− src/HaskellWorks/Polysemy/ByteString/Strict.hs 
@@ -1,25 +0,0 @@-module HaskellWorks.Polysemy.ByteString.Strict-  ( readFile-  ) where--import qualified Control.Exception             as CE-import qualified Data.ByteString               as BS-import qualified Data.Text                     as Text-import           HaskellWorks.Polysemy.Prelude--import           Polysemy-import           Polysemy.Error-import           Polysemy.Log---- | Read the contents of the 'filePath' file.-readFile :: ()-  => HasCallStack-  => Member (Error IOException) r-  => Member (Embed IO) r-  => Member Log r-  => FilePath-  -> Sem r ByteString-readFile filePath = withFrozenCallStack $ do-  info $ "Reading bytestring file: " <> Text.pack filePath-  r <- embed $ CE.try @IOException $ BS.readFile filePath-  fromEither r
− src/HaskellWorks/Polysemy/Data/String.hs 
@@ -1,20 +0,0 @@-module HaskellWorks.Polysemy.Data.String-  ( ToString(..)-  ) where---import qualified Data.Text                     as T-import qualified Data.Text.Lazy                as LT-import           HaskellWorks.Polysemy.Prelude--class ToString a where-  toString :: a -> String--instance ToString String where-  toString = id--instance ToString Text where-  toString = T.unpack--instance ToString LT.Text where-  toString = LT.unpack
− src/HaskellWorks/Polysemy/Either.hs 
@@ -1,15 +0,0 @@-module HaskellWorks.Polysemy.Either-  ( onLeftThrow-  ) where--import           HaskellWorks.Polysemy.Prelude--import           Polysemy-import           Polysemy.Error--onLeftThrow :: ()-  => Member (Error e) r-  => Sem r (Either e a)-  -> Sem r a-onLeftThrow f =-  f >>= either throw pure
− src/HaskellWorks/Polysemy/Error.hs 
@@ -1,20 +0,0 @@-module HaskellWorks.Polysemy.Error-  ( onLeft-  , onNothing-  , onLeftM-  , onNothingM-  ) where--import           HaskellWorks.Polysemy.Prelude--onLeft :: Monad m => (e -> m a) -> Either e a -> m a-onLeft f = either f pure--onNothing :: Monad m => m b -> Maybe b -> m b-onNothing h = maybe h return--onLeftM :: Monad m => (e -> m a) -> m (Either e a) -> m a-onLeftM f action = onLeft f =<< action--onNothingM :: Monad m => m b -> m (Maybe b) -> m b-onNothingM h f = onNothing h =<< f
− src/HaskellWorks/Polysemy/Hedgehog.hs 
@@ -1,56 +0,0 @@--module HaskellWorks.Polysemy.Hedgehog-  ( propertyOnce--  , Hedgehog--  , hedgehogToIntegrationFinal-  , interpretDataLogHedgehog--  , leftFail-  , leftFailM-  , catchFail--  , failure-  , failMessage-  , (===)--  , eval-  , evalIO-  , evalM-  , evalIO_-  , evalM_--  , jotShow-  , jotShow_-  , jotWithCallstack-  , jot-  , jot_-  , jotText_-  , jotM-  , jotM_-  , jotBsUtf8M-  , jotLbsUtf8M-  , jotIO-  , jotIO_-  , jotShowM-  , jotShowM_-  , jotShowIO-  , jotShowIO_-  , jotEach-  , jotEach_-  , jotEachM-  , jotEachM_-  , jotEachIO-  , jotEachIO_--  , Property--  ) where--import           HaskellWorks.Polysemy.Hedgehog.Assert-import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog-import           HaskellWorks.Polysemy.Hedgehog.Effect.Log-import           HaskellWorks.Polysemy.Hedgehog.Eval-import           HaskellWorks.Polysemy.Hedgehog.Jot-import           HaskellWorks.Polysemy.Hedgehog.Property
− src/HaskellWorks/Polysemy/Hedgehog/Assert.hs 
@@ -1,84 +0,0 @@-module HaskellWorks.Polysemy.Hedgehog.Assert-  ( leftFail-  , leftFailM-  , requireHead-  , catchFail-  , evalIO-  , failure-  , failMessage--  , (===)--  ) where---import qualified GHC.Stack                                      as GHC-import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog-import           HaskellWorks.Polysemy.Prelude-import           Polysemy-import           Polysemy.Error--(===) :: ()-  => Member Hedgehog r-  => Eq a-  => Show a-  => HasCallStack-  => a-  -> a-  -> Sem r ()-(===) a b = withFrozenCallStack $ assertEquals a b---- | Fail when the result is Left.-leftFail :: forall e r a. ()-  => Member Hedgehog r-  => Show e-  => HasCallStack-  => Either e a-  -> Sem r a-leftFail r = withFrozenCallStack $ case r of-  Right a -> pure a-  Left e  -> failMessage GHC.callStack ("Expected Right: " <> show e)--failure :: ()-  => Member Hedgehog r-  => HasCallStack-  => Sem r a-failure =-  withFrozenCallStack $ failWith Nothing ""--failMessage :: ()-  => Member Hedgehog r-  => HasCallStack-  => GHC.CallStack-  -> String-  -> Sem r a-failMessage cs =-  withFrozenCallStack $ failWithCustom cs Nothing--leftFailM :: forall e r a. ()-  => Member Hedgehog r-  => Show e-  => HasCallStack-  => Sem r (Either e a)-  -> Sem r a-leftFailM f =-  withFrozenCallStack $ f >>= leftFail--catchFail :: forall e r a.()-  => Member Hedgehog r-  => HasCallStack-  => Show e-  => Sem (Error e ': r) a-  -> Sem r a-catchFail f =-  withFrozenCallStack $ f & runError & leftFailM--requireHead :: ()-  => Member Hedgehog r-  => HasCallStack-  => [a]-  -> Sem r a-requireHead = withFrozenCallStack $-  \case-    []    -> failMessage GHC.callStack "Cannot take head of empty list"-    (x:_) -> pure x
− src/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs 
@@ -1,83 +0,0 @@-{-# LANGUAGE GADTs           #-}-{-# LANGUAGE TemplateHaskell #-}--module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog-  ( Hedgehog--  , assertEquals-  , eval-  , evalM-  , evalIO-  , writeLog-  , failWith-  , failWithCustom--  , hedgehogToIntegrationFinal--  ) where--import qualified GHC.Stack                                               as GHC-import           HaskellWorks.Polysemy.Prelude--import qualified Hedgehog                                                as H-import qualified Hedgehog.Internal.Property                              as H--import qualified HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal as I-import           Polysemy-import           Polysemy.Final--data Hedgehog m rv where-  AssertEquals :: (GHC.HasCallStack, Eq a, Show a)-    => a-    -> a-    -> Hedgehog m ()--  Eval :: GHC.HasCallStack-    => a-    -> Hedgehog m a--  EvalM :: GHC.HasCallStack-    => m a-    -> Hedgehog m a--  EvalIO :: GHC.HasCallStack-    => IO a-    -> Hedgehog m a--  WriteLog :: ()-    => H.Log-    -> Hedgehog m ()--  FailWith :: GHC.HasCallStack-    => Maybe H.Diff-    -> String-    -> Hedgehog m a--  FailWithCustom :: ()-    => GHC.CallStack-    -> Maybe H.Diff-    -> String-    -> Hedgehog m a--makeSem ''Hedgehog--hedgehogToIntegrationFinal :: ()-  => Member (Final (H.PropertyT IO)) r-  => Sem (Hedgehog ': r) a-  -> Sem r a-hedgehogToIntegrationFinal = interpretFinal \case-  AssertEquals a b ->-    liftS $ a H.=== b-  Eval a ->-    liftS $ H.eval a-  EvalIO f ->-    liftS $ H.evalIO f-  EvalM f -> do-    g <- runS f-    pure $ H.evalM g-  FailWith mdiff msg ->-    liftS $ H.failWith mdiff msg-  FailWithCustom cs mdiff msg ->-    liftS $ I.failWithCustom cs mdiff msg-  WriteLog logValue ->-    liftS $ H.writeLog logValue
− src/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog/Internal.hs 
@@ -1,17 +0,0 @@-module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal-  ( failWithCustom-  ) where--import           HaskellWorks.Polysemy.Prelude-import qualified Hedgehog                      as H-import qualified Hedgehog.Internal.Property    as H-import qualified Hedgehog.Internal.Source      as H--failWithCustom :: ()-  => H.MonadTest m-  => CallStack-  -> Maybe H.Diff-  -> String-  -> m a-failWithCustom cs mdiff msg =-  H.liftTest $ H.mkTest (Left $ H.Failure (H.getCaller cs) msg mdiff, mempty)
− src/HaskellWorks/Polysemy/Hedgehog/Effect/Log.hs 
@@ -1,26 +0,0 @@-module HaskellWorks.Polysemy.Hedgehog.Effect.Log-  ( interpretDataLogHedgehog-  , getLogEntryCallStack-  ) where--import qualified Data.Text                                      as Text-import qualified GHC.Stack                                      as GHC-import           HaskellWorks.Polysemy.Prelude--import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog-import           HaskellWorks.Polysemy.Hedgehog.Jot-import           Polysemy-import           Polysemy.Log--interpretDataLogHedgehog :: ()-  => Member Hedgehog r-  => (a -> Text)-  -> (a -> GHC.CallStack)-  -> InterpreterFor (DataLog a) r-interpretDataLogHedgehog fmt cs sem = do-  interpretDataLog (\a -> jotWithCallstack (cs a) $ Text.unpack $ fmt a) sem-{-# inline interpretDataLogHedgehog #-}--getLogEntryCallStack :: LogEntry LogMessage -> GHC.CallStack-getLogEntryCallStack = \case-  LogEntry _ _ cs -> cs
− src/HaskellWorks/Polysemy/Hedgehog/Eval.hs 
@@ -1,28 +0,0 @@-module HaskellWorks.Polysemy.Hedgehog.Eval-  ( evalIO_-  , evalM_-  , eval-  , evalM-  , evalIO--  ) where--import qualified GHC.Stack                                      as GHC-import           HaskellWorks.Polysemy.Prelude--import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog-import           Polysemy--evalIO_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => IO a-  -> Sem r ()-evalIO_ = void . evalIO--evalM_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Sem r a-  -> Sem r ()-evalM_ = void . evalM
− src/HaskellWorks/Polysemy/Hedgehog/Jot.hs 
@@ -1,284 +0,0 @@-module HaskellWorks.Polysemy.Hedgehog.Jot-  ( jotShow-  , jotShow_-  , jotWithCallstack--  , jot-  , jot_-  , jotText_-  , jotM-  , jotM_-  , jotBsUtf8M-  , jotLbsUtf8M-  , jotIO-  , jotIO_-  , jotShowM-  , jotShowM_-  , jotShowIO-  , jotShowIO_-  , jotEach-  , jotEach_-  , jotEachM-  , jotEachM_-  , jotEachIO-  , jotEachIO_--  ) where---import qualified Data.ByteString.Lazy                           as LBS-import qualified Data.Text                                      as Text-import qualified Data.Text.Encoding                             as Text-import qualified Data.Text.Lazy                                 as LT-import qualified Data.Text.Lazy.Encoding                        as LT-import qualified GHC.Stack                                      as GHC-import           HaskellWorks.Polysemy.Prelude--import qualified Hedgehog.Internal.Property                     as H-import qualified Hedgehog.Internal.Source                       as H--import           HaskellWorks.Polysemy.Data.String-import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog-import           Polysemy---- | Annotate the given string at the context supplied by the callstack.-jotWithCallstack :: ()-  => Member Hedgehog r-  => GHC.CallStack-  -> String-  -> Sem r ()-jotWithCallstack cs a =-  writeLog $ H.Annotation (H.getCaller cs) a---- | Annotate with the given string.-jot :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => String-  -> Sem r String-jot a = GHC.withFrozenCallStack $ do-  !b <- eval a-  jotWithCallstack GHC.callStack b-  return b---- | Annotate the given string returning unit.-jot_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => String-  -> Sem r ()-jot_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack a---- | Annotate the given text returning unit.-jotText_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Text-  -> Sem r ()-jotText_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack $ Text.unpack a---- | Annotate the given string in a monadic context.-jotM :: ()-  => ToString s-  => Member Hedgehog r-  => GHC.HasCallStack-  => Sem r s-  -> Sem r s-jotM a = GHC.withFrozenCallStack $ do-  !b <- evalM a-  jotWithCallstack GHC.callStack $ toString b-  return b--jotBsUtf8M :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Sem r ByteString-  -> Sem r ByteString-jotBsUtf8M a = GHC.withFrozenCallStack $ do-  !b <- evalM a-  jotWithCallstack GHC.callStack $ Text.unpack $ Text.decodeUtf8 b-  return b--jotLbsUtf8M :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Sem r LBS.ByteString-  -> Sem r LBS.ByteString-jotLbsUtf8M a = GHC.withFrozenCallStack $ do-  !b <- evalM a-  jotWithCallstack GHC.callStack $ LT.unpack $ LT.decodeUtf8 b-  return b---- | Annotate the given string in a monadic context returning unit.-jotM_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Sem r String-  -> Sem r ()-jotM_ a = GHC.withFrozenCallStack $ do-  !b <- evalM a-  jotWithCallstack GHC.callStack b-  return ()---- | Annotate the given string in IO.-jotIO :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => IO String-  -> Sem r String-jotIO f = GHC.withFrozenCallStack $ do-  !a <- evalIO f-  jotWithCallstack GHC.callStack a-  return a---- | Annotate the given string in IO returning unit.-jotIO_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => IO String-  -> Sem r ()-jotIO_ f = GHC.withFrozenCallStack $ do-  !a <- evalIO f-  jotWithCallstack GHC.callStack a-  return ()---- | Annotate the given value.-jotShow :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => a-  -> Sem r a-jotShow a = GHC.withFrozenCallStack $ do-  !b <- eval a-  jotWithCallstack GHC.callStack (show b)-  return b---- | Annotate the given value returning unit.-jotShow_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => a-  -> Sem r ()-jotShow_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack (show a)---- | Annotate the given value in a monadic context.-jotShowM :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Sem r a-  -> Sem r a-jotShowM a = GHC.withFrozenCallStack $ do-  !b <- evalM a-  jotWithCallstack GHC.callStack (show b)-  return b---- | Annotate the given value in a monadic context returning unit.-jotShowM_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Sem r a-  -> Sem r ()-jotShowM_ a = GHC.withFrozenCallStack $ do-  !b <- evalM a-  jotWithCallstack GHC.callStack (show b)-  return ()---- | Annotate the given value in IO.-jotShowIO :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => IO a-  -> Sem r a-jotShowIO f = GHC.withFrozenCallStack $ do-  !a <- evalIO f-  jotWithCallstack GHC.callStack (show a)-  return a---- | Annotate the given value in IO returning unit.-jotShowIO_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => IO a-  -> Sem r ()-jotShowIO_ f = GHC.withFrozenCallStack $ do-  !a <- evalIO f-  jotWithCallstack GHC.callStack (show a)-  return ()---- | Annotate the each value in the given traversable.-jotEach :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Traversable f-  => f a-  -> Sem r (f a)-jotEach as = GHC.withFrozenCallStack $ do-  for_ as $ jotWithCallstack GHC.callStack . show-  return as---- | Annotate the each value in the given traversable returning unit.-jotEach_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Traversable f-  => f a-  -> Sem r ()-jotEach_ as = GHC.withFrozenCallStack $ for_ as $ jotWithCallstack GHC.callStack . show---- | Annotate the each value in the given traversable in a monadic context.-jotEachM :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Traversable f-  => Sem r (f a)-  -> Sem r (f a)-jotEachM f = GHC.withFrozenCallStack $ do-  !as <- f-  for_ as $ jotWithCallstack GHC.callStack . show-  return as---- | Annotate the each value in the given traversable in a monadic context returning unit.-jotEachM_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Traversable f-  => Sem r (f a)-  -> Sem r ()-jotEachM_ f = GHC.withFrozenCallStack $ do-  !as <- f-  for_ as $ jotWithCallstack GHC.callStack . show---- | Annotate the each value in the given traversable in IO.-jotEachIO :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Traversable f-  => IO (f a)-  -> Sem r (f a)-jotEachIO f = GHC.withFrozenCallStack $ do-  !as <- evalIO f-  for_ as $ jotWithCallstack GHC.callStack . show-  return as---- | Annotate the each value in the given traversable in IO returning unit.-jotEachIO_ :: ()-  => Member Hedgehog r-  => GHC.HasCallStack-  => Show a-  => Traversable f-  => IO (f a)-  -> Sem r ()-jotEachIO_ f = GHC.withFrozenCallStack $ do-  !as <- evalIO f-  for_ as $ jotWithCallstack GHC.callStack . show
− src/HaskellWorks/Polysemy/Hedgehog/Property.hs 
@@ -1,44 +0,0 @@-module HaskellWorks.Polysemy.Hedgehog.Property-  ( Property-  , propertyOnce--  ) where--import qualified GHC.Stack                                      as GHC-import           HaskellWorks.Polysemy.Prelude--import           Hedgehog                                       (Property)-import qualified Hedgehog                                       as H--import           Control.Monad.IO.Class                         (liftIO)-import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog-import           HaskellWorks.Polysemy.Hedgehog.Effect.Log-import           Polysemy-import           Polysemy.Embed-import           Polysemy.Log-import           Polysemy.Time.Interpreter.Ghc--propertyOnce :: ()-  => Sem-        [ Log-        , DataLog (LogEntry LogMessage)-        , DataLog Text-        , GhcTime-        , Hedgehog-        , Embed IO-        , Embed (H.PropertyT IO)-        , Final (H.PropertyT IO)-        ] ()-  -> H.Property-propertyOnce f = f-  & interpretLogDataLog-  & setLogLevel (Just Info)-  & interpretDataLogHedgehog formatLogEntry getLogEntryCallStack-  & interpretDataLogHedgehog id (const GHC.callStack)-  & interpretTimeGhc-  & hedgehogToIntegrationFinal-  & runEmbedded liftIO-  & embedToFinal @(H.PropertyT IO)-  & runFinal-  & H.property-  & H.withTests 1
− src/HaskellWorks/Polysemy/IO.hs 
@@ -1,26 +0,0 @@-module HaskellWorks.Polysemy.IO-  ( readFile-  ) where--import qualified Control.Exception             as CE-import qualified Data.Text                     as Text-import qualified GHC.Stack                     as GHC-import           HaskellWorks.Polysemy.Prelude-import qualified System.IO                     as IO--import           Polysemy-import           Polysemy.Error-import           Polysemy.Log---- | Read the contents of the 'filePath' file.-readFile :: ()-  => GHC.HasCallStack-  => Member (Error IOException) r-  => Member (Embed IO) r-  => Member Log r-  => FilePath-  -> Sem r String-readFile filePath = GHC.withFrozenCallStack $ do-  info $ "Reading string file: " <> Text.pack filePath-  r <- embed $ CE.try @IOException $ IO.readFile filePath-  fromEither r
− src/HaskellWorks/Polysemy/Prelude.hs 
@@ -1,167 +0,0 @@-module HaskellWorks.Polysemy.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-  , ($!)-  , ($)-  , (&)-  , (.)-  , (</>)--  , 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_--  , Monad(..)-  , MonadFail(..)-  , MonadPlus(..)-  , Applicative(..)-  , Alternative(..)-  , Contravariant(..)-  , Divisible(..)-  , Functor(..)-  , Bifunctor(..)-  , Semigroup(..)-  , Monoid(..)-  , Foldable(..)-  , Traversable(..)--  , IO--  , CallStack-  , HasCallStack-  , withFrozenCallStack--  , Generic--  , IOException-  , SomeException(..)-  ) where--import           Control.Applicative-import           Control.Exception-import           Control.Monad-import           Data.Bifunctor-import           Data.Bool-import           Data.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-import           Data.Traversable-import           Data.Tuple-import           Data.Void-import           Data.Word-import           GHC.Base-import           GHC.Generics-import           GHC.Num-import           GHC.Stack-import           System.FilePath-import           Text.Show--import qualified Data.Text                            as T--tshow :: Show a => a -> Text-tshow = T.pack . show
− src/HaskellWorks/Polysemy/Text.hs 
@@ -1,144 +0,0 @@-module HaskellWorks.Polysemy.Text-  ( Text--  -- * Creation and elimination-  , pack-  , unpack-  , singleton-  , empty--  -- * Basic interface-  , length-  , compareLength-  , null--  -- * Transformations-  , map-  , intercalate-  , intersperse-  , transpose-  , reverse-  , replace--  -- ** Case conversion-  -- $case-  , toCaseFold-  , toLower-  , toUpper-  , toTitle--  -- ** Justification-  , justifyLeft-  , justifyRight-  , center--  -- * Folds-  , foldl-  , foldl'-  , foldl1-  , foldl1'-  , foldr-  , foldr'-  , foldr1--  -- ** Special folds-  , concat-  , concatMap-  , any-  , all-  , maximum-  , minimum-  , isAscii--  -- * Construction--  -- ** Scans-  , scanl-  , scanl1-  , scanr-  , scanr1--  -- ** Accumulating maps-  , mapAccumL-  , mapAccumR--  -- ** Generation and unfolding-  , replicate-  , unfoldr-  , unfoldrN--  -- * Substrings--  -- ** Breaking strings-  , take-  , takeEnd-  , drop-  , dropEnd-  , takeWhile-  , takeWhileEnd-  , dropWhile-  , dropWhileEnd-  , dropAround-  , strip-  , stripStart-  , stripEnd-  , splitAt-  , breakOn-  , breakOnEnd-  , break-  , span-  , spanM-  , spanEndM-  , group-  , groupBy-  , inits-  , tails--  -- ** Breaking into many substrings-  -- $split-  , splitOn-  , split-  , chunksOf--  -- ** Breaking into lines and words-  , lines-  --, lines'-  , words-  , unlines-  , unwords--  -- * Predicates-  , isPrefixOf-  , isSuffixOf-  , isInfixOf--  -- ** View patterns-  , stripPrefix-  , stripSuffix-  , commonPrefixes--  -- * Searching-  , filter-  , breakOnAll-  , find-  , elem-  , partition--  -- , findSubstring--  -- * Indexing-  -- $index-  , index-  , findIndex-  , count--  -- * Zipping-  , zip-  , zipWith--  -- * File reading-  , readFile--  ) where--import           HaskellWorks.Polysemy.Text.Strict
− src/HaskellWorks/Polysemy/Text/Lazy.hs 
@@ -1,164 +0,0 @@-module HaskellWorks.Polysemy.Text.Lazy-  ( LT.Text--  -- * Creation and elimination-  , LT.pack-  , LT.unpack-  , LT.singleton-  , LT.empty--  -- * Basic interface-  , LT.length-  , LT.compareLength--  -- * Transformations-  , LT.map-  , LT.intercalate-  , LT.intersperse-  , LT.transpose-  , LT.reverse-  , LT.replace--  -- ** Case conversion-  -- $case-  , LT.toCaseFold-  , LT.toLower-  , LT.toUpper-  , LT.toTitle--  -- ** Justification-  , LT.justifyLeft-  , LT.justifyRight-  , LT.center--  -- * Folds-  , LT.foldl-  , LT.foldl'-  , LT.foldl1-  , LT.foldl1'-  , LT.foldr-  , LT.foldr1--  -- ** Special folds-  , LT.concat-  , LT.concatMap-  , LT.any-  , LT.all-  , LT.maximum-  , LT.minimum-  , LT.isAscii--  -- * Construction--  -- ** Scans-  , LT.scanl-  , LT.scanl1-  , LT.scanr-  , LT.scanr1--  -- ** Accumulating maps-  , LT.mapAccumL-  , LT.mapAccumR--  -- ** Generation and unfolding-  , LT.replicate-  , LT.unfoldr-  , LT.unfoldrN--  -- * Substrings--  -- ** Breaking strings-  , LT.take-  , LT.takeEnd-  , LT.drop-  , LT.dropEnd-  , LT.takeWhile-  , LT.takeWhileEnd-  , LT.dropWhile-  , LT.dropWhileEnd-  , LT.dropAround-  , LT.strip-  , LT.stripStart-  , LT.stripEnd-  , LT.splitAt-  , LT.breakOn-  , LT.breakOnEnd-  , LT.break-  , LT.span-  , LT.spanM-  , LT.spanEndM-  , LT.group-  , LT.groupBy-  , LT.inits-  , LT.tails--  -- ** Breaking into many substrings-  -- $split-  , LT.splitOn-  , LT.split-  , LT.chunksOf--  -- ** Breaking into lines and words-  , LT.lines-  --, LT.lines'-  , LT.words-  , LT.unlines-  , LT.unwords--  -- * Predicates-  , LT.isPrefixOf-  , LT.isSuffixOf-  , LT.isInfixOf--  -- ** View patterns-  , LT.stripPrefix-  , LT.stripSuffix-  , LT.commonPrefixes--  -- * Searching-  , LT.filter-  , LT.breakOnAll-  , LT.find-  , LT.elem-  , LT.partition--  -- , LT.findSubstring--  -- * Indexing-  -- $index-  , LT.index-  , LT.count--  -- * Zipping-  , LT.zip-  , LT.zipWith--  -- * File reading-  , readFile--  ) where--import qualified Control.Exception             as CE-import qualified Data.Text                     as T-import qualified Data.Text.Lazy                as LT-import qualified Data.Text.Lazy.IO             as LT-import qualified GHC.Stack                     as GHC-import           HaskellWorks.Polysemy.Prelude--import           Polysemy-import           Polysemy.Error-import           Polysemy.Log---- | Read the contents of the 'filePath' file.-readFile :: ()-  => GHC.HasCallStack-  => Member (Error IOException) r-  => Member (Embed IO) r-  => Member Log r-  => FilePath-  -> Sem r LT.Text-readFile filePath =-  GHC.withFrozenCallStack $ do-    info $ "Reading text file: " <> T.pack filePath-    r <- embed $ CE.try @IOException $ LT.readFile filePath-    fromEither r
− src/HaskellWorks/Polysemy/Text/Strict.hs 
@@ -1,164 +0,0 @@-module HaskellWorks.Polysemy.Text.Strict-  ( T.Text--  -- * Creation and elimination-  , T.pack-  , T.unpack-  , T.singleton-  , T.empty--  -- * Basic interface-  , T.length-  , T.compareLength-  , T.null--  -- * Transformations-  , T.map-  , T.intercalate-  , T.intersperse-  , T.transpose-  , T.reverse-  , T.replace--  -- ** Case conversion-  -- $case-  , T.toCaseFold-  , T.toLower-  , T.toUpper-  , T.toTitle--  -- ** Justification-  , T.justifyLeft-  , T.justifyRight-  , T.center--  -- * Folds-  , T.foldl-  , T.foldl'-  , T.foldl1-  , T.foldl1'-  , T.foldr-  , T.foldr'-  , T.foldr1--  -- ** Special folds-  , T.concat-  , T.concatMap-  , T.any-  , T.all-  , T.maximum-  , T.minimum-  , T.isAscii--  -- * Construction--  -- ** Scans-  , T.scanl-  , T.scanl1-  , T.scanr-  , T.scanr1--  -- ** Accumulating maps-  , T.mapAccumL-  , T.mapAccumR--  -- ** Generation and unfolding-  , T.replicate-  , T.unfoldr-  , T.unfoldrN--  -- * Substrings--  -- ** Breaking strings-  , T.take-  , T.takeEnd-  , T.drop-  , T.dropEnd-  , T.takeWhile-  , T.takeWhileEnd-  , T.dropWhile-  , T.dropWhileEnd-  , T.dropAround-  , T.strip-  , T.stripStart-  , T.stripEnd-  , T.splitAt-  , T.breakOn-  , T.breakOnEnd-  , T.break-  , T.span-  , T.spanM-  , T.spanEndM-  , T.group-  , T.groupBy-  , T.inits-  , T.tails--  -- ** Breaking into many substrings-  -- $split-  , T.splitOn-  , T.split-  , T.chunksOf--  -- ** Breaking into lines and words-  , T.lines-  --, T.lines'-  , T.words-  , T.unlines-  , T.unwords--  -- * Predicates-  , T.isPrefixOf-  , T.isSuffixOf-  , T.isInfixOf--  -- ** View patterns-  , T.stripPrefix-  , T.stripSuffix-  , T.commonPrefixes--  -- * Searching-  , T.filter-  , T.breakOnAll-  , T.find-  , T.elem-  , T.partition--  -- * Indexing-  -- $index-  , T.index-  , T.findIndex-  , T.count--  -- * Zipping-  , T.zip-  , T.zipWith--  -- * File reading-  , readFile--  ) where--import qualified Control.Exception             as CE-import qualified Data.Text                     as T-import qualified Data.Text.IO                  as T-import qualified GHC.Stack                     as GHC-import           HaskellWorks.Polysemy.Prelude--import           Polysemy-import           Polysemy.Error-import           Polysemy.Log---- | Read the contents of the 'filePath' file.-readFile :: ()-  => GHC.HasCallStack-  => Member (Error IOException) r-  => Member (Embed IO) r-  => Member Log r-  => FilePath-  -> Sem r Text-readFile filePath =-  GHC.withFrozenCallStack $ do-    info $ "Reading text file: " <> T.pack filePath-    r <- embed $ CE.try @IOException $ T.readFile filePath-    fromEither r
test/HaskellWorks/Polysemy/HedgehogSpec.hs view
@@ -9,9 +9,9 @@ import           HaskellWorks.Polysemy.Prelude  import qualified Data.List                             as L+import qualified HaskellWorks.Polysemy.Data.Text       as T import           HaskellWorks.Polysemy.Hedgehog import           HaskellWorks.Polysemy.Hedgehog.Assert-import qualified HaskellWorks.Polysemy.Text            as T  default (String)