polysemy-extra 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+116/−42 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• LICENSE +16/−27
• polysemy-extra.cabal +1/−1
• src/Polysemy/Extra.hs +95/−14

@@ -1,5 +1,9 @@ # Changelog for polysemy-extra +## v0.1.2.0++* Add `rotateEffects2`, `rotateEffects3L` and `rotateEffects3R`.+ ## v0.1.1.0  * Add `reinterpretUnder`, `reinterpretUnder2` and `reinterpret2Under`.

@@ -1,30 +1,19 @@-Copyright Daniel Firth (c) 2020--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+Copyright (c) 2020 Daniel Firth -    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+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: -    * Neither the name of Author name here nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+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.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-extra-version:        0.1.1.0+version:        0.1.2.0 synopsis:       Extra Input and Output functions for polysemy.. category:       Polysemy author:         Daniel Firth

@@ -1,14 +1,45 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DataKinds      #-}-{-# LANGUAGE GADTs          #-}-{-# LANGUAGE LambdaCase     #-}-{-# LANGUAGE RankNTypes     #-}-{-# LANGUAGE PolyKinds      #-}+{-|+Module      : Polysemy.Extra+License     : MIT+Maintainer  : dan.firth@homotopic.tech+Stability   : experimental++Extra convenience functions for polysemy.+-}+{-# LANGUAGE BlockArguments      #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE PolyKinds           #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators  #-}-module Polysemy.Extra where+{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE TypeOperators       #-}+module Polysemy.Extra (+-- * Input+  contramapInput+, contramapInputSem +-- * Output+, mapOutput+, mapOutputSem+, runOutputMapAsKVStore++-- * KVStore+, runKVStoreAsKVStore+, runKVStoreAsKVStoreSem++-- * Combinatorial Reinterpreters+, reinterpretUnder+, reinterpretUnder2+, reinterpret2Under++-- * Rotation+, rotateEffects2+, rotateEffects3L+, rotateEffects3R+) where+ import Control.Arrow import Data.Map as Map import Polysemy@@ -17,25 +48,35 @@ import Polysemy.Output import Polysemy.Membership --- | Run a KVStore in terms of another KVStore by way of pure key and value+-- | Run a `KVStore` in terms of another `KVStore` by way of pure key and value -- transformations.+--+-- @since 0.1.0.0 runKVStoreAsKVStore :: forall k v k' v' r a.                        (k  -> k')+                       -- ^ A function to transform the key into the interpreted key.                     -> (v  -> v')+                       -- ^ A function to transform the value into the interpreted value.                     -> (v' -> v )+                       -- ^ A function to transform the interpreted key back into the current value.                     -> Sem (KVStore k v ': r) a                     -> Sem (KVStore k' v' ': r) a runKVStoreAsKVStore f g h = reinterpret \case   LookupKV k   -> fmap h <$> lookupKV @k' @v' (f k)   UpdateKV k x -> updateKV @k' @v' (f k) (fmap g x) --- | Run a KVStore in terms of another KVStore by way of transforming the+-- | Run a `KVStore` in terms of another `KVStore` by way of transforming the -- keys and values with Sem functions.+--+-- @since 0.1.0.0 runKVStoreAsKVStoreSem :: forall k v k' v' r a.                           Members '[KVStore k' v'] r                        => (k  -> Sem r k')+                          -- ^ A function to transform the key into the interpreted key.                        -> (v  -> Sem r v')+                          -- ^ A function to transform the value into the interpreted value.                        -> (v' -> Sem r v )+                          -- ^ A function to transform the interpreted value back into the current value.                        -> Sem (KVStore k v ': r) a                        -> Sem r a runKVStoreAsKVStoreSem f g h = interpret \case@@ -45,51 +86,67 @@     z' <- mapM g x     updateKV @k' @v' z z' --- | Run an `Output (Map k v)` as a `KVStore` by writing the values to+-- | Run an `Output` (`Map` k v) as a `KVStore` by writing the values to -- the keys.+--+-- @since 0.1.0.0 runOutputMapAsKVStore :: Members '[ KVStore k v ] r                       => Sem (Output (Map k v) ': r) a                       -> Sem r a runOutputMapAsKVStore = interpret \case   Output xs -> mapM_ (uncurry writeKV) (Map.toList xs) --- | Map an Output forwards+-- | Map an `Output` covariantly.+--+-- @since 0.1.0.0 mapOutput :: Members '[ Output o' ] r           => (o -> o')+             -- ^ A function to map the old output to the new output.           -> Sem (Output o ': r) a           -> Sem r a mapOutput f = interpret \case   Output o -> output (f o) --- | Map an Output forwards through a monadic function.+-- | Map an `Output` covariantly through a monadic function.+--+-- @since 0.1.0.0 mapOutputSem :: Members '[ Output o' ] r              => (o -> Sem r o')+                -- ^ A function to map the old output to the new output.              -> Sem (Output o ': r) a              -> Sem r a mapOutputSem f = interpret \case   Output o -> f o >>= output  -- | Map an `Input` contravariantly.+-- @since 0.1.0.0 contramapInput :: forall i i' r a.             Members '[ Input i' ] r          => (i' -> i)+            -- ^ A function to map the new input to the old input.          -> Sem (Input i ': r) a          -> Sem r a contramapInput f = interpret \case   Input -> f <$> input @i'  -- | Map an `Input` contravariantly through a monadic function.+--+-- @since 0.1.0.0 contramapInputSem :: forall i i' r a.                      Members '[ Input i' ] r                   => (i' -> Sem r i)+                     -- ^ A function to map the new input to the old input.                   -> Sem (Input i ': r) a                   -> Sem r a contramapInputSem f = interpret \case   Input -> f =<< input @i'  -- | Reinterpret the second effect in the stack into a single effect.+--+-- @since 0.1.1.0 reinterpretUnder :: forall e1 e2 e3 r a.                     (forall m x. Sem (e2 ': m) x -> Sem (e3 ': m) x)+                    -- ^ A natural transformation from the handled effect to the new effects.                  -> Sem (e1 ': e2 ': r) a                  -> Sem (e1 ': e3 ': r) a reinterpretUnder f = raise2Under @e1 @e1 @e2@@ -99,8 +156,11 @@                  >>> subsumeUsing @e3 (There Here)  -- | Reinterpret the third effect in the stack into a single effect.+--+-- @since 0.1.1.0 reinterpretUnder2 :: forall e1 e2 e3 e4 r a.                      (forall m x. Sem (e3 ': m) x -> Sem (e4 ': m) x)+                     -- ^ A natural transformation from the handled effect to the new effects.                   -> Sem (e1 ': e2 ': e3 ': r) a                   -> Sem (e1 ': e2 ': e4 ': r) a reinterpretUnder2 f = raise3Under @e1 @e1 @e2 @e3@@ -112,8 +172,11 @@                   >>> subsumeUsing @e4 (There $ There Here)  -- | Reinterpret the second effect in the stack in terms of two effects.+--+-- @since 0.1.1.0 reinterpret2Under :: forall e1 e2 e3 e4 r a.                      (forall m x. Sem (e2 ': m) x -> Sem (e3 ': e4 ': m) x)+                     -- ^ A natural transformation from the handled effect to the new effects.                   -> Sem (e1 ': e2 ': r) a                   -> Sem (e1 ': e3 ': e4 ': r) a reinterpret2Under f = raise2Under @e1 @e1 @e2@@ -123,3 +186,21 @@                   >>> subsumeUsing @e3 (There $ There Here)                   >>> raise3Under @e4 @e4 @e1 @e3                   >>> subsumeUsing @e4 (There $ There Here)++-- | Swap the positions of the first two effects in the stack.+--+-- @since 0.1.2.0+rotateEffects2 :: forall e1 e2 r a. Sem (e1 ': e2 ': r) a -> Sem (e2 ': e1 ': r) a+rotateEffects2 = raise2Under >>> subsumeUsing (There Here)++-- | Rotate the first three effects in the stack to the left.+--+-- @since 0.1.2.0+rotateEffects3L :: forall e1 e2 e3 r a. Sem (e1 ': e2 ': e3 ': r) a -> Sem (e2 ': e3 ': e1 ': r) a+rotateEffects3L = raise3Under >>> subsumeUsing (There $ There Here)++-- | Rotate the first three effects in the stack to the right.+--+-- @since 0.1.2.0+rotateEffects3R :: forall e1 e2 e3 r a. Sem (e1 ': e2 ': e3 ': r) a -> Sem (e3 ': e1 ': e2 ': r) a+rotateEffects3R = rotateEffects3L >>> rotateEffects3L