json-spec 1.0.1.0 → 1.1.0.0

raw patch · 5 files changed

+139/−14 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +1/−1
• json-spec.cabal +14/−1
• src/Data/JsonSpec.hs +1/−1
• src/Data/JsonSpec/Spec.hs +45/−11
• test/stable-environment.hs +78/−0

@@ -9,7 +9,7 @@ Historically, the trade-off has been:  1. Use Generic instances, and therefore your API is brittle. Changes-   to Deeply nested object might unexpectedly change (and break) your+   to a deeply nested object might unexpectedly change (and break) your    API. You must structure your Haskell types exactly as they are    rendered into JSON, which may not always be "natural" and easy to    work with. In exchange, you get the ability to auto-derive matching

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                json-spec-version:             1.0.1.0+version:             1.1.0.0 synopsis:            Type-level JSON specification maintainer:          rick@owensmurray.com description:         See the README at: https://github.com/owensmurray/json-spec#json-spec@@ -47,6 +47,19 @@ test-suite jsonspec   import: dependencies, warnings   main-is: jsonspec.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  default-language: Haskell2010+  build-depends:+    , json-spec+    , bytestring >= 0.11.1.0 && < 0.13+    , hspec      >= 2.8.5    && < 2.12+    , om-show    >= 0.1.2.9  && < 0.2+++test-suite stable-environment+  import: dependencies, warnings+  main-is: stable-environment.hs   type: exitcode-stdio-1.0   hs-source-dirs: test   default-language: Haskell2010

@@ -42,7 +42,7 @@   Historically, the trade-off has been:    1. Use Generic instances, and therefore your API is brittle. Changes-     to Deeply nested object might unexpectedly change (and break) your+     to a deeply nested object might unexpectedly change (and break) your      API. You must structure your Haskell types exactly as they are      rendered into JSON, which may not always be "natural" and easy to      work with. In exchange, you get the ability to auto-derive matching

@@ -153,9 +153,9 @@       >        ])       >      ]       >      (JsonObject '[-      >        Required "vertex1" JsonRef "Vertex",-      >        Required "vertex2" JsonRef "Vertex",-      >        Required "vertex3" JsonRef "Vertex"+      >        "vertex1" ::: JsonRef "Vertex",+      >        "vertex2" ::: JsonRef "Vertex",+      >        "vertex3" ::: JsonRef "Vertex"       >      ])        Another use is to define recursive types:@@ -164,8 +164,8 @@       >   JsonLet       >     '[       >       '("LabelledTree", JsonObject '[-      >         Required "label", JsonString,-      >         Required "children" (JsonArray (JsonRef "LabelledTree"))+      >         "label" ::: JsonString,+      >         "children" ::: JsonArray (JsonRef "LabelledTree")       >        ])       >      ]       >     (JsonRef "LabelledTree")@@ -221,11 +221,42 @@   JSONStructure spec = JStruct '[] spec  -type family Lookup env k where-  Lookup ('(k, v) : more) k = v-  Lookup (_ : more) k = Lookup more k+{-|+  Make the correct reference type by looking up the symbol, and providing+  the environment in which the symbol was _defined_. We mustn't use the+  environment in which the reference is _used_, or else 'Specification'+  would be a dynamically scoped language, instead of a statically scoped+  language.+-}+type family+    LookupRef+      (env :: Env)+      (search :: Env)+      (target :: Symbol)+    :: Type+  where+    LookupRef+        env+        ( ('(target, spec) : moreDefs) : moreStack )+        target+      =+        Ref env spec +    LookupRef+        env+        ( ('(miss, spec) : moreDefs) : moreStack)+        target+      =+        LookupRef env ( moreDefs : moreStack) target +    LookupRef+        env+        ( '[] : moreStack)+        target+      =+        LookupRef moreStack moreStack target++ type family PushAll (a :: [k]) (b :: [k]) :: [k] where   PushAll '[] b = b   PushAll (e : more) b = PushAll more (e : b)@@ -233,7 +264,7 @@  type family   JStruct-    (env :: [(Symbol, Specification)])+    (env :: Env)     (spec :: Specification)   :: Type   where@@ -259,8 +290,8 @@     JStruct env JsonDateTime = UTCTime     JStruct env (JsonNullable spec) = Maybe (JStruct env spec)     JStruct env (JsonLet defs spec) =-      JStruct (PushAll defs env) spec-    JStruct env (JsonRef ref) = Ref env (Lookup env ref)+      JStruct (defs : env) spec+    JStruct env (JsonRef ref) = LookupRef env env ref     JStruct env JsonRaw = Value  @@ -357,5 +388,8 @@      )   => b sym = fromString $ symbolVal (Proxy @a)+++type Env = [[(Symbol, Specification)]]  

@@ -0,0 +1,78 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Main (main) where++import Data.JsonSpec+  ( HasJsonEncodingSpec(EncodingSpec, toJSONStructure), Ref(Ref)+  , Specification(JsonLet, JsonRef, JsonString)+  )+import Data.Text (Text)+import Prelude (Applicative(pure), ($), (.), Eq, IO, Ord)+++main :: IO ()+main =+  {-+    The "test" is that this file compiles at all. It _should_ compile but+    the "stable environment" bug this is testing was causing this to fail+    to compile because the reference to "Baz" via "bar" did not share+    the same environment as the direct reference to Baz in the instance+    `HasJsonEncodingSpec Baz`.  That is to say, the "structure type"+    created by one references was `Ref env1 spec` and `Ref env2 spec`+    for the other reference, where env1 and env2 are not identical+    even though they are functionally equivalent. This means that+    `instance HasJsonEncodingSpec Foo` could not delegate to `instance+    HasJsonEncodingSpec Baz`, which is a major usability problem.++    The solution was to have the environment in the `Ref env spec`+    structure be fixed at the point where the reference is defined,+    not where it is used.+  -}+  pure ()+++{-| Shared specification definitions. -}+type TestShared a =+  JsonLet+    '[ '( "Foo"+        , JsonLet '[ '("bar", JsonRef "Baz") ] (JsonRef "bar")+        )+     , '( "Baz" , JsonString)+     ]+    (JsonRef a)+++newtype Foo = Foo Baz+  deriving stock (Eq, Ord)+instance HasJsonEncodingSpec Foo where+  type EncodingSpec Foo =+    TestShared "Foo"+  toJSONStructure (Foo val) =+    Ref . Ref . toJSONStructure $ val+++newtype Baz = Baz Text+  deriving newtype+    ( Eq+    , Ord+    )+instance HasJsonEncodingSpec Baz where+  type EncodingSpec Baz =+    TestShared "Baz"+  toJSONStructure (Baz val) = Ref val++