From f134ca6f17e32d492c765d4dbf7f47bffa5bc567 Mon Sep 17 00:00:00 2001
From: Tom Harding <tom.harding@habito.com>
Date: Thu, 17 Aug 2017 12:58:48 +0100
Subject: [PATCH] Add instances to `Nullable`

This commit adds an awful lot of new instances to the `Nullable` type.
While I'm certainly not suggesting that their use should be
_encouraged_, I think they are, nevertheless, valid implementations...
---
 bower.json             |  3 ++-
 src/Data/Nullable.purs | 50 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/bower.json b/bower.json
index e57093f..3ce114f 100644
--- a/bower.json
+++ b/bower.json
@@ -15,7 +15,8 @@
   ],
   "dependencies": {
     "purescript-maybe": "^3.0.0",
-    "purescript-functions": "^3.0.0"
+    "purescript-functions": "^3.0.0",
+    "purescript-foldable-traversable": "^3.4.0"
   },
   "repository": {
     "type": "git",
diff --git a/src/Data/Nullable.purs b/src/Data/Nullable.purs
index 26a0f48..34ca225 100644
--- a/src/Data/Nullable.purs
+++ b/src/Data/Nullable.purs
@@ -9,11 +9,19 @@ module Data.Nullable
 
 import Prelude
 
+import Control.Alt (class Alt, alt)
+import Control.Alternative (class Alternative)
+import Control.Extend (class Extend)
+import Control.Plus (class Plus)
 import Data.Eq (class Eq1)
+import Data.Foldable (class Foldable, foldMap, foldl, foldr)
 import Data.Function (on)
 import Data.Function.Uncurried (Fn3, runFn3)
 import Data.Maybe (Maybe(..), maybe)
+import Data.Monoid (class Monoid, mempty)
+import Data.Newtype (traverse)
 import Data.Ord (class Ord1)
+import Data.Traversable (class Traversable)
 
 -- | A nullable type.
 -- |
@@ -51,3 +59,45 @@ instance ordNullable :: Ord a => Ord (Nullable a) where
 
 instance ord1Nullable :: Ord1 Nullable where
   compare1 = compare
+
+instance semigroupNullable :: Semigroup a => Semigroup (Nullable a) where
+  append x y = toNullable (append (toMaybe x) (toMaybe y))
+
+instance monoidNullable :: Monoid (Nullable a) where
+  mempty = null
+
+instance functorNullable :: Functor Nullable where
+  map f = toNullable <<< map f <<< toMaybe
+
+instance foldableNullable :: Foldable Nullable where
+  foldMap f = foldMap f <<< toMaybe
+
+  foldl f acc = foldl f acc <<< toMaybe
+  foldr f acc = foldr f acc <<< toMaybe
+
+instance traversableNullable :: Traversable Nullable where
+  traverse f = toNullable <<< traverse f <<< toMaybe
+
+instance applyNullable :: Apply Nullable where
+  apply f x = toNullable $ (toMaybe f) `apply` (toMaybe x)
+
+instance applicativeNullable :: Applicative Nullable where
+  pure = notNull
+
+instance altNullable :: Alt Nullable where
+  alt x y = toNullable $ (toMaybe x) `alt` (toMaybe y)
+
+instance plusNullable :: Plus Nullable where
+  empty = null
+
+instance alternativeNullable :: Alternative Nullable
+
+instance bindNullable :: Bind Nullable where
+  bind x f = toNullable $ (toMaybe x) >>= (toMaybe <<< f)
+
+instance monadNullable :: Monad Nullable
+
+instance extendNullable :: Extend Nullable where
+  extend f x = case toMaybe x of
+    Just value -> notNull (f x)
+    Nothing    -> null