polysemy-vinyl 0.1.4.0 → 0.1.5.0

raw patch · 3 files changed

+106/−70 lines, 3 filesdep +polysemy-severaldep ~polysemydep ~polysemy-extradep ~vinylPVP ok

version bump matches the API change (PVP)

Dependencies added: polysemy-several

Dependency ranges changed: polysemy, polysemy-extra, vinyl

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• polysemy-vinyl.cabal +6/−5
• src/Polysemy/Vinyl.hs +96/−65

@@ -1,5 +1,9 @@ # Changelog for polysemy-vinyl +## v0.1.5.0++* Add `runSeveral`.+ ## v0.1.4.0  * Fix export of `runInputConstFC`.

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack  name:           polysemy-vinyl-version:        0.1.4.0+version:        0.1.5.0 synopsis:       Functions for mapping vinyl records in polysemy. description:    Extra functions for using vinyl records in polysemy. category:       Polysemy Vinyl@@ -33,7 +33,8 @@   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:       base >=4.7 && <5-    , polysemy-    , polysemy-extra >=0.1.6.0-    , vinyl+    , polysemy >=1.3 && <1.7+    , polysemy-extra >=0.1.6.0 && <0.3+    , polysemy-several ==0.1.*+    , vinyl >=0.10.0 && <0.14   default-language: Haskell2010

@@ -1,61 +1,70 @@-{-|-Module      : Polysemy.Vinyl-License     : MIT-Maintainer  : dan.firth@homotopic.tech-Stability   : experimental--Extra functions for using vinyl records with polysemy.--}-{-# LANGUAGE BlockArguments      #-}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeOperators       #-}-module Polysemy.Vinyl (-  rContramapInput-, rContramapInput'-, rMapOutput-, rMapOutput'-, separateRecInput-, separateRecInput'-, stripRecInput-, endRecInput-, runInputConstFC-) where+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} -import Control.Arrow+-- |+-- Module      : Polysemy.Vinyl+-- License     : MIT+-- Maintainer  : dan.firth@homotopic.tech+-- Stability   : experimental+--+-- Extra functions for using vinyl records with polysemy.+module Polysemy.Vinyl+  ( rContramapInput,+    rContramapInput',+    rMapOutput,+    rMapOutput',+    separateRecInput,+    separateRecInput',+    stripRecInput,+    endRecInput,+    runInputConstFC,+    runSeveral,+  )+where+ import Control.Applicative+import Control.Arrow+import Data.Kind import Data.Vinyl import Data.Vinyl.Functor import Polysemy import Polysemy.Extra import Polysemy.Input import Polysemy.Output+import Polysemy.Several hiding (runSeveral)  -- | Map an `Input` containing a `Rec` contravariantly via a natural transformation. -- Uses `rmap`. -- -- @since 0.1.0.0-rContramapInput :: (RMap xs, Members '[Input (Rec f xs)] r)-                => (forall y. f y -> g y)-                   -- ^ A natural transformation from f to g.-                -> Sem (Input (Rec g xs) ': r) a-                -> Sem r a+rContramapInput ::+  (RMap xs, Members '[Input (Rec f xs)] r) =>+  -- | A natural transformation from f to g.+  (forall y. f y -> g y) ->+  Sem (Input (Rec g xs) ': r) a ->+  Sem r a rContramapInput k = contramapInput (rmap k) {-# INLINE rContramapInput #-}  -- | Reinterpreting version of `rContramapInput`. -- -- @since 0.1.0.0-rContramapInput' :: RMap xs-                 => (forall y. f y -> g y)-                    -- ^ A natural transformation from f to g.-                 -> Sem (Input (Rec g xs) ': r) a-                 -> Sem (Input (Rec f xs) ': r) a+rContramapInput' ::+  RMap xs =>+  -- | A natural transformation from f to g.+  (forall y. f y -> g y) ->+  Sem (Input (Rec g xs) ': r) a ->+  Sem (Input (Rec f xs) ': r) a rContramapInput' k = raiseUnder >>> rContramapInput k {-# INLINE rContramapInput' #-} @@ -63,33 +72,39 @@ -- Uses `rmap`. -- -- @since 0.1.0.0-rMapOutput :: (RMap xs, Members '[Output (Rec g xs)] r)-           => (forall y. f y -> g y)-              -- ^ A natural transformation from f to g.-           -> Sem (Output (Rec f xs) ': r) a-           -> Sem r a+rMapOutput ::+  (RMap xs, Members '[Output (Rec g xs)] r) =>+  -- | A natural transformation from f to g.+  (forall y. f y -> g y) ->+  Sem (Output (Rec f xs) ': r) a ->+  Sem r a rMapOutput k = mapOutput (rmap k) {-# INLINE rMapOutput #-}  -- | Reinterpreting version of `rMapOutput`. -- -- @since 0.1.0.0-rMapOutput' :: RMap xs-            => (forall y. f y -> g y)-               -- ^ A natural transformation from f to g.-            -> Sem (Output (Rec f xs) ': r) a-            -> Sem (Output (Rec g xs) ': r) a+rMapOutput' ::+  RMap xs =>+  -- | A natural transformation from f to g.+  (forall y. f y -> g y) ->+  Sem (Output (Rec f xs) ': r) a ->+  Sem (Output (Rec g xs) ': r) a rMapOutput' k = raiseUnder >>> rMapOutput k {-# INLINE rMapOutput' #-}  -- | Separate one of the fields of an `Input` `Rec` into its own `Input`. -- -- @since 0.1.2.0-separateRecInput :: forall f x xs r a.-                    Members '[ Input (Rec f xs)-                             , Input (f x)] r-                 => Sem (Input (Rec f (x ': xs)) ': r) a-                 -> Sem r a+separateRecInput ::+  forall f x xs r a.+  Members+    '[ Input (Rec f xs),+       Input (f x)+     ]+    r =>+  Sem (Input (Rec f (x ': xs)) ': r) a ->+  Sem r a separateRecInput = interpret \case   Input -> liftA2 (:&) (input @(f x)) (input @(Rec f xs)) {-# INLINE separateRecInput #-}@@ -98,10 +113,11 @@ -- the separated case first. -- -- @since 0.1.2.0-separateRecInput' :: forall f x xs r a.-                     Sem (Input (Rec f (x ': xs)) ': r) a-                  -> Sem (Input (f x) ': Input (Rec f xs) ': r) a-separateRecInput'= reinterpret2 \case+separateRecInput' ::+  forall f x xs r a.+  Sem (Input (Rec f (x ': xs)) ': r) a ->+  Sem (Input (f x) ': Input (Rec f xs) ': r) a+separateRecInput' = reinterpret2 \case   Input -> liftA2 (:&) (input @(f x)) (raise $ input @(Rec f xs)) {-# INLINE separateRecInput' #-} @@ -110,10 +126,11 @@ -- want to eliminate the record first by repeated applications of `stripRecInput`. -- -- @since 0.1.2.0-stripRecInput :: forall f x xs r a.-                 Members '[Input (f x)] (Input (Rec f xs) ': r)-              => Sem (Input (Rec f (x ': xs)) ': r) a-              -> Sem (Input (Rec f xs) ':  r) a+stripRecInput ::+  forall f x xs r a.+  Members '[Input (f x)] (Input (Rec f xs) ': r) =>+  Sem (Input (Rec f (x ': xs)) ': r) a ->+  Sem (Input (Rec f xs) ': r) a stripRecInput = reinterpret \case   Input -> liftA2 (:&) (input @(f x)) (input @(Rec f xs)) {-# INLINE stripRecInput #-}@@ -129,9 +146,23 @@ -- | Like `runInputConstF` but for vinyl composed functors. -- -- @since 0.1.3.0-runInputConstFC :: forall b f g r a.-                   f (g b)-                -> Sem (Input ((f :. g) b) ': r) a-                -> Sem r a+runInputConstFC ::+  forall b f g r a.+  f (g b) ->+  Sem (Input ((f :. g) b) ': r) a ->+  Sem r a runInputConstFC f = runInputConstF @b @(f :. g) (Compose f) {-# INLINE runInputConstFC #-}++-- | Like `Polysemy.Several.runSeveral` but for a vinyl `Rec`.+--+-- @since 0.1.5.0+runSeveral ::+  forall (e :: Type -> Effect) f (r :: [Effect]) xs a.+  (forall r' k x. k -> Sem (e k ': r') x -> Sem r' x) ->+  Rec f xs ->+  Sem (Append (TypeMap e (TypeMap f xs)) r) a ->+  Sem r a+runSeveral f (a :& as) = runSeveral f as . f a+runSeveral _ RNil = id+{-# INLINE runSeveral #-}