ehmry/dhall-haskell
ehmry/dhall-haskell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Change YAML/JSON encoding for NaN/Infinity/-Infinity (#946)

Browse Source 
Before, `dhall-to-json`/`dhall-to-yaml` would use approximate
representations for special `Double` values.  Specifically, `NaN`
would encode as `null` and `±Infinity` would encode as the minimum
and maximum `Double` values.

After this change, YAML will now use `nan`/`inf`/`-inf` to encode
these values (since special `Double` values are natively supported
by YAML) and the JSON encoding will reject them by default.  The
user can restore the old behavior for the JSON encoding by enabling
the `--approximate-special-doubles` flag.
This commit is contained in:
Gabriel Gonzalez 2019-05-12 16:04:25 -07:00 committed by GitHub
parent 07906673af
commit 8139c3678c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 107 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
dhall-json/dhall-json.cabal
View File

@ -37,6 +37,7 @@ Library
aeson >= 1.0.0.0 && < 1.5 ,
bytestring < 0.11,
dhall >= 1.22.0 && < 1.24,
lens >= 2.5 && < 4.18,
optparse-applicative >= 0.14.0.0 && < 0.15,
text >= 0.11.1.0 && < 1.3 ,
unordered-containers < 0.3 ,

27
dhall-json/dhall-to-json/Main.hs
View File

@ -9,7 +9,7 @@ import Control.Monad (when)
import Data.Aeson (Value)
import Data.Monoid ((<>))
import Data.Version (showVersion)
import Dhall.JSON (Conversion)
import Dhall.JSON (Conversion, SpecialDoubleMode(..))
import Options.Applicative (Parser, ParserInfo)
import qualified Control.Exception
@ -27,11 +27,12 @@ import qualified System.Exit
import qualified System.IO
data Options = Options
{ explain :: Bool
, pretty :: Bool
, omission :: Value -> Value
, version :: Bool
, conversion :: Conversion
{ explain :: Bool
, pretty :: Bool
, omission :: Value -> Value
, version :: Bool
, conversion :: Conversion
, approximateSpecialDoubles :: Bool
}
parseOptions :: Parser Options
@ -42,6 +43,7 @@ parseOptions =
<*> Dhall.JSON.parseOmission
<*> parseVersion
<*> Dhall.JSON.parseConversion
<*> parseApproximateSpecialDoubles
where
parseExplain =
Options.Applicative.switch
@ -75,6 +77,12 @@ parseOptions =
<> Options.Applicative.help "Display version"
)
parseApproximateSpecialDoubles =
Options.Applicative.switch
( Options.Applicative.long "approximate-special-doubles"
<> Options.Applicative.help "Use approximate representation for NaN/±Infinity"
)
parserInfo :: ParserInfo Options
parserInfo =
Options.Applicative.info
@ -106,9 +114,14 @@ main = do
let explaining = if explain then Dhall.detailed else id
let specialDoubleMode =
if approximateSpecialDoubles
then ApproximateWithinJSON
else ForbidWithinJSON
stdin <- Data.Text.IO.getContents
json <- omission <$> explaining (Dhall.JSON.codeToValue conversion "(stdin)" stdin)
json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode "(stdin)" stdin)
Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json

4
dhall-json/dhall-to-yaml/Main.hs
View File

@ -6,7 +6,7 @@ module Main where
import Control.Exception (SomeException)
import Data.Aeson (Value)
import Data.Monoid ((<>))
import Dhall.JSON (Conversion)
import Dhall.JSON (Conversion, SpecialDoubleMode(..))
import Options.Applicative (Parser, ParserInfo)
import qualified Control.Exception
@ -73,7 +73,7 @@ main = do
stdin <- Data.Text.IO.getContents
json <- omission <$> explaining (Dhall.JSON.codeToValue conversion "(stdin)" stdin)
json <- omission <$> explaining (Dhall.JSON.codeToValue conversion UseYAMLEncoding "(stdin)" stdin)
let yaml = Dhall.JSON.jsonToYaml json documents quoted

97
dhall-json/src/Dhall/JSON.hs
View File

@ -165,6 +165,8 @@ module Dhall.JSON (
, Conversion(..)
, convertToHomogeneousMaps
, parseConversion
, SpecialDoubleMode(..)
, handleSpecialDoubles
, codeToValue
, jsonToYaml
@ -183,6 +185,7 @@ import Dhall.TypeCheck (X)
import Dhall.Map (Map)
import Options.Applicative (Parser)
import qualified Control.Lens
import qualified Data.ByteString
import qualified Data.Foldable
import qualified Data.HashMap.Strict
@ -207,6 +210,7 @@ import qualified Text.Libyaml
-}
data CompileError
= Unsupported (Expr X X)
| SpecialDouble Double
| BareNone
instance Show CompileError where
@ -233,6 +237,26 @@ instance Show CompileError where
\ \n\
\ \n\
\The conversion to JSON/YAML only translates the fully applied form to ❰null❱. "
show (SpecialDouble n) =
Data.Text.unpack $
_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\
\ \n\
\● Using ❰dhall-to-yaml❱ instead of ❰dhall-to-json❱, since YAML does support \n\
\ ❰NaN❱/❰Infinity❱/❰-Infinity❱ \n\
\ \n\
\● Enabling the ❰--approximate-special-doubles❱ flag which will encode ❰NaN❱ as \n\
\ ❰null❱, ❰Infinity❱ as the maximum ❰Double❱, and ❰-Infinity❱ as the minimum \n\
\❰Double❱ \n\
\ \n\
\● See if there is a way to remove ❰NaN❱/❰Infinity❱/❰-Infinity❱ from the \n\
\ expression that you are converting to JSON "
where
special = Data.Text.pack (show n)
show (Unsupported e) =
Data.Text.unpack $
_ERROR <> ": Cannot translate to JSON \n\
@ -261,17 +285,16 @@ Right (Object (fromList [("foo",Number 1.0),("bar",String "ABC")]))
>>> fmap Data.Aeson.encode it
Right "{\"foo\":1,\"bar\":\"ABC\"}"
-}
dhallToJSON :: Expr s X -> Either CompileError Value
dhallToJSON
:: Expr s X
-> Either CompileError Value
dhallToJSON e0 = loop (Dhall.Core.normalize e0)
where
loop e = case e of
Dhall.Core.BoolLit a -> return (toJSON a)
Dhall.Core.NaturalLit a -> return (toJSON a)
Dhall.Core.IntegerLit a -> return (toJSON a)
Dhall.Core.DoubleLit a
| isInfinite a && a > 0 -> return (toJSON ( 1.7976931348623157e308 :: Double))
| isInfinite a && a < 0 -> return (toJSON (-1.7976931348623157e308 :: Double))
| otherwise -> return (toJSON a)
Dhall.Core.DoubleLit a -> return (toJSON a)
Dhall.Core.TextLit (Dhall.Core.Chunks [] a) -> do
return (toJSON a)
Dhall.Core.ListLit _ a -> do
@ -796,6 +819,55 @@ parseConversion =
<> Options.Applicative.help "Disable conversion of association lists to homogeneous maps"
)
-- | This option specifies how to encode @NaN@\/@Infinity@\/@-Infinity@
data SpecialDoubleMode
= UseYAMLEncoding
-- ^ YAML natively supports @NaN@\/@Infinity@\/@-Infinity@
| ForbidWithinJSON
-- ^ Forbid @NaN@\/@Infinity@\/@-Infinity@ because JSON doesn't support them
| ApproximateWithinJSON
-- ^ Encode @NaN@\/@Infinity@\/@-Infinity@ as
-- @null@\/@1.7976931348623157e308@\/@-1.7976931348623157e308@,
-- respectively
{-| Pre-process an expression containing @NaN@\/@Infinity@\/@-Infinity@,
handling them as specified according to the `SpecialDoubleMode`
-}
handleSpecialDoubles
:: SpecialDoubleMode -> Expr s X -> Either CompileError (Expr s X)
handleSpecialDoubles specialDoubleMode =
Control.Lens.rewriteMOf Dhall.Core.subExpressions rewrite
where
rewrite =
case specialDoubleMode of
UseYAMLEncoding -> useYAMLEncoding
ForbidWithinJSON -> forbidWithinJSON
ApproximateWithinJSON -> approximateWithinJSON
useYAMLEncoding (Dhall.Core.DoubleLit n)
| isInfinite n && 0 < n =
return (Just (Dhall.Core.TextLit (Dhall.Core.Chunks [] "inf")))
| isInfinite n && n < 0 =
return (Just (Dhall.Core.TextLit (Dhall.Core.Chunks [] "-inf")))
| isNaN n =
return (Just (Dhall.Core.TextLit (Dhall.Core.Chunks [] "nan")))
useYAMLEncoding _ =
return Nothing
forbidWithinJSON (Dhall.Core.DoubleLit n)
| isInfinite n || isNaN n =
Left (SpecialDouble n)
forbidWithinJSON _ =
return Nothing
approximateWithinJSON (Dhall.Core.DoubleLit n)
| isInfinite n && n > 0 =
return (Just (Dhall.Core.DoubleLit ( 1.7976931348623157e308 :: Double)))
| isInfinite n && n < 0 =
return (Just (Dhall.Core.DoubleLit (-1.7976931348623157e308 :: Double)))
-- Do nothing for @NaN@, which already encodes to @null@
approximateWithinJSON _ =
return Nothing
{-| Convert a piece of Text carrying a Dhall inscription to an equivalent JSON Value
@ -806,24 +878,23 @@ parseConversion =
-}
codeToValue
:: Conversion
-> SpecialDoubleMode
-> 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) code of
Left err -> Control.Exception.throwIO err
Right parsedExpression -> return parsedExpression
codeToValue conversion specialDoubleMode name code = do
parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText (Data.Text.unpack name) code)
resolvedExpression <- Dhall.Import.load parsedExpression
case Dhall.TypeCheck.typeOf resolvedExpression of
Left err -> Control.Exception.throwIO err
Right _ -> return ()
_ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
let convertedExpression =
convertToHomogeneousMaps conversion resolvedExpression
case dhallToJSON convertedExpression of
specialDoubleExpression <- Dhall.Core.throws (handleSpecialDoubles specialDoubleMode convertedExpression)
case dhallToJSON specialDoubleExpression of
Left err -> Control.Exception.throwIO err
Right json -> return json