quiver-instances (empty) → 0.1.0.0
raw patch · 6 files changed
+196/−0 lines, 6 filesdep +basedep +exceptionsdep +quiversetup-changed
Dependencies added: base, exceptions, quiver, transformers
Files
- LICENSE +20/−0
- README.md +13/−0
- Setup.hs +2/−0
- quiver-instances.cabal +37/−0
- src/Control/Quiver/Instances.hs +80/−0
- stack.yaml +44/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Ivan Lazar Miljenovic++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,13 @@+quiver-instances+================++[](https://hackage.haskell.org/package/quiver-instances) [](https://travis-ci.org/ivan-m/quiver-instances)++Various extra instances for [Quiver] that aren't yet in the main+library.++At this time these consist of instances for the typeclasses found in+the [exceptions] library.++[Quiver]: http://hackage.haskell.org/package/quiver+[exceptions]: http://hackage.haskell.org/package/exceptions
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ quiver-instances.cabal view
@@ -0,0 +1,37 @@+name: quiver-instances+version: 0.1.0.0+synopsis: Extra instances for Quiver+description:+ Various extra instances for Quiver that aren't yet in the main library.+ .+ Currently this provides instances for the 'MonadThrow', 'MonadCatch'+ and 'MonadMask' classes from the+ <http://hackage.haskell.org/package/exceptions exceptions> library.+license: MIT+license-file: LICENSE+author: Ivan Lazar Miljenovic+maintainer: Ivan.Miljenovic@gmail.com+-- copyright:+category: Control+build-type: Simple+extra-source-files: README.md+ , stack.yaml+cabal-version: >=1.10++tested-with: GHC == 7.10.2, GHC == 7.11.*++source-repository head+ type: git+ location: https://github.com/ivan-m/quiver-sort.git++library+ exposed-modules: Control.Quiver.Instances+ -- other-modules:+ build-depends: base >=4.8 && <4.9+ , exceptions == 0.8.*+ , quiver >= 1.1.3 && < 1.2+ , transformers+ hs-source-dirs: src+ default-language: Haskell2010++ ghc-options: -Wall
+ src/Control/Quiver/Instances.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE RankNTypes #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{- |+ Module : Control.Quiver.Instances+ Description : Extra instances for Quiver+ Copyright : (c) Ivan Lazar Miljenovic+ License : MIT+ Maintainer : Ivan.Miljenovic@gmail.com++Currently this provides instances for the 'MonadThrow', 'MonadCatch'+and 'MonadMask' classes from the+<http://hackage.haskell.org/package/exceptions exceptions> library.++ -}+module Control.Quiver.Instances () where++import Control.Quiver.Internal++import Control.Monad.Catch+import Control.Monad.IO.Class (MonadIO (..))+import Data.IORef (newIORef, readIORef, writeIORef)++--------------------------------------------------------------------------------++-- | Throws exceptions into the base monad.+instance (MonadThrow f) => MonadThrow (P a a' b b' f) where+ throwM = qlift . throwM++instance (MonadCatch f) => MonadCatch (P a a' b b' f) where+ catch p onErr = go p+ where+ go p' = case p' of+ Consume x k q -> consume x (go . k) (decouple (go q))+ Produce y k q -> produce y (go . k) (deplete (go q))+ Enclose m -> enclose (catch (go <$> m) (return . onErr))+ Deliver r -> deliver r++-- Based upon code in pipes-safe++instance (MonadIO f, MonadMask f) => MonadMask (P a a' b b' f) where+ mask = liftMask mask++ uninterruptibleMask = liftMask uninterruptibleMask++data Restore m = Unmasked | Masked (forall x . m x -> m x)++liftMask :: (MonadIO f, MonadMask f)+ => (forall s. ((forall x. f x -> f x) -> f s) -> f s)+ -> ((forall x. P a a' b b' f x -> P a a' b b' f x)+ -> P a a' b b' f r)+ -> P a a' b b' f r+liftMask maskVariant pk = do+ ioref <- liftIO $ newIORef Unmasked++ let+ -- Mask actions in the base monad+ maskM p = case p of+ Consume x k q -> consume x (maskM . k) (decouple (maskM q))+ Produce y k q -> produce y (maskM . k) (deplete (maskM q))+ Enclose m -> enclose $ maskVariant $ \unmaskVariant -> do+ -- stash base's unmask and merge action+ liftIO $ writeIORef ioref $ Masked unmaskVariant+ maskM <$> (m >>= mergeAdjacent)+ Deliver r -> deliver r++ unmask p = case p of+ Consume x k q -> consume x (unmask . k) (decouple (unmask q))+ Produce y k q -> produce y (unmask . k) (deplete (unmask q))+ Enclose m -> enclose $ do+ -- retrieve base's unmask and apply to merged action+ Masked unmaskVariant <- liftIO $ readIORef ioref+ unmaskVariant (unmask <$> (m >>= mergeAdjacent))+ Deliver r -> deliver r++ mergeAdjacent p = case p of+ Enclose m -> m >>= mergeAdjacent+ _ -> return p+ maskM (pk unmask)
+ stack.yaml view
@@ -0,0 +1,44 @@+# This file was automatically generated by stack init+# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/++# A message to be displayed to the user. Used when autogenerated config ignored some packages or added extra deps.+user-message: ! 'Warning: Specified resolver could not satisfy all dependencies. Some+ external packages have been added as dependencies.++ You can suppress this message by removing it from stack.yaml++'++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-5.11++# Local packages, usually specified by relative directory name+packages:+- '.'+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps:+- quiver-1.1.3++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true++# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: >= 1.0.0++# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64++# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]++# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor