dhall-json 1.1.0 → 1.2.0

raw patch · 4 files changed

+510/−59 lines, 4 filesdep +insert-ordered-containersdep +optparse-applicativedep −optparse-genericdep ~dhallPVP ok

version bump matches the API change (PVP)

Dependencies added: insert-ordered-containers, optparse-applicative

Dependencies removed: optparse-generic

Dependency ranges changed: dhall

API changes (from Hackage documentation)

Files

• dhall-json.cabal +16/−14
• dhall-to-json/Main.hs +60/−21
• dhall-to-yaml/Main.hs +46/−16
• src/Dhall/JSON.hs +388/−8

@@ -1,5 +1,5 @@ Name: dhall-json-Version: 1.1.0+Version: 1.2.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 7.10.2, GHC == 8.0.1@@ -29,11 +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.14,-        text                 >= 0.11.1.0 && < 1.3 ,-        unordered-containers                < 0.3+        base                      >= 4.8.0.0  && < 5   ,+        aeson                     >= 1.0.0.0  && < 1.4 ,+        dhall                     >= 1.14.0   && < 1.15,+        insert-ordered-containers                < 1.14,+        optparse-applicative      >= 0.14.0.0 && < 0.15,+        text                      >= 0.11.1.0 && < 1.3 ,+        unordered-containers                     < 0.3     Exposed-Modules: Dhall.JSON     GHC-Options: -Wall @@ -41,13 +43,13 @@     Hs-Source-Dirs: dhall-to-json     Main-Is: Main.hs     Build-Depends:-        base                                  ,-        aeson                                 ,-        aeson-pretty                    < 0.9 ,-        bytestring                      < 0.11,-        dhall                                 ,-        dhall-json                            ,-        optparse-generic >= 1.1.1    && < 1.4 ,+        base                       ,+        aeson                      ,+        aeson-pretty         < 0.9 ,+        bytestring           < 0.11,+        dhall                      ,+        dhall-json                 ,+        optparse-applicative       ,         text     GHC-Options: -Wall @@ -59,7 +61,7 @@         bytestring                      < 0.11,         dhall                                 ,         dhall-json                            ,-        optparse-generic >= 1.1.1    && < 1.4 ,+        optparse-applicative                  ,         yaml             >= 0.5.0    && < 0.9 ,         text     GHC-Options: -Wall

@@ -1,14 +1,13 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ApplicativeDo     #-} {-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TypeOperators     #-}+{-# LANGUAGE OverloadedStrings #-}  module Main where  import Control.Exception (SomeException)-import Options.Generic (Generic, ParseRecord, type (<?>))+import Data.Monoid ((<>))+import Dhall.JSON (Conversion)+import Options.Applicative (Parser, ParserInfo)  import qualified Control.Exception import qualified Data.Aeson@@ -19,32 +18,72 @@ import qualified Dhall import qualified Dhall.JSON import qualified GHC.IO.Encoding-import qualified Options.Generic+import qualified Options.Applicative import qualified System.Exit import qualified System.IO  data Options = Options-    { explain  :: Bool <?> "Explain error messages in detail"-    , pretty   :: Bool <?> "Pretty print generated JSON"-    , omitNull :: Bool <?> "Omit record fields that are null"-    } deriving (Generic, ParseRecord)+    { explain    :: Bool+    , pretty     :: Bool+    , omitNull   :: Bool+    , conversion :: Conversion+    } +parseOptions :: Parser Options+parseOptions = Options.Applicative.helper <*> do+    explain    <- parseExplain+    pretty     <- parsePretty+    omitNull   <- parseOmitNull+    conversion <- Dhall.JSON.parseConversion+    return (Options {..})+  where+    parseExplain =+        Options.Applicative.switch+            (   Options.Applicative.long "explain"+            <>  Options.Applicative.help "Explain error messages in detail"+            )++    parsePretty =+        Options.Applicative.switch+            (   Options.Applicative.long "pretty"+            <>  Options.Applicative.help "Pretty print generated JSON"+            )++    parseOmitNull =+        Options.Applicative.switch+            (   Options.Applicative.long "omitNull"+            <>  Options.Applicative.help "Omit record fields that are null"+            )++parserInfo :: ParserInfo Options+parserInfo =+    Options.Applicative.info+        parseOptions+        (   Options.Applicative.fullDesc+        <>  Options.Applicative.progDesc "Compile Dhall to JSON"+        )+ main :: IO ()-main = handle $ do+main = do     GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8-    Options {..} <- Options.Generic.getRecord "Compile Dhall to JSON" -    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+    Options {..} <- Options.Applicative.execParser parserInfo -    stdin <- Data.Text.IO.getContents+    handle $ do+        let encode =+                if pretty+                then Data.Aeson.Encode.Pretty.encodePretty+                else Data.Aeson.encode -    json  <- omittingNull <$> explaining (Dhall.JSON.codeToValue "(stdin)" stdin)+        let explaining = if explain then Dhall.detailed else id -    Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json +        let omittingNull = if omitNull then Dhall.JSON.omitNull else id++        stdin <- Data.Text.IO.getContents++        json <- omittingNull <$> explaining (Dhall.JSON.codeToValue conversion "(stdin)" stdin)++        Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json  handle :: IO a -> IO a handle = Control.Exception.handle handler

@@ -1,14 +1,13 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE ApplicativeDo     #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TypeOperators     #-}  module Main where  import Control.Exception (SomeException)-import Options.Generic (Generic, ParseRecord, type (<?>))+import Data.Monoid ((<>))+import Dhall.JSON (Conversion)+import Options.Applicative (Parser, ParserInfo)  import qualified Control.Exception import qualified Data.ByteString@@ -17,28 +16,59 @@ import qualified Dhall import qualified Dhall.JSON import qualified GHC.IO.Encoding-import qualified Options.Generic+import qualified Options.Applicative import qualified System.Exit import qualified System.IO  data Options = Options-    { explain  :: Bool <?> "Explain error messages in detail"-    , omitNull :: Bool <?> "Omit record fields that are null"-    } deriving (Generic, ParseRecord)+    { explain    :: Bool+    , omitNull   :: Bool+    , conversion :: Conversion+    } +parseOptions :: Parser Options+parseOptions = Options.Applicative.helper <*> do+    explain    <- parseExplain+    omitNull   <- parseOmitNull+    conversion <- Dhall.JSON.parseConversion+    return (Options {..})+  where+    parseExplain =+        Options.Applicative.switch+            (   Options.Applicative.long "explain"+            <>  Options.Applicative.help "Explain error messages in detail"+            )++    parseOmitNull =+        Options.Applicative.switch+            (   Options.Applicative.long "omitNull"+            <>  Options.Applicative.help "Omit record fields that are null"+            )++parserInfo :: ParserInfo Options+parserInfo =+    Options.Applicative.info+        parseOptions+        (   Options.Applicative.fullDesc+        <>  Options.Applicative.progDesc "Compile Dhall to YAML"+        )+ main :: IO ()-main = handle $ do+main = do     GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8-    Options{..} <- Options.Generic.getRecord "Compile Dhall to JSON" -    let explaining   = if Options.Generic.unHelpful explain  then Dhall.detailed      else id-        omittingNull = if Options.Generic.unHelpful omitNull then Dhall.JSON.omitNull else id+    Options {..} <- Options.Applicative.execParser parserInfo -    stdin <- Data.Text.IO.getContents+    handle $ do+        let explaining = if explain then Dhall.detailed else id -    json  <- omittingNull <$> explaining (Dhall.JSON.codeToValue "(stdin)" stdin)+        let omittingNull = if omitNull then Dhall.JSON.omitNull else id -    Data.ByteString.putStr $ Data.Yaml.encode json +        stdin <- Data.Text.IO.getContents++        json <- omittingNull <$> explaining (Dhall.JSON.codeToValue conversion "(stdin)" stdin)++        Data.ByteString.putStr $ Data.Yaml.encode json   handle :: IO a -> IO a handle = Control.Exception.handle handler

@@ -1,5 +1,7 @@+{-# LANGUAGE ApplicativeDo      #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RecordWildCards    #-}  {-| This library only exports a single `dhallToJSON` function for translating a     Dhall syntax tree to a JSON syntax tree (i.e. a `Value`) for the @aeson@@@ -100,21 +102,30 @@     -- * Dhall to JSON       dhallToJSON     , omitNull+    , Conversion(..)+    , convertToHomogeneousMaps+    , parseConversion     , codeToValue      -- * Exceptions     , CompileError(..)     ) where +import Control.Applicative (empty, (<|>))+import Control.Monad (guard) import Control.Exception (Exception, throwIO) import Data.Aeson (Value(..)) import Data.Monoid ((<>))+import Data.Text.Lazy (Text) import Data.Typeable (Typeable) import Dhall.Core (Expr) import Dhall.TypeCheck (X)+import Options.Applicative (Parser)  import qualified Data.Aeson+import qualified Data.Foldable import qualified Data.HashMap.Strict+import qualified Data.HashMap.Strict.InsOrd import qualified Data.Text import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder@@ -122,6 +133,7 @@ import qualified Dhall.Import import qualified Dhall.Parser import qualified Dhall.TypeCheck+import qualified Options.Applicative  {-| This is the exception type for errors that might arise when translating     Dhall to JSON@@ -197,6 +209,369 @@ omitNull Null =     Null +{-| Specify whether or not to convert association lists of type+    @List { mapKey: Text, mapValue : v }@ to records+-}+data Conversion+    = NoConversion+    | Conversion { mapKey :: Text, mapValue :: Text }++{-| Convert association lists to homogeneous maps++    This converts an association list of the form:++    > [ { mapKey = k0, mapValue = v0 }, { mapKey = k1, mapValue = v1 } ]++    ... to a record of the form:++    > { k0 = v0, k1 = v1 }+-}+convertToHomogeneousMaps :: Conversion -> Expr s X -> Expr s X+convertToHomogeneousMaps NoConversion e0 = e0+convertToHomogeneousMaps (Conversion {..}) e0 = loop (Dhall.Core.normalize e0)+  where+    loop e = case e of+        Dhall.Core.Const a ->+            Dhall.Core.Const a++        Dhall.Core.Var v ->+            Dhall.Core.Var v++        Dhall.Core.Lam a b c ->+            Dhall.Core.Lam a b' c'+          where+            b' = loop b+            c' = loop c++        Dhall.Core.Pi a b c ->+            Dhall.Core.Pi a b' c'+          where+            b' = loop b+            c' = loop c++        Dhall.Core.App a b ->+            Dhall.Core.App a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.Let a b c d ->+            Dhall.Core.Let a b' c' d'+          where+            b' = fmap loop b+            c' =      loop c+            d' =      loop d++        Dhall.Core.Annot a b ->+            Dhall.Core.Annot a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.Bool ->+            Dhall.Core.Bool++        Dhall.Core.BoolLit a ->+            Dhall.Core.BoolLit a++        Dhall.Core.BoolAnd a b ->+            Dhall.Core.BoolAnd a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.BoolOr a b ->+            Dhall.Core.BoolOr a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.BoolEQ a b ->+            Dhall.Core.BoolEQ a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.BoolNE a b ->+            Dhall.Core.BoolNE a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.BoolIf a b c ->+            Dhall.Core.BoolIf a' b' c'+          where+            a' = loop a+            b' = loop b+            c' = loop c++        Dhall.Core.Natural ->+            Dhall.Core.Natural++        Dhall.Core.NaturalLit a ->+            Dhall.Core.NaturalLit a++        Dhall.Core.NaturalFold ->+            Dhall.Core.NaturalFold++        Dhall.Core.NaturalBuild ->+            Dhall.Core.NaturalBuild++        Dhall.Core.NaturalIsZero ->+            Dhall.Core.NaturalIsZero++        Dhall.Core.NaturalEven ->+            Dhall.Core.NaturalEven++        Dhall.Core.NaturalOdd ->+            Dhall.Core.NaturalOdd++        Dhall.Core.NaturalToInteger ->+            Dhall.Core.NaturalToInteger++        Dhall.Core.NaturalShow ->+            Dhall.Core.NaturalShow++        Dhall.Core.NaturalPlus a b ->+            Dhall.Core.NaturalPlus a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.NaturalTimes a b ->+            Dhall.Core.NaturalTimes a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.Integer ->+            Dhall.Core.Integer++        Dhall.Core.IntegerLit a ->+            Dhall.Core.IntegerLit a++        Dhall.Core.IntegerShow ->+            Dhall.Core.IntegerShow++        Dhall.Core.Double ->+            Dhall.Core.Double++        Dhall.Core.DoubleLit a ->+            Dhall.Core.DoubleLit a++        Dhall.Core.DoubleShow ->+            Dhall.Core.DoubleShow++        Dhall.Core.Text ->+            Dhall.Core.Text++        Dhall.Core.TextLit (Dhall.Core.Chunks a b) ->+            Dhall.Core.TextLit (Dhall.Core.Chunks a' b)+          where+            a' = fmap (fmap loop) a++        Dhall.Core.TextAppend a b ->+            Dhall.Core.TextAppend a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.List ->+            Dhall.Core.List++        Dhall.Core.ListLit a b ->+            case transform of+                Just c  -> c+                Nothing -> Dhall.Core.ListLit a' b'+          where+            elements = Data.Foldable.toList b++            toKeyValue :: Expr s X -> Maybe (Text, Expr s X)+            toKeyValue (Dhall.Core.RecordLit m) = do+                guard (Data.HashMap.Strict.InsOrd.size m == 2)++                key   <- Data.HashMap.Strict.InsOrd.lookup mapKey   m+                value <- Data.HashMap.Strict.InsOrd.lookup mapValue m++                keyText <- case key of+                    Dhall.Core.TextLit (Dhall.Core.Chunks [] keyText) ->+                        return keyText++                    _ ->+                        empty++                return (Data.Text.Lazy.Builder.toLazyText keyText, value)+            toKeyValue _ = do+                empty++            transform =+                case elements of+                    [] ->+                        case a of+                            Just (Dhall.Core.Record m) -> do+                                guard (Data.HashMap.Strict.InsOrd.size m == 2)+                                guard (Data.HashMap.Strict.InsOrd.member mapKey   m)+                                guard (Data.HashMap.Strict.InsOrd.member mapValue m)+                                return (Dhall.Core.RecordLit Data.HashMap.Strict.InsOrd.empty)+                            _ -> do+                                empty++                    _  -> do+                        keyValues <- traverse toKeyValue elements++                        let recordLiteral =+                                Data.HashMap.Strict.InsOrd.fromList keyValues++                        return (Dhall.Core.RecordLit recordLiteral)++            a' = fmap loop a+            b' = fmap loop b++        Dhall.Core.ListAppend a b ->+            Dhall.Core.ListAppend a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.ListBuild ->+            Dhall.Core.ListBuild++        Dhall.Core.ListFold ->+            Dhall.Core.ListFold++        Dhall.Core.ListLength ->+            Dhall.Core.ListLength++        Dhall.Core.ListHead ->+            Dhall.Core.ListHead++        Dhall.Core.ListLast ->+            Dhall.Core.ListLast++        Dhall.Core.ListIndexed ->+            Dhall.Core.ListIndexed++        Dhall.Core.ListReverse ->+            Dhall.Core.ListReverse++        Dhall.Core.Optional ->+            Dhall.Core.Optional++        Dhall.Core.OptionalLit a b ->+            Dhall.Core.OptionalLit a' b'+          where+            a' =      loop a+            b' = fmap loop b++        Dhall.Core.OptionalFold ->+            Dhall.Core.OptionalFold++        Dhall.Core.OptionalBuild ->+            Dhall.Core.OptionalBuild++        Dhall.Core.Record a ->+            Dhall.Core.Record a'+          where+            a' = fmap loop a++        Dhall.Core.RecordLit a ->+            Dhall.Core.RecordLit a'+          where+            a' = fmap loop a++        Dhall.Core.Union a ->+            Dhall.Core.Union a'+          where+            a' = fmap loop a++        Dhall.Core.UnionLit a b c ->+            Dhall.Core.UnionLit a b' c'+          where+            b' =      loop b+            c' = fmap loop c++        Dhall.Core.Combine a b ->+            Dhall.Core.Combine a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.CombineTypes a b ->+            Dhall.Core.CombineTypes a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.Prefer a b ->+            Dhall.Core.Prefer a' b'+          where+            a' = loop a+            b' = loop b++        Dhall.Core.Merge a b c ->+            Dhall.Core.Merge a' b' c'+          where+            a' =      loop a+            b' =      loop b+            c' = fmap loop c++        Dhall.Core.Constructors a ->+            Dhall.Core.Constructors a'+          where+            a' = loop a++        Dhall.Core.Field a b ->+            Dhall.Core.Field a' b+          where+            a' = loop a++        Dhall.Core.Project a b ->+            Dhall.Core.Project a' b+          where+            a' = loop a++        Dhall.Core.Note a b ->+            Dhall.Core.Note a b'+          where+            b' = loop b++        Dhall.Core.Embed a ->+            Dhall.Core.Embed a++parseConversion :: Parser Conversion+parseConversion =+        conversion+    <|> noConversion+  where+    conversion = do+        mapKey   <- parseKeyField+        mapValue <- parseValueField+        return (Conversion {..})+      where+        parseKeyField =+            Options.Applicative.strOption+                (   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+                )++        parseValueField =+            Options.Applicative.strOption+                (   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+                )++    noConversion =+        Options.Applicative.flag'+            NoConversion+            (   Options.Applicative.long "noMaps"+            <>  Options.Applicative.help "Disable conversion of association lists to homogeneous maps"+            )++ {-| Convert a piece of Text carrying a Dhall inscription to an equivalent JSON Value  >>> :set -XOverloadedStrings@@ -205,19 +580,24 @@ >>> Object (fromList [("a",Number 1.0)]) -} codeToValue-  :: Data.Text.Text  -- ^ Describe the input for the sake of error location.+  :: Conversion+  -> Data.Text.Text  -- ^ 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 (Data.Text.unpack name) (Data.Text.Lazy.fromStrict code) of-      Left  err  -> Control.Exception.throwIO err-      Right expr -> return expr+codeToValue conversion name code = do+    parsedExpression <- case Dhall.Parser.exprFromText (Data.Text.unpack name) (Data.Text.Lazy.fromStrict code) of+      Left  err              -> Control.Exception.throwIO err+      Right parsedExpression -> return parsedExpression -    expr' <- Dhall.Import.load expr-    case Dhall.TypeCheck.typeOf expr' of+    resolvedExpression <- Dhall.Import.load parsedExpression++    case Dhall.TypeCheck.typeOf resolvedExpression  of       Left  err -> Control.Exception.throwIO err       Right _   -> return () -    case dhallToJSON expr' of+    let convertedExpression =+            convertToHomogeneousMaps conversion resolvedExpression++    case dhallToJSON convertedExpression of       Left  err  -> Control.Exception.throwIO err       Right json -> return json