diff --git a/dhall-json/dhall-to-json/Main.hs b/dhall-json/dhall-to-json/Main.hs index afccca408..4c24c9c09 100644 --- a/dhall-json/dhall-to-json/Main.hs +++ b/dhall-json/dhall-to-json/Main.hs @@ -8,7 +8,7 @@ import Control.Applicative (optional, (<|>)) import Control.Exception (SomeException) import Data.Aeson (Value) import Data.Version (showVersion) -import Dhall.JSON (Conversion, SpecialDoubleMode (..)) +import Dhall.JSON (Conversion, SpecialDoubleMode (..), EncodeTarget) import Options.Applicative (Parser, ParserInfo) import qualified Control.Exception @@ -31,6 +31,7 @@ data Options , pretty :: Bool , omission :: Value -> Value , conversion :: Conversion + , encodeTarget :: EncodeTarget , approximateSpecialDoubles :: Bool , file :: Maybe FilePath , output :: Maybe FilePath @@ -44,6 +45,7 @@ parseOptions = <*> parsePretty <*> Dhall.JSON.parsePreservationAndOmission <*> Dhall.JSON.parseConversion + <*> Dhall.JSON.parseEncodeTarget <*> parseApproximateSpecialDoubles <*> optional parseFile <*> optional parseOutput @@ -150,7 +152,7 @@ main = do Nothing -> Text.IO.getContents Just path -> Text.IO.readFile path - json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode file text) + json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode encodeTarget file text) let write = case output of diff --git a/dhall-json/src/Dhall/JSON.hs b/dhall-json/src/Dhall/JSON.hs index 563326fc9..feccafd6c 100644 --- a/dhall-json/src/Dhall/JSON.hs +++ b/dhall-json/src/Dhall/JSON.hs @@ -201,6 +201,8 @@ module Dhall.JSON ( , omitNull , omitEmpty , parsePreservationAndOmission + , EncodeTarget(..) + , parseEncodeTarget , Conversion(..) , defaultConversion , convertToHomogeneousMaps @@ -592,6 +594,32 @@ dhallToJSON e0 = loop (Core.alphaNormalize (Core.normalize e0)) outer _ = Left (Unsupported e) outer value + + -- Schemas + Core.Bool -> return (Aeson.String "Bool") + Core.Natural -> return (Aeson.String "Natural") + Core.Bytes -> return (Aeson.String "Bytes") + Core.Integer -> return (Aeson.String "Integer") + Core.Double -> return (Aeson.String "Double") + Core.Text -> return (Aeson.String "Text") + Core.Date -> return (Aeson.String "Date") + Core.Time -> return (Aeson.String "Time") + Core.TimeZone -> return (Aeson.String "TimeZone") + Core.App Core.List t -> do + t' <- loop t + return $ Aeson.Object [("type", Aeson.String "List"), ("element", t')] + Core.App Core.Optional t -> do + t' <- loop t + return $ Aeson.Object [("type", Aeson.String "Optional"), ("element", t')] + Core.Record a -> do + a' <- traverse (loop . Core.recordFieldValue) a + return $ Aeson.Object [("type", Aeson.String "Record"), ("fields", Aeson.toJSON (Dhall.Map.toMap a')) ] + Core.Union a -> do + let go Nothing = return $ Aeson.Object [] + go (Just t) = loop t + a' <- traverse go a + return $ Aeson.Object [("type", Aeson.String "Union"), ("choices", Aeson.toJSON (Dhall.Map.toMap a')) ] + _ -> Left (Unsupported e) getContents :: Expr s Void -> Maybe (Text, Maybe (Expr s Void)) @@ -692,6 +720,22 @@ parseNullPreservation = parsePreservationAndOmission :: Parser (Value -> Value) parsePreservationAndOmission = parseOmission <|> parseNullPreservation + +{-| Specify whether to encode data or type as JSON (default data) -} +data EncodeTarget + = EncodeData + | EncodeType + +parseEncodeTarget :: Parser EncodeTarget +parseEncodeTarget = + Options.Applicative.flag' + EncodeType + ( Options.Applicative.long "type" + <> Options.Applicative.help "Encode the type of the input expression instead of the value" + ) + <|> pure EncodeData + + {-| Specify whether or not to convert association lists of type @List { mapKey: Text, mapValue : v }@ to records -} @@ -1198,12 +1242,13 @@ handleSpecialDoubles specialDoubleMode = codeToValue :: Conversion -> SpecialDoubleMode + -> EncodeTarget -> 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 mFilePath code = do - fmap snd (codeToHeaderAndValue conversion specialDoubleMode mFilePath code) +codeToValue conversion specialDoubleMode encodeTarget mFilePath code = do + fmap snd (codeToHeaderAndValue conversion specialDoubleMode encodeTarget mFilePath code) {-| This is like `codeToValue`, except also returning a `Header` that is a valid YAML comment derived from the original Dhall code's `Header` @@ -1211,11 +1256,12 @@ codeToValue conversion specialDoubleMode mFilePath code = do codeToHeaderAndValue :: Conversion -> SpecialDoubleMode + -> EncodeTarget -> Maybe FilePath -- ^ The source file path. If no path is given, imports -- are resolved relative to the current directory. -> Text -- ^ Input text. -> IO (Header, Value) -codeToHeaderAndValue conversion specialDoubleMode mFilePath code = do +codeToHeaderAndValue conversion specialDoubleMode encodeTarget mFilePath code = do (Header header, parsedExpression) <- Core.throws (Dhall.Parser.exprAndHeaderFromText (fromMaybe "(input)" mFilePath) code) let adapt line = @@ -1231,10 +1277,15 @@ codeToHeaderAndValue conversion specialDoubleMode mFilePath code = do resolvedExpression <- Dhall.Import.loadRelativeTo rootDirectory UseSemanticCache parsedExpression - _ <- Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) + t <- Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) + + let resolvedExpression' = + case encodeTarget of + EncodeData -> resolvedExpression + EncodeType -> t let convertedExpression = - convertToHomogeneousMaps conversion resolvedExpression + convertToHomogeneousMaps conversion resolvedExpression' specialDoubleExpression <- Core.throws (handleSpecialDoubles specialDoubleMode convertedExpression) diff --git a/dhall-json/src/Dhall/JSON/Yaml.hs b/dhall-json/src/Dhall/JSON/Yaml.hs index 687601c3b..2f7a7a1f1 100644 --- a/dhall-json/src/Dhall/JSON/Yaml.hs +++ b/dhall-json/src/Dhall/JSON/Yaml.hs @@ -90,7 +90,7 @@ dhallToYaml Options{..} mFilePath code = do let adapt (header, value) = (header, omission value) - (Header comment, json) <- adapt <$> explaining (Dhall.JSON.codeToHeaderAndValue conversion UseYAMLEncoding mFilePath code) + (Header comment, json) <- adapt <$> explaining (Dhall.JSON.codeToHeaderAndValue conversion UseYAMLEncoding Dhall.JSON.EncodeData mFilePath code) let suffix | preserveHeader = Data.Text.Encoding.encodeUtf8 comment diff --git a/dhall-json/tasty/Main.hs b/dhall-json/tasty/Main.hs index 7d71c8145..cde166a81 100644 --- a/dhall-json/tasty/Main.hs +++ b/dhall-json/tasty/Main.hs @@ -34,6 +34,7 @@ testTree = , testDhallToJSON "./tasty/data/emptyObjectStrongType" , testDhallToJSON "./tasty/data/toArbitraryJSON_12_0_0" , testDhallToJSON "./tasty/data/toArbitraryJSON_13_0_0" + , testDhallToJSON "./tasty/data/types" , testJSONToDhall "./tasty/data/emptyAlternative" , testJSONToDhall "./tasty/data/emptyObject" , testJSONToDhall "./tasty/data/emptyList" diff --git a/dhall-json/tasty/data/types.dhall b/dhall-json/tasty/data/types.dhall new file mode 100644 index 000000000..bb6dc9e62 --- /dev/null +++ b/dhall-json/tasty/data/types.dhall @@ -0,0 +1,7 @@ +{ + field: Text, + nested: { nested_field: Natural }, + list: List Bool, + optional: Optional Text, + union: < A: Natural | B: Text | C > +} \ No newline at end of file diff --git a/dhall-json/tasty/data/types.json b/dhall-json/tasty/data/types.json new file mode 100644 index 000000000..774658055 --- /dev/null +++ b/dhall-json/tasty/data/types.json @@ -0,0 +1,28 @@ +{ + "fields": { + "field": "Text", + "list": { + "element": "Bool", + "type": "List" + }, + "nested": { + "fields": { + "nested_field": "Natural" + }, + "type": "Record" + }, + "optional": { + "element": "Text", + "type": "Optional" + }, + "union": { + "choices": { + "A": "Natural", + "B": "Text", + "C": {} + }, + "type": "Union" + } + }, + "type": "Record" +} \ No newline at end of file diff --git a/dhall-yaml/src/Dhall/Yaml.hs b/dhall-yaml/src/Dhall/Yaml.hs index d300231b9..2f6901970 100644 --- a/dhall-yaml/src/Dhall/Yaml.hs +++ b/dhall-yaml/src/Dhall/Yaml.hs @@ -12,7 +12,7 @@ module Dhall.Yaml import Data.ByteString (ByteString) import Data.ByteString.Lazy (toStrict) import Data.Text (Text) -import Dhall.JSON (SpecialDoubleMode (..), codeToHeaderAndValue) +import Dhall.JSON (SpecialDoubleMode (..), codeToHeaderAndValue, EncodeTarget(EncodeData)) import Dhall.JSON.Yaml (Options (..)) import Dhall.Parser (Header (..)) @@ -44,7 +44,7 @@ dhallToYaml Options{..} mFilePath code = do let adapt (header, value) = (header, omission value) - (Header comment, json) <- adapt <$> explaining (codeToHeaderAndValue conversion UseYAMLEncoding mFilePath code) + (Header comment, json) <- adapt <$> explaining (codeToHeaderAndValue conversion UseYAMLEncoding EncodeData mFilePath code) let suffix | preserveHeader = Data.Text.Encoding.encodeUtf8 comment