Add traversable and foldable instances

Author: MonoidMusician

src/Data/Functor/Variant.purs

@@ -17,8 +17,10 @@ import Prelude
 
 import Control.Alternative (class Alternative, empty)
 import Data.List as L
+import Data.Monoid (class Monoid)
 import Data.Symbol (SProxy(..)) as Exports
-import Data.Symbol (SProxy, class IsSymbol, reflectSymbol)
+import Data.Symbol (SProxy(..), class IsSymbol, reflectSymbol)
+import Data.Traversable as TF
 import Data.Variant.Internal (class Contractable, FProxy(..), class VariantFMatchCases) as Exports
 import Data.Variant.Internal (class Contractable, class VariantFMatchCases, class VariantTags, FProxy, RLProxy(..), RProxy(..), VariantFCase, VariantCase, contractWith, lookup, unsafeGet, unsafeHas, variantTags)
 import Partial.Unsafe (unsafeCrashWith)
@@ -50,6 +52,51 @@ instance functorVariantF ∷ Functor (VariantF r) where
     coerceV ∷ ∀ f a. VariantFRep f a → VariantF r a
     coerceV = unsafeCoerce
 
+class FoldableVFRL (rl :: R.RowList) (row :: # Type) | rl -> row where
+  foldMapVFRL :: forall a m. Monoid m => RLProxy rl -> (a -> m) -> VariantF row a -> m
+
+instance foldableNil :: FoldableVFRL R.Nil () where
+  foldMapVFRL _ f = case_
+
+instance foldableCons ::
+  ( IsSymbol k
+  , TF.Foldable f
+  , FoldableVFRL rl r
+  , RowCons k (FProxy f) r r'
+  ) => FoldableVFRL (R.Cons k (FProxy f) rl) r' where
+  foldMapVFRL _ f = on k (TF.foldMap f) (foldMapVFRL (RLProxy :: RLProxy rl) f)
+    where k = SProxy :: SProxy k
+
+class FoldableVFRL rl row <= TraversableVFRL (rl :: R.RowList) (row :: # Type) | rl -> row where
+  traverseVFRL :: forall f a b. Applicative f => RLProxy rl -> (a -> f b) -> VariantF row a -> f (VariantF row b)
+
+instance traversableNil :: TraversableVFRL R.Nil () where
+  traverseVFRL _ f = case_
+
+instance traversableCons ::
+  ( IsSymbol k
+  , TF.Traversable f
+  , TraversableVFRL rl r
+  , RowCons k (FProxy f) r r'
+  , Union r bleh r'
+  ) => TraversableVFRL (R.Cons k (FProxy f) rl) r' where
+  traverseVFRL _ f = on k (TF.traverse f >>> map (inj k))
+    (traverseVFRL (RLProxy :: RLProxy rl) f >>> map expand)
+    where k = SProxy :: SProxy k
+
+instance foldableVariantF ::
+  (R.RowToList row rl, FoldableVFRL rl row) =>
+  TF.Foldable (VariantF row) where
+    foldMap = foldMapVFRL (RLProxy :: RLProxy rl)
+    foldr a = TF.foldrDefault a
+    foldl a = TF.foldlDefault a
+
+instance traversableVariantF ::
+  (R.RowToList row rl, TraversableVFRL rl row) =>
+  TF.Traversable (VariantF row) where
+    traverse = traverseVFRL (RLProxy :: RLProxy rl)
+    sequence a = TF.sequenceDefault a
+
 -- | Inject into the variant at a given label.
 -- | ```purescript
 -- | maybeAtFoo :: forall r. VariantF (foo :: FProxy Maybe | r) Int