hw-polysemy (empty) → 0.1.0.0
raw patch · 25 files changed
+1634/−0 lines, 25 filesdep +basedep +bytestringdep +filepath
Dependencies added: base, bytestring, filepath, hedgehog, hw-polysemy, polysemy, polysemy-log, polysemy-plugin, polysemy-time, tasty, tasty-hedgehog, text
Files
- CHANGELOG.md +5/−0
- LICENSE +202/−0
- README.md +1/−0
- hw-polysemy.cabal +95/−0
- src/HaskellWorks/Polysemy.hs +1/−0
- src/HaskellWorks/Polysemy/ByteString.hs +5/−0
- src/HaskellWorks/Polysemy/ByteString/Lazy.hs +25/−0
- src/HaskellWorks/Polysemy/ByteString/Strict.hs +25/−0
- src/HaskellWorks/Polysemy/Data/String.hs +20/−0
- src/HaskellWorks/Polysemy/Either.hs +15/−0
- src/HaskellWorks/Polysemy/Hedgehog.hs +56/−0
- src/HaskellWorks/Polysemy/Hedgehog/Assert.hs +84/−0
- src/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs +83/−0
- src/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog/Internal.hs +17/−0
- src/HaskellWorks/Polysemy/Hedgehog/Effect/Log.hs +26/−0
- src/HaskellWorks/Polysemy/Hedgehog/Eval.hs +28/−0
- src/HaskellWorks/Polysemy/Hedgehog/Jot.hs +284/−0
- src/HaskellWorks/Polysemy/Hedgehog/Property.hs +44/−0
- src/HaskellWorks/Polysemy/IO.hs +26/−0
- src/HaskellWorks/Polysemy/Prelude.hs +87/−0
- src/HaskellWorks/Polysemy/Text.hs +144/−0
- src/HaskellWorks/Polysemy/Text/Lazy.hs +164/−0
- src/HaskellWorks/Polysemy/Text/Strict.hs +164/−0
- test/HaskellWorks/Polysemy/HedgehogSpec.hs +32/−0
- test/Main.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hw-polysemy++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,1 @@+# Opinionated polysemy library
+ hw-polysemy.cabal view
@@ -0,0 +1,95 @@+cabal-version: 3.4+name: hw-polysemy+version: 0.1.0.0+synopsis: Opinionated polysemy library+description: Opinionated polysemy library.+license: Apache-2.0+license-file: LICENSE+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2024 John Ky+category: Development+build-type: Simple+extra-doc-files: CHANGELOG.md+extra-source-files: README.md++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-polysemy++common base { build-depends: base >= 4.18.2.1 && < 5 }++common bytestring { build-depends: bytestring < 0.13 }+common filepath { build-depends: filepath < 1.6 }+common hedgehog { build-depends: hedgehog < 1.5 }+common polysemy { build-depends: polysemy < 2 }+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 tasty { build-depends: tasty < 1.6 }+common tasty-hedgehog { build-depends: tasty-hedgehog < 1.5 }+common text { build-depends: text < 3 }++common hw-polysemy { build-depends: hw-polysemy }++common project-config+ import: polysemy,+ polysemy-plugin,+ default-extensions: BlockArguments+ DataKinds+ FlexibleContexts+ FlexibleInstances+ LambdaCase+ NoImplicitPrelude+ OverloadedStrings+ TypeApplications+ ghc-options: -Wall+ -fplugin=Polysemy.Plugin++library+ import: base, project-config,+ bytestring,+ filepath,+ hedgehog,+ polysemy,+ polysemy-log,+ polysemy-time,+ text,+ exposed-modules: HaskellWorks.Polysemy+ HaskellWorks.Polysemy.ByteString+ HaskellWorks.Polysemy.ByteString.Lazy+ HaskellWorks.Polysemy.ByteString.Strict+ HaskellWorks.Polysemy.Data.String+ HaskellWorks.Polysemy.Either+ 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.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+ default-language: GHC2021++test-suite hw-polysemy-test+ import: base, project-config,+ filepath,+ hw-polysemy,+ polysemy,+ polysemy-log,+ tasty-hedgehog,+ tasty,+ text,+ default-language: GHC2021+ type: exitcode-stdio-1.0+ build-tool-depends: tasty-discover:tasty-discover+ hs-source-dirs: test+ main-is: Main.hs+ other-modules: HaskellWorks.Polysemy.HedgehogSpec+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T
+ src/HaskellWorks/Polysemy.hs view
@@ -0,0 +1,1 @@+module HaskellWorks.Polysemy () where
+ src/HaskellWorks/Polysemy/ByteString.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Polysemy.ByteString+ ( readFile+ ) where++import HaskellWorks.Polysemy.ByteString.Strict
+ src/HaskellWorks/Polysemy/ByteString/Lazy.hs view
@@ -0,0 +1,25 @@+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 view
@@ -0,0 +1,25 @@+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 view
@@ -0,0 +1,20 @@+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 view
@@ -0,0 +1,15 @@+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/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
+ src/HaskellWorks/Polysemy/Hedgehog/Assert.hs view
@@ -0,0 +1,84 @@+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 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
+ src/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)
+ src/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
+ src/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
+ src/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.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 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
+ src/HaskellWorks/Polysemy/IO.hs view
@@ -0,0 +1,26 @@+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 view
@@ -0,0 +1,87 @@+module HaskellWorks.Polysemy.Prelude+ ( Bool(..)+ , Maybe(..)+ , Either(..)+ , String+ , Text+ , ByteString+ , Int+ , Int8+ , Int16+ , Int32+ , Int64+ , Word+ , Word8+ , Word16+ , Word32+ , Word64+ , FilePath++ , Eq(..)+ , Ord(..)+ , Show(..)+ , tshow++ , const+ , either+ , maybe+ , fst+ , snd+ , id+ , ($)+ , (&)+ , (.)+ , (</>)++ , void++ , for_++ , Monad(..)+ , Applicative(..)+ , Functor(..)+ , Bifunctor(..)+ , Semigroup(..)+ , Monoid(..)+ , Foldable(..)+ , Traversable(..)++ , IO++ , CallStack+ , HasCallStack+ , withFrozenCallStack++ , IOException+ , SomeException(..)+ ) where++import Control.Applicative+import Control.Exception+import Control.Monad+import Data.Bifunctor+import Data.Bool+import Data.ByteString+import Data.Either+import Data.Eq+import Data.Foldable+import Data.Function+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.Word+import GHC.Stack+import System.FilePath+import System.IO+import Text.Show++import qualified Data.Text as T++tshow :: Show a => a -> Text+tshow = T.pack . show
+ src/HaskellWorks/Polysemy/Text.hs view
@@ -0,0 +1,144 @@+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 view
@@ -0,0 +1,164 @@+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 view
@@ -0,0 +1,164 @@+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
@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}++module HaskellWorks.Polysemy.HedgehogSpec+ ( hprop_example+ ) where++import HaskellWorks.Polysemy.Prelude++import qualified Data.List as L+import HaskellWorks.Polysemy.Hedgehog+import HaskellWorks.Polysemy.Hedgehog.Assert+import qualified HaskellWorks.Polysemy.Text as T++default (String)++hprop_example :: Property+hprop_example = propertyOnce $ do+ let projectRoot = "."++ contents <- T.readFile (projectRoot </> "LICENSE")+ & catchFail @IOException++ line1 <- T.lines contents+ & L.dropWhile T.null+ & requireHead+ & jotShowM++ let text = T.strip line1++ text === "Apache License"
+ test/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}