dhall-json 1.2.0 → 1.2.1
raw patch · 3 files changed
+160/−18 lines, 3 filesdep ~aesondep ~dhallPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, dhall
API changes (from Hackage documentation)
Files
- dhall-json.cabal +3/−3
- dhall-to-json/Main.hs +6/−1
- src/Dhall/JSON.hs +151/−14
dhall-json.cabal view
@@ -1,5 +1,5 @@ Name: dhall-json-Version: 1.2.0+Version: 1.2.1 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 7.10.2, GHC == 8.0.1@@ -30,8 +30,8 @@ Hs-Source-Dirs: src Build-Depends: base >= 4.8.0.0 && < 5 ,- aeson >= 1.0.0.0 && < 1.4 ,- dhall >= 1.14.0 && < 1.15,+ aeson >= 1.0.0.0 && < 1.5 ,+ dhall >= 1.15.0 && < 1.16, insert-ordered-containers < 1.14, optparse-applicative >= 0.14.0.0 && < 0.15, text >= 0.11.1.0 && < 1.3 ,
dhall-to-json/Main.hs view
@@ -70,9 +70,14 @@ Options {..} <- Options.Applicative.execParser parserInfo handle $ do+ let config = Data.Aeson.Encode.Pretty.Config+ { Data.Aeson.Encode.Pretty.confIndent = Data.Aeson.Encode.Pretty.Spaces 2+ , Data.Aeson.Encode.Pretty.confCompare = compare+ , Data.Aeson.Encode.Pretty.confNumFormat = Data.Aeson.Encode.Pretty.Generic+ , Data.Aeson.Encode.Pretty.confTrailingNewline = False } let encode = if pretty- then Data.Aeson.Encode.Pretty.encodePretty+ then Data.Aeson.Encode.Pretty.encodePretty' config else Data.Aeson.encode let explaining = if explain then Dhall.detailed else id
src/Dhall/JSON.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -91,6 +92,65 @@ > $ dhall-to-json <<< "./config" > [{"age":47,"name":"John"},{"location":"North Pole"},{"location":"Sahara Desert"},{"age":35,"name":"Alice"}] + You can preserve the name of the alternative if you wrap the value in a+ record with three fields:++ * @contents@: The union literal that you want to preserve the tag of++ * @field@: the name of the field that will store the name of the+ alternative++ * @nesting@: A value of type @\< Inline : {} | Nested : Text \>@.++ If @nesting@ is set to @Inline@ and the union literal stored in @contents@+ contains a record then the name of the alternative is stored inline within+ the same record. For example, this code:++> let Example = < Left : { foo : Natural } | Right : { bar : Bool } >+> +> in let example = constructors Example+> +> in let Nesting = < Inline : {} | Nested : Text >+> +> in let nesting = constructors Nesting+> +> in { field = "name"+> , nesting = nesting.Inline {=}+> , contents = example.Left { foo = 2 }+> }++ ... produces this JSON:++> {+> "foo": 2,+> "name": "Left"+> }++ If @nesting@ is set to @Nested nestedField@ then the union is store+ underneath a field named @nestedField@. For example, this code:++> let Example = < Left : { foo : Natural } | Right : { bar : Bool } >+> +> in let example = constructors Example+> +> in let Nesting = < Inline : {} | Nested : Text >+> +> in let nesting = constructors Nesting+> +> in { field = "name"+> , nesting = nesting.Nested "value"+> , contents = example.Left { foo = 2 }+> }++ ... produces this JSON:++> {+> "name": "Left",+> "value": {+> "foo": 2+> }+> }+ Also, all Dhall expressions are normalized before translation to JSON: > $ dhall-to-json <<< "True == False"@@ -115,8 +175,9 @@ import Control.Monad (guard) import Control.Exception (Exception, throwIO) import Data.Aeson (Value(..))+import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import Data.Monoid ((<>))-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Typeable (Typeable) import Dhall.Core (Expr) import Dhall.TypeCheck (X)@@ -126,9 +187,9 @@ import qualified Data.Foldable import qualified Data.HashMap.Strict import qualified Data.HashMap.Strict.InsOrd+import qualified Data.List+import qualified Data.Ord import qualified Data.Text-import qualified Data.Text.Lazy-import qualified Data.Text.Lazy.Builder import qualified Dhall.Core import qualified Dhall.Import import qualified Dhall.Parser@@ -155,7 +216,7 @@ \ \n\ \↳ " <> txt <> " " where- txt = Data.Text.Lazy.toStrict (Dhall.Core.pretty e)+ txt = Dhall.Core.pretty e _ERROR :: Data.Text.Text _ERROR = "\ESC[1;31mError\ESC[0m"@@ -181,19 +242,86 @@ Dhall.Core.IntegerLit a -> return (Data.Aeson.toJSON a) Dhall.Core.DoubleLit a -> return (Data.Aeson.toJSON a) Dhall.Core.TextLit (Dhall.Core.Chunks [] a) -> do- return (Data.Aeson.toJSON (Data.Text.Lazy.Builder.toLazyText a))+ return (Data.Aeson.toJSON a) Dhall.Core.ListLit _ a -> do a' <- traverse loop a return (Data.Aeson.toJSON a') Dhall.Core.OptionalLit _ a -> do a' <- traverse loop a return (Data.Aeson.toJSON a')- Dhall.Core.RecordLit a -> do- a' <- traverse loop a- return (Data.Aeson.toJSON a')+ Dhall.Core.RecordLit a ->+ case toOrderedList a of+ [ ( "contents"+ , Dhall.Core.UnionLit alternativeName contents _+ )+ , ( "field"+ , Dhall.Core.TextLit+ (Dhall.Core.Chunks [] field)+ )+ , ( "nesting"+ , Dhall.Core.UnionLit+ "Nested"+ (Dhall.Core.TextLit+ (Dhall.Core.Chunks [] nestedField)+ )+ [ ("Inline", Dhall.Core.Record []) ]+ )+ ] -> do+ contents' <- loop contents++ let taggedValue =+ Data.HashMap.Strict.InsOrd.fromList+ [ ( field+ , Data.Aeson.toJSON alternativeName+ )+ , ( nestedField+ , contents'+ )+ ]++ return (Data.Aeson.toJSON taggedValue)++ [ ( "contents"+ , Dhall.Core.UnionLit+ alternativeName+ (Dhall.Core.RecordLit contents)+ _+ )+ , ( "field"+ , Dhall.Core.TextLit+ (Dhall.Core.Chunks [] field)+ )+ , ( "nesting"+ , Dhall.Core.UnionLit+ "Inline"+ (Dhall.Core.RecordLit [])+ [ ("Nested", Dhall.Core.Text) ]+ )+ ] -> do+ let contents' =+ Data.HashMap.Strict.InsOrd.insert+ field+ (Dhall.Core.TextLit+ (Dhall.Core.Chunks+ []+ alternativeName+ )+ )+ contents++ loop (Dhall.Core.RecordLit contents')+ _ -> do+ a' <- traverse loop a+ return (Data.Aeson.toJSON a') Dhall.Core.UnionLit _ b _ -> loop b _ -> Left (Unsupported e) +toOrderedList :: Ord k => InsOrdHashMap k v -> [(k, v)]+toOrderedList =+ Data.List.sortBy (Data.Ord.comparing fst)+ . Data.HashMap.Strict.toList+ . Data.HashMap.Strict.InsOrd.toHashMap+ -- | Omit record fields that are @null@ omitNull :: Value -> Value omitNull (Object object) =@@ -353,6 +481,9 @@ Dhall.Core.IntegerShow -> Dhall.Core.IntegerShow + Dhall.Core.IntegerToDouble ->+ Dhall.Core.IntegerToDouble+ Dhall.Core.Double -> Dhall.Core.Double @@ -400,7 +531,7 @@ _ -> empty - return (Data.Text.Lazy.Builder.toLazyText keyText, value)+ return (keyText, value) toKeyValue _ = do empty @@ -530,6 +661,12 @@ where a' = loop a + Dhall.Core.ImportAlt a b ->+ Dhall.Core.ImportAlt a' b'+ where+ a' = loop a+ b' = loop b+ Dhall.Core.Note a b -> Dhall.Core.Note a b' where@@ -553,7 +690,7 @@ ( Options.Applicative.long "key" <> Options.Applicative.help "Reserved key field name for association lists" <> Options.Applicative.value "mapKey"- <> Options.Applicative.showDefaultWith Data.Text.Lazy.unpack+ <> Options.Applicative.showDefaultWith Data.Text.unpack ) parseValueField =@@ -561,7 +698,7 @@ ( Options.Applicative.long "value" <> Options.Applicative.help "Reserved value field name for association lists" <> Options.Applicative.value "mapValue"- <> Options.Applicative.showDefaultWith Data.Text.Lazy.unpack+ <> Options.Applicative.showDefaultWith Data.Text.unpack ) noConversion =@@ -581,11 +718,11 @@ -} codeToValue :: Conversion- -> Data.Text.Text -- ^ Describe the input for the sake of error location.- -> Data.Text.Text -- ^ Input text.+ -> Text -- ^ Describe the input for the sake of error location.+ -> Text -- ^ Input text. -> IO Value codeToValue conversion name code = do- parsedExpression <- case Dhall.Parser.exprFromText (Data.Text.unpack name) (Data.Text.Lazy.fromStrict code) of+ parsedExpression <- case Dhall.Parser.exprFromText (Data.Text.unpack name) code of Left err -> Control.Exception.throwIO err Right parsedExpression -> return parsedExpression