Merge pull request #1 from paf31/apply-divide

Apply and Divide instances
zudov · Nov 18, 2015 · 46b4e20 · 46b4e20
2 parents 32ed454 + 8026b3e
commit 46b4e20
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 13 deletions.
diff --git a/docs/Control/Monad/Eff/Var.md b/docs/Control/Monad/Eff/Var.md
@@ -37,8 +37,8 @@ Typeclass for vars that can be read.
 
 ##### Instances
 ``` purescript
-instance gettableVar :: Gettable eff (Var eff) a
-instance gettableGettableVar :: Gettable eff (GettableVar eff) a
+Gettable eff (Var eff) a
+Gettable eff (GettableVar eff) a
 ```
 
 #### `Settable`
@@ -52,8 +52,8 @@ Typeclass for vars that can be written.
 
 ##### Instances
 ``` purescript
-instance settableVar :: Settable eff (Var eff) a
-instance settableSettableVar :: Settable eff (SettableVar eff) a
+Settable eff (Var eff) a
+Settable eff (SettableVar eff) a
 ```
 
 #### `($=)`
@@ -75,7 +75,7 @@ Typeclass for vars that can be updated.
 
 ##### Instances
 ``` purescript
-instance updatableVar :: Updatable eff (Var eff) a
+Updatable eff (Var eff) a
 ```
 
 #### `($~)`
@@ -97,10 +97,10 @@ when read or written.
 
 ##### Instances
 ``` purescript
-instance settableVar :: Settable eff (Var eff) a
-instance gettableVar :: Gettable eff (Var eff) a
-instance updatableVar :: Updatable eff (Var eff) a
-instance invariantVar :: Invariant (Var eff)
+Settable eff (Var eff) a
+Gettable eff (Var eff) a
+Updatable eff (Var eff) a
+Invariant (Var eff)
 ```
 
 #### `makeVar`
@@ -122,8 +122,10 @@ when read.
 
 ##### Instances
 ``` purescript
-instance gettableGettableVar :: Gettable eff (GettableVar eff) a
-instance functorGettableVar :: Functor (GettableVar eff)
+Gettable eff (GettableVar eff) a
+Functor (GettableVar eff)
+Apply (GettableVar eff)
+Applicative (GettableVar eff)
 ```
 
 #### `makeGettableVar`
@@ -145,8 +147,12 @@ when written.
 
 ##### Instances
 ``` purescript
-instance settableSettableVar :: Settable eff (SettableVar eff) a
-instance contravariantSettableVar :: Contravariant (SettableVar eff)
+Settable eff (SettableVar eff) a
+Contravariant (SettableVar eff)
+Divide (SettableVar eff)
+Divisible (SettableVar eff)
+Decide (SettableVar eff)
+Decidable (SettableVar eff)
 ```
 
 #### `makeSettableVar`

diff --git a/src/Control/Monad/Eff/Var.purs b/src/Control/Monad/Eff/Var.purs
@@ -45,7 +45,11 @@ module Control.Monad.Eff.Var
 import Prelude
 
 import Control.Monad.Eff
+
+import Data.Tuple
+import Data.Either
 import Data.Functor.Contravariant
+import Data.Functor.Contravariant.Divisible
 import Data.Functor.Invariant
 
 -- | Typeclass for vars that can be read.
@@ -106,6 +110,12 @@ instance gettableGettableVar :: Gettable eff (GettableVar eff) a where
 instance functorGettableVar :: Functor (GettableVar eff) where
   map f (GettableVar a) = GettableVar (f <$> a)
 
+instance applyGettableVar :: Apply (GettableVar eff) where
+  apply (GettableVar f) (GettableVar a) = GettableVar (apply f a)
+
+instance applicativeGettableVar :: Applicative (GettableVar eff) where
+  pure = GettableVar <<< pure
+
 -- | Write-only var which holds a value of type `a` and produces effects `eff`
 -- | when written.
 newtype SettableVar eff a = SettableVar (a -> Eff eff Unit)
@@ -119,3 +129,19 @@ instance settableSettableVar :: Settable eff (SettableVar eff) a where
 
 instance contravariantSettableVar :: Contravariant (SettableVar eff) where
   cmap f (SettableVar a) = SettableVar (a <<< f)
+
+instance divideSettableVar :: Divide (SettableVar eff) where
+  divide f (SettableVar setb) (SettableVar setc) = SettableVar \a ->
+    case f a of
+      Tuple b c -> do
+        setb b
+        setc c
+
+instance divisibleSettableVar :: Divisible (SettableVar eff) where
+  conquer = SettableVar \_ -> return unit
+
+instance decideSettableVar :: Decide (SettableVar eff) where
+  decide f (SettableVar setb) (SettableVar setc) = SettableVar (either setb setc <<< f)
+
+instance decidableSettableVar :: Decidable (SettableVar eff) where
+  lose = SettableVar