fix: order-preserving objects

.psc-ide-port

@@ -1 +1 @@
-15163
+15965

src/Data/YAML/Foreign/Encode.js

@@ -16,7 +16,12 @@ export function toYAMLImpl(a) {
   const replacer = (_, o) => {
     if (typeof o === 'object') {
       Object.entries(o).forEach(([k, v]) => {
-        if (typeof v === 'undefined' || v === null || (v instanceof Array && v.length === 0) || (typeof v === 'object' && Object.keys(v).length === 0)) {
+        if (
+          typeof v === 'undefined' ||
+          v === null ||
+          (v instanceof Array && v.length === 0) ||
+          (typeof v === 'object' && Object.keys(v).length === 0)
+        ) {
           delete o[k]
         }
       })

src/Data/YAML/Foreign/Encode.purs

@@ -8,23 +8,29 @@ module Data.YAML.Foreign.Encode
   , printYAML
   ) where
 
-import Data.Map as M
+import Data.Bifunctor (rmap)
-import Data.Map (Map)
-import Data.Array (toUnfoldable)
 import Data.Function.Uncurried (Fn4, runFn4)
-import Data.List (List)
+import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe, maybe)
+import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Tuple (Tuple(..), fst, snd)
+import Data.Tuple.Nested (type (/\))
 import Prelude (class Eq, class Show, identity, map, show, ($), (<>), (==), (<<<))
 import Unsafe.Coerce (unsafeCoerce)
 
-type YObject = M.Map String YValue
+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)
+
 type YArray = Array YValue
 
 foreign import data YAML :: Type
 
 data YValue
-  = YObject YObject
+  = YObject (YObjectExpr YValue)
   | YArray YArray
   | YString String
   | YNumber Number
@@ -54,28 +60,31 @@ instance eqYValue :: Eq YValue where
 class ToYAML a where
   toYAML :: a -> YValue
 
-instance mapToYAML :: (ToYAML a) => ToYAML (Map String a) where
+instance (ToYAML a) => ToYAML (Map String a) where
-  toYAML m = YObject $ map (\value -> toYAML value) m
+  toYAML m = YObject $ YObjectExpr $ Map.toUnfoldable $ map toYAML $ m
 
-instance booleanToYAML :: ToYAML Boolean where
+instance (ToYAML a) => ToYAML (YObjectExpr a) where
+  toYAML m = YObject $ wrap $ map (rmap toYAML) $ unwrap m
+
+instance ToYAML Boolean where
   toYAML = YBoolean
 
-instance intToYAML :: ToYAML Int where
+instance ToYAML Int where
   toYAML = YInt
 
-instance numberToYAML :: ToYAML Number where
+instance ToYAML Number where
   toYAML = YNumber
 
-instance stringToYAML :: ToYAML String where
+instance ToYAML String where
   toYAML = YString
 
-instance arrayToYAML :: (ToYAML a) => ToYAML (Array a) where
+instance (ToYAML a) => ToYAML (Array a) where
   toYAML = YArray <<< map toYAML
 
-instance maybeToYAML :: (ToYAML a) => ToYAML (Maybe a) where
+instance (ToYAML a) => ToYAML (Maybe a) where
   toYAML = maybe YNull toYAML
 
-instance yvalueToYAML :: ToYAML YValue where
+instance ToYAML YValue where
   toYAML = identity
 
 type Pair = Tuple String YValue
@@ -88,11 +97,12 @@ entry name value = Tuple name (toYAML value)
 
 infixl 4 entry as :=
 
--- | Helper function to create a YAML object.
+-- | Helper function to create a YAML object, preserving the
+-- | order of the pairs.
 -- |
 -- | `obj = object [ "Name" := "This is the name", "Size" := 1.5 ]`
 object :: Array Pair -> YValue
-object ps = YObject $ M.fromFoldable (toUnfoldable ps :: List Pair)
+object ps = YObject $ wrap ps
 
 foreign import jsNull :: YAML
 foreign import objToHash
@@ -103,7 +113,7 @@ foreign import objToHash
        YAML
 
 valueToYAML :: YValue -> YAML
-valueToYAML (YObject o) = runFn4 objToHash valueToYAML fst snd $ M.toUnfoldable o
+valueToYAML (YObject o) = runFn4 objToHash valueToYAML fst snd $ unwrap o
 valueToYAML (YArray a) = unsafeCoerce $ map valueToYAML a
 valueToYAML (YString s) = unsafeCoerce s
 valueToYAML (YNumber n) = unsafeCoerce n

test/Main.purs

@@ -47,9 +47,8 @@ yamlInput =
 
 yamlOutput :: String
 yamlOutput =
-  """- Coverage: 10
+  """- Name: House
-  Mobility: Fix
+  Scale: 9.5
-  Name: House
   Points:
     - X: 10
       Y: 10
@@ -57,10 +56,10 @@ yamlOutput =
       Y: 10
     - X: 5
       Y: 5
-  Scale: 9.5
-- Coverage: 10
   Mobility: Fix
-  Name: Tree
+  Coverage: 10
+- Name: Tree
+  Scale: 1
   Points:
     - X: 1
       Y: 1
@@ -68,15 +67,15 @@ yamlOutput =
       Y: 2
     - X: 0
       Y: 0
-  Scale: 1
+  Mobility: Fix
+  Coverage: 10
 """
 
 yamlMapOutput :: String
 yamlMapOutput =
   """key:
-  - Coverage: 10
+  - Name: House
-    Mobility: Fix
+    Scale: 9.5
-    Name: House
     Points:
       - X: 10
         Y: 10
@@ -84,10 +83,10 @@ yamlMapOutput =
         Y: 10
       - X: 5
         Y: 5
-    Scale: 9.5
-  - Coverage: 10
     Mobility: Fix
-    Name: Tree
+    Coverage: 10
+  - Name: Tree
+    Scale: 1
     Points:
       - X: 1
         Y: 1
@@ -95,7 +94,8 @@ yamlMapOutput =
         Y: 2
       - X: 0
         Y: 0
-    Scale: 1
+    Mobility: Fix
+    Coverage: 10
 """
 
 pointYaml :: String