dhall 1.33.0 → 1.33.1

raw patch · 23 files changed

+181/−151 lines, 23 filesdep ~data-fixdep ~replinedep ~tasty-expected-failurePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: data-fix, repline, tasty-expected-failure

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• dhall-lang/Prelude/JSON/package.dhall +2/−2
• dhall-lang/Prelude/JSON/render +1/−1
• dhall-lang/Prelude/JSON/renderAs +73/−82
• dhall-lang/Prelude/JSON/renderYAML +1/−1
• dhall-lang/Prelude/package.dhall +1/−1
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword00.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword01.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword02.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword03.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword04.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword05.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword06.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword07.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword08.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword09.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword10.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword11.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword12.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword13.dhall +1/−0
• dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword14.dhall +1/−0
• dhall.cabal +2/−2
• src/Dhall/Repl.hs +80/−62

@@ -1,3 +1,9 @@+1.33.1++* [Multi-line REPL / support `repline-0.4.0.0`](https://github.com/dhall-lang/dhall-haskell/pull/1867)+    * `dhall repl` supports a new `:paste` command that lets you input a command+       by pasting one or more lines+ 1.33.0  * [Supports version 17.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v17.0.0)

@@ -1,8 +1,8 @@   { render =-        ./render sha256:eb26e0a4eee530dcda9d73974e9e9256fbad264916101866406a1647e28e280d+        ./render sha256:b5e5aee66b8fc018b50e1019a76340deafe5f8176854ea3611476d79990785da       ? ./render   , renderYAML =-        ./renderYAML sha256:d406a8744b81ced6a485da3cdb40a357fdd37338f4f134b00e7da3684054ebd3+        ./renderYAML sha256:dad92a120956ae852be7496d1e1955bbf3f60834ab2ad32641269098f2846477       ? ./renderYAML   , omitNullFields =         ./omitNullFields sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0

@@ -9,7 +9,7 @@       ? ./core.dhall  let renderAs =-        ./renderAs sha256:f16238edec4c6dd846f19677c6675b27c579999dcff91db6193c10ade1d83174+        ./renderAs sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043       ? ./renderAs  let Format =

@@ -12,18 +12,6 @@         ../Text/concatMap sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f       ? ../Text/concatMap -let List/take =-        ../List/take sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa-      ? ../List/take--let List/drop =-        ../List/drop sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf-      ? ../List/drop--let List/null =-        ../List/null sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80-      ? ../List/null- let List/map =         ../List/map sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680       ? ../List/map@@ -32,27 +20,39 @@         ../List/concatMap sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64       ? ../List/concatMap -let Optional/map =-        ../Optional/map sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa-      ? ../Optional/map- let NonEmpty     : Type → Type     = λ(a : Type) → { head : a, tail : List a } +let NonEmpty/singleton+    : ∀(a : Type) → a → NonEmpty a+    = λ(a : Type) → λ(x : a) → { head = x, tail = [] : List a }+ let List/uncons     : ∀(a : Type) → List a → Optional (NonEmpty a)-    = λ(a : Type) →+    = {- This version uses the `ls` argument only once to prevent cache blowups at the price+         of performing two passes over the list:+         A first one to reverse it, a second one with `List/fold` to determine+         the head element.+         See https://github.com/dhall-lang/dhall-lang/pull/1015#issuecomment-633381024+         for some context regarding the caching issue.+      -}+      λ(a : Type) →       λ(ls : List a) →-        Optional/map+        List/fold           a-          (NonEmpty a)-          (λ(head : a) → { head, tail = List/drop 1 a ls })-          (List/head a ls)--let NonEmpty/singleton-    : ∀(a : Type) → a → NonEmpty a-    = λ(a : Type) → λ(x : a) → { head = x, tail = [] : List a }+          (List/reverse a ls)+          (Optional (NonEmpty a))+          ( λ(x : a) →+            λ(acc : Optional (NonEmpty a)) →+              merge+                { None = Some (NonEmpty/singleton a x)+                , Some =+                    λ(ne : NonEmpty a) → Some (ne ⫽ { tail = ne.tail # [ x ] })+                }+                acc+          )+          (None (NonEmpty a))  let NonEmpty/toList     : ∀(a : Type) → NonEmpty a → List a@@ -90,37 +90,6 @@       λ(ls : NonEmpty a) →         ls ⫽ { tail = List/map a a fn ls.tail } -let List/splitAt-    : Natural → ∀(a : Type) → List a → { head : List a, tail : List a }-    = λ(index : Natural) →-      λ(a : Type) →-      λ(ls : List a) →-        { head = List/take index a ls, tail = List/drop index a ls }--let _testSplitAt0 =-        assert-      :   List/splitAt 0 Natural [ 1, 2, 3 ]-        ≡ { head = [] : List Natural, tail = [ 1, 2, 3 ] }--let _testSplitAt1 =-        assert-      : List/splitAt 1 Natural [ 1, 2, 3 ] ≡ { head = [ 1 ], tail = [ 2, 3 ] }--let _testSplitAt3 =-        assert-      :   List/splitAt 3 Natural [ 1, 2, 3 ]-        ≡ { head = [ 1, 2, 3 ], tail = [] : List Natural }--let _testSplitAt =-        assert-      :   List/splitAt 1 Natural ([] : List Natural)-        ≡ { head = [] : List Natural, tail = [] : List Natural }--let List/splitLast =-      λ(a : Type) →-      λ(ls : List a) →-        List/splitAt (Natural/subtract 1 (List/length a ls)) a ls- let NonEmpty/prepend     : ∀(a : Type) → a → NonEmpty a → NonEmpty a     = λ(a : Type) →@@ -128,38 +97,54 @@       λ(ls : NonEmpty a) →         { head = prefix, tail = NonEmpty/toList a ls } -let NonEmpty/append-    : ∀(a : Type) → a → NonEmpty a → NonEmpty a+let NonYtpme+    : Type → Type+    = λ(a : Type) → { init : List a, last : a }++let List/unsnoc+    : ∀(a : Type) → List a → Optional (NonYtpme a)     = λ(a : Type) →-      λ(suffix : a) →-      λ(ls : NonEmpty a) →-        { head = ls.head, tail = ls.tail # [ suffix ] }+      λ(ls : List a) →+        List/fold+          a+          ls+          (Optional (NonYtpme a))+          ( λ(x : a) →+            λ(acc : Optional (NonYtpme a)) →+              merge+                { None = Some { init = [] : List a, last = x }+                , Some =+                    λ(ny : NonYtpme a) → Some (ny ⫽ { init = [ x ] # ny.init })+                }+                acc+          )+          (None (NonYtpme a))  let NonEmpty/mapLast     : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a     = λ(a : Type) →       λ(fn : a → a) →       λ(ls : NonEmpty a) →-        if    List/null a ls.tail-        then  { head = fn ls.head, tail = [] : List a }-        else  let split = List/splitLast a ls.tail--              in  { head = ls.head-                  , tail = split.head # List/map a a fn split.tail-                  }+        merge+          { Some = λ(x : NonYtpme a) → ls ⫽ { tail = x.init # [ fn x.last ] }+          , None = NonEmpty/singleton a (fn ls.head)+          }+          (List/unsnoc a ls.tail)  let NonEmpty/mapLeading     : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a     = λ(a : Type) →       λ(fn : a → a) →       λ(ls : NonEmpty a) →-        if    List/null a ls.tail-        then  ls-        else  let split = List/splitLast a ls.tail--              in  { head = fn ls.head-                  , tail = List/map a a fn split.head # split.tail-                  }+        merge+          { Some =+              λ(x : NonYtpme a) →+                { head = fn ls.head+                , tail = List/map a a fn x.init # [ x.last ]+                }+          , None = ls+          }+          (List/unsnoc a ls.tail)  let Lines     : Type@@ -214,7 +199,7 @@       λ(prefix : Text) →       λ(suffix : Text) →       λ(blocks : NonEmpty Lines) →-        let indent = NonEmpty/map Text Text addIndent+        let indent = List/map Text Text addIndent          let appendComma             : Lines → Lines@@ -224,12 +209,18 @@          let block = NonEmpty/concat Text blocks -        in  if    List/null Text block.tail-            then  NonEmpty/singleton Text "${prefix} ${block.head} ${suffix}"-            else  NonEmpty/prepend-                    Text-                    prefix-                    (NonEmpty/append Text suffix (indent block))+        in  merge+              { None =+                  NonEmpty/singleton Text "${prefix} ${block.head} ${suffix}"+              , Some =+                  λ(ny : NonYtpme Text) →+                    { head = prefix+                    , tail =+                          indent ([ block.head ] # ny.init # [ ny.last ])+                        # [ suffix ]+                    }+              }+              (List/unsnoc Text block.tail)  let renderObject =       λ(format : Format) →

@@ -14,7 +14,7 @@       ? ./core.dhall  let renderAs =-        ./renderAs sha256:f16238edec4c6dd846f19677c6675b27c579999dcff91db6193c10ade1d83174+        ./renderAs sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043       ? ./renderAs  let Format =

@@ -29,7 +29,7 @@       ./Optional/package.dhall sha256:4324b2bf84ded40f67485f14355e4cb7b237a8f173e713c791ec44cebebc552c     ? ./Optional/package.dhall , JSON =-      ./JSON/package.dhall sha256:1b02c5ff4710f90ee3f8dc1a2565f1b52b45e5317e2df4775307e2ba0cadcf21+      ./JSON/package.dhall sha256:79dfc281a05bc7b78f927e0da0c274ee5709b1c55c9e5f59499cb28e9d6f3ec0     ? ./JSON/package.dhall , Text =       ./Text/package.dhall sha256:819a967038fbf6f28cc289fa2651e42835f70b326210c86e51acf48f46f913d8

@@ -0,0 +1,1 @@+{ if: Text }

@@ -0,0 +1,1 @@+{ then: Text }

@@ -0,0 +1,1 @@+{ else: Text }

@@ -0,0 +1,1 @@+{ let: Text }

@@ -0,0 +1,1 @@+{ in: Text }

@@ -0,0 +1,1 @@+{ using: Text }

@@ -0,0 +1,1 @@+{ missing: Text }

@@ -0,0 +1,1 @@+{ assert: Text }

@@ -0,0 +1,1 @@+{ as: Text }

@@ -0,0 +1,1 @@+{ Infinity: Text }

@@ -0,0 +1,1 @@+{ NaN: Text }

@@ -0,0 +1,1 @@+{ merge: Text }

@@ -0,0 +1,1 @@+{ toMap: Text }

@@ -0,0 +1,1 @@+{ with: Text }

@@ -0,0 +1,1 @@+{ forall: Text }

@@ -1,5 +1,5 @@ Name: dhall-Version: 1.33.0+Version: 1.33.1 Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1@@ -482,7 +482,7 @@         prettyprinter-ansi-terminal >= 1.1.1    && < 1.2 ,         pretty-simple                              < 4   ,         profunctors                 >= 3.1.2    && < 5.6 ,-        repline                     >= 0.2.1.0  && < 0.4 ,+        repline                     >= 0.4.0.0  && < 0.5 ,         serialise                   >= 0.2.0.0  && < 0.3 ,         scientific                  >= 0.3.0.0  && < 0.4 ,         template-haskell            >= 2.11.1.0 && < 2.17,

@@ -2,9 +2,11 @@  {-# language CPP               #-} {-# language FlexibleContexts  #-}+{-# language LambdaCase        #-} {-# language NamedFieldPuns    #-} {-# language OverloadedStrings #-} {-# language RecordWildCards   #-}+{-# language ViewPatterns      #-}  module Dhall.Repl     ( -- * Repl@@ -19,7 +21,8 @@ import Control.Monad.State.Strict ( evalStateT ) -- For the MonadFail instance for StateT. import Control.Monad.Trans.Instances ()-import Data.List ( isPrefixOf, nub )+import Data.Char ( isSpace )+import Data.List ( dropWhileEnd, groupBy, isPrefixOf, nub ) import Data.Maybe ( mapMaybe ) import Data.Semigroup ((<>)) import Data.Text ( Text )@@ -76,15 +79,21 @@     io =       evalStateT         ( Repline.evalRepl-            ( pure $ turnstile ++ " " )+            banner             ( dontCrash . eval )             options             ( Just optionsPrefix )+            ( Just "paste" )             completer             greeter+            finaliser         )         (emptyEnv { characterSet, explain }) +    banner = pure . \case+      Repline.SingleLine -> turnstile <> " "+      Repline.MultiLine  -> "| "+     turnstile =       case characterSet of         Unicode -> "⊢"@@ -159,12 +168,10 @@   -typeOf :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m ()-typeOf [] = Fail.fail ":type requires an argument to check the type of"--typeOf srcs = do+typeOf :: ( MonadFail m, MonadIO m, MonadState Env m ) => String -> m ()+typeOf src = do   loaded <--    parseAndLoad ( unwords srcs )+    parseAndLoad src    exprType <-     typeCheck loaded@@ -207,26 +214,21 @@     Left  e -> liftIO ( wrap (throwIO e) )     Right a -> return a --- Separate the equal sign to be its own word in order to simplify parsing--- This is intended to be used with the options that require assignment-separateEqual :: [String] -> [String]-separateEqual [] =-    []-separateEqual (str₀ : ('=' : str₁) : strs) =-    str₀ : "=" : str₁ : strs-separateEqual (str : strs)-    | (str₀, '=' : str₁) <- break (== '=') str =-        str₀ : "=" : str₁ : strs-    | otherwise =-        str : strs+-- Split on the first '=' if there is any+parseAssignment :: String -> Either String (String, String)+parseAssignment str+  | (var, '=' : expr) <- break (== '=') str+  = Right (trim var, expr)+  | otherwise+  = Left (trim str) -addBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m ()-addBinding (k : "=" : srcs) = do+addBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => Either String (String, String) -> m ()+addBinding (Right (k, src)) = do   varName <- case Megaparsec.parse (unParser Parser.Token.label) "(input)" (Text.pack k) of       Left   _      -> Fail.fail "Invalid variable name"       Right varName -> return varName -  loaded <- parseAndLoad ( unwords srcs )+  loaded <- parseAndLoad src    t <- typeCheck loaded @@ -246,17 +248,14 @@  addBinding _ = Fail.fail ":let should be of the form `:let x = y`" -clearBindings :: (MonadFail m, MonadState Env m) => [String] -> m ()-clearBindings [] = modify adapt+clearBindings :: (MonadFail m, MonadState Env m) => String -> m ()+clearBindings _ = modify adapt   where     adapt (Env {..}) = Env { envBindings = Dhall.Context.empty, ..} -clearBindings _ = Fail.fail ":clear takes no arguments"--hashBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m ()-hashBinding [] = Fail.fail ":hash should be of the form `:hash expr"-hashBinding tokens = do-  loadedExpression <- parseAndLoad (unwords tokens)+hashBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => String -> m ()+hashBinding src = do+  loadedExpression <- parseAndLoad src    _ <- typeCheck loadedExpression @@ -299,25 +298,33 @@    pure $ saveFilePrefix <> "-" <> show nextIndex -loadBinding :: [String] -> Repl ()-loadBinding [] = do+loadBinding :: String -> Repl ()+loadBinding "" = do   mFile <- currentSaveFile    case mFile of-    Just file -> loadBinding [file]+    Just file -> loadBinding file     Nothing   ->       Fail.fail $ ":load couldn't find any `" <> saveFilePrefix <> "-*` files" -loadBinding [file] = do+loadBinding file = do   -- Read commands from the save file-  replLines <- map words . lines <$> liftIO (readFile file)+  -- Some commands can span multiple lines, only the first line will start with+  -- the optionsPrefix+  loadedLines <- lines <$> liftIO (readFile file) -  let runCommand ((c:cmd):opts)+  let -- Group lines that belong to the same command+      commands = flip groupBy loadedLines $ \_prev next ->+        not $ [optionsPrefix] `isPrefixOf` next++      runCommand line@(words -> (c:cmd):_)         | c == optionsPrefix-        , Just action <- lookup cmd options-        = action opts+        = case lookup cmd options of+            Just action -> action (drop (1 + length cmd + 1) line)+            Nothing -> Fail.fail $+              ":load unexpected command `" <> cmd <> "` in file `" <> file <> "`"       runCommand _ = Fail.fail $-        ":load expects `" <> file <> "` to contain one command per line"+        ":load expects `" <> file <> "` to contain a command"    -- Keep current handle in scope   Env { outputHandle } <- get@@ -326,24 +333,22 @@   modify (\e -> e { outputHandle = Nothing })    -- Run all the commands-  forM_ replLines runCommand+  forM_ commands (runCommand . unlines)    -- Restore the previous handle   modify (\e -> e { outputHandle = outputHandle })    writeOutputHandle $ "Loaded `" <> Text.pack file <> "`\n" -loadBinding _ = Fail.fail ":load should be of the form `:load` or `:load file`"--saveBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m ()+saveBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => Either String (String, String) -> m () -- Save all the bindings into a context save file-saveBinding [] = do+saveBinding (Left "") = do   file <- nextSaveFile -  saveBinding [file]+  saveBinding (Left file)  -- Save all the bindings into `file`-saveBinding [file] = do+saveBinding (Left file) = do   env <- get    let bindings@@ -368,8 +373,8 @@   writeOutputHandle $ "Context saved to `" <> Text.pack file <> "`\n"  -- Save a single expression to `file`-saveBinding (file : "=" : tokens) = do-  loadedExpression <- parseAndLoad (unwords tokens)+saveBinding (Right (file, src)) = do+  loadedExpression <- parseAndLoad src    _ <- typeCheck loadedExpression @@ -386,28 +391,29 @@    writeOutputHandle $ "Expression saved to `" <> Text.pack file <> "`\n" -saveBinding _ = Fail.fail ":save should be of the form `:save`, `:save file`, or `:save file = expr`"--setOption :: ( MonadIO m, MonadState Env m ) => [String] -> m ()-setOption [ "--explain" ] = do+setOption :: ( MonadIO m, MonadState Env m ) => String -> m ()+setOption "--explain" = do   modify (\e -> e { explain = True }) setOption _ = do   writeOutputHandle ":set should be of the form `:set <command line option>`" -unsetOption :: ( MonadIO m, MonadState Env m ) => [String] -> m ()-unsetOption [ "--explain" ] = do+unsetOption :: ( MonadIO m, MonadState Env m ) => String -> m ()+unsetOption "--explain" = do   modify (\e -> e { explain = False }) unsetOption _ = do   writeOutputHandle ":unset should be of the form `:unset <command line option>`" -cmdQuit :: ( MonadIO m, MonadState Env m ) => [String] -> m ()+quitMessage :: String+quitMessage = "Goodbye."++cmdQuit :: ( MonadIO m, MonadState Env m ) => String -> m () cmdQuit _ = do-  liftIO (putStrLn "Goodbye.")+  liftIO (putStrLn quitMessage)   liftIO (throwIO Interrupt)  help   :: ( MonadFail m, MonadIO m, MonadState Env m )-  => HelpOptions m -> [String] -> m ()+  => HelpOptions m -> String -> m () help hs _ = do   liftIO (putStrLn "Type any expression to normalize it or use one of the following commands:")   forM_ hs $ \h -> do@@ -420,6 +426,9 @@ optionsPrefix :: Char optionsPrefix = ':' +trim :: String -> String+trim = dropWhile isSpace . dropWhileEnd isSpace+ data HelpOption m = HelpOption   { helpOptionName :: String   , helpOptionSyntax :: String@@ -437,6 +446,11 @@       "Print help text and describe options"       (dontCrash . help helpOptions)   , HelpOption+      "paste"+      ""+      "Start a multi-line input. Submit with <Ctrl-D>"+      (error "Dhall.Repl.helpOptions: Unreachable")+  , HelpOption       "type"       "EXPRESSION"       "Infer the type of an expression"@@ -450,7 +464,7 @@       "let"       "IDENTIFIER = EXPRESSION"       "Assign an expression to a variable"-      (dontCrash . addBinding . separateEqual)+      (dontCrash . addBinding . parseAssignment)   , HelpOption       "clear"       ""@@ -460,22 +474,22 @@       "load"       "[FILENAME]"       "Load bound variables from a file"-      (dontCrash . loadBinding)+      (dontCrash . loadBinding . trim)   , HelpOption       "save"       "[FILENAME | FILENAME = EXPRESSION]"       "Save bound variables or a given expression to a file"-      (dontCrash . saveBinding . separateEqual)+      (dontCrash . saveBinding . parseAssignment)   , HelpOption       "set"       "OPTION"       "Set an option. Currently supported: --explain"-      (dontCrash . setOption)+      (dontCrash . setOption . trim)   , HelpOption       "unset"       "OPTION"       "Unset an option"-      (dontCrash . unsetOption)+      (dontCrash . unsetOption . trim)   , HelpOption       "quit"       ""@@ -578,6 +592,10 @@       message = "Welcome to the Dhall v" <> version <> " REPL! Type :help for more information."   in liftIO (putStrLn message) +finaliser :: MonadIO m => m Repline.ExitDecision+finaliser = do+  liftIO (putStrLn quitMessage)+  pure Repline.Exit  dontCrash :: Repl () -> Repl () dontCrash m =