dhall 1.9.0 → 1.9.1

raw patch · 13 files changed

+137/−27 lines, 13 filesdep +lens-family-coredep −lensdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: lens-family-core

Dependencies removed: lens

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• dhall.cabal +4/−2
• src/Dhall/Core.hs +43/−2
• src/Dhall/Import.hs +5/−4
• src/Dhall/Tutorial.hs +1/−1
• src/Dhall/TypeCheck.hs +7/−17
• tests/Format.hs +57/−0
• tests/Regression.hs +1/−1
• tests/Tests.hs +2/−0
• tests/format/escapeSingleQuotedOpenInterpolationA.dhall +1/−0
• tests/format/escapeSingleQuotedOpenInterpolationB.dhall +3/−0
• tests/format/multilineA.dhall +1/−0
• tests/format/multilineB.dhall +3/−0

@@ -1,3 +1,12 @@+1.9.1++* `dhall-format` now emits single-quoted strings for multi-line strings+    * See: https://github.com/dhall-lang/dhall-haskell/pull/237+* Improved error messages for list elements with the wrong type+    * See: https://github.com/dhall-lang/dhall-haskell/pull/236+* Change `lens` dependency to `lens-family-core`+    * See: https://github.com/dhall-lang/dhall-haskell/pull/238+ 1.9.0  * Feature: BREAKING CHANGE TO LANGUAGE AND API: Add `constructors` keyword

@@ -1,5 +1,5 @@ Name: dhall-Version: 1.9.0+Version: 1.9.1 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 8.0.1@@ -81,6 +81,7 @@     Prelude/Text/concatMap     Prelude/Text/concatMapSep     Prelude/Text/concatSep+    tests/format/*.dhall     tests/parser/*.dhall     tests/regression/*.dhall     tests/tutorial/*.dhall@@ -104,7 +105,7 @@         exceptions           >= 0.8.3    && < 0.9 ,         http-client          >= 0.4.30   && < 0.6 ,         http-client-tls      >= 0.2.0    && < 0.4 ,-        lens                 >= 2.4      && < 4.16,+        lens-family-core     >= 1.0.0    && < 1.3 ,         parsers              >= 0.12.4   && < 0.13,         prettyprinter        >= 1.1.1    && < 1.2 ,         system-filepath      >= 0.3.1    && < 0.5 ,@@ -173,6 +174,7 @@     GHC-Options: -Wall     Other-Modules:         Examples+        Format         Normalization         Parser         Regression

@@ -611,8 +611,32 @@  prettyChunks :: Pretty a => Chunks s a -> Doc ann prettyChunks (Chunks a b) =-    "\"" <> foldMap prettyChunk a <> prettyText b <> "\""+    if any (\(builder, _) -> hasNewLine builder) a || hasNewLine b+    then+        Pretty.align+        (   "''" <> Pretty.hardline+        <>  Pretty.align+            (foldMap prettyMultilineChunk a <> prettyMultilineBuilder b)+        <>  "''"+        )+    else "\"" <> foldMap prettyChunk a <> prettyText b <> "\""   where+    hasNewLine builder = Text.any (== '\n') lazyText+      where+        lazyText = Builder.toLazyText builder++    prettyMultilineChunk (c, d) =+      prettyMultilineBuilder c <> "${" <> prettyExprA d <> "}"++    prettyMultilineBuilder builder = mconcat docs+      where+        lazyText = Builder.toLazyText (escapeSingleQuotedText builder)++        lazyLines = Text.splitOn "\n" lazyText++        docs =+            Data.List.intersperse Pretty.hardline (fmap Pretty.pretty lazyLines)+     prettyChunk (c, d) = prettyText c <> "${" <> prettyExprA d <> "}"      prettyText t = Pretty.pretty (Builder.toLazyText (escapeText t))@@ -1114,6 +1138,19 @@   where     buildChunk (c, d) = escapeText c <> "${" <> buildExprA d <> "}" +-- | Escape a `Builder` literal using Dhall's escaping rules for single-quoted+--   @Text@+escapeSingleQuotedText :: Builder -> Builder+escapeSingleQuotedText inputBuilder = outputBuilder+  where+    inputText = Builder.toLazyText inputBuilder++    outputText = substitute "${" "''${" (substitute "''" "'''" inputText)++    outputBuilder = Builder.fromLazyText outputText++    substitute before after = Text.intercalate after . Text.splitOn before+ -- | Escape a `Builder` literal using Dhall's escaping rules -- -- Note that the result does not include surrounding quotes@@ -1122,7 +1159,11 @@   where     adapt c         | '\x20' <= c && c <= '\x21' = Text.singleton c-        | '\x23' <= c && c <= '\x5B' = Text.singleton c+        -- '\x22' == '"'+        | '\x23' == c                = Text.singleton c+        -- '\x24' == '$'+        | '\x25' <= c && c <= '\x5B' = Text.singleton c+        -- '\x5C' == '\\'         | '\x5D' <= c && c <= '\x7F' = Text.singleton c         | c == '"'                   = "\\\""         | c == '$'                   = "\\$"

@@ -118,7 +118,6 @@ import Control.Applicative (empty) import Control.Exception     (Exception, IOException, SomeException, onException, throwIO)-import Control.Lens (Lens', zoom) import Control.Monad (join) import Control.Monad.Catch (throwM, MonadCatch(catch)) import Control.Monad.IO.Class (MonadIO(..))@@ -147,6 +146,8 @@     ) import Dhall.Parser (Parser(..), ParseError(..), Src(..)) import Dhall.TypeCheck (X(..))+import Lens.Family (LensLike')+import Lens.Family.State.Strict (zoom) #if MIN_VERSION_http_client(0,5,0) import Network.HTTP.Client     (HttpException(..), HttpExceptionContent(..), Manager)@@ -346,13 +347,13 @@ canonicalizeAll :: [Path] -> [Path] canonicalizeAll = map canonicalizePath . List.tails -stack :: Lens' Status [Path]+stack :: Functor f => LensLike' f Status [Path] stack k s = fmap (\x -> s { _stack = x }) (k (_stack s)) -cache :: Lens' Status (Map Path (Expr Src X))+cache :: Functor f => LensLike' f Status (Map Path (Expr Src X)) cache k s = fmap (\x -> s { _cache = x }) (k (_cache s)) -manager :: Lens' Status (Maybe Manager)+manager :: Functor f => LensLike' f Status (Maybe Manager) manager k s = fmap (\x -> s { _manager = x }) (k (_manager s))  needManager :: StateT Status IO Manager

@@ -660,7 +660,7 @@ -- >>> dhallAnd True False -- False ----- However, you can't convert anything more complex than that like a polymorphic+-- However, you can't convert anything more complex than that (like a polymorphic -- or higher-order function).  You will need to apply those functions to their -- arguments within Dhall before converting their result to a Haskell value. --

@@ -380,7 +380,7 @@                             let nf_t  = Dhall.Core.normalize t                             let nf_t' = Dhall.Core.normalize t'                             let err   = MismatchedListElements i nf_t x nf_t'-                            Left (TypeError ctx e err) )+                            Left (TypeError ctx x err) )                 return (App List t)     loop ctx e@(ListLit (Just t ) xs) = do         s <- fmap Dhall.Core.normalize (loop ctx t)@@ -394,7 +394,7 @@                 else do                     let nf_t  = Dhall.Core.normalize t                     let nf_t' = Dhall.Core.normalize t'-                    Left (TypeError ctx e (InvalidListElement i nf_t x nf_t')) )+                    Left (TypeError ctx x (InvalidListElement i nf_t x nf_t')) )         return (App List t)     loop ctx e@(ListAppend l r  ) = do         tl <- fmap Dhall.Core.normalize (loop ctx l)@@ -1702,10 +1702,10 @@         \                                                                                \n\         \You cannot supply an empty list without a type annotation                       \n" -prettyTypeMessage (MismatchedListElements i expr0 expr1 expr2) =+prettyTypeMessage (MismatchedListElements i expr0 _expr1 expr2) =     ErrorMessages {..}   where-    short = "List elements should have the same type"+    short = "List elements should all have the same type"      long =         "Explanation: Every element in a list must have the same type                    \n\@@ -1730,20 +1730,15 @@         \                                                                                \n\         \↳ " <> txt0 <> "                                                                \n\         \                                                                                \n\-        \... but the following element at index " <> txt1 <> ":                          \n\-        \                                                                                \n\-        \↳ " <> txt2 <> "                                                                \n\-        \                                                                                \n\-        \... has this type instead:                                                      \n\+        \... but the element at index #" <> txt1 <> " has this type instead:             \n\         \                                                                                \n\         \↳ " <> txt3 <> "                                                                \n"       where         txt0 = build expr0         txt1 = build i-        txt2 = build expr1         txt3 = build expr2 -prettyTypeMessage (InvalidListElement i expr0 expr1 expr2) =+prettyTypeMessage (InvalidListElement i expr0 _expr1 expr2) =     ErrorMessages {..}   where     short = "List element has the wrong type"@@ -1772,17 +1767,12 @@         \                                                                                \n\         \↳ " <> txt0 <> "                                                                \n\         \                                                                                \n\-        \... but the following element at index " <> txt1 <> ":                          \n\-        \                                                                                \n\-        \↳ " <> txt2 <> "                                                                \n\-        \                                                                                \n\-        \... has this type instead:                                                      \n\+        \... but the element at index #" <> txt1 <> " has this type instead:             \n\         \                                                                                \n\         \↳ " <> txt3 <> "                                                                \n"       where         txt0 = build expr0         txt1 = build i-        txt2 = build expr1         txt3 = build expr2  prettyTypeMessage (InvalidOptionalType expr0) = ErrorMessages {..}

@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++module Format where++import Data.Monoid (mempty, (<>))+import Data.Text (Text)+import Test.Tasty (TestTree)++import qualified Control.Exception+import qualified Data.Text+import qualified Data.Text.Lazy.IO+import qualified Data.Text.Prettyprint.Doc+import qualified Data.Text.Prettyprint.Doc.Render.Text+import qualified Dhall.Parser+import qualified Test.Tasty+import qualified Test.Tasty.HUnit++formatTests :: TestTree+formatTests =+    Test.Tasty.testGroup "format tests"+        [ should+            "prefer multi-line strings when newlines present"+            "multiline"+        , should+            "escape ${ for single-quoted strings"+            "escapeSingleQuotedOpenInterpolation"+        ]++opts :: Data.Text.Prettyprint.Doc.LayoutOptions+opts =+    Data.Text.Prettyprint.Doc.defaultLayoutOptions+        { Data.Text.Prettyprint.Doc.layoutPageWidth =+            Data.Text.Prettyprint.Doc.AvailablePerLine 80 1.0+        }++should :: Text -> Text -> TestTree+should name basename =+    Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do+        let inputFile =+                Data.Text.unpack ("./tests/format/" <> basename <> "A.dhall")+        let outputFile =+                Data.Text.unpack ("./tests/format/" <> basename <> "B.dhall")+        inputText <- Data.Text.Lazy.IO.readFile inputFile++        expr <- case Dhall.Parser.exprFromText mempty inputText of+            Left  err  -> Control.Exception.throwIO err+            Right expr -> return expr++        let doc        = Data.Text.Prettyprint.Doc.pretty expr+        let docStream  = Data.Text.Prettyprint.Doc.layoutSmart opts doc+        let actualText = Data.Text.Prettyprint.Doc.Render.Text.renderLazy docStream++        expectedText <- Data.Text.Lazy.IO.readFile outputFile++        let message =+                "The formatted expression did not match the expected output"+        Test.Tasty.HUnit.assertEqual message expectedText actualText

@@ -83,7 +83,7 @@         \  foo\n\         \  bar\n\         \''"-    Util.normalize' e @?= "\"foo\\nbar\\n\"" )+    Util.normalize' e @?= "''\nfoo\nbar\n''" )  issue151 :: TestTree issue151 = Test.Tasty.HUnit.testCase "Issue #151" (do

@@ -5,6 +5,7 @@ import Parser (parserTests) import Regression (regressionTests) import Tutorial (tutorialTests)+import Format (formatTests) import Test.Tasty  allTests :: TestTree@@ -15,6 +16,7 @@         , parserTests         , regressionTests         , tutorialTests+        , formatTests         ]  main :: IO ()

@@ -0,0 +1,1 @@+"\${\n"

@@ -0,0 +1,3 @@+''+''${+''

@@ -0,0 +1,1 @@+"ABC\nDEF"

@@ -0,0 +1,3 @@+''+ABC+DEF''