focus 1.0.1.4 → 1.0.2

raw patch · 4 files changed

+48/−20 lines, 4 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• focus.cabal +2/−2
• library/Focus.hs +30/−18
• library/Focus/Prelude.hs +1/−0
• test/Main.hs +15/−0

@@ -1,5 +1,5 @@ name: focus-version: 1.0.1.4+version: 1.0.2 synopsis: A general abstraction for manipulating elements of container data structures description:   An API for construction of free-form strategies of access and manipulation of @@ -39,7 +39,7 @@   other-modules:     Focus.Prelude   build-depends:-    base >=4.9 && <5,+    base >=4.11 && <5,     transformers >=0.5 && <0.6  test-suite test

@@ -16,27 +16,30 @@ deriving instance Functor m => Functor (Focus element m)  instance Monad m => Applicative (Focus element m) where-  pure = return+  pure a = Focus (pure (a, Leave)) (const (pure (a, Leave)))   (<*>) = ap  instance Monad m => Monad (Focus element m) where-  return result = Focus (return (result, Leave)) (\ element -> return (result, Set element))-  (>>=) (Focus aAbsent bPresent) bKleisli = let-    sendSome element = do-      (aResult, aChange) <- bPresent element-      case bKleisli aResult of-        Focus bAbsent bOnElement -> case aChange of-          Leave -> bOnElement element-          Remove -> bAbsent-          Set newElement -> bOnElement newElement-    sendNone = do-      (aResult, aChange) <- aAbsent-      case bKleisli aResult of-        Focus bAbsent bOnElement -> case aChange of-          Set newElement -> bOnElement newElement-          Leave -> bAbsent-          Remove -> bAbsent-    in Focus sendNone sendSome+  return = pure+  (>>=) (Focus lAbsent lPresent) rk =+    Focus absent present+    where+      absent =+        do+          (lr, lChange) <- lAbsent+          let Focus rAbsent rPresent = rk lr+          case lChange of+            Leave -> rAbsent+            Remove -> rAbsent & fmap (fmap (mappend lChange))+            Set newElement -> rPresent newElement & fmap (fmap (mappend lChange))+      present element =+        do+          (lr, lChange) <- lPresent element+          let Focus rAbsent rPresent = rk lr+          case lChange of+            Leave -> rPresent element+            Remove -> rAbsent & fmap (fmap (mappend lChange))+            Set newElement -> rPresent newElement & fmap (fmap (mappend lChange))  instance MonadTrans (Focus element) where   lift m = Focus (fmap (,Leave) m) (const (fmap (,Leave) m))@@ -51,6 +54,15 @@   Remove {-^ Delete it -} |   Set a {-^ Set its value to the provided one -}   deriving (Functor, Eq, Ord, Show)++instance Semigroup (Change a) where+  (<>) l r =+    case r of+      Leave -> l+      _ -> r++instance Monoid (Change a) where+  mempty = Leave   -- * Pure functions

@@ -36,6 +36,7 @@ import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports+import Data.Semigroup as Exports import Data.STRef as Exports import Data.String as Exports import Data.Traversable as Exports

@@ -49,4 +49,19 @@       in do         assertEqual "" ((), Focus.Remove) (runIdentity (present "zero"))         assertEqual "" ((), Focus.Leave) (runIdentity absent)+    ,+    testCase "delete" $ let+      Focus.Focus absent present = Focus.delete+      in do+        assertEqual "" ((), Focus.Remove) (runIdentity (present "zero"))+        assertEqual "" ((), Focus.Leave @()) (runIdentity absent)+    ,+    testCase "Monadically composed lookup and delete (https://github.com/nikita-volkov/focus/issues/7)" $ let+      Focus.Focus absent present = do+        a <- Focus.lookup+        Focus.delete+        pure a+      in do+        assertEqual "" (Just (), Focus.Remove) (runIdentity (present ()))+        assertEqual "" (Nothing @(), Focus.Leave) (runIdentity absent)   ]