Ordered keys

autodocodec-aeson/src/Autodocodec/Aeson/Document.hs

@@ -12,12 +12,15 @@ import Autodocodec
 import Autodocodec.Aeson.Encode
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as JSON
+import Data.Foldable
 import qualified Data.HashMap.Strict as HM
+import Data.List
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
+import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Validity
 import Data.Validity.Aeson ()
@@ -35,7 +38,8 @@ data JSONSchema
   | StringSchema
   | NumberSchema
   | ArraySchema !JSONSchema
-  | ObjectSchema !(Map Text (KeyRequirement, JSONSchema)) -- TODO it's important (for docs) that these stay ordered.
+  | -- | This needs to be a list because keys should stay in their original ordering.
+    ObjectSchema ![(Text, (KeyRequirement, JSONSchema))]
   | ValueSchema !JSON.Value
   | ChoiceSchema !(NonEmpty JSONSchema)
   | CommentSchema !Text !JSONSchema
@@ -49,6 +53,10 @@ instance Validity JSONSchema where
           CommentSchema _ (CommentSchema _ _) -> False
           _ -> True,
         case js of
+          ObjectSchema ks ->
+            declare "there are no two equal keys in a keys schema" $
+              let l = map fst ks
+               in nub l == l
           ChoiceSchema cs -> declare "there are 2 of more choices" $ length cs >= 2
           _ -> valid
       ]
@@ -70,23 +78,26 @@ instance ToJSON JSONSchema where
         ArraySchema s -> ["type" JSON..= ("array" :: Text), "items" JSON..= s]
         ValueSchema v -> ["const" JSON..= v]
         ObjectSchema os ->
-          let combine (ps, rps) k (r, s) =
+          let combine (ps, rps) (k, (r, s)) =
                 ( (k, s) : ps,
                   case r of
-                    Required -> k : rps
+                    Required -> S.insert k rps
                     Optional -> rps
                 )
-           in case M.foldlWithKey combine ([], []) os of
-                ([], _) -> ["type" JSON..= ("object" :: Text)]
-                (ps, []) ->
-                  [ "type" JSON..= ("object" :: Text),
-                    "properties" JSON..= HM.fromList ps
-                  ]
-                (ps, rps) ->
-                  [ "type" JSON..= ("object" :: Text),
-                    "properties" JSON..= HM.fromList ps,
-                    "required" JSON..= rps
-                  ]
+              (props, requiredProps) = foldl' combine ([], S.empty) os
+           in case props of
+                [] -> ["type" JSON..= ("object" :: Text)]
+                _ ->
+                  if S.null requiredProps
+                    then
+                      [ "type" JSON..= ("object" :: Text),
+                        "properties" JSON..= HM.fromList props
+                      ]
+                    else
+                      [ "type" JSON..= ("object" :: Text),
+                        "properties" JSON..= HM.fromList props,
+                        "required" JSON..= requiredProps
+                      ]
         ChoiceSchema jcs -> ["anyOf" JSON..= jcs]
         CommentSchema comment s -> ("$comment" JSON..= comment) : go s -- TODO this is probably wrong.
 
@@ -108,18 +119,18 @@ instance FromJSON JSONSchema where
       Just "object" -> do
         mP <- o JSON..:? "properties"
         case mP of
-          Nothing -> pure $ ObjectSchema M.empty
+          Nothing -> pure $ ObjectSchema []
           Just (props :: Map Text JSONSchema) -> do
             requiredProps <- fromMaybe [] <$> o JSON..:? "required"
             let keySchemaFor k s =
-                  M.singleton
-                    k
+                  ( k,
                     ( if k `elem` requiredProps
                         then Required
                         else Optional,
                       s
                     )
-            pure $ ObjectSchema $ M.unions $ map (uncurry keySchemaFor) $ M.toList props
+                  )
+            pure $ ObjectSchema $ map (uncurry keySchemaFor) $ M.toList props
       Nothing -> do
         mAny <- o JSON..:? "anyOf"
         case mAny of
@@ -161,10 +172,10 @@ jsonSchemaVia = go
           ChoiceSchema ss -> goChoice ss
           s' -> s' :| []
 
-    goObject :: ObjectCodec input output -> Map Text (KeyRequirement, JSONSchema)
+    goObject :: ObjectCodec input output -> [(Text, (KeyRequirement, JSONSchema))]
     goObject = \case
-      RequiredKeyCodec k c -> M.singleton k (Required, go c)
-      OptionalKeyCodec k c -> M.singleton k (Optional, go c)
+      RequiredKeyCodec k c -> [(k, (Required, go c))]
+      OptionalKeyCodec k c -> [(k, (Optional, go c))]
       BimapObjectCodec _ _ oc -> goObject oc
-      PureObjectCodec _ -> M.empty
-      ApObjectCodec oc1 oc2 -> M.union (goObject oc1) (goObject oc2)
+      PureObjectCodec _ -> []
+      ApObjectCodec oc1 oc2 -> goObject oc1 ++ goObject oc2

autodocodec-aeson/test/Autodocodec/Aeson/DocumentSpec.hs

@@ -10,6 +10,7 @@ module Autodocodec.Aeson.DocumentSpec (spec) where
 
 import Autodocodec
 import Autodocodec.Aeson
+import qualified Data.Aeson as JSON
 import Data.Data
 import Data.GenValidity
 import Data.GenValidity.Aeson ()
@@ -27,7 +28,6 @@ import Test.QuickCheck
 import Test.Syd
 import Test.Syd.Aeson
 import Test.Syd.Validity
-import Test.Syd.Validity.Aeson
 import Test.Syd.Validity.Utils
 
 spec :: Spec
@@ -56,7 +56,15 @@ spec = do
   jsonSchemaSpec @Example "example"
   describe "JSONSchema" $ do
     genValidSpec @JSONSchema
-    jsonSpecOnValid @JSONSchema
+    it "roundtrips through json and back" $
+      forAllValid $ \jsonSchema ->
+        -- We use the reencode version to survive the ordering change through map
+        let encoded = JSON.encode (jsonSchema :: JSONSchema)
+         in case JSON.eitherDecode encoded of
+              Left err -> expectationFailure err
+              Right decoded ->
+                let encodedAgain = JSON.encode (decoded :: JSONSchema)
+                 in encodedAgain `shouldBe` encoded
 
 instance GenValid JSONSchema where
   shrinkValid = \case
@@ -66,7 +74,7 @@ instance GenValid JSONSchema where
     StringSchema -> [AnySchema]
     NumberSchema -> [AnySchema]
     ArraySchema s -> s : (ArraySchema <$> shrinkValid s)
-    ObjectSchema os -> ObjectSchema <$> shrinkValid os
+    ObjectSchema os -> filter isValid $ ObjectSchema <$> shrinkValid os
     ValueSchema v -> ValueSchema <$> shrinkValid v
     ChoiceSchema ss -> case ss of
       s :| [] -> [s]
@@ -80,7 +88,7 @@ instance GenValid JSONSchema where
       else
         oneof
           [ ArraySchema <$> resize (n -1) genValid,
-            ObjectSchema <$> resize (n -1) genValid,
+            (ObjectSchema <$> resize (n -1) genValid) `suchThat` isValid,
             do
               (a, b, c) <- genSplit3 (n -1)
               choice1 <- resize a genValid

autodocodec-aeson/test_resources/schema/example.json

@@ -1,10 +1,10 @@
 {
     "$comment": "Example",
     "required": [
-        "text",
         "bool",
+        "fruit",
         "maybe",
-        "fruit"
+        "text"
     ],
     "type": "object",
     "properties": {

autodocodec-yaml/src/Autodocodec/Yaml/Document.hs

@@ -9,7 +9,6 @@ module Autodocodec.Yaml.Document where
 import Autodocodec
 import Autodocodec.Aeson
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.Map as M
 import qualified Data.Text.Encoding as TE
 import qualified Data.Text.Encoding.Error as TE
 import Data.Yaml as Yaml
@@ -47,9 +46,9 @@ jsonSchemaChunks = concatMap (\l -> l ++ ["\n"]) . go
               Required -> fore red "required"
               Optional -> fore blue "optional"
             keySchemaFor k (kr, ks) = addInFrontOfFirstInList [fore white $ chunk k, ":", " "] (["# ", requirementComment kr] : go ks)
-         in if M.null s
+         in if null s
               then [["<object>"]]
-              else concatMap (uncurry keySchemaFor) (M.toList s)
+              else concatMap (uncurry keySchemaFor) s
       ValueSchema v -> [[chunk $ TE.decodeUtf8With TE.lenientDecode (Yaml.encode v)]]
       ChoiceSchema s ->
         let addListAround = \case

autodocodec-yaml/test_resources/schema/example.txt

@@ -1,6 +1,14 @@
 # Example
+text: # required
+  <string>
 bool: # required
   <boolean>
+maybe: # required
+  [ null
+  , <string>
+  ]
+optional: # optional
+  <string>
 fruit: # required
   [ Apple
 
@@ -11,11 +19,3 @@
   , Melon
 
   ]
-maybe: # required
-  [ null
-  , <string>
-  ]
-optional: # optional
-  <string>
-text: # required
-  <string>