dhall-json 1.4.0 → 1.4.1
raw patch · 28 files changed
+569/−266 lines, 28 filesdep +filepathdep ~ansi-terminaldep ~dhalldep ~prettyprinterPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: filepath
Dependency ranges changed: ansi-terminal, dhall, prettyprinter
API changes (from Hackage documentation)
+ Dhall.JSON: InvalidInlineContents :: Expr X X -> Expr X X -> CompileError
+ Dhall.Yaml: [output] :: Options -> Maybe FilePath
- Dhall.JSON: codeToValue :: Conversion -> SpecialDoubleMode -> Text -> Text -> IO Value
+ Dhall.JSON: codeToValue :: Conversion -> SpecialDoubleMode -> Maybe FilePath -> Text -> IO Value
- Dhall.Yaml: Options :: Bool -> (Value -> Value) -> Bool -> Bool -> Conversion -> Maybe FilePath -> Options
+ Dhall.Yaml: Options :: Bool -> (Value -> Value) -> Bool -> Bool -> Conversion -> Maybe FilePath -> Maybe FilePath -> Options
- Dhall.Yaml: dhallToYaml :: Options -> Text -> Text -> IO ByteString
+ Dhall.Yaml: dhallToYaml :: Options -> Maybe FilePath -> Text -> IO ByteString
Files
- CHANGELOG.md +11/−0
- dhall-json.cabal +6/−2
- dhall-to-json/Main.hs +59/−48
- dhall-to-yaml/Main.hs +45/−20
- json-to-dhall/Main.hs +68/−44
- src/Dhall/JSON.hs +180/−85
- src/Dhall/JSONToDhall.hs +25/−19
- src/Dhall/Yaml.hs +6/−3
- tasty/Main.hs +12/−3
- tasty/data/emptyList.dhall +17/−0
- tasty/data/emptyList.json +1/−0
- tasty/data/emptyListSchema.dhall +17/−0
- tasty/data/emptyListStrongType.dhall +1/−0
- tasty/data/emptyListStrongType.json +1/−0
- tasty/data/emptyListStrongTypeSchema.dhall +1/−0
- tasty/data/emptyObject.dhall +17/−0
- tasty/data/emptyObject.json +1/−0
- tasty/data/emptyObjectSchema.dhall +17/−0
- tasty/data/emptyObjectStrongType.dhall +1/−0
- tasty/data/emptyObjectStrongType.json +1/−0
- tasty/data/emptyObjectStrongTypeSchema.dhall +1/−0
- tasty/data/nesting2.dhall +8/−0
- tasty/data/nesting2.json +1/−0
- tasty/data/nesting3.dhall +8/−0
- tasty/data/nesting3.json +1/−0
- tasty/data/normal.dhall +1/−1
- tasty/data/quoted.dhall +1/−1
- yaml-to-dhall/Main.hs +61/−40
CHANGELOG.md view
@@ -1,3 +1,14 @@+1.4.1++* [Enable `--records-strict` by default for `{json-yaml}-to-dhall`](https://github.com/dhall-lang/dhall-haskell/pull/1181)+* [Fix `--file` flag for `dhall-to-{json,yaml}`](https://github.com/dhall-lang/dhall-haskell/pull/1191)+* [Fix `--version` flag for `{yaml,json}-to-dhall`](https://github.com/dhall-lang/dhall-haskell/pull/1199)+* [`Nesting`: Support empty alternatives as contents](https://github.com/dhall-lang/dhall-haskell/pull/1204)+* [Fix `yaml-to-dhall` support for empty objects](https://github.com/dhall-lang/dhall-haskell/pull/1186)+* [Throw error when union value is incompatible with inline nesting](https://github.com/dhall-lang/dhall-haskell/pull/1226)+* [Add `--output` options](https://github.com/dhall-lang/dhall-haskell/pull/1304)+* [Minor bug fixes for `yaml-to-dhall` error messages](https://github.com/dhall-lang/dhall-haskell/pull/1305)+ 1.4.0 * BREAKING CHANGE: Split `Dhall.YAML` into `Dhall.YAML` + `Dhall.YAMLToDhall`
dhall-json.cabal view
@@ -1,5 +1,5 @@ Name: dhall-json-Version: 1.4.0+Version: 1.4.1 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 7.10.3, GHC == 8.4.3, GHC == 8.6.1@@ -47,9 +47,11 @@ aeson-pretty < 0.9 , bytestring < 0.11, containers ,- dhall >= 1.25.0 && < 1.26,+ dhall >= 1.26.0 && < 1.27, exceptions >= 0.8.3 && < 0.11,+ filepath < 1.5 , optparse-applicative >= 0.14.0.0 && < 0.16,+ prettyprinter >= 1.2.0.1 && < 1.3 , scientific >= 0.3.0.0 && < 0.4 , text >= 0.11.1.0 && < 1.3 , unordered-containers < 0.3 ,@@ -99,6 +101,8 @@ dhall-json , optparse-applicative , text+ Other-Modules:+ Paths_dhall_json GHC-Options: -Wall Executable json-to-dhall
dhall-to-json/Main.hs view
@@ -5,7 +5,6 @@ import Control.Applicative ((<|>), optional) import Control.Exception (SomeException)-import Control.Monad (when) import Data.Aeson (Value) import Data.Monoid ((<>)) import Data.Version (showVersion)@@ -15,9 +14,7 @@ import qualified Control.Exception import qualified Data.Aeson import qualified Data.Aeson.Encode.Pretty-import qualified Data.ByteString.Char8 import qualified Data.ByteString.Lazy-import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import qualified Dhall import qualified Dhall.JSON@@ -27,26 +24,30 @@ import qualified System.Exit import qualified System.IO -data Options = Options- { explain :: Bool- , pretty :: Bool- , omission :: Value -> Value- , version :: Bool- , conversion :: Conversion- , approximateSpecialDoubles :: Bool- , file :: Maybe FilePath- }+data Options+ = Options+ { explain :: Bool+ , pretty :: Bool+ , omission :: Value -> Value+ , conversion :: Conversion+ , approximateSpecialDoubles :: Bool+ , file :: Maybe FilePath+ , output :: Maybe FilePath+ }+ | Version parseOptions :: Parser Options parseOptions =- Options- <$> parseExplain- <*> parsePretty- <*> Dhall.JSON.parseOmission- <*> parseVersion- <*> Dhall.JSON.parseConversion- <*> parseApproximateSpecialDoubles- <*> optional parseFile+ ( Options+ <$> parseExplain+ <*> parsePretty+ <*> Dhall.JSON.parseOmission+ <*> Dhall.JSON.parseConversion+ <*> parseApproximateSpecialDoubles+ <*> optional parseFile+ <*> optional parseOutput+ )+ <|> parseVersion where parseExplain = Options.switch@@ -75,7 +76,8 @@ pure False parseVersion =- Options.switch+ Options.flag'+ Version ( Options.long "version" <> Options.help "Display version" )@@ -93,6 +95,13 @@ <> Options.metavar "FILE" ) + parseOutput =+ Options.strOption+ ( Options.long "output"+ <> Options.help "Write JSON to a file instead of standard output"+ <> Options.metavar "FILE"+ )+ parserInfo :: ParserInfo Options parserInfo = Options.info@@ -105,41 +114,43 @@ main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - Options {..} <- Options.execParser parserInfo+ options <- Options.execParser parserInfo - when version $ do- putStrLn (showVersion Meta.version)- System.Exit.exitSuccess+ case options of+ Version -> do+ putStrLn (showVersion Meta.version) - 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' config- else Data.Aeson.encode+ Options {..} -> do+ 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' config+ else Data.Aeson.encode - let explaining = if explain then Dhall.detailed else id+ let explaining = if explain then Dhall.detailed else id - let specialDoubleMode =- if approximateSpecialDoubles- then ApproximateWithinJSON- else ForbidWithinJSON+ let specialDoubleMode =+ if approximateSpecialDoubles+ then ApproximateWithinJSON+ else ForbidWithinJSON - text <- case file of- Nothing -> Text.IO.getContents- Just path -> Text.IO.readFile path+ text <- case file of+ Nothing -> Text.IO.getContents+ Just path -> Text.IO.readFile path - let path = case file of- Nothing -> "(stdin)"- Just p -> Text.pack p+ json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode file text) - json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode path text)+ let write =+ case output of+ Nothing -> Data.ByteString.Lazy.putStr+ Just file_ -> Data.ByteString.Lazy.writeFile file_ - Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json+ write (encode json <> "\n") handle :: IO a -> IO a handle = Control.Exception.handle handler
dhall-to-yaml/Main.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE RecordWildCards #-} module Main where -import Control.Applicative (optional)+import Control.Applicative (optional, (<|>)) import Control.Exception (SomeException) import Data.Monoid ((<>)) import Dhall.JSON (parseOmission, parseConversion)@@ -11,22 +11,27 @@ import qualified Control.Exception import qualified Data.ByteString-import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO+import qualified Data.Version import qualified GHC.IO.Encoding import qualified Options.Applicative as Options+import qualified Paths_dhall_json as Meta import qualified System.Exit import qualified System.IO -parseOptions :: Parser Options+parseOptions :: Parser (Maybe Options) parseOptions =- Options- <$> parseExplain- <*> Dhall.JSON.parseOmission- <*> parseDocuments- <*> parseQuoted- <*> Dhall.JSON.parseConversion- <*> optional parseFile+ Just+ <$> ( Options+ <$> parseExplain+ <*> Dhall.JSON.parseOmission+ <*> parseDocuments+ <*> parseQuoted+ <*> Dhall.JSON.parseConversion+ <*> optional parseFile+ <*> optional parseOutput+ )+ <|> parseVersion where parseExplain = Options.switch@@ -41,7 +46,21 @@ <> Options.metavar "FILE" ) -parserInfo :: ParserInfo Options+ parseVersion =+ Options.flag'+ Nothing+ ( Options.long "version"+ <> Options.help "Display version"+ )++ parseOutput =+ Options.strOption+ ( Options.long "output"+ <> Options.help "Write YAML to a file instead of standard output"+ <> Options.metavar "FILE"+ )++parserInfo :: ParserInfo (Maybe Options) parserInfo = Options.info (Options.helper <*> parseOptions)@@ -53,18 +72,24 @@ main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - options@Options {..} <- Options.execParser parserInfo+ maybeOptions <- Options.execParser parserInfo - handle $ do- contents <- case file of- Nothing -> Text.IO.getContents- Just path -> Text.IO.readFile path+ case maybeOptions of+ Nothing -> do+ putStrLn (Data.Version.showVersion Meta.version) - let path = case file of- Nothing -> "(stdin)"- Just p -> Text.pack p+ Just options@(Options {..}) -> do+ handle $ do+ contents <- case file of+ Nothing -> Text.IO.getContents+ Just path -> Text.IO.readFile path - Data.ByteString.putStr =<< dhallToYaml options path contents+ let write =+ case output of+ Nothing -> Data.ByteString.putStr+ Just file_ -> Data.ByteString.writeFile file_++ write =<< dhallToYaml options file contents handle :: IO a -> IO a handle = Control.Exception.handle handler
json-to-dhall/Main.hs view
@@ -8,9 +8,8 @@ module Main where -import Control.Applicative (optional)+import Control.Applicative (optional, (<|>)) import Control.Exception (SomeException, throwIO)-import Control.Monad (when) import Data.Monoid ((<>)) import Data.Text (Text) import Data.Version (showVersion)@@ -24,6 +23,7 @@ import qualified Data.Text.IO as Text.IO import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal+import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text import qualified GHC.IO.Encoding import qualified Options.Applicative as Options import qualified System.Console.ANSI as ANSI@@ -45,23 +45,30 @@ ) -- | All the command arguments and options-data Options = Options- { version :: Bool- , schema :: Text- , conversion :: Conversion- , file :: Maybe FilePath- , ascii :: Bool- , plain :: Bool- } deriving Show+data Options+ = Options+ { schema :: Text+ , conversion :: Conversion+ , file :: Maybe FilePath+ , output :: Maybe FilePath+ , ascii :: Bool+ , plain :: Bool+ }+ | Version+ deriving Show -- | Parser for all the command arguments and options parseOptions :: Parser Options-parseOptions = Options <$> parseVersion- <*> parseSchema- <*> parseConversion- <*> optional parseFile- <*> parseASCII- <*> parsePlain+parseOptions =+ ( Options+ <$> parseSchema+ <*> parseConversion+ <*> optional parseFile+ <*> optional parseOutput+ <*> parseASCII+ <*> parsePlain+ )+ <|> parseVersion where parseSchema = Options.strArgument@@ -70,7 +77,8 @@ ) parseVersion =- Options.switch+ Options.flag'+ Version ( Options.long "version" <> Options.short 'V' <> Options.help "Display version"@@ -83,6 +91,13 @@ <> Options.metavar "FILE" ) + parseOutput =+ Options.strOption+ ( Options.long "output"+ <> Options.help "Write Dhall expression to a file instead of standard output"+ <> Options.metavar "FILE"+ )+ parseASCII = Options.switch ( Options.long "ascii"@@ -103,45 +118,54 @@ main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - Options {..} <- Options.execParser parserInfo+ options <- Options.execParser parserInfo - let characterSet = case ascii of- True -> ASCII- False -> Unicode+ case options of+ Version -> do+ putStrLn (showVersion Meta.version) - when version $ do- putStrLn (showVersion Meta.version)- System.Exit.exitSuccess+ Options {..} -> do+ let characterSet = case ascii of+ True -> ASCII+ False -> Unicode - handle $ do- bytes <- case file of- Nothing -> ByteString.getContents- Just path -> ByteString.readFile path+ handle $ do+ bytes <- case file of+ Nothing -> ByteString.getContents+ Just path -> ByteString.readFile path - value :: Aeson.Value <- case Aeson.eitherDecode bytes of- Left err -> throwIO (userError err)- Right v -> pure v+ value :: Aeson.Value <- case Aeson.eitherDecode bytes of+ Left err -> throwIO (userError err)+ Right v -> pure v - expr <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema+ expr <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema - result <- case dhallFromJSON conversion expr value of- Left err -> throwIO err- Right result -> return result+ result <- case dhallFromJSON conversion expr value of+ Left err -> throwIO err+ Right result -> return result - let document = Dhall.Pretty.prettyCharacterSet characterSet result+ let document = Dhall.Pretty.prettyCharacterSet characterSet result - let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document+ let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document - supportsANSI <- ANSI.hSupportsANSI IO.stdout+ case output of+ Nothing -> do+ supportsANSI <- ANSI.hSupportsANSI IO.stdout - let ansiStream =- if supportsANSI && not plain- then fmap Dhall.Pretty.annToAnsiStyle stream- else Pretty.unAnnotateS stream+ let ansiStream =+ if supportsANSI && not plain+ then fmap Dhall.Pretty.annToAnsiStyle stream+ else Pretty.unAnnotateS stream - Pretty.Terminal.renderIO IO.stdout ansiStream+ Pretty.Terminal.renderIO IO.stdout ansiStream - Text.IO.putStrLn ""+ Text.IO.putStrLn ""++ Just file_ ->+ IO.withFile file_ IO.WriteMode $ \h -> do+ Pretty.Text.renderIO h stream++ Text.IO.hPutStrLn h "" handle :: IO a -> IO a handle = Control.Exception.handle handler
src/Dhall/JSON.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} @@ -72,22 +73,17 @@ Dhall unions translate to the wrapped value: -> $ dhall-to-json <<< "< Left = +2 | Right : Natural>"+> $ dhall-to-json <<< "< Left : Natural | Right : Natural>.Left 2" > 2 > $ cat config-> [ < Person = { age = 47, name = "John" }-> | Place : { location : Text }-> >-> , < Place = { location = "North Pole" }-> | Person : { age : Natural, name : Text }-> >-> , < Place = { location = "Sahara Desert" }-> | Person : { age : Natural, name : Text }-> >-> , < Person = { age = 35, name = "Alice" }-> | Place : { location : Text }-> >-> ]+> let MyType =+> < Person : { age : Natural, name : Text } | Place : { location : Text } >+>+> in [ MyType.Person { age = 47, name = "John" }+> , MyType.Place { location = "North Pole" }+> , MyType.Place { location = "Sahara Desert" }+> , MyType.Person { age = 35, name = "Alice" }+> ] > $ dhall-to-json <<< "./config" > [{"age":47,"name":"John"},{"location":"North Pole"},{"location":"Sahara Desert"},{"age":35,"name":"Alice"}] @@ -107,10 +103,10 @@ > let Example = < Left : { foo : Natural } | Right : { bar : Bool } > > -> let Nesting = < Inline : {} | Nested : Text >+> let Nesting = < Inline | Nested : Text > > > in { field = "name"-> , nesting = Nesting.Inline {=}+> , nesting = Nesting.Inline > , contents = Example.Left { foo = 2 } > } @@ -121,7 +117,7 @@ > "name": "Left" > } - If @nesting@ is set to @Nested nestedField@ then the union is store+ If @nesting@ is set to @Nested nestedField@ then the union is stored underneath a field named @nestedField@. For example, this code: > let Example = < Left : { foo : Natural } | Right : { bar : Bool } >@@ -188,28 +184,38 @@ 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 Dhall.Core (Expr)+import Data.Text.Prettyprint.Doc (Pretty)+import Dhall.Core (Binding(..), Expr)+import Dhall.Import (SemanticCacheMode(..)) import Dhall.TypeCheck (X) import Dhall.Map (Map) import Dhall.JSON.Util (pattern V) import Options.Applicative (Parser)+import Prelude hiding (getContents) -import qualified Data.Aeson as Aeson-import qualified Data.Foldable as Foldable-import qualified Data.HashMap.Strict as HashMap+import qualified Data.Aeson as Aeson+import qualified Data.Foldable as Foldable+import qualified Data.HashMap.Strict as HashMap import qualified Data.List+import qualified Data.Map import qualified Data.Ord import qualified Data.Text-import qualified Data.Vector as Vector-import qualified Dhall.Core as Core+import qualified Data.Text.Prettyprint.Doc as Pretty+import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty+import qualified Data.Vector as Vector+import qualified Dhall.Core as Core import qualified Dhall.Import import qualified Dhall.Map import qualified Dhall.Optics import qualified Dhall.Parser+import qualified Dhall.Pretty import qualified Dhall.TypeCheck+import qualified Dhall.Util import qualified Options.Applicative+import qualified System.FilePath {-| This is the exception type for errors that might arise when translating Dhall to JSON@@ -221,6 +227,7 @@ = Unsupported (Expr X X) | SpecialDouble Double | BareNone+ | InvalidInlineContents (Expr X X) (Expr X X) instance Show CompileError where show BareNone =@@ -249,7 +256,7 @@ show (SpecialDouble n) = Data.Text.unpack $- _ERROR <> ": " <> special <> " disallowed in JSON \n\+ _ERROR <> ": " <> special <> " disallowed in JSON \n\ \ \n\ \Explanation: The JSON standard does not define a canonical way to encode \n\ \❰NaN❱/❰Infinity❱/❰-Infinity❱. You can fix this error by either: \n\@@ -275,13 +282,89 @@ \ \n\ \The following Dhall expression could not be translated to JSON: \n\ \ \n\- \↳ " <> txt <> " "- where- txt = Core.pretty e+ \" <> insert e + show (InvalidInlineContents record alternativeContents) =+ Data.Text.unpack $+ _ERROR <> ": Union value is not compatible with ❰Inline❱ nesting. \n\+ \ \n\+ \Explanation: You can use the ❰Inline❱ nesting to compactly encode a union while \n\+ \preserving the name of the alternative. However the alternative must either be \n\+ \empty or contain a record value. \n\+ \ \n\+ \For example: \n\+ \ \n\+ \ \n\+ \ ┌─────────────────────────────────────────────────┐ \n\+ \ │ let Example = < Empty | Record : { x : Bool } > │ \n\+ \ │ │ \n\+ \ │ let Nesting = < Inline | Nested : Text > │ \n\+ \ │ │ \n\+ \ │ in { field = \"name\" │ \n\+ \ │ , nesting = Nesting.Inline │ \n\+ \ │ , contents = Example.Empty │ An empty alternative \n\+ \ │ } │ is ok. \n\+ \ └─────────────────────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \... is converted to this JSON: \n\+ \ \n\+ \ \n\+ \ ┌─────────────────────┐ \n\+ \ │ { \"name\": \"Empty\" } │ \n\+ \ └─────────────────────┘ \n\+ \ \n\+ \ \n\+ \ ┌──────────────────────────────────────────────┐ \n\+ \ │ ... │ \n\+ \ │ │ \n\+ \ │ in { field = \"name\" │ \n\+ \ │ , nesting = Nesting.Inline │ \n\+ \ │ , contents = Example.Record { x = True } │ An alternative containing \n\+ \ │ } │ a record value is ok. \n\+ \ └──────────────────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \... is converted to this JSON: \n\+ \ \n\+ \ \n\+ \ ┌─────────────────────────────────┐ \n\+ \ │ { \"name\": \"Record\", \"x\": true } │ \n\+ \ └─────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \This isn't valid: \n\+ \ \n\+ \ \n\+ \ ┌──────────────────────────────────────────┐ \n\+ \ │ let Example = < Foo : Bool > │ \n\+ \ │ │ \n\+ \ │ let Nesting = < Inline | Nested : Text > │ \n\+ \ │ │ \n\+ \ │ in { field = \"name\" │ \n\+ \ │ , nesting = Nesting.Inline │ \n\+ \ │ , contents = Example.Foo True │ ❰True❱ is not a record \n\+ \ │ } │ \n\+ \ └──────────────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \The following Dhall expression could not be translated to JSON: \n\+ \ \n\+ \" <> insert record <> " \n\+ \ \n\+ \... because \n\+ \ \n\+ \" <> insert alternativeContents <> " \n\+ \ \n\+ \... is not a record."+ _ERROR :: Data.Text.Text-_ERROR = "\ESC[1;31mError\ESC[0m"+_ERROR = Dhall.Util._ERROR +insert :: Pretty a => a -> Text+insert =+ Pretty.renderStrict . Pretty.layoutPretty Dhall.Pretty.layoutOpts . Dhall.Util.insert+ instance Exception CompileError {-| Convert a Dhall expression to the equivalent JSON expression@@ -322,12 +405,7 @@ Core.RecordLit a -> case toOrderedList a of [ ( "contents"- , Core.App- (Core.Field- _- alternativeName- )- contents+ , contents ) , ( "field" , Core.TextLit@@ -347,28 +425,26 @@ (Core.Chunks [] nestedField) ) )- ] | all (== Core.Record []) mInlineType -> do- contents' <- loop contents+ ] | all (== Core.Record []) mInlineType+ , Just (alternativeName, mExpr) <- getContents contents -> do+ contents' <- case mExpr of+ Just expr -> loop expr+ Nothing -> return Aeson.Null - let taggedValue =- Dhall.Map.fromList- [ ( field- , toJSON alternativeName- )- , ( nestedField- , contents'- )- ]+ let taggedValue =+ Data.Map.fromList+ [ ( field+ , toJSON alternativeName+ )+ , ( nestedField+ , contents'+ )+ ] - return (Aeson.toJSON ( Dhall.Map.toMap taggedValue ))+ return (Aeson.toJSON taggedValue) [ ( "contents"- , Core.App- (Core.Field- _- alternativeName- )- (Core.RecordLit contents)+ , contents ) , ( "field" , Core.TextLit@@ -377,23 +453,23 @@ , ( "nesting" , nesting )- ] | isInlineNesting nesting -> do- let contents' =- Dhall.Map.insert- field- (Core.TextLit- (Core.Chunks- []- alternativeName- )- )- contents+ ] | isInlineNesting nesting+ , Just (alternativeName, mExpr) <- getContents contents -> do+ kvs0 <- case mExpr of+ Just (Core.RecordLit kvs) -> return kvs+ Just alternativeContents ->+ Left (InvalidInlineContents e alternativeContents)+ Nothing -> return mempty - loop (Core.RecordLit contents')+ let name = Core.TextLit (Core.Chunks [] alternativeName)++ let kvs1 = Dhall.Map.insert field name kvs0++ loop (Core.RecordLit kvs1)+ _ -> do a' <- traverse loop a return (Aeson.toJSON (Dhall.Map.toMap a'))- Core.UnionLit _ b _ -> loop b Core.App (Core.Field (Core.Union _) _) b -> loop b Core.Field (Core.Union _) k -> return (Aeson.toJSON k) Core.Lam _ (Core.Const Core.Type)@@ -436,6 +512,17 @@ outer value _ -> Left (Unsupported e) +getContents :: Expr s X -> Maybe (Text, Maybe (Expr s X))+getContents (Core.App+ (Core.Field+ _+ alternativeName+ )+ expression+ ) = Just (alternativeName, Just expression)+getContents (Core.Field _ alternativeName) = Just (alternativeName, Nothing)+getContents _ = Nothing+ isInlineNesting :: Expr s X -> Bool isInlineNesting (Core.App (Core.Field@@ -563,17 +650,12 @@ a' = loop a b' = loop b - Core.Let as b ->- Core.Let as' b'+ Core.Let (Binding src0 a src1 b src2 c) d ->+ Core.Let (Binding src0 a src1 b' src2 c') d' where- f (Core.Binding x y z) = Core.Binding x y' z'- where- y' = fmap loop y- z' = loop z-- as' = fmap f as-- b' = loop b+ b' = fmap (fmap loop) b+ c' = loop c+ d' = loop d Core.Annot a b -> Core.Annot a' b'@@ -645,6 +727,9 @@ Core.NaturalShow -> Core.NaturalShow + Core.NaturalSubtract ->+ Core.NaturalSubtract+ Core.NaturalPlus a b -> Core.NaturalPlus a' b' where@@ -808,12 +893,6 @@ where a' = fmap (fmap loop) a - Core.UnionLit a b c ->- Core.UnionLit a b' c'- where- b' = loop b- c' = fmap (fmap loop) c- Core.Combine a b -> Core.Combine a' b' where@@ -855,6 +934,17 @@ where a' = loop a + Core.Assert a ->+ Core.Assert a'+ where+ a' = loop a++ Core.Equivalent a b ->+ Core.Equivalent a' b'+ where+ a' = loop a+ b' = loop b+ Core.ImportAlt a b -> Core.ImportAlt a' b' where@@ -960,13 +1050,18 @@ codeToValue :: Conversion -> SpecialDoubleMode- -> Text -- ^ Describe the input for the sake of error location.+ -> Maybe FilePath -- ^ The source file path. If no path is given, imports+ -- are resolved relative to the current directory. -> Text -- ^ Input text. -> IO Value-codeToValue conversion specialDoubleMode name code = do- parsedExpression <- Core.throws (Dhall.Parser.exprFromText (Data.Text.unpack name) code)+codeToValue conversion specialDoubleMode mFilePath code = do+ parsedExpression <- Core.throws (Dhall.Parser.exprFromText (fromMaybe "(stdin)" mFilePath) code) - resolvedExpression <- Dhall.Import.load parsedExpression+ let rootDirectory = case mFilePath of+ Nothing -> "."+ Just fp -> System.FilePath.takeDirectory fp++ resolvedExpression <- Dhall.Import.loadRelativeTo rootDirectory UseSemanticCache parsedExpression _ <- Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
src/Dhall/JSONToDhall.hs view
@@ -236,7 +236,6 @@ import Options.Applicative (Parser) import Dhall.JSON.Util (pattern V)-import qualified Dhall import qualified Dhall.Core as D import Dhall.Core (Expr(App), Chunks(..)) import qualified Dhall.Import@@ -257,10 +256,17 @@ <*> parseKVMap <*> parseUnion where- parseStrict = O.switch- ( O.long "records-strict"- <> O.help "Parse all fields in records"- )+ parseStrict =+ O.flag' True+ ( O.long "records-strict"+ <> O.help "Fail if any YAML 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"+ )+ <|> pure True+ parseKVArr = O.switch ( O.long "no-keyval-arrays" <> O.help "Disable conversion of key-value arrays to records"@@ -448,7 +454,7 @@ let records = (fmap f . Seq.fromList . HM.toList) keyExprMap - let typeAnn = if HM.null o then Just mapValue else Nothing+ let typeAnn = if HM.null o then Just t else Nothing return (D.ListLit typeAnn records) | noKeyValMap@@ -460,7 +466,7 @@ loop (App D.List t) (A.Array a) = let f :: [ExprX] -> ExprX f es = D.ListLit- (if null es then Just t else Nothing)+ (if null es then Just (App D.List t) else Nothing) (Seq.fromList es) in f <$> traverse (loop t) (toList a) @@ -473,9 +479,9 @@ -- number ~> Natural loop D.Natural (A.Number x)- | Right n <- floatingOrInteger x :: Either Double Dhall.Natural+ | Right n <- floatingOrInteger x :: Either Double Integer , n >= 0- = Right (D.NaturalLit n)+ = Right (D.NaturalLit (fromInteger n)) | otherwise = Left (Mismatch D.Natural (A.Number x)) @@ -527,7 +533,7 @@ elementType | null elements =- Just (D.Record [ ("mapKey", D.Text), ("mapValue", "JSON") ])+ Just (D.App D.List (D.Record [ ("mapKey", D.Text), ("mapValue", "JSON") ])) | otherwise = Nothing @@ -538,7 +544,7 @@ let elements = Seq.fromList (fmap outer (Vector.toList a)) elementType- | null elements = Just "JSON"+ | null elements = Just (D.App D.List "JSON") | otherwise = Nothing in D.App (D.Field "json" "array") (D.ListLit elementType elements)@@ -631,15 +637,15 @@ UndecidableUnion e v xs -> prefix <> "More than one union component type matches " <> format <> " value"- <> "\n\nDhall:\n" <> showExpr e+ <> "\n\nExpected Dhall type:\n" <> showExpr e <> "\n\n" <> format <> ":\n" <> showValue v <> "\n\nPossible matches:\n\n" -- Showing all the allowed matches <> Text.unpack (Text.intercalate sep $ D.pretty <$> xs) where sep = red "\n--------\n" :: Text Mismatch e v -> prefix- <> "Dhall type expression and json value do not match:"- <> "\n\nDhall:\n" <> showExpr e+ <> "Dhall type expression and " <> format <> " value do not match:"+ <> "\n\nExpected Dhall type:\n" <> showExpr e <> "\n\n" <> format <> ":\n" <> showValue v <> "\n" @@ -651,22 +657,22 @@ UnhandledKeys ks e v -> prefix <> "Key(s) " <> purple (Text.unpack (Text.intercalate ", " ks))- <> " present in the " <> format <> " object but not in the corresponding Dhall record. This is not allowed in presence of "- <> green "--records-strict" <> " flag:"- <> "\n\nDhall:\n" <> showExpr e+ <> " 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 <> "\n" NoKeyValArray e v -> prefix <> "" <> format <> " (key-value) arrays cannot be converted to Dhall records under " <> green "--no-keyval-arrays" <> " flag"- <> "\n\nDhall:\n" <> showExpr e+ <> "\n\nExpected Dhall type:\n" <> showExpr e <> "\n\n" <> format <> ":\n" <> showValue v <> "\n" NoKeyValMap e v -> prefix <> "Homogeneous " <> format <> " map objects cannot be converted to Dhall association lists under " <> green "--no-keyval-arrays" <> " flag"- <> "\n\nDhall:\n" <> showExpr e+ <> "\n\nExpected Dhall type:\n" <> showExpr e <> "\n\n" <> format <> ":\n" <> showValue v <> "\n"
src/Dhall/Yaml.hs view
@@ -38,6 +38,7 @@ , quoted :: Bool , conversion :: Conversion , file :: Maybe FilePath+ , output :: Maybe FilePath } defaultOptions :: Options@@ -48,6 +49,7 @@ , quoted = False , conversion = NoConversion , file = Nothing+ , output = Nothing } parseDocuments :: Parser Bool@@ -68,14 +70,15 @@ -} dhallToYaml :: Options- -> Text -- ^ Describe the input for the sake of error location.+ -> Maybe FilePath -- ^ The source file path. If no path is given, imports+ -- are resolved relative to the current directory. -> Text -- ^ Input text. -> IO ByteString-dhallToYaml Options{..} name code = do+dhallToYaml Options{..} mFilePath code = do let explaining = if explain then Dhall.detailed else id - json <- omission <$> explaining (codeToValue conversion UseYAMLEncoding name code)+ json <- omission <$> explaining (codeToValue conversion UseYAMLEncoding mFilePath code) return $ jsonToYaml json documents quoted
tasty/Main.hs view
@@ -11,7 +11,6 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString import qualified Data.ByteString.Lazy-import qualified Data.Text import qualified Data.Text.IO import qualified Dhall.Core as Core import qualified Dhall.Import@@ -20,12 +19,16 @@ import qualified Dhall.Parser import qualified Dhall.TypeCheck import qualified Dhall.Yaml+import qualified GHC.IO.Encoding import qualified Test.Tasty import qualified Test.Tasty.HUnit main :: IO ()-main = Test.Tasty.defaultMain testTree+main = do+ GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 + Test.Tasty.defaultMain testTree+ testTree :: TestTree testTree = Test.Tasty.testGroup "dhall-json"@@ -37,9 +40,15 @@ (Dhall.Yaml.defaultOptions { Dhall.Yaml.quoted = True }) "./tasty/data/quoted" , testJSONToDhall "./tasty/data/emptyAlternative"+ , testJSONToDhall "./tasty/data/emptyObject"+ , testJSONToDhall "./tasty/data/emptyList"+ , testJSONToDhall "./tasty/data/emptyObjectStrongType"+ , testJSONToDhall "./tasty/data/emptyListStrongType" , Test.Tasty.testGroup "Nesting" [ testDhallToJSON "./tasty/data/nesting0" , testDhallToJSON "./tasty/data/nesting1"+ , testDhallToJSON "./tasty/data/nesting2"+ , testDhallToJSON "./tasty/data/nesting3" , testDhallToJSON "./tasty/data/nestingLegacy0" , testDhallToJSON "./tasty/data/nestingLegacy1" ]@@ -131,7 +140,7 @@ text <- Data.Text.IO.readFile inputFile actualValue <- do- Dhall.Yaml.dhallToYaml options (Data.Text.pack inputFile) text+ Dhall.Yaml.dhallToYaml options (Just inputFile) text expectedValue <- Data.ByteString.readFile outputFile
+ tasty/data/emptyList.dhall view
@@ -0,0 +1,17 @@+ λ(JSON : Type)+→ λ ( json+ : { array :+ List JSON → JSON+ , bool :+ Bool → JSON+ , null :+ JSON+ , number :+ Double → JSON+ , object :+ List { mapKey : Text, mapValue : JSON } → JSON+ , string :+ Text → JSON+ }+ )+→ json.array ([] : List JSON)
+ tasty/data/emptyList.json view
@@ -0,0 +1,1 @@+[]
+ tasty/data/emptyListSchema.dhall view
@@ -0,0 +1,17 @@+ ∀(JSON : Type)+→ ∀ ( json+ : { array :+ List JSON → JSON+ , bool :+ Bool → JSON+ , null :+ JSON+ , number :+ Double → JSON+ , object :+ List { mapKey : Text, mapValue : JSON } → JSON+ , string :+ Text → JSON+ }+ )+→ JSON
+ tasty/data/emptyListStrongType.dhall view
@@ -0,0 +1,1 @@+[] : List Natural
+ tasty/data/emptyListStrongType.json view
@@ -0,0 +1,1 @@+[]
+ tasty/data/emptyListStrongTypeSchema.dhall view
@@ -0,0 +1,1 @@+List Natural
+ tasty/data/emptyObject.dhall view
@@ -0,0 +1,17 @@+ λ(JSON : Type)+→ λ ( json+ : { array :+ List JSON → JSON+ , bool :+ Bool → JSON+ , null :+ JSON+ , number :+ Double → JSON+ , object :+ List { mapKey : Text, mapValue : JSON } → JSON+ , string :+ Text → JSON+ }+ )+→ json.object ([] : List { mapKey : Text, mapValue : JSON })
+ tasty/data/emptyObject.json view
@@ -0,0 +1,1 @@+{}
+ tasty/data/emptyObjectSchema.dhall view
@@ -0,0 +1,17 @@+ ∀(JSON : Type)+→ ∀ ( json+ : { array :+ List JSON → JSON+ , bool :+ Bool → JSON+ , null :+ JSON+ , number :+ Double → JSON+ , object :+ List { mapKey : Text, mapValue : JSON } → JSON+ , string :+ Text → JSON+ }+ )+→ JSON
+ tasty/data/emptyObjectStrongType.dhall view
@@ -0,0 +1,1 @@+[] : List { mapKey : Text, mapValue : Natural }
+ tasty/data/emptyObjectStrongType.json view
@@ -0,0 +1,1 @@+{}
+ tasty/data/emptyObjectStrongTypeSchema.dhall view
@@ -0,0 +1,1 @@+List { mapKey : Text, mapValue : Natural }
+ tasty/data/nesting2.dhall view
@@ -0,0 +1,8 @@+let Example = < Left : { foo : Natural } | Middle | Right : { bar : Bool } >++let Nesting = < Inline | Nested : Text >++in { field = "name"+ , nesting = Nesting.Inline+ , contents = Example.Middle+ }
+ tasty/data/nesting2.json view
@@ -0,0 +1,1 @@+{ "name": "Middle" }
+ tasty/data/nesting3.dhall view
@@ -0,0 +1,8 @@+let Example = < Left : { foo : Natural } | Middle | Right : { bar : Bool } >++let Nesting = < Inline | Nested : Text >++in { field = "name"+ , nesting = Nesting.Nested "value"+ , contents = Example.Middle+ }
+ tasty/data/nesting3.json view
@@ -0,0 +1,1 @@+{ "name": "Middle", "value": null }
tasty/data/normal.dhall view
@@ -1,5 +1,5 @@ { string_value = "2000-01-01"-, text = ./tasty/data/yaml.txt as Text+, text = ./yaml.txt as Text , int_value = 1 , bool_value = True }
tasty/data/quoted.dhall view
@@ -1,5 +1,5 @@ { string_value = "2000-01-01"-, text = ./tasty/data/yaml.txt as Text+, text = ./yaml.txt as Text , int_value = 1 , bool_value = True }
yaml-to-dhall/Main.hs view
@@ -8,9 +8,8 @@ module Main where -import Control.Applicative (optional)+import Control.Applicative (optional, (<|>)) import Control.Exception (SomeException)-import Control.Monad (when) import Data.Monoid ((<>)) import Data.Text (Text) import Data.Version (showVersion)@@ -24,6 +23,7 @@ import qualified Data.Text.IO as Text.IO import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal+import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text import qualified Dhall.Pretty import qualified GHC.IO.Encoding import qualified Options.Applicative as Options@@ -36,14 +36,17 @@ -- Command options -- --------------- -data CommandOptions = CommandOptions- { version :: Bool- , schema :: Text- , conversion :: Conversion- , file :: Maybe FilePath- , ascii :: Bool- , plain :: Bool- } deriving Show+data CommandOptions+ = CommandOptions+ { schema :: Text+ , conversion :: Conversion+ , file :: Maybe FilePath+ , output :: Maybe FilePath+ , ascii :: Bool+ , plain :: Bool+ }+ | Version+ deriving (Show) -- | Command info and description parserInfo :: ParserInfo CommandOptions@@ -53,16 +56,18 @@ <> Options.progDesc "Convert a YAML expression to a Dhall expression, given the expected Dhall type" ) -- -- | Parser for all the command arguments and options parseOptions :: Parser CommandOptions-parseOptions = CommandOptions <$> parseVersion- <*> parseSchema- <*> parseConversion- <*> optional parseFile- <*> parseASCII- <*> parsePlain+parseOptions =+ ( CommandOptions+ <$> parseSchema+ <*> parseConversion+ <*> optional parseFile+ <*> optional parseOutput+ <*> parseASCII+ <*> parsePlain+ )+ <|> parseVersion where parseSchema = Options.strArgument@@ -71,7 +76,8 @@ ) parseVersion =- Options.switch+ Options.flag'+ Version ( Options.long "version" <> Options.short 'V' <> Options.help "Display version"@@ -84,6 +90,13 @@ <> Options.metavar "FILE" ) + parseOutput =+ Options.strOption+ ( Options.long "output"+ <> Options.help "Write Dhall expression to a file instead of standard output"+ <> Options.metavar "FILE"+ )+ parseASCII = Options.switch ( Options.long "ascii"@@ -104,38 +117,46 @@ main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - CommandOptions{..} <- Options.execParser parserInfo+ options <- Options.execParser parserInfo - let characterSet = case ascii of- True -> ASCII- False -> Unicode+ case options of+ Version -> do+ putStrLn (showVersion Meta.version) - when version $ do- putStrLn (showVersion Meta.version)- System.Exit.exitSuccess+ CommandOptions {..} -> do+ let characterSet = case ascii of+ True -> ASCII+ False -> Unicode - handle $ do- bytes <- case file of- Nothing -> BSL8.getContents- Just path -> BSL8.readFile path+ handle $ do+ bytes <- case file of+ Nothing -> BSL8.getContents+ Just path -> BSL8.readFile path - result <- dhallFromYaml (Options schema conversion) bytes+ result <- dhallFromYaml (Options schema conversion) bytes - let document = Dhall.Pretty.prettyCharacterSet characterSet result+ let document = Dhall.Pretty.prettyCharacterSet characterSet result - let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document+ let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document - supportsANSI <- ANSI.hSupportsANSI IO.stdout+ case output of+ Nothing -> do+ supportsANSI <- ANSI.hSupportsANSI IO.stdout - let ansiStream =- if supportsANSI && not plain- then fmap Dhall.Pretty.annToAnsiStyle stream- else Pretty.unAnnotateS stream+ let ansiStream =+ if supportsANSI && not plain+ then fmap Dhall.Pretty.annToAnsiStyle stream+ else Pretty.unAnnotateS stream - Pretty.Terminal.renderIO IO.stdout ansiStream+ Pretty.Terminal.renderIO IO.stdout ansiStream - Text.IO.putStrLn ""+ Text.IO.putStrLn "" + Just file_ ->+ IO.withFile file_ IO.WriteMode $ \h -> do+ Pretty.Text.renderIO h stream++ Text.IO.hPutStrLn h "" handle :: IO a -> IO a handle = Control.Exception.handle handler