dhall-json 1.6.4 → 1.7.0

raw patch · 24 files changed

+348/−180 lines, 24 filesdep +tasty-silverdep ~aeson-yamldep ~containersdep ~dhallPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-silver

Dependency ranges changed: aeson-yaml, containers, dhall

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• dhall-json.cabal +16/−12
• src/Dhall/DhallToYaml/Main.hs +16/−9
• src/Dhall/JSON.hs +22/−28
• src/Dhall/JSON/Yaml.hs +21/−7
• src/Dhall/JSONToDhall.hs +132/−108
• tasty/Main.hs +54/−14
• tasty/data/error/mismatchMessage0.golden +8/−0
• tasty/data/error/mismatchMessage0.json +14/−0
• tasty/data/error/mismatchMessage0Schema.dhall +3/−0
• tasty/data/error/mismatchMessage1.golden +8/−0
• tasty/data/error/mismatchMessage1.json +1/−0
• tasty/data/error/mismatchMessage1Schema.dhall +1/−0
• tasty/data/error/mismatchMessage2.golden +8/−0
• tasty/data/error/mismatchMessage2.json +1/−0
• tasty/data/error/mismatchMessage2Schema.dhall +1/−0
• tasty/data/error/missingKey.golden +5/−0
• tasty/data/error/missingKey.json +4/−0
• tasty/data/error/missingKeySchema.dhall +1/−0
• tasty/data/error/unhandledKeys.golden +10/−0
• tasty/data/error/unhandledKeys.json +4/−0
• tasty/data/error/unhandledKeysSchema.dhall +1/−0
• tasty/data/missingList.dhall +1/−1
• tasty/data/missingListSchema.dhall +1/−1

@@ -1,3 +1,18 @@+1.7.0++* BREAKING CHANGE: [Add `--generated-comment` flag for `dhall-to-yaml{-ng}`](https://github.com/dhall-lang/dhall-haskell/pull/1840)+    * You can now optionally add a comment header to the YAML output+      indicating that the file is generated and should not be hand-edited+    * This is a breaking change because this adds a new `noEdit` field to the+      options type+    * In practice this breakage won't affect most users+* [Produce output compatible with YAML 1.1](https://github.com/dhall-lang/dhall-haskell/pull/1788)+    * Special strings like `on` are now quoted in order to avoid being+      misinterpreted as boolean values by YAML 1.1 implementations+* [Show JSON/YAML path on error reporting](https://github.com/dhall-lang/dhall-haskell/pull/1799)+    * Error messages will now include the path to the error in the diagnostic+      output+ 1.6.4  * [Add `json-to-dhall` support for inferring the schema](https://github.com/dhall-lang/dhall-haskell/pull/1773)

@@ -1,5 +1,5 @@ Name: dhall-json-Version: 1.6.4+Version: 1.7.0 Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1@@ -27,6 +27,9 @@     CHANGELOG.md     tasty/data/*.dhall     tasty/data/*.json+    tasty/data/error/*.golden+    tasty/data/error/*.json+    tasty/data/error/*.dhall  Source-Repository head     Type: git@@ -36,12 +39,12 @@     Hs-Source-Dirs: src     Build-Depends:         base                      >= 4.8.0.0  && < 5   ,-        aeson                     >= 1.0.0.0  && < 1.5 ,+        aeson                     >= 1.0.0.0  && < 1.6 ,         aeson-pretty                             < 0.9 ,         aeson-yaml                >= 1.0.6    && < 1.1 ,         bytestring                               < 0.11,-        containers                                     ,-        dhall                     >= 1.31.0   && < 1.33,+        containers                >= 0.5.9    && < 0.7 ,+        dhall                     >= 1.33.0   && < 1.34,         exceptions                >= 0.8.3    && < 0.11,         filepath                                 < 1.5 ,         optparse-applicative      >= 0.14.0.0 && < 0.16,@@ -115,13 +118,14 @@     Hs-Source-Dirs: tasty     Main-Is: Main.hs     Build-Depends:-        base              ,-        aeson             ,-        bytestring        ,-        dhall             ,-        dhall-json        ,-        tasty       <  1.3,-        text              ,-        tasty-hunit >= 0.2+        base               ,+        aeson              ,+        bytestring         ,+        dhall              ,+        dhall-json         ,+        tasty        <  1.4,+        text               ,+        tasty-hunit  >= 0.2,+        tasty-silver >= 3.0     GHC-Options: -Wall     Default-Language: Haskell2010

@@ -6,12 +6,12 @@ module Dhall.DhallToYaml.Main (main) where  import Control.Applicative (optional, (<|>))-import Control.Exception (SomeException)-import Data.ByteString (ByteString)-import Data.Monoid ((<>))-import Data.Text (Text)-import Dhall.JSON (parsePreservationAndOmission, parseConversion)-import Dhall.JSON.Yaml (Options(..), parseDocuments, parseQuoted)+import Control.Exception   (SomeException)+import Data.ByteString     (ByteString)+import Data.Monoid         ((<>))+import Data.Text           (Text)+import Dhall.JSON          (parseConversion, parsePreservationAndOmission)+import Dhall.JSON.Yaml     (Options (..), parseDocuments, parseQuoted) import Options.Applicative (Parser, ParserInfo)  import qualified Control.Exception@@ -34,6 +34,7 @@             <*> Dhall.JSON.parseConversion             <*> optional parseFile             <*> optional parseOutput+            <*> parseNoEdit             )     <|> parseVersion   where@@ -64,6 +65,12 @@             <>  Options.metavar "FILE"             ) +    parseNoEdit =+        Options.switch+           (   Options.long "generated-comment"+           <>  Options.help "Include a comment header warning not to edit the generated file"+           )+ parserInfo :: ParserInfo (Maybe Options) parserInfo =     Options.info@@ -82,10 +89,10 @@     maybeOptions <- Options.execParser parserInfo      case maybeOptions of-        Nothing -> do+        Nothing ->             putStrLn (Data.Version.showVersion version) -        Just options@(Options {..}) -> do+        Just options@Options{..} ->             handle $ do                 contents <- case file of                     Nothing   -> Text.IO.getContents@@ -93,7 +100,7 @@                  let write =                         case output of-                            Nothing -> Data.ByteString.putStr+                            Nothing    -> Data.ByteString.putStr                             Just file_ -> Data.ByteString.writeFile file_                  write =<< dhallToYaml options file contents

@@ -124,9 +124,9 @@     the same record.  For example, this code:  > let Example = < Left : { foo : Natural } | Right : { bar : Bool } >-> +> > let Nesting = < Inline | Nested : Text >-> +> > in  { field    = "name" >     , nesting  = Nesting.Inline >     , contents = Example.Left { foo = 2 }@@ -143,9 +143,9 @@     underneath a field named @nestedField@.  For example, this code:  > let Example = < Left : { foo : Natural } | Right : { bar : Bool } >-> +> > let Nesting = < Inline | Nested : Text >-> +> > in  { field    = "name" >     , nesting  = Nesting.Nested "value" >     , contents = Example.Left { foo = 2 }@@ -165,7 +165,7 @@  > $ cat ./example.dhall > let JSON = https://prelude.dhall-lang.org/JSON/package.dhall-> +> > in  JSON.object >     [ { mapKey = "foo", mapValue = JSON.null } >     , { mapKey =@@ -212,21 +212,21 @@     , CompileError(..)     ) where -import Control.Applicative (empty, (<|>))-import Control.Monad (guard)-import Control.Exception (Exception, throwIO)-import Data.Aeson (Value(..), ToJSON(..))-import Data.Maybe (fromMaybe)-import Data.Monoid ((<>), mempty)-import Data.Text (Text)+import Control.Applicative       (empty, (<|>))+import Control.Exception         (Exception, throwIO)+import Control.Monad             (guard)+import Data.Aeson                (ToJSON (..), Value (..))+import Data.Maybe                (fromMaybe)+import Data.Monoid               (mempty, (<>))+import Data.Text                 (Text) import Data.Text.Prettyprint.Doc (Pretty)-import Data.Void (Void)-import Dhall.Core (Binding(..), DhallDouble(..), Expr)-import Dhall.Import (SemanticCacheMode(..))-import Dhall.Map (Map)-import Dhall.JSON.Util (pattern V)-import Options.Applicative (Parser)-import Prelude hiding (getContents)+import Data.Void                 (Void)+import Dhall.Core                (Binding (..), DhallDouble (..), Expr)+import Dhall.Import              (SemanticCacheMode (..))+import Dhall.JSON.Util           (pattern V)+import Dhall.Map                 (Map)+import Options.Applicative       (Parser)+import Prelude                   hiding (getContents)  import qualified Data.Aeson                            as Aeson import qualified Data.Foldable                         as Foldable@@ -412,7 +412,7 @@     -> Either CompileError Value dhallToJSON e0 = loop (Core.alphaNormalize (Core.normalize e0))   where-    loop e = case e of +    loop e = case e of         Core.BoolLit a -> return (toJSON a)         Core.NaturalLit a -> return (toJSON a)         Core.IntegerLit a -> return (toJSON a)@@ -459,7 +459,7 @@                    , Just (alternativeName, mExpr) <- getContents contents -> do                        contents' <- case mExpr of                            Just expr -> loop expr-                           Nothing -> return Aeson.Null+                           Nothing   -> return Aeson.Null                         let taggedValue =                                Data.Map.fromList@@ -637,7 +637,7 @@ omitNull Null =     Null -{-| Omit record fields that are @null@, arrays and records whose transitive +{-| Omit record fields that are @null@, arrays and records whose transitive     fields are all null -} omitEmpty :: Value -> Value@@ -962,12 +962,6 @@          Core.None ->             Core.None--        Core.OptionalFold ->-            Core.OptionalFold--        Core.OptionalBuild ->-            Core.OptionalBuild          Core.Record a ->             Core.Record a'

@@ -13,12 +13,13 @@   , defaultOptions   , dhallToYaml   , jsonToYaml+  , generatedCodeNotice   ) where -import Data.ByteString (ByteString)-import Data.Monoid ((<>))-import Data.Text (Text)-import Dhall.JSON (Conversion(..), SpecialDoubleMode(..))+import Data.ByteString     (ByteString)+import Data.Monoid         ((<>))+import Data.Text           (Text)+import Dhall.JSON          (Conversion (..), SpecialDoubleMode (..)) import Options.Applicative (Parser)  import qualified Data.Aeson@@ -37,6 +38,7 @@     , conversion :: Conversion     , file       :: Maybe FilePath     , output     :: Maybe FilePath+    , noEdit     :: Bool     }  defaultOptions :: Options@@ -48,6 +50,7 @@           , conversion = Dhall.JSON.defaultConversion           , file = Nothing           , output = Nothing+          , noEdit = False           }  parseDocuments :: Parser Bool@@ -63,7 +66,13 @@             (   Options.Applicative.long "quoted"             <>  Options.Applicative.help "Prevent from generating not quoted scalars"             )-                           ++{-| The notice added to the top of a generated file when enabling the+    @--generated-comment@+-}+generatedCodeNotice :: ByteString+generatedCodeNotice = "# Code generated by dhall-to-yaml.  DO NOT EDIT.\n"+ {-| Convert a piece of Text carrying a Dhall inscription to an equivalent YAML ByteString -} dhallToYaml@@ -73,12 +82,17 @@   -> Text  -- ^ Input text.   -> IO ByteString dhallToYaml Options{..} mFilePath code = do-  +   let explaining = if explain then Dhall.detailed else id    json <- omission <$> explaining (Dhall.JSON.codeToValue conversion UseYAMLEncoding mFilePath code) -  return $ jsonToYaml json documents quoted+  let header =+          if noEdit+          then generatedCodeNotice+          else mempty++  return $ header <> jsonToYaml json documents quoted  -- | Transform json representation into yaml jsonToYaml

@@ -191,7 +191,22 @@ > $ json-to-dhall --no-keyval-maps 'List { mapKey : Text, mapValue : Text }' <<< '{ "foo": "bar" }' > Error: Homogeneous JSON map objects cannot be converted to Dhall association lists under --no-keyval-arrays flag +    If your schema is a record with a `List` field and omit that field in the JSON,+    you'll get an error: +> $ json-to-dhall  '{ a : List Natural }' <<< '{}'+>+>+> Error: Key a, expected by Dhall type:+> List Natural+> is not present in JSON object:+> {}++    You can use the @--omissible-lists@ option to default to an empty list in this case++> $ json-to-dhall --omissible-lists  '{ a : List Natural }' <<< '{}'+> { a = [] : List Natural }+ == Optional values and unions      JSON @null@ values correspond to @Optional@ Dhall values:@@ -344,44 +359,45 @@     , showCompileError     ) where -import           Control.Applicative ((<|>))-import           Control.Exception (Exception, throwIO)-import           Control.Monad.Catch (throwM, MonadCatch)-import           Data.Aeson (Value)-import qualified Data.Aeson as A-import           Data.Aeson.Encode.Pretty (encodePretty)+import Control.Applicative      ((<|>))+import Control.Exception        (Exception, throwIO)+import Control.Monad.Catch      (MonadCatch, throwM)+import Data.Aeson               (Value)+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.Either              (rights)+import Data.Foldable            (toList)+import Data.List                ((\\))+import Data.Monoid              (Any (..))+import Data.Scientific          (floatingOrInteger, toRealFloat)+import Data.Semigroup           (Semigroup (..))+import Data.Text                (Text)+import Data.Void                (Void)+import Dhall.Core               (Chunks (..), DhallDouble (..), Expr (App))+import Dhall.JSON.Util          (pattern V)+import Dhall.Parser             (Src)+import Options.Applicative      (Parser)++import qualified Data.Aeson                 as Aeson+import qualified Data.Aeson.Types           as Aeson.Types import qualified Data.ByteString.Lazy.Char8 as BSL8-import           Data.Either (rights)-import           Data.Foldable (toList)-import qualified Data.Foldable as Foldable-import qualified Data.HashMap.Strict as HM-import           Data.List ((\\))-import qualified Data.List as List+import qualified Data.Foldable              as Foldable+import qualified Data.HashMap.Strict        as HM+import qualified Data.List                  as List import qualified Data.Map-import qualified Data.Map.Merge.Lazy as Data.Map.Merge-import           Data.Monoid (Any(..))-import qualified Data.Ord as Ord-import           Data.Scientific (floatingOrInteger, toRealFloat)-import           Data.Semigroup (Semigroup(..))-import qualified Data.Sequence as Seq+import qualified Data.Map.Merge.Lazy        as Data.Map.Merge+import qualified Data.Ord                   as Ord+import qualified Data.Sequence              as Seq import qualified Data.String-import qualified Data.Text as Text-import           Data.Text (Text)-import qualified Data.Vector as Vector-import           Data.Void (Void)-import qualified Options.Applicative as O-import           Options.Applicative (Parser)--import           Dhall.JSON.Util (pattern V)-import qualified Dhall.Core as D-import           Dhall.Core (Expr(App), Chunks(..), DhallDouble(..))+import qualified Data.Text                  as Text+import qualified Data.Vector                as Vector+import qualified Dhall.Core                 as D import qualified Dhall.Import-import qualified Dhall.Lint as Lint-import qualified Dhall.Map as Map-import qualified Dhall.Optics as Optics+import qualified Dhall.Lint                 as Lint+import qualified Dhall.Map                  as Map+import qualified Dhall.Optics               as Optics import qualified Dhall.Parser-import           Dhall.Parser (Src)-import qualified Dhall.TypeCheck as D+import qualified Dhall.TypeCheck            as D+import qualified Options.Applicative        as O  -- --------------- -- Command options@@ -398,11 +414,11 @@     parseStrict =             O.flag' True             (  O.long "records-strict"-            <> O.help "Fail if any YAML fields are missing from the expected Dhall type"+            <> O.help "Fail if any JSON fields are missing from the expected Dhall type"             )         <|> O.flag' False             (  O.long "records-loose"-            <> O.help "Tolerate YAML fields not present within the expected Dhall type"+            <> O.help "Tolerate JSON fields not present within the expected Dhall type"             )         <|> pure True @@ -502,8 +518,8 @@       _              -> throwM . compileException $ BadDhallType t expr  keyValMay :: Value -> Maybe (Text, Value)-keyValMay (A.Object o) = do-     A.String k <- HM.lookup "key" o+keyValMay (Aeson.Object o) = do+     Aeson.String k <- HM.lookup "key" o      v <- HM.lookup "value" o      return (k, v) keyValMay _ = Nothing@@ -515,26 +531,26 @@     on the command line -} inferSchema :: Value -> Schema-inferSchema (A.Object m) =+inferSchema (Aeson.Object m) =     let convertMap = Data.Map.fromList . HM.toList      in (Record . RecordSchema . convertMap) (fmap inferSchema m)-inferSchema (A.Array xs) =+inferSchema (Aeson.Array xs) =     List (Foldable.foldMap inferSchema xs)-inferSchema (A.String _) =+inferSchema (Aeson.String _) =     Text-inferSchema (A.Number n) =+inferSchema (Aeson.Number n) =     case floatingOrInteger n of         Left (_ :: Double) -> Double         Right (integer :: Integer)             | 0 <= integer -> Natural             | otherwise    -> Integer-inferSchema (A.Bool _) =+inferSchema (Aeson.Bool _) =     Bool-inferSchema A.Null =+inferSchema Aeson.Null =     Optional mempty --- | A record type that `inferSchema` can infer+-- | Aeson record type that `inferSchema` can infer newtype RecordSchema =     RecordSchema { getRecordSchema :: Data.Map.Map Text Schema } @@ -778,11 +794,11 @@ >>> :set -XOverloadedStrings >>> import qualified Dhall.Core as D >>> import qualified Dhall.Map as Map->>> import qualified Data.Aeson as A+>>> import qualified Data.Aeson as Aeson >>> import qualified Data.HashMap.Strict as HM  >>> s = D.Record (Map.fromList [("foo", D.Integer)])->>> v = A.Object (HM.fromList [("foo", A.Number 1)])+>>> v = Aeson.Object (HM.fromList [("foo", Aeson.Number 1)]) >>> dhallFromJSON defaultConversion s v Right (RecordLit (fromList [("foo",IntegerLit 1)])) @@ -790,74 +806,75 @@ dhallFromJSON   :: Conversion -> ExprX -> Value -> Either CompileError ExprX dhallFromJSON (Conversion {..}) expressionType =-    fmap (Optics.rewriteOf D.subExpressions Lint.useToMap) . loop (D.alphaNormalize (D.normalize expressionType))+    fmap (Optics.rewriteOf D.subExpressions Lint.useToMap) . loop [] (D.alphaNormalize (D.normalize expressionType))   where+    loop :: Aeson.Types.JSONPath -> ExprX -> Aeson.Value -> Either CompileError ExprX     -- any ~> Union-    loop t@(D.Union tm) v = do+    loop jsonPath t@(D.Union tm) v = do       let f key maybeType =             case maybeType of               Just _type -> do-                expression <- loop _type v+                expression <- loop jsonPath _type v                  return (D.App (D.Field t key) expression) -              Nothing -> do+              Nothing ->                 case v of-                    A.String text | key == text -> do+                    Aeson.String text | key == text ->                         return (D.Field t key)-                    _ -> do-                        Left (Mismatch t v)+                    _ ->+                        Left (Mismatch t v jsonPath)        case (unions, rights (toList (Map.mapWithKey f tm))) of         (UNone  , _         ) -> Left (ContainsUnion t)         (UStrict, xs@(_:_:_)) -> Left (UndecidableUnion t v xs)-        (_      , [ ]       ) -> Left (Mismatch t v)+        (_      , [ ]       ) -> Left (Mismatch t v jsonPath)         (UFirst , x:_       ) -> Right x         (UStrict, [x]       ) -> Right x      -- object ~> Record-    loop (D.Record r) v@(A.Object o)+    loop jsonPath (D.Record r) v@(Aeson.Object o)         | extraKeys <- HM.keys o \\ Map.keys r         , strictRecs && not (null extraKeys)-        = Left (UnhandledKeys extraKeys (D.Record r) v)+        = Left (UnhandledKeys extraKeys (D.Record r) v jsonPath)         | otherwise         = let f :: Text -> ExprX -> Either CompileError ExprX               f k t | Just value <- HM.lookup k o-                    = loop t value+                    = loop (Aeson.Types.Key k : jsonPath) t value                     | App D.Optional t' <- t                     = Right (App D.None t')                     | App D.List _ <- t                     , omissibleLists                     = Right (D.ListLit (Just t) [])                     | otherwise-                    = Left (MissingKey k t v)+                    = Left (MissingKey k t v jsonPath)            in D.RecordLit <$> Map.traverseWithKey f r      -- key-value list ~> Record-    loop t@(D.Record _) v@(A.Array a)+    loop jsonPath t@(D.Record _) v@(Aeson.Array a)         | not noKeyValArr         , os :: [Value] <- toList a         , Just kvs <- traverse keyValMay os-        = loop t (A.Object $ HM.fromList kvs)+        = loop jsonPath t (Aeson.Object $ HM.fromList kvs)         | noKeyValArr         = Left (NoKeyValArray t v)         | otherwise-        = Left (Mismatch t v)+        = Left (Mismatch t v jsonPath)      -- object ~> List (key, value)-    loop t@(App D.List (D.Record r)) v@(A.Object o)+    loop jsonPath t@(App D.List (D.Record r)) v@(Aeson.Object o)         | not noKeyValMap         , ["mapKey", "mapValue"] == Map.keys r         , Just mapKey   <- Map.lookup "mapKey" r         , Just mapValue <- Map.lookup "mapValue" r         = do-          keyExprMap <- traverse (loop mapValue) o+          keyExprMap <- HM.traverseWithKey  (\k child -> loop (Aeson.Types.Key k : jsonPath) mapValue child) o -          toKey <- do+          toKey <-               case mapKey of-                  D.Text    -> return (\key -> D.TextLit (Chunks [] key))-                  D.Union _ -> return (\key -> D.Field mapKey key)-                  _         -> Left (Mismatch t v)+                  D.Text    -> return $ D.TextLit . Chunks []+                  D.Union _ -> return $ D.Field mapKey+                  _         -> Left (Mismatch t v jsonPath)            let f :: (Text, ExprX) -> ExprX               f (key, val) = D.RecordLit ( Map.fromList@@ -873,59 +890,60 @@         | noKeyValMap         = Left (NoKeyValMap t v)         | otherwise-        = Left (Mismatch t v)+        = Left (Mismatch t v jsonPath)      -- array ~> List-    loop (App D.List t) (A.Array a)+    loop jsonPath (App D.List t) (Aeson.Array a)         = let f :: [ExprX] -> ExprX               f es = D.ListLit                        (if null es then Just (App D.List t) else Nothing)                        (Seq.fromList es)-           in f <$> traverse (loop t) (toList a)+           in f <$> traverse (\(idx, val) -> loop (Aeson.Types.Index idx : jsonPath) t val) (zip [0..] $ toList a)      -- null ~> List-    loop t@(App D.List _) (A.Null)+    loop jsonPath t@(App D.List _) Aeson.Null         = if omissibleLists           then Right (D.ListLit (Just t) [])-          else Left (Mismatch t A.Null)+          else Left (Mismatch t Aeson.Null jsonPath)      -- number ~> Integer-    loop D.Integer (A.Number x)+    loop jsonPath D.Integer (Aeson.Number x)         | Right n <- floatingOrInteger x :: Either Double Integer         = Right (D.IntegerLit n)         | otherwise-        = Left (Mismatch D.Integer (A.Number x))+        = Left (Mismatch D.Integer (Aeson.Number x) jsonPath)      -- number ~> Natural-    loop D.Natural (A.Number x)+    loop jsonPath D.Natural (Aeson.Number x)         | Right n <- floatingOrInteger x :: Either Double Integer         , n >= 0         = Right (D.NaturalLit (fromInteger n))         | otherwise-        = Left (Mismatch D.Natural (A.Number x))+        = Left (Mismatch D.Natural (Aeson.Number x) jsonPath)      -- number ~> Double-    loop D.Double (A.Number x)+    loop _ D.Double (Aeson.Number x)         = Right (D.DoubleLit $ DhallDouble $ toRealFloat x)      -- string ~> Text-    loop D.Text (A.String t)+    loop _ D.Text (Aeson.String t)         = Right (D.TextLit (Chunks [] t))      -- bool ~> Bool-    loop D.Bool (A.Bool t)+    loop _ D.Bool (Aeson.Bool t)         = Right (D.BoolLit t)      -- null ~> Optional-    loop (App D.Optional expr) A.Null+    loop _ (App D.Optional expr) Aeson.Null         = Right $ App D.None expr      -- value ~> Optional-    loop (App D.Optional expr) value-        = D.Some <$> loop expr value+    loop jsonPath (App D.Optional expr) value+        = D.Some <$> loop jsonPath expr value      -- Arbitrary JSON ~> https://prelude.dhall-lang.org/JSON/Type (< v13.0.0)     loop+      _       (D.Pi _ (D.Const D.Type)           (D.Pi _               (D.Record@@ -941,7 +959,7 @@           )       )       value = do-          let outer (A.Object o) =+          let outer (Aeson.Object o) =                   let inner (key, val) =                           D.RecordLit                               [ ("mapKey"  , D.TextLit (D.Chunks [] key))@@ -965,8 +983,8 @@                        keyValues = D.ListLit elementType elements -                  in  (D.App (D.Field "json" "object") keyValues)-              outer (A.Array a) =+                  in  D.App (D.Field "json" "object") keyValues+              outer (Aeson.Array a) =                   let elements = Seq.fromList (fmap outer (Vector.toList a))                        elementType@@ -974,13 +992,13 @@                           | otherwise     = Nothing                    in  D.App (D.Field "json" "array") (D.ListLit elementType elements)-              outer (A.String s) =+              outer (Aeson.String s) =                   D.App (D.Field "json" "string") (D.TextLit (D.Chunks [] s))-              outer (A.Number n) =+              outer (Aeson.Number n) =                   D.App (D.Field "json" "number") (D.DoubleLit (DhallDouble (toRealFloat n)))-              outer (A.Bool b) =+              outer (Aeson.Bool b) =                   D.App (D.Field "json" "bool") (D.BoolLit b)-              outer A.Null =+              outer Aeson.Null =                   D.Field "json" "null"            let result =@@ -1002,6 +1020,7 @@      -- Arbitrary JSON ~> https://prelude.dhall-lang.org/JSON/Type (v13.0.0 <=)     loop+      _       (D.Pi _ (D.Const D.Type)           (D.Pi _               (D.Record@@ -1018,7 +1037,7 @@           )       )       value = do-          let outer (A.Object o) =+          let outer (Aeson.Object o) =                   let inner (key, val) =                           D.RecordLit                               [ ("mapKey"  , D.TextLit (D.Chunks [] key))@@ -1042,8 +1061,8 @@                        keyValues = D.ListLit elementType elements -                  in  (D.App (D.Field "json" "object") keyValues)-              outer (A.Array a) =+                  in  D.App (D.Field "json" "object") keyValues+              outer (Aeson.Array a) =                   let elements = Seq.fromList (fmap outer (Vector.toList a))                        elementType@@ -1051,15 +1070,15 @@                           | otherwise     = Nothing                    in  D.App (D.Field "json" "array") (D.ListLit elementType elements)-              outer (A.String s) =+              outer (Aeson.String s) =                   D.App (D.Field "json" "string") (D.TextLit (D.Chunks [] s))-              outer (A.Number n) =+              outer (Aeson.Number n) =                   case floatingOrInteger n of                       Left floating -> D.App (D.Field "json" "double") (D.DoubleLit (DhallDouble floating))                       Right integer -> D.App (D.Field "json" "integer") (D.IntegerLit integer)-              outer (A.Bool b) =+              outer (Aeson.Bool b) =                   D.App (D.Field "json" "bool") (D.BoolLit b)-              outer A.Null =+              outer Aeson.Null =                   D.Field "json" "null"            let result =@@ -1081,8 +1100,8 @@           return result      -- fail-    loop expr value-        = Left (Mismatch expr value)+    loop jsonPath expr value+        = Left (Mismatch expr value jsonPath)   -- ----------@@ -1111,9 +1130,10 @@   | Mismatch       ExprX   -- Dhall expression       Value -- Aeson value+      Aeson.Types.JSONPath -- JSON Path to the error   -- record specific-  | MissingKey     Text  ExprX Value-  | UnhandledKeys [Text] ExprX Value+  | MissingKey     Text  ExprX Value Aeson.Types.JSONPath+  | UnhandledKeys [Text] ExprX Value Aeson.Types.JSONPath   | NoKeyValArray        ExprX Value   | NoKeyValMap          ExprX Value   -- union specific@@ -1149,21 +1169,22 @@       <> Text.unpack (Text.intercalate sep $ D.pretty <$> xs)         where sep = red "\n--------\n" :: Text -    Mismatch e v -> prefix-      <> "Dhall type expression and " <> format <> " value do not match:"+    Mismatch e v jsonPath -> prefix+      <> showJsonPath jsonPath <> ": Dhall type expression and " <> format <> " value do not match:"       <> "\n\nExpected Dhall type:\n" <> showExpr e       <> "\n\n" <> format <> ":\n"  <> showValue v       <> "\n" -    MissingKey k e v -> prefix-      <> "Key " <> purple (Text.unpack k) <> ", expected by Dhall type:\n"+    MissingKey k e v jsonPath -> prefix+      <> showJsonPath jsonPath <> ": Key " <> purple (Text.unpack k) <> ", expected by Dhall type:\n"       <> showExpr e       <> "\nis not present in " <> format <> " object:\n"       <> showValue v <> "\n" -    UnhandledKeys ks e v -> prefix-      <> "Key(s) " <> purple (Text.unpack (Text.intercalate ", " ks))-      <> " present in the " <> format <> " object but not in the expected Dhall record type. This is not allowed unless you enable the "+    UnhandledKeys ks e v jsonPath -> prefix+      <> showJsonPath jsonPath <> ": Key(s) " <> purple (Text.unpack (Text.intercalate ", " ks))+      <> " present in the " <> format <> " object but not in the expected Dhall"+      <> " record type. This is not allowed unless you enable the "       <> green "--records-loose" <> " flag:"       <> "\n\nExpected Dhall type:\n" <> showExpr e       <> "\n\n" <> format <> ":\n"  <> showValue v@@ -1178,7 +1199,10 @@      NoKeyValMap e v -> prefix       <> "Homogeneous " <> format <> " map objects cannot be converted to Dhall association lists under "-      <> green "--no-keyval-arrays" <> " flag"+      <> green "--no-keyval-maps" <> " flag"       <> "\n\nExpected Dhall type:\n" <> showExpr e       <> "\n\n" <> format <> ":\n"  <> showValue v       <> "\n"++showJsonPath :: Aeson.Types.JSONPath -> String+showJsonPath = Aeson.Types.formatPath . reverse

@@ -5,10 +5,12 @@ module Main where  import Data.Monoid ((<>))-import Test.Tasty (TestTree)+import Data.Void   (Void)+import Test.Tasty  (TestTree)  import qualified Data.Aeson           as Aeson import qualified Data.ByteString.Lazy+import qualified Data.Text import qualified Data.Text.IO import qualified Dhall.Core           as Core import qualified Dhall.Import@@ -19,6 +21,7 @@ import qualified GHC.IO.Encoding import qualified Test.Tasty import qualified Test.Tasty.HUnit+import qualified Test.Tasty.Silver  main :: IO () main = do@@ -42,6 +45,13 @@         , testJSONToDhall "./tasty/data/fromArbitraryJSON_13_0_0"         , inferJSONToDhall "./tasty/data/potpourri"         , testCustomConversionJSONToDhall False omissibleLists "./tasty/data/missingList"+        , Test.Tasty.testGroup "Errors"+            [ testJSONToDhallErrorMessage "./tasty/data/error/mismatchMessage0" defaultConversion+            , testJSONToDhallErrorMessage "./tasty/data/error/mismatchMessage1" defaultConversion+            , testJSONToDhallErrorMessage "./tasty/data/error/mismatchMessage2" defaultConversion+            , testJSONToDhallErrorMessage "./tasty/data/error/unhandledKeys" strictRecs+            , testJSONToDhallErrorMessage "./tasty/data/error/missingKey" strictRecs+            ]         , Test.Tasty.testGroup "Nesting"             [ testDhallToJSON "./tasty/data/nesting0"             , testDhallToJSON "./tasty/data/nesting1"@@ -55,7 +65,10 @@             , testDhallToJSON "./tasty/data/unionKeys"             ]         ]-    where omissibleLists = JSONToDhall.defaultConversion{JSONToDhall.omissibleLists = True}+    where+        defaultConversion = JSONToDhall.defaultConversion+        omissibleLists = defaultConversion{JSONToDhall.omissibleLists = True}+        strictRecs = defaultConversion{JSONToDhall.strictRecs = True}  testDhallToJSON :: String -> TestTree testDhallToJSON prefix = Test.Tasty.HUnit.testCase prefix $ do@@ -96,23 +109,15 @@      bytes <- Data.ByteString.Lazy.readFile inputFile -    value <- do+    value <-         case Aeson.eitherDecode bytes of             Left string -> fail string             Right value -> return value -    schema <- do+    schema <-         if infer-            then do-                return (JSONToDhall.schemaToDhallType (JSONToDhall.inferSchema value))-            else do-                let schemaFile = prefix <> "Schema.dhall"--                schemaText <- Data.Text.IO.readFile schemaFile--                parsedSchema <- Core.throws (Dhall.Parser.exprFromText schemaFile schemaText)--                Dhall.Import.load parsedSchema+            then return (JSONToDhall.schemaToDhallType (JSONToDhall.inferSchema value))+            else let schemaFile = prefix <> "Schema.dhall" in loadSchemaFromFile schemaFile      _ <- Core.throws (Dhall.TypeCheck.typeOf schema) @@ -142,3 +147,38 @@ inferJSONToDhall :: String -> TestTree inferJSONToDhall =     testCustomConversionJSONToDhall True JSONToDhall.defaultConversion++loadSchemaFromFile :: FilePath -> IO (Core.Expr Dhall.Parser.Src Void)+loadSchemaFromFile schemaFile = do+    schemaText <- Data.Text.IO.readFile schemaFile++    parsedSchema <- Core.throws (Dhall.Parser.exprFromText schemaFile schemaText)++    Dhall.Import.load parsedSchema++testJSONToDhallErrorMessage :: String -> JSONToDhall.Conversion -> TestTree+testJSONToDhallErrorMessage prefix conv =+    Test.Tasty.Silver.goldenVsAction prefix goldenFile action converter+    where+        goldenFile = prefix <> ".golden"+        schemaFile = prefix <> "Schema.dhall"+        inputFile  = prefix <> ".json"++        action = do+            bytes <- Data.ByteString.Lazy.readFile inputFile++            value <-+                case Aeson.eitherDecode bytes of+                    Left string -> fail string+                    Right value -> return value++            schema <- loadSchemaFromFile schemaFile++            _ <- Core.throws (Dhall.TypeCheck.typeOf schema)++            case JSONToDhall.dhallFromJSON conv schema value of+                Right _ -> fail $ prefix <> " should fail"+                Left compileError ->+                    return (Data.Text.pack $ show compileError)++        converter = id

@@ -0,0 +1,8 @@+[1;31m+Error: [0m$.a.b[1]: Dhall type expression and JSON value do not match:++Expected Dhall type:+Natural++JSON:+0.5

@@ -0,0 +1,14 @@+{+    "a": {+        "b": [+            10,+            0.5+        ]+    },+    "c": {+        "d": [+            10,+            0.5+        ]+    }+}

@@ -0,0 +1,3 @@+{ a : { b : List Natural }+, c : { d : List Integer }+}

@@ -0,0 +1,8 @@+[1;31m+Error: [0m$: Dhall type expression and JSON value do not match:++Expected Dhall type:+Text++JSON:+1

@@ -0,0 +1,1 @@+1

@@ -0,0 +1,1 @@+Text

@@ -0,0 +1,8 @@+[1;31m+Error: [0m$[3]: Dhall type expression and JSON value do not match:++Expected Dhall type:+Natural++JSON:+"oh oh"

@@ -0,0 +1,1 @@+[ 1, 2, 3, "oh oh" ]

@@ -0,0 +1,1 @@+List Natural

@@ -0,0 +1,5 @@+[1;31m+Error: [0m$.a: Key [1;35mb[0m, expected by Dhall type:+Bool+is not present in JSON object:+{}

@@ -0,0 +1,4 @@+{+    "a": {+    }+}

@@ -0,0 +1,1 @@+{ a: { b: Bool } }

@@ -0,0 +1,10 @@+[1;31m+Error: [0m$[1]: Key(s) [1;35mb[0m present in the JSON object but not in the expected Dhall record type. This is not allowed unless you enable the [0;32m--records-loose[0m flag:++Expected Dhall type:+{ a : Natural }++JSON:+{+    "b": 2+}

@@ -0,0 +1,4 @@+[+    { "a": 1 },+    { "b": 2 }+]

@@ -0,0 +1,1 @@+List { a: Natural }

@@ -1,4 +1,4 @@-{ missing = [] : List Text+{ missingProp = [] : List Text , null = [] : List Text , present = ["some-stuff"] }

@@ -1,1 +1,1 @@-{present : List Text, null  : List Text, missing : List Text}+{present : List Text, null  : List Text, missingProp : List Text}