From 3800ddfbf25956a9a8e67f8e85170ebc783fd598 Mon Sep 17 00:00:00 2001
From: Mike Solomon <mike@wavr.so>
Date: Tue, 23 Nov 2021 00:33:25 +0200
Subject: [PATCH] Adds more instances

---
 CHANGELOG.md                  |  6 +++
 spago.dhall                   |  1 +
 src/WAGS/Graph/Parameter.purs | 93 +++++++++++++++++++++++++++++++++--
 3 files changed, 97 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c78224b7..502ef787 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [0.6.1] - 2021-11-22
+
+### Added
+
+- More instances for `Maybe'` like `Traversable`, `Foldable`, etc.
+
 ## [0.6.0] - 2021-11-22
 
 ### Added
diff --git a/spago.dhall b/spago.dhall
index 5de9c6f9..cc1e23e3 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -17,6 +17,7 @@
   , "free"
   , "indexed-monad"
   , "integers"
+  , "invariant"
   , "js-timers"
   , "lazy"
   , "lists"
diff --git a/src/WAGS/Graph/Parameter.purs b/src/WAGS/Graph/Parameter.purs
index a4ba58c0..f6578454 100644
--- a/src/WAGS/Graph/Parameter.purs
+++ b/src/WAGS/Graph/Parameter.purs
@@ -3,11 +3,22 @@ module WAGS.Graph.Parameter where
 import Prelude hiding (apply)
 
 import Control.Alt (class Alt)
+import Control.Alternative (class Alternative)
+import Control.Extend (class Extend)
+import Control.MonadZero (class MonadZero)
 import Control.Plus (class Plus)
+import Data.Eq (class Eq1)
+import Data.Foldable (class Foldable, foldMapDefaultL)
+import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndexDefaultL)
 import Data.Function (apply)
+import Data.Functor.Invariant (class Invariant)
+import Data.FunctorWithIndex (class FunctorWithIndex)
 import Data.Generic.Rep (class Generic)
 import Data.Newtype (class Newtype, unwrap)
+import Data.Ord (class Ord1)
 import Data.Show.Generic (genericShow)
+import Data.Traversable (class Traversable, sequenceDefault)
+import Data.TraversableWithIndex (class TraversableWithIndex)
 import Data.Variant (Variant, default, inj, match, on)
 import Record as R
 import Type.Proxy (Proxy(..))
@@ -118,6 +129,12 @@ _isJust = unwrap >>>
 _maybe :: forall a b. b -> (a -> b) -> Maybe' a -> b
 _maybe b f (Maybe' v) = (default b # _onJust f) v
 
+_maybe' :: forall a b. (Unit -> b) -> (a -> b) -> Maybe' a -> b
+_maybe' fb f (Maybe' v) = v # match
+  { just: f
+  , nothing: fb
+  }
+
 _fromMaybe :: forall a. a -> Maybe' a -> a
 _fromMaybe a (Maybe' v) = v # match
   { just: \b -> b
@@ -126,6 +143,49 @@ _fromMaybe a (Maybe' v) = v # match
 
 derive instance newtypeMaybe' :: Newtype (Maybe' a) _
 derive instance eqMaybe' :: Eq a => Eq (Maybe' a)
+instance eq1Maybe' :: Eq1 Maybe' where
+  eq1 a b = _isNothing a == _isNothing b
+instance ord1Maybe' :: Ord1 Maybe' where
+  compare1 a b = compare (_isJust a) (_isJust b)
+instance boundedMaybe' :: Bounded a => Bounded (Maybe' a) where
+  top = _just top
+  bottom = _just bottom
+instance foldableMaybe' :: Foldable Maybe' where
+  foldl f b (Maybe' a) = a # match
+    { just: \a' -> f b a'
+    , nothing: \_ -> b
+    }
+  foldr f b (Maybe' a) = a # match
+    { just: \a' -> f a' b
+    , nothing: \_ -> b
+    }
+  foldMap = foldMapDefaultL
+instance foldableWithIndexMaybe' :: FoldableWithIndex Unit Maybe' where
+  foldlWithIndex f b (Maybe' a) = a # match
+    { just: \a' -> f unit b a'
+    , nothing: \_ -> b
+    }
+  foldrWithIndex f b (Maybe' a) = a # match
+    { just: \a' -> f unit a' b
+    , nothing: \_ -> b
+    }
+  foldMapWithIndex = foldMapWithIndexDefaultL
+instance traversableMaybe :: Traversable Maybe' where
+  traverse f (Maybe' a) = a # match
+    { just: \a' -> _just <$> f a'
+    , nothing: \_ -> pure _nothing
+    }
+  sequence = sequenceDefault
+instance traversableWithIndexMaybe :: TraversableWithIndex Unit Maybe' where
+  traverseWithIndex f (Maybe' a) = a # match
+    { just: \a' -> _just <$> f unit a'
+    , nothing: \_ -> pure _nothing
+    }
+instance functorWithIndexMaybe' :: FunctorWithIndex Unit Maybe' where
+  mapWithIndex f (Maybe' a) = a # match
+    { just: \a' -> _just (f unit a')
+    , nothing: \_ -> _nothing
+    }
 derive instance ordMaybe' :: Ord a => Ord (Maybe' a)
 instance functorMaybe' :: Functor Maybe' where
   map f (Maybe' v) = v # match
@@ -141,13 +201,40 @@ instance applyMaybe' :: Apply Maybe' where
     , nothing: const _nothing
     }
     fa
-
 instance applicativeMaybe' :: Applicative Maybe' where
   pure = _just
-
 instance bindMaybe' :: Bind Maybe' where
   bind (Maybe' ma) f = (default _nothing # _onJust f) ma
-
+instance monadMaybe' :: Monad Maybe'
+instance altMaybe' :: Alt Maybe' where
+  alt a b
+    | _isJust a = a
+    | _isJust b = b
+    | otherwise = a
+instance plusMaybe' :: Plus Maybe' where
+  empty = _nothing
+instance alternativeMaybe' :: Alternative Maybe'
+instance monadZero' :: MonadZero Maybe'
+instance extendMaybe' :: Extend Maybe' where
+  extend f x = _just (f x)
+instance invariantMaybe :: Invariant Maybe' where
+  imap f _ (Maybe' v) = v # match
+    { just: \a -> _just $ f a
+    , nothing: \_ -> _nothing
+    }
+instance semigroupMaybe :: Semigroup a => Semigroup (Maybe' a) where
+  append _a@(Maybe' ax) _b@(Maybe' bx) = ax # match
+    { just: \a -> bx # match
+        { just: \b -> _just (a <> b)
+        , nothing: \_ -> _a
+        }
+    , nothing: \_ -> bx # match
+        { just: \_ -> _b
+        , nothing: \_ -> _nothing
+        }
+    }
+instance monoidMaybe :: Monoid a => Monoid (Maybe' a) where
+  mempty = _nothing
 derive newtype instance showMaybe' :: Show a => Show (Maybe' a)
 
 type AudioParameter_' a