diff --git a/dhall-json.cabal b/dhall-json.cabal --- a/dhall-json.cabal +++ b/dhall-json.cabal @@ -1,5 +1,5 @@ Name: dhall-json -Version: 1.0.12 +Version: 1.0.13 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 7.10.2, GHC == 8.0.1 @@ -29,10 +29,13 @@ Library Hs-Source-Dirs: src Build-Depends: - base >= 4.8.0.0 && < 5 , - aeson >= 1.0.0.0 && < 1.4 , - dhall >= 1.11.0 && < 1.12, - text >= 0.11.1.0 && < 1.3 + base >= 4.8.0.0 && < 5 , + bytestring < 0.11, + aeson >= 1.0.0.0 && < 1.4 , + dhall >= 1.11.0 && < 1.13, + text >= 0.11.1.0 && < 1.3 , + trifecta >= 1.6 && < 1.8 , + unordered-containers < 0.3 Exposed-Modules: Dhall.JSON GHC-Options: -Wall @@ -47,7 +50,6 @@ dhall , dhall-json , optparse-generic >= 1.1.1 && < 1.4 , - trifecta >= 1.6 && < 1.8 , text GHC-Options: -Wall @@ -60,7 +62,6 @@ dhall , dhall-json , optparse-generic >= 1.1.1 && < 1.4 , - trifecta >= 1.6 && < 1.8 , yaml >= 0.5.0 && < 0.9 , text GHC-Options: -Wall diff --git a/dhall-to-json/Main.hs b/dhall-to-json/Main.hs --- a/dhall-to-json/Main.hs +++ b/dhall-to-json/Main.hs @@ -9,54 +9,42 @@ import Control.Exception (SomeException) import Options.Generic (Generic, ParseRecord, type ()) -import Text.Trifecta.Delta (Delta(..)) import qualified Control.Exception import qualified Data.Aeson import qualified Data.Aeson.Encode.Pretty -import qualified Data.ByteString.Lazy.Char8 -import qualified Data.Text.Lazy.IO +import qualified Data.ByteString.Char8 +import qualified Data.ByteString.Lazy +import qualified Data.Text.IO import qualified Dhall -import qualified Dhall.Import import qualified Dhall.JSON -import qualified Dhall.Parser -import qualified Dhall.TypeCheck import qualified GHC.IO.Encoding import qualified Options.Generic import qualified System.Exit import qualified System.IO data Options = Options - { explain :: Bool "Explain error messages in detail" - , pretty :: Bool "Pretty print generated JSON" + { explain :: Bool "Explain error messages in detail" + , pretty :: Bool "Pretty print generated JSON" + , omitNull :: Bool "Omit record fields that are null" } deriving (Generic, ParseRecord) main :: IO () -main = handle (do +main = handle $ do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 Options {..} <- Options.Generic.getRecord "Compile Dhall to JSON" - (if Options.Generic.unHelpful explain then Dhall.detailed else id) (do - inText <- Data.Text.Lazy.IO.getContents - - expr <- case Dhall.Parser.exprFromText (Directed "(stdin)" 0 0 0 0) inText of - Left err -> Control.Exception.throwIO err - Right expr -> return expr + let encode = if Options.Generic.unHelpful pretty + then Data.Aeson.Encode.Pretty.encodePretty + else Data.Aeson.encode + explaining = if Options.Generic.unHelpful explain then Dhall.detailed else id + omittingNull = if Options.Generic.unHelpful omitNull then Dhall.JSON.omitNull else id - expr' <- Dhall.Import.load expr - case Dhall.TypeCheck.typeOf expr' of - Left err -> Control.Exception.throwIO err - Right _ -> return () + stdin <- Data.Text.IO.getContents - json <- case Dhall.JSON.dhallToJSON expr' of - Left err -> Control.Exception.throwIO err - Right json -> return json + json <- omittingNull <$> explaining (Dhall.JSON.codeToValue "(stdin)" stdin) - let encode = - if Options.Generic.unHelpful pretty - then Data.Aeson.Encode.Pretty.encodePretty - else Data.Aeson.encode - Data.ByteString.Lazy.Char8.putStrLn (encode json) )) + Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json handle :: IO a -> IO a handle = Control.Exception.handle handler diff --git a/dhall-to-yaml/Main.hs b/dhall-to-yaml/Main.hs --- a/dhall-to-yaml/Main.hs +++ b/dhall-to-yaml/Main.hs @@ -9,47 +9,36 @@ import Control.Exception (SomeException) import Options.Generic (Generic, ParseRecord, type ()) -import Text.Trifecta.Delta (Delta(..)) import qualified Control.Exception import qualified Data.ByteString -import qualified Data.Text.Lazy.IO +import qualified Data.Text.IO import qualified Data.Yaml import qualified Dhall -import qualified Dhall.Import import qualified Dhall.JSON -import qualified Dhall.Parser -import qualified Dhall.TypeCheck import qualified GHC.IO.Encoding import qualified Options.Generic import qualified System.Exit import qualified System.IO -newtype Options = Options - { explain :: Bool "Explain error messages in detail" +data Options = Options + { explain :: Bool "Explain error messages in detail" + , omitNull :: Bool "Omit record fields that are null" } deriving (Generic, ParseRecord) main :: IO () -main = handle (do +main = handle $ do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - Options {..} <- Options.Generic.getRecord "Compile Dhall to JSON" + Options{..} <- Options.Generic.getRecord "Compile Dhall to JSON" - (if Options.Generic.unHelpful explain then Dhall.detailed else id) (do - inText <- Data.Text.Lazy.IO.getContents + let explaining = if Options.Generic.unHelpful explain then Dhall.detailed else id + omittingNull = if Options.Generic.unHelpful omitNull then Dhall.JSON.omitNull else id - expr <- case Dhall.Parser.exprFromText (Directed "(stdin)" 0 0 0 0) inText of - Left err -> Control.Exception.throwIO err - Right expr -> return expr + stdin <- Data.Text.IO.getContents - expr' <- Dhall.Import.load expr - case Dhall.TypeCheck.typeOf expr' of - Left err -> Control.Exception.throwIO err - Right _ -> return () + json <- omittingNull <$> explaining (Dhall.JSON.codeToValue "(stdin)" stdin) - json <- case Dhall.JSON.dhallToJSON expr' of - Left err -> Control.Exception.throwIO err - Right json -> return json - Data.ByteString.putStr (Data.Yaml.encode json) )) + Data.ByteString.putStr $ Data.Yaml.encode json handle :: IO a -> IO a handle = Control.Exception.handle handler diff --git a/src/Dhall/JSON.hs b/src/Dhall/JSON.hs --- a/src/Dhall/JSON.hs +++ b/src/Dhall/JSON.hs @@ -99,23 +99,31 @@ module Dhall.JSON ( -- * Dhall to JSON dhallToJSON + , omitNull + , codeToValue -- * Exceptions , CompileError(..) ) where -import Control.Exception (Exception) -import Data.Aeson (Value) +import Control.Exception (Exception, throwIO) +import Data.Aeson (Value(..)) +import Data.ByteString import Data.Monoid ((<>)) import Data.Typeable (Typeable) import Dhall.Core (Expr) import Dhall.TypeCheck (X) +import Text.Trifecta.Delta (Delta(..)) import qualified Data.Aeson +import qualified Data.HashMap.Strict 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 +import qualified Dhall.TypeCheck {-| This is the exception type for errors that might arise when translating Dhall to JSON @@ -144,7 +152,7 @@ instance Exception CompileError -{-| Convert a Dhall expression to the equivalent Nix expression +{-| Convert a Dhall expression to the equivalent JSON expression >>> :set -XOverloadedStrings >>> :set -XOverloadedLists @@ -175,3 +183,43 @@ return (Data.Aeson.toJSON a') Dhall.Core.UnionLit _ b _ -> loop b _ -> Left (Unsupported e) + +-- | Omit record fields that are @null@ +omitNull :: Value -> Value +omitNull (Object object) = + Object (fmap omitNull (Data.HashMap.Strict.filter (/= Null) object)) +omitNull (Array array) = + Array (fmap omitNull array) +omitNull (String string) = + String string +omitNull (Number number) = + Number number +omitNull (Bool bool) = + Bool bool +omitNull Null = + Null + +{-| Convert a piece of Text carrying a Dhall inscription to an equivalent JSON Value + +>>> :set -XOverloadedStrings +>>> import Dhall.Core +>>> Dhall.JSON.codeToValue "(stdin)" "{ a = 1 }" +>>> Object (fromList [("a",Number 1.0)]) +-} +codeToValue + :: Data.ByteString.ByteString -- ^ Describe the input for the sake of error location. + -> Data.Text.Text -- ^ Input text. + -> IO Value +codeToValue name code = do + expr <- case Dhall.Parser.exprFromText (Directed name 0 0 0 0) $ Data.Text.Lazy.fromStrict code of + Left err -> Control.Exception.throwIO err + Right expr -> return expr + + expr' <- Dhall.Import.load expr + case Dhall.TypeCheck.typeOf expr' of + Left err -> Control.Exception.throwIO err + Right _ -> return () + + case dhallToJSON expr' of + Left err -> Control.Exception.throwIO err + Right json -> return json