fused-effects-lens (empty) → 0.1.0.0

raw patch · 7 files changed

+270/−0 lines, 7 filesdep +basedep +fused-effectsdep +fused-effects-lenssetup-changed

Dependencies added: base, fused-effects, fused-effects-lens, hspec, lens

Files

CHANGES.md +3/−0
LICENSE +30/−0
README.md +40/−0
Setup.hs +2/−0
fused-effects-lens.cabal +36/−0
src/Control/Effect/Lens.hs +96/−0
test/Main.hs +63/−0

+ CHANGES.md view

@@ -0,0 +1,3 @@+# v0.1.0.0++Initial release.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Patrick Thomson (c) 2018++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.++    * 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.++    * Neither the name of Patrick Thomson here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++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.

+ README.md view

@@ -0,0 +1,40 @@+# fused-effects-lens++This package provides an interface to the [lens](github.com/ekmett/lens) library that is compatible with [fused-effects](github.com/robrix/fused-effects). The standard formulation of `lens` combinators for operating in `MonadState` contexts—`use`, `.=`, et al—rely on `mtl` for `MonadState` and `MonadReader`, which is not applicable to `Reader` and `State` effects.++This package is meant to be used alongside `lens`, like so:++``` haskell+import Control.Lens hiding (view, use, assign)+import Control.Effect.Lens (view, use, assign)+```++## Example++Given a `Context` type that we will use in a `State` effect:++``` haskell+data Context = Context+  { _amount :: Int+  , _disabled :: Bool+  } deriving (Eq, Show)+  +makeLenses ''Context+```++We can can use the `use` combinators to extract a lens target from the current state, and `assign` to write to a field of that state:++``` haskell+stateTest :: (Member (State Context) sig, Carrier sig m, Monad m) => m Int+stateTest = do+  initial <- use amount+  assign amount (initial + 1)+  assign disabled True+  use amount+```++You can find a more complete example, including one that works with multiple `State` constraints in a single computation, in the `test` directory.++## License++BSD3, like `fused-effects`.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ fused-effects-lens.cabal view

@@ -0,0 +1,36 @@+name:                fused-effects-lens+version:             0.1.0.0+synopsis:            Monadic lens combinators for fused-effects.+description:         Provides combinators for the lens-based manipulation of state and context types provided by the fused-effects library, similar to those provided for mtl-based monad transformers.+homepage:            https://github.com/patrickt/fused-effects-lens#readme+license:             BSD3+license-file:        LICENSE+author:              Patrick Thomson+maintainer:          patrickt@github.com+copyright:           2018 Patrick Thomson+category:            Web+build-type:          Simple+cabal-version:       >=1.10+extra-source-files:+  README.md+  CHANGES.md                 ++library+  hs-source-dirs:      src+  exposed-modules:     Control.Effect.Lens+  default-language:    Haskell2010+  build-depends:       base >= 4.7 && < 5+                     , lens >= 4   && < 5+                     , fused-effects >= 0.1.2 && < 1+  ghc-options:         -Wall++test-suite test+  type:                exitcode-stdio-1.0+  main-is:             Main.hs+  hs-source-dirs:      test+  default-language:    Haskell2010+  build-depends:       base >=4.7 && < 5.0+                     , fused-effects-lens+                     , lens >=4   && < 5+                     , fused-effects >= 0.1.2 && < 1+                     , hspec >= 2.4.1

+ src/Control/Effect/Lens.hs view

@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module Control.Effect.Lens+  ( view+  , views+  , use+  , uses+  , assign+  , (.=)+  , modifying+  , (%=)+  ) where++import Control.Effect+import qualified Control.Effect.State as State+import qualified Control.Effect.Reader as Reader+import qualified Control.Lens as Lens+import Control.Lens.Getter (Getting)+import Control.Lens.Setter (ASetter)++-- | View the value pointed to by a 'Control.Lens.Getter.Getter',+-- 'Control.Lens.Iso.Iso' or 'Control.Lens.Lens.Lens' or the result of+-- folding over all the results of a 'Control.Lens.Fold.Fold' or+-- 'Control.Lens.Traversal.Traversal' corresponding to the 'Reader'+-- context of the given monadic carrier.+view :: forall r a sig m . (Member (Reader r) sig, Carrier sig m, Functor m) => Getting a r a -> m a+view l = Reader.asks (Lens.view l)+{-# INLINE view #-}++-- | View a function of the value pointed to by a+-- 'Control.Lens.Getter.Getter', 'Control.Lens.Iso.Iso' or+-- 'Control.Lens.Lens.Lens' or the result of folding over all the+-- results of a 'Control.Lens.Fold.Fold' or+-- 'Control.Lens.Traversal.Traversal' corresponding to the 'Reader'+-- context of the given monadic carrier.+-- +-- This is slightly more general in lens itself, but should suffice for our purposes.+views :: (Member (Reader s) sig, Carrier sig m, Functor m) => Getting a s a -> (a -> b) -> m b+views l f = fmap f (Reader.asks (Lens.view l))+{-# INLINE views #-}++-- | Extract the target of a 'Control.Lens.Lens',+-- 'Control.Lens.Iso.Iso', or 'Control.Lens.Getter.Getter' from the,+-- or use a summary of a 'Control.Lens.Fold.Fold' or+-- 'Control.Lens.Traversal.Traversal' that points to a monoidal value.+use :: forall s a sig m . (Member (State s) sig, Carrier sig m, Monad m) => Getting a s a -> m a+use l = State.gets (Lens.view l)+{-# INLINE use #-}++-- | Use a function of the target of a 'Control.Lens.Lens.Lens',+-- 'Control.Lens.Iso.Iso', or 'Control.Lens.Getter.Getter' in the+-- current state, or use a summary of a 'Control.Lens.Fold.Fold' or+-- 'Control.Lens.Traversal.Traversal' that points to a monoidal value.+uses :: (Carrier sig f, Functor f, Member (State s) sig) => Getting a s a -> (a -> b) -> f b+uses l f = fmap f (State.gets (Lens.view l))+{-# INLINE uses #-}++-- | Replace the target of a 'Control.Lens.Lens.Lens' or all of the+-- targets of a 'Control.Lens.Setter.Setter' or+-- 'Control.Lens.Traversal.Traversal' in our monadic state with a new+-- value, irrespective of the old.+--+-- This is a prefix version of '.='.+assign :: forall s a b sig m . (Member (State s) sig, Carrier sig m, Monad m) => ASetter s s a b -> b -> m ()+assign l b = State.modify (Lens.set l b)+{-# INLINE assign #-}++-- | Replace the target of a 'Control.Lens.Lens.Lens' or all of the+-- targets of a 'Control.Lens.Setter.Setter' or+-- 'Control.Lens.Traversal.Traversal' in our monadic state with a new+-- value, irrespective of the old.+--+-- This is an infix version of 'assign'.+infixr 4 .=+(.=) :: forall s a b sig m . (Member (State s) sig, Carrier sig m, Monad m) => ASetter s s a b -> b -> m ()+(.=) = assign+{-# INLINE (.=) #-}++-- | Map over the target of a 'Control.Lens.Lens.Lens' or all of the+-- targets of a 'Control.Lens.Setter.Setter' or+-- 'Control.Lens.Traversal.Traversal' in our monadic state.+--+-- This is a prefix version of '%='.+modifying :: forall s a b sig m . (Member (State s) sig, Carrier sig m, Monad m) => ASetter s s a b -> (a -> b) -> m ()+modifying l f = State.modify (Lens.over l f)+{-# INLINE modifying #-}++-- | Map over the target of a 'Control.Lens.Lens.Lens' or all of the+-- targets of a 'Control.Lens.Setter.Setter' or+-- 'Control.Lens.Traversal.Traversal' in our monadic state.+--+-- This is an infix version of 'modifying'.+infixr 4 %=+(%=) :: forall s a b sig m . (Member (State s) sig, Carrier sig m, Monad m) => ASetter s s a b -> (a -> b) -> m ()+(%=) = modifying+{-# INLINE (%=) #-}

+ test/Main.hs view

@@ -0,0 +1,63 @@+{-# LANGUAGE TypeApplications, FlexibleContexts, MultiParamTypeClasses, TemplateHaskell, TypeFamilies, FlexibleInstances #-}++module Main where++import Control.Effect+import Control.Effect.Reader+import Control.Effect.State+import Control.Lens.Wrapped+import Control.Lens.TH+import Test.Hspec++import Control.Effect.Lens++data Context = Context+  { _amount :: Int+  , _sweatshirt :: Bool+  } deriving (Eq, Show)++initial :: Context+initial = Context 0 False++makeLenses ''Context++stateTest :: (Member (State Context) sig, Carrier sig m, Monad m) => m Int+stateTest = do+  initial <- use amount+  assign amount (initial + 1)+  assign sweatshirt True+  use amount++newtype Foo = Foo { _unFoo :: Int } deriving (Eq, Show)++makeWrapped ''Foo++newtype Bar = Bar { _unBar :: Float } deriving (Eq, Show)++makeWrapped ''Bar++doubleStateTest :: (Member (State Bar) sig, Member (State Foo) sig, Carrier sig m, Monad m) => m Int+doubleStateTest = do+  assign @Foo _Wrapped 5+  assign @Bar _Wrapped 30.5+  pure 50++readerTest :: (Member (Reader Context) sig, Carrier sig m, Monad m) => m Int+readerTest = succ <$> view amount++spec :: Spec+spec = describe "use/assign" $ do+  it "should modify stateful variables" $ do+    let result = run $ runState initial stateTest+    result `shouldBe` (Context 1 True, 1)++  it "works in the presence of polymorphic lenses with -XTypeAnnotations" $ do+    let result = run $ runState (Bar 5) $ runState (Foo 500) doubleStateTest+    result `shouldBe` (Bar 30.5, (Foo 5, 50))++  it "should read from an environment" $ do+    let result = run $ runReader initial readerTest+    result `shouldBe` 1++main :: IO ()+main = hspec $ describe "Control.Effect.Lens" spec