dhall-json 1.7.1 → 1.7.2
raw patch · 6 files changed
+74/−59 lines, 6 filesdep ~aesondep ~dhallPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, dhall
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- dhall-json.cabal +5/−5
- src/Dhall/JSON.hs +29/−29
- src/Dhall/JSON/Util.hs +7/−1
- src/Dhall/JSON/Yaml.hs +6/−1
- src/Dhall/JSONToDhall.hs +23/−23
CHANGELOG.md view
@@ -1,3 +1,7 @@+1.7.2++* [The `--documents` flag now wraps non-`List`s in a document](https://github.com/dhall-lang/dhall-haskell/pull/1977)+ 1.7.1 * [Format documents with leading `---`](https://github.com/dhall-lang/dhall-haskell/pull/1865)
dhall-json.cabal view
@@ -1,5 +1,5 @@ Name: dhall-json-Version: 1.7.1+Version: 1.7.2 Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 8.4.3, GHC == 8.6.1@@ -39,16 +39,16 @@ Hs-Source-Dirs: src Build-Depends: base >= 4.11.0.0 && < 5 ,- aeson >= 1.0.0.0 && < 1.6 ,+ aeson >= 1.4.6.0 && < 1.6 , aeson-pretty < 0.9 , aeson-yaml >= 1.1.0 && < 1.2 , bytestring < 0.11, containers >= 0.5.9 && < 0.7 ,- dhall >= 1.33.0 && < 1.35,+ dhall >= 1.35.0 && < 1.36, exceptions >= 0.8.3 && < 0.11, filepath < 1.5 , lens-family-core >= 1.0.0 && < 2.2 ,- optparse-applicative >= 0.14.0.0 && < 0.16,+ optparse-applicative >= 0.14.0.0 && < 0.17, prettyprinter >= 1.5.1 && < 1.8 , scientific >= 0.3.0.0 && < 0.4 , text >= 0.11.1.0 && < 1.3 ,@@ -98,7 +98,7 @@ Build-Depends: base , aeson ,- ansi-terminal >= 0.6.3.1 && < 0.11,+ ansi-terminal >= 0.6.3.1 && < 0.12, bytestring < 0.11, dhall , dhall-json ,
src/Dhall/JSON.hs view
@@ -223,7 +223,7 @@ import Data.Void (Void) import Dhall.Core (Binding (..), DhallDouble (..), Expr) import Dhall.Import (SemanticCacheMode (..))-import Dhall.JSON.Util (pattern V)+import Dhall.JSON.Util (pattern FA, pattern V) import Dhall.Map (Map) import Options.Applicative (Parser) import Prelude hiding (getContents)@@ -447,7 +447,7 @@ , ("Nested", Just Core.Text) ] )- "Nested"+ (FA "Nested") ) (Core.TextLit (Core.Chunks [] nestedField)@@ -499,9 +499,9 @@ a' <- traverse (loop . Core.recordFieldValue) a return (Aeson.toJSON (Dhall.Map.toMap a')) Core.App (Core.Field (Core.Union _) _) b -> loop b- Core.Field (Core.Union _) k -> return (Aeson.toJSON k)- Core.Lam _ (Core.Const Core.Type)- (Core.Lam _+ Core.Field (Core.Union _) (FA k) -> return (Aeson.toJSON k)+ Core.Lam (Core.functionBindingAnnotation -> Core.Const Core.Type)+ (Core.Lam (Core.functionBindingAnnotation -> (Core.Record [ ("array" , Core.recordFieldValue -> Core.Pi _ (Core.App Core.List (V 0)) (V 1)) , ("bool" , Core.recordFieldValue -> Core.Pi _ Core.Bool (V 1))@@ -513,17 +513,17 @@ , ("mapValue", Core.recordFieldValue -> V 0)])) (V 1)) , ("string", Core.recordFieldValue -> Core.Pi _ Core.Text (V 1)) ]- )+ )) value ) -> do- let outer (Core.Field (V 0) "null") = return Aeson.Null- outer (Core.App (Core.Field (V 0) "bool") (Core.BoolLit b)) =+ let outer (Core.Field (V 0) (FA "null")) = return Aeson.Null+ outer (Core.App (Core.Field (V 0) (FA "bool")) (Core.BoolLit b)) = return (Aeson.Bool b)- outer (Core.App (Core.Field (V 0) "array") (Core.ListLit _ xs)) = do+ outer (Core.App (Core.Field (V 0) (FA "array")) (Core.ListLit _ xs)) = do ys <- traverse outer (Foldable.toList xs) return (Aeson.Array (Vector.fromList ys))- outer (Core.App (Core.Field (V 0) "object") (Core.ListLit _ xs)) = do+ outer (Core.App (Core.Field (V 0) (FA "object")) (Core.ListLit _ xs)) = do let inner (Core.RecordLit [ ("mapKey", Core.recordFieldValue -> Core.TextLit (Core.Chunks [] mapKey)) , ("mapValue", Core.recordFieldValue -> mapExpression)]) = do@@ -535,15 +535,15 @@ ys <- traverse inner (Foldable.toList xs) return (Aeson.Object (HashMap.fromList ys))- outer (Core.App (Core.Field (V 0) "number") (Core.DoubleLit (DhallDouble n))) =+ outer (Core.App (Core.Field (V 0) (FA "number")) (Core.DoubleLit (DhallDouble n))) = return (Aeson.toJSON n)- outer (Core.App (Core.Field (V 0) "string") (Core.TextLit (Core.Chunks [] text))) =+ outer (Core.App (Core.Field (V 0) (FA "string")) (Core.TextLit (Core.Chunks [] text))) = return (toJSON text) outer _ = Left (Unsupported e) outer value- Core.Lam _ (Core.Const Core.Type)- (Core.Lam _+ Core.Lam (Core.functionBindingAnnotation -> Core.Const Core.Type)+ (Core.Lam (Core.functionBindingAnnotation -> (Core.Record [ ("array" , Core.recordFieldValue -> Core.Pi _ (Core.App Core.List (V 0)) (V 1)) , ("bool" , Core.recordFieldValue -> Core.Pi _ Core.Bool (V 1))@@ -557,18 +557,18 @@ ])) (V 1)) , ("string", Core.recordFieldValue -> Core.Pi _ Core.Text (V 1)) ]- )+ )) value ) -> do- let outer (Core.Field (V 0) "null") =+ let outer (Core.Field (V 0) (FA "null")) = return Aeson.Null- outer (Core.App (Core.Field (V 0) "bool") (Core.BoolLit b)) =+ outer (Core.App (Core.Field (V 0) (FA "bool")) (Core.BoolLit b)) = return (Aeson.Bool b)- outer (Core.App (Core.Field (V 0) "array") (Core.ListLit _ xs)) = do+ outer (Core.App (Core.Field (V 0) (FA "array")) (Core.ListLit _ xs)) = do ys <- traverse outer (Foldable.toList xs) return (Aeson.Array (Vector.fromList ys))- outer (Core.App (Core.Field (V 0) "object") (Core.ListLit _ xs)) = do+ outer (Core.App (Core.Field (V 0) (FA "object")) (Core.ListLit _ xs)) = do let inner (Core.RecordLit [ ("mapKey", Core.recordFieldValue -> Core.TextLit (Core.Chunks [] mapKey)) , ("mapValue", Core.recordFieldValue -> mapExpression)]) = do@@ -580,11 +580,11 @@ ys <- traverse inner (Foldable.toList xs) return (Aeson.Object (HashMap.fromList ys))- outer (Core.App (Core.Field (V 0) "double") (Core.DoubleLit (DhallDouble n))) =+ outer (Core.App (Core.Field (V 0) (FA "double")) (Core.DoubleLit (DhallDouble n))) = return (Aeson.toJSON n)- outer (Core.App (Core.Field (V 0) "integer") (Core.IntegerLit n)) =+ outer (Core.App (Core.Field (V 0) (FA "integer")) (Core.IntegerLit n)) = return (Aeson.toJSON n)- outer (Core.App (Core.Field (V 0) "string") (Core.TextLit (Core.Chunks [] text))) =+ outer (Core.App (Core.Field (V 0) (FA "string")) (Core.TextLit (Core.Chunks [] text))) = return (toJSON text) outer _ = Left (Unsupported e) @@ -595,11 +595,11 @@ getContents (Core.App (Core.Field _- alternativeName+ (FA alternativeName) ) expression ) = Just (alternativeName, Just expression)-getContents (Core.Field _ alternativeName) = Just (alternativeName, Nothing)+getContents (Core.Field _ (FA alternativeName)) = Just (alternativeName, Nothing) getContents _ = Nothing isInlineNesting :: Expr s Void -> Bool@@ -610,7 +610,7 @@ , ("Nested", Just Core.Text) ] )- "Inline"+ (FA "Inline") ) (Core.RecordLit []) ) = True@@ -620,7 +620,7 @@ , ("Nested", Just Core.Text) ] )- "Inline"+ (FA "Inline") ) = True isInlineNesting _ = False @@ -728,8 +728,8 @@ case we do *not* want to perform this rewrite since it will interfere with decoding the value. -}- Core.Lam a b c ->- Core.Lam a b c+ Core.Lam a b ->+ Core.Lam a b Core.Pi a b c -> Core.Pi a b' c'@@ -900,7 +900,7 @@ Core.TextLit (Core.Chunks [] keyText) -> return keyText - Core.Field (Core.Union _) keyText ->+ Core.Field (Core.Union _) (FA keyText) -> return keyText _ ->
src/Dhall/JSON/Util.hs view
@@ -3,11 +3,17 @@ module Dhall.JSON.Util ( pattern V+ , pattern FA ) where -import Dhall.Core (Expr)+import Data.Text (Text)+import Dhall.Core (Expr, FieldSelection) import qualified Dhall.Core as Core pattern V :: Int -> Expr s a pattern V n = Core.Var (Core.V "_" n)++pattern FA :: Text -> FieldSelection s+pattern FA t <- Core.FieldSelection _ t _+ where FA = Core.makeFieldSelection
src/Dhall/JSON/Yaml.hs view
@@ -56,7 +56,7 @@ parseDocuments = Options.Applicative.switch ( Options.Applicative.long "documents"- <> Options.Applicative.help "If given a Dhall list, output a document for every element. Each document, including the first one, will be preceded by \"---\", even if there is only one document"+ <> Options.Applicative.help "If given a Dhall list, output a document for every element. Each document, including the first one, will be preceded by \"---\", even if there is only one document. If not given a list, output a single document (as if it were a list of one element)" ) parseQuoted :: Parser Bool@@ -106,6 +106,11 @@ then Data.Aeson.Yaml.encodeQuotedDocuments else Data.Aeson.Yaml.encodeDocuments ) (Data.Vector.toList elems)+ (True, value)+ -> (if quoted+ then Data.Aeson.Yaml.encodeQuotedDocuments+ else Data.Aeson.Yaml.encodeDocuments+ ) [ value ] _ -> (if quoted then Data.Aeson.Yaml.encodeQuoted else Data.Aeson.Yaml.encode
src/Dhall/JSONToDhall.hs view
@@ -373,7 +373,7 @@ import Data.Text (Text) import Data.Void (Void) import Dhall.Core (Chunks (..), DhallDouble (..), Expr (App))-import Dhall.JSON.Util (pattern V)+import Dhall.JSON.Util (pattern FA, pattern V) import Dhall.Parser (Src) import Options.Applicative (Parser) @@ -814,12 +814,12 @@ Just _type -> do expression <- loop jsonPath _type v - return (D.App (D.Field t key) expression)+ return (D.App (D.Field t $ FA key) expression) Nothing -> case v of Aeson.String text | key == text ->- return (D.Field t key)+ return (D.Field t $ FA key) _ -> Left (Mismatch t v jsonPath) @@ -871,7 +871,7 @@ toKey <- case mapKey of D.Text -> return $ D.TextLit . Chunks []- D.Union _ -> return $ D.Field mapKey+ D.Union _ -> return $ D.Field mapKey . FA _ -> Left (Mismatch t v jsonPath) let f :: (Text, ExprX) -> ExprX@@ -988,7 +988,7 @@ keyValues = D.ListLit elementType elements - in D.App (D.Field "json" "object") keyValues+ in D.App (D.Field "json" $ FA "object") keyValues outer (Aeson.Array a) = let elements = Seq.fromList (fmap outer (Vector.toList a)) @@ -996,19 +996,19 @@ | null elements = Just (D.App D.List "JSON") | otherwise = Nothing - in D.App (D.Field "json" "array") (D.ListLit elementType elements)+ in D.App (D.Field "json" $ FA "array") (D.ListLit elementType elements) outer (Aeson.String s) =- D.App (D.Field "json" "string") (D.TextLit (D.Chunks [] s))+ D.App (D.Field "json" $ FA "string") (D.TextLit (D.Chunks [] s)) outer (Aeson.Number n) =- D.App (D.Field "json" "number") (D.DoubleLit (DhallDouble (toRealFloat n)))+ D.App (D.Field "json" $ FA "number") (D.DoubleLit (DhallDouble (toRealFloat n))) outer (Aeson.Bool b) =- D.App (D.Field "json" "bool") (D.BoolLit b)+ D.App (D.Field "json" $ FA "bool") (D.BoolLit b) outer Aeson.Null =- D.Field "json" "null"+ D.Field "json" $ FA "null" let result =- D.Lam "JSON" (D.Const D.Type)- (D.Lam "json"+ D.Lam (D.makeFunctionBinding "JSON" (D.Const D.Type))+ (D.Lam (D.makeFunctionBinding "json" (D.Record [ ("array" , D.makeRecordField $ D.Pi "_" (D.App D.List "JSON") "JSON") , ("bool" , D.makeRecordField $ D.Pi "_" D.Bool "JSON")@@ -1021,7 +1021,7 @@ ])) "JSON") , ("string", D.makeRecordField $ D.Pi "_" D.Text "JSON") ]- )+ )) (outer value) ) @@ -1076,7 +1076,7 @@ keyValues = D.ListLit elementType elements - in D.App (D.Field "json" "object") keyValues+ in D.App (D.Field "json" (FA "object")) keyValues outer (Aeson.Array a) = let elements = Seq.fromList (fmap outer (Vector.toList a)) @@ -1084,21 +1084,21 @@ | null elements = Just (D.App D.List "JSON") | otherwise = Nothing - in D.App (D.Field "json" "array") (D.ListLit elementType elements)+ in D.App (D.Field "json" (FA "array")) (D.ListLit elementType elements) outer (Aeson.String s) =- D.App (D.Field "json" "string") (D.TextLit (D.Chunks [] s))+ D.App (D.Field "json" (FA "string")) (D.TextLit (D.Chunks [] s)) 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)+ Left floating -> D.App (D.Field "json" (FA "double")) (D.DoubleLit (DhallDouble floating))+ Right integer -> D.App (D.Field "json" (FA "integer")) (D.IntegerLit integer) outer (Aeson.Bool b) =- D.App (D.Field "json" "bool") (D.BoolLit b)+ D.App (D.Field "json" (FA "bool")) (D.BoolLit b) outer Aeson.Null =- D.Field "json" "null"+ D.Field "json" (FA "null") let result =- D.Lam "JSON" (D.Const D.Type)- (D.Lam "json"+ D.Lam (D.makeFunctionBinding "JSON" (D.Const D.Type))+ (D.Lam (D.makeFunctionBinding "json" (D.Record [ ("array" , D.makeRecordField $ D.Pi "_" (D.App D.List "JSON") "JSON") , ("bool" , D.makeRecordField $ D.Pi "_" D.Bool "JSON")@@ -1111,7 +1111,7 @@ , ("mapValue", D.makeRecordField "JSON")])) "JSON") , ("string", D.makeRecordField $ D.Pi "_" D.Text "JSON") ]- )+ )) (outer value) )