fix: typeclasses on yobjectexpr

src/Data/YAML/Foreign/Encode.purs

@@ -8,14 +8,20 @@ module Data.YAML.Foreign.Encode
   , printYAML
   ) where
 
+import Prelude
+
+import Data.Array as Array
 import Data.Bifunctor (rmap)
+import Data.Foldable (class Foldable, foldMapDefaultL, foldl, foldr)
 import Data.Function.Uncurried (Fn4, runFn4)
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe, maybe)
+import Data.Monoid (class Monoid, class Semigroup)
 import Data.Newtype (class Newtype, unwrap, wrap)
+import Data.Traversable (class Traversable, sequenceDefault, traverse)
 import Data.Tuple (Tuple(..), fst, snd)
-import Data.Tuple.Nested (type (/\))
+import Data.Tuple.Nested (type (/\), (/\))
 import Prelude (class Eq, class Show, identity, map, show, ($), (<>), (==), (<<<))
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -24,6 +30,30 @@ newtype YObjectExpr a = YObjectExpr (Array (String /\ a))
 derive instance Newtype (YObjectExpr a) _
 derive newtype instance (Show a) => Show (YObjectExpr a)
 derive newtype instance (Eq a) => Eq (YObjectExpr a)
+derive newtype instance Semigroup (YObjectExpr a)
+derive newtype instance Monoid (YObjectExpr a)
+
+instance Functor YObjectExpr where
+  map f = wrap <<< map (rmap f) <<< unwrap
+
+instance Apply YObjectExpr where
+  apply fs' =
+    let
+      fs = map (\f a -> fst a /\ (snd f (snd a))) $ unwrap fs'
+    in
+      wrap <<< apply fs <<< unwrap
+
+instance Foldable YObjectExpr where
+  foldl f b xs = foldl f b $ map snd $ unwrap xs
+  foldr f b xs = foldr f b $ map snd $ unwrap xs
+  foldMap = foldMapDefaultL
+
+instance Traversable YObjectExpr where
+  traverse f t = map wrap $ traverse (\a -> map (fst a /\ _) $ f (snd a)) $ unwrap t
+  sequence = sequenceDefault
+
+instance Bind YObjectExpr where
+  bind xs f = wrap $ Array.nubByEq (\a b -> fst a == fst b) $ bind (unwrap xs) (\a -> unwrap $ f (snd a))
 
 type YArray = Array YValue