diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/dhall-lang/Prelude/JSON/package.dhall b/dhall-lang/Prelude/JSON/package.dhall --- a/dhall-lang/Prelude/JSON/package.dhall +++ b/dhall-lang/Prelude/JSON/package.dhall @@ -1,8 +1,8 @@ { render = - ./render sha256:eb26e0a4eee530dcda9d73974e9e9256fbad264916101866406a1647e28e280d + ./render sha256:b5e5aee66b8fc018b50e1019a76340deafe5f8176854ea3611476d79990785da ? ./render , renderYAML = - ./renderYAML sha256:d406a8744b81ced6a485da3cdb40a357fdd37338f4f134b00e7da3684054ebd3 + ./renderYAML sha256:dad92a120956ae852be7496d1e1955bbf3f60834ab2ad32641269098f2846477 ? ./renderYAML , omitNullFields = ./omitNullFields sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0 diff --git a/dhall-lang/Prelude/JSON/render b/dhall-lang/Prelude/JSON/render --- a/dhall-lang/Prelude/JSON/render +++ b/dhall-lang/Prelude/JSON/render @@ -9,7 +9,7 @@ ? ./core.dhall let renderAs = - ./renderAs sha256:f16238edec4c6dd846f19677c6675b27c579999dcff91db6193c10ade1d83174 + ./renderAs sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043 ? ./renderAs let Format = diff --git a/dhall-lang/Prelude/JSON/renderAs b/dhall-lang/Prelude/JSON/renderAs --- a/dhall-lang/Prelude/JSON/renderAs +++ b/dhall-lang/Prelude/JSON/renderAs @@ -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) → diff --git a/dhall-lang/Prelude/JSON/renderYAML b/dhall-lang/Prelude/JSON/renderYAML --- a/dhall-lang/Prelude/JSON/renderYAML +++ b/dhall-lang/Prelude/JSON/renderYAML @@ -14,7 +14,7 @@ ? ./core.dhall let renderAs = - ./renderAs sha256:f16238edec4c6dd846f19677c6675b27c579999dcff91db6193c10ade1d83174 + ./renderAs sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043 ? ./renderAs let Format = diff --git a/dhall-lang/Prelude/package.dhall b/dhall-lang/Prelude/package.dhall --- a/dhall-lang/Prelude/package.dhall +++ b/dhall-lang/Prelude/package.dhall @@ -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 diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword00.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword00.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword00.dhall @@ -0,0 +1,1 @@ +{ if: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword01.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword01.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword01.dhall @@ -0,0 +1,1 @@ +{ then: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword02.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword02.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword02.dhall @@ -0,0 +1,1 @@ +{ else: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword03.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword03.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword03.dhall @@ -0,0 +1,1 @@ +{ let: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword04.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword04.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword04.dhall @@ -0,0 +1,1 @@ +{ in: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword05.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword05.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword05.dhall @@ -0,0 +1,1 @@ +{ using: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword06.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword06.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword06.dhall @@ -0,0 +1,1 @@ +{ missing: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword07.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword07.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword07.dhall @@ -0,0 +1,1 @@ +{ assert: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword08.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword08.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword08.dhall @@ -0,0 +1,1 @@ +{ as: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword09.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword09.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword09.dhall @@ -0,0 +1,1 @@ +{ Infinity: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword10.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword10.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword10.dhall @@ -0,0 +1,1 @@ +{ NaN: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword11.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword11.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword11.dhall @@ -0,0 +1,1 @@ +{ merge: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword12.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword12.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword12.dhall @@ -0,0 +1,1 @@ +{ toMap: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword13.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword13.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword13.dhall @@ -0,0 +1,1 @@ +{ with: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword14.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword14.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword14.dhall @@ -0,0 +1,1 @@ +{ forall: Text } diff --git a/dhall.cabal b/dhall.cabal --- a/dhall.cabal +++ b/dhall.cabal @@ -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, diff --git a/src/Dhall/Repl.hs b/src/Dhall/Repl.hs --- a/src/Dhall/Repl.hs +++ b/src/Dhall/Repl.hs @@ -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 `" -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 `" -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 " + (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 =