From 209f56c2aafd1ee8721000c1f01407a33db13b25 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 11:18:21 +0200 Subject: [PATCH 01/13] dhall format multiple files --- dhall/src/Dhall/Format.hs | 37 ++++++++++++++++++++++--------------- dhall/src/Dhall/Main.hs | 26 ++++++++++++++++++++++---- 2 files changed, 44 insertions(+), 19 deletions(-) diff --git a/dhall/src/Dhall/Format.hs b/dhall/src/Dhall/Format.hs index c53f6d96e..8886247b7 100644 --- a/dhall/src/Dhall/Format.hs +++ b/dhall/src/Dhall/Format.hs @@ -11,15 +11,20 @@ module Dhall.Format , format ) where -import Data.Foldable (for_) -import Data.Maybe (fromMaybe) -import Dhall.Pretty (CharacterSet, annToAnsiStyle, detectCharacterSet) +import Data.Foldable (for_) +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe (fromMaybe) +import Dhall.Pretty + ( CharacterSet + , annToAnsiStyle + , detectCharacterSet + ) import Dhall.Util ( Censor , CheckFailed (..) , Header (..) + , Input (..) , OutputMode (..) - , PossiblyTransitiveInput (..) , Transitivity (..) ) @@ -40,19 +45,21 @@ import qualified System.IO data Format = Format { chosenCharacterSet :: Maybe CharacterSet , censor :: Censor - , input :: PossiblyTransitiveInput + , transitivity :: Transitivity + , inputs :: NonEmpty Input , outputMode :: OutputMode } -- | Implementation of the @dhall format@ subcommand format :: Format -> IO () -format (Format { input = input0, ..}) = go input0 +format (Format { inputs = inputs0, transitivity = transitivity0, ..}) = + mapM_ go inputs0 where go input = do let directory = case input of - NonTransitiveStandardInput -> + StandardInput -> "." - PossiblyTransitiveInputFile file _ -> + InputFile file -> System.FilePath.takeDirectory file let status = Dhall.Import.emptyStatus directory @@ -66,16 +73,16 @@ format (Format { input = input0, ..}) = go input0 <> "\n") (originalText, transitivity) <- case input of - PossiblyTransitiveInputFile file transitivity -> do + InputFile file -> do text <- Data.Text.IO.readFile file - return (text, transitivity) - - NonTransitiveStandardInput -> do + return (text, transitivity0) + StandardInput -> do text <- Data.Text.IO.getContents return (text, NonTransitive) + headerAndExpr@(_, parsedExpression) <- Dhall.Util.getExpressionAndHeaderFromStdinText censor originalText case transitivity of @@ -84,7 +91,7 @@ format (Format { input = input0, ..}) = go input0 maybeFilepath <- Dhall.Import.dependencyToFile status import_ for_ maybeFilepath $ \filepath -> - go (PossiblyTransitiveInputFile filepath Transitive) + go (InputFile filepath) NonTransitive -> return () @@ -96,14 +103,14 @@ format (Format { input = input0, ..}) = go input0 case outputMode of Write -> case input of - PossiblyTransitiveInputFile file _ -> + InputFile file -> if originalText == formattedText then return () else AtomicWrite.LazyText.atomicWriteFile file (Pretty.Text.renderLazy docStream) - NonTransitiveStandardInput -> do + StandardInput -> do supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout Pretty.Terminal.renderIO diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index 1180f3ad1..da0d15302 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -143,7 +143,7 @@ data Mode } | Normalize { file :: Input , alpha :: Bool } | Repl - | Format { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode } + | Format { transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } | Freeze { possiblyTransitiveInput :: PossiblyTransitiveInput, all_ :: Bool, cache :: Bool, outputMode :: OutputMode } | Hash { file :: Input, cache :: Bool } | Diff { expr1 :: Text, expr2 :: Text } @@ -242,7 +242,7 @@ parseMode = Manipulate "format" "Standard code formatter for the Dhall language" - (Format <$> parseInplaceTransitive <*> parseCheck "formatted") + (Format <$> parseTransitiveSwitch <*> parseCheck "formatted" <*> parseFiles) <|> subcommand Manipulate "freeze" @@ -349,6 +349,17 @@ parseMode = <> Options.Applicative.action "file" ) + parseFiles = fmap f (Options.Applicative.many p) + where + f [] = StandardInput :| [] + f (file:files) = InputFile <$> (file :| files) + + p = Options.Applicative.strArgument + ( Options.Applicative.help "Read expression from files instead of standard input" + <> Options.Applicative.metavar "FILES" + <> Options.Applicative.action "file" + ) + parseOutput = fmap f (optional p) where f Nothing = StandardOutput @@ -422,6 +433,14 @@ parseMode = <> Options.Applicative.action "file" ) + parseTransitiveSwitch = fmap f (Options.Applicative.switch + ( Options.Applicative.long "transitive" + <> Options.Applicative.help "Modify the input and its transitive relative imports in-place" + )) + where + f False = NonTransitive + f True = Transitive + parseInplaceNonTransitive = fmap InputFile parseInplace <|> pure StandardInput @@ -788,8 +807,7 @@ command (Options {..}) = do else Exit.exitFailure Format {..} -> - Dhall.Format.format - Dhall.Format.Format{ input = possiblyTransitiveInput, ..} + Dhall.Format.format Dhall.Format.Format{..} Freeze {..} -> do let scope = if all_ then AllImports else OnlyRemoteImports From 7b7227a9e2ff8c18997b35d6dab2118f56d7c482 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 11:32:33 +0200 Subject: [PATCH 02/13] parse stdin as a file argument --- dhall/src/Dhall/Main.hs | 10 +++++++--- dhall/src/Dhall/Util.hs | 2 +- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index da0d15302..6f450da16 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -25,7 +25,7 @@ import Control.Applicative (optional, (<|>)) import Control.Exception (Handler (..), SomeException) import Data.Foldable (for_) import Data.Maybe (fromMaybe) -import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty) import Data.Void (Void) @@ -351,8 +351,12 @@ parseMode = parseFiles = fmap f (Options.Applicative.many p) where - f [] = StandardInput :| [] - f (file:files) = InputFile <$> (file :| files) + -- Parse explicit stdin in the input filepaths + parseStdin inputs + | any (== InputFile "-") inputs = StandardInput : filter (/= InputFile "-") inputs + | otherwise = inputs + + f = fromMaybe (pure StandardInput) . nonEmpty . parseStdin . fmap InputFile p = Options.Applicative.strArgument ( Options.Applicative.help "Read expression from files instead of standard input" diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index a57d2ef78..00cb35022 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -140,7 +140,7 @@ throws (Right r) = return r data Censor = NoCensor | Censor -- | Path to input -data Input = StandardInput | InputFile FilePath +data Input = StandardInput | InputFile FilePath deriving (Eq) -- | Path to input or raw input text, necessary since we can't read STDIN twice data InputOrTextFromStdin = Input_ Input | StdinText Text From 88056659a01cf3d1037230e45018c2643c79b500 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 11:42:59 +0200 Subject: [PATCH 03/13] dhall freeze multiple files --- dhall/src/Dhall/Freeze.hs | 28 ++++++++++++++++------------ dhall/src/Dhall/Main.hs | 6 +++--- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/dhall/src/Dhall/Freeze.hs b/dhall/src/Dhall/Freeze.hs index a461b8deb..2aefd64bf 100644 --- a/dhall/src/Dhall/Freeze.hs +++ b/dhall/src/Dhall/Freeze.hs @@ -22,6 +22,7 @@ module Dhall.Freeze ) where import Data.Foldable (for_) +import Data.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe) import Dhall.Pretty (CharacterSet, detectCharacterSet) import Dhall.Syntax @@ -34,8 +35,8 @@ import Dhall.Util ( Censor , CheckFailed (..) , Header (..) + , Input (..) , OutputMode (..) - , PossiblyTransitiveInput (..) , Transitivity (..) ) import System.Console.ANSI (hSupportsANSI) @@ -140,7 +141,8 @@ data Intent -- | Implementation of the @dhall freeze@ subcommand freeze :: OutputMode - -> PossiblyTransitiveInput + -> Transitivity + -> NonEmpty Input -> Scope -> Intent -> Maybe CharacterSet @@ -152,30 +154,32 @@ freeze = freezeWithManager Dhall.Import.defaultNewManager freezeWithManager :: IO Dhall.Import.Manager -> OutputMode - -> PossiblyTransitiveInput + -> Transitivity + -> NonEmpty Input -> Scope -> Intent -> Maybe CharacterSet -> Censor -> IO () -freezeWithManager newManager outputMode input0 scope intent chosenCharacterSet censor = go input0 +freezeWithManager newManager outputMode transitivity0 inputs scope intent chosenCharacterSet censor = + mapM_ go inputs where go input = do let directory = case input of - NonTransitiveStandardInput -> + StandardInput -> "." - PossiblyTransitiveInputFile file _ -> + InputFile file -> System.FilePath.takeDirectory file let status = Dhall.Import.emptyStatusWithManager newManager directory (originalText, transitivity) <- case input of - PossiblyTransitiveInputFile file transitivity -> do + InputFile file -> do text <- Text.IO.readFile file - return (text, transitivity) + return (text, transitivity0) - NonTransitiveStandardInput -> do + StandardInput -> do text <- Text.IO.getContents return (text, NonTransitive) @@ -190,7 +194,7 @@ freezeWithManager newManager outputMode input0 scope intent chosenCharacterSet c maybeFilepath <- Dhall.Import.dependencyToFile status import_ for_ maybeFilepath $ \filepath -> - go (PossiblyTransitiveInputFile filepath Transitive) + go (InputFile filepath) NonTransitive -> return () @@ -210,7 +214,7 @@ freezeWithManager newManager outputMode input0 scope intent chosenCharacterSet c let unAnnotated = Pretty.unAnnotateS stream case input of - PossiblyTransitiveInputFile file _ -> + InputFile file -> if originalText == modifiedText then return () else @@ -218,7 +222,7 @@ freezeWithManager newManager outputMode input0 scope intent chosenCharacterSet c file (Pretty.Text.renderLazy unAnnotated) - NonTransitiveStandardInput -> do + StandardInput -> do supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout if supportsANSI then diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index 6f450da16..6c142afda 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -144,7 +144,7 @@ data Mode | Normalize { file :: Input , alpha :: Bool } | Repl | Format { transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } - | Freeze { possiblyTransitiveInput :: PossiblyTransitiveInput, all_ :: Bool, cache :: Bool, outputMode :: OutputMode } + | Freeze { transitivity :: Transitivity, all_ :: Bool, cache :: Bool, outputMode :: OutputMode, inputs :: NonEmpty Input } | Hash { file :: Input, cache :: Bool } | Diff { expr1 :: Text, expr2 :: Text } | Lint { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode } @@ -247,7 +247,7 @@ parseMode = Manipulate "freeze" "Add integrity checks to remote import statements of an expression" - (Freeze <$> parseInplaceTransitive <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen") + (Freeze <$> parseTransitiveSwitch <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen" <*> parseFiles) <|> subcommand Manipulate "lint" @@ -818,7 +818,7 @@ command (Options {..}) = do let intent = if cache then Cache else Secure - Dhall.Freeze.freeze outputMode possiblyTransitiveInput scope intent chosenCharacterSet censor + Dhall.Freeze.freeze outputMode transitivity inputs scope intent chosenCharacterSet censor Hash {..} -> do expression <- getExpression file From f77df2adfcd7f04ff90b1b8f36ad03f770304aba Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 11:46:35 +0200 Subject: [PATCH 04/13] dhall lint multiple files --- dhall/src/Dhall/Main.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index 6c142afda..f4e198bb7 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -147,7 +147,7 @@ data Mode | Freeze { transitivity :: Transitivity, all_ :: Bool, cache :: Bool, outputMode :: OutputMode, inputs :: NonEmpty Input } | Hash { file :: Input, cache :: Bool } | Diff { expr1 :: Text, expr2 :: Text } - | Lint { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode } + | Lint { transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } | Tags { input :: Input , output :: Output @@ -252,7 +252,7 @@ parseMode = Manipulate "lint" "Improve Dhall code by using newer language features and removing dead code" - (Lint <$> parseInplaceTransitive <*> parseCheck "linted") + (Lint <$> parseTransitiveSwitch <*> parseCheck "linted" <*> parseFiles) <|> subcommand Manipulate "rewrite-with-schemas" @@ -837,21 +837,21 @@ command (Options {..}) = do Data.Text.IO.putStrLn (Dhall.Import.hashExpressionToCode normalizedExpression) - Lint { possiblyTransitiveInput = input0, ..} -> go input0 + Lint { transitivity = transitivity0, ..} -> mapM_ go inputs where go input = do let directory = case input of - NonTransitiveStandardInput -> "." - PossiblyTransitiveInputFile file _ -> System.FilePath.takeDirectory file + StandardInput -> "." + InputFile file -> System.FilePath.takeDirectory file let status = Dhall.Import.emptyStatus directory (originalText, transitivity) <- case input of - PossiblyTransitiveInputFile file transitivity -> do + InputFile file -> do text <- Data.Text.IO.readFile file - return (text, transitivity) - NonTransitiveStandardInput -> do + return (text, transitivity0) + StandardInput -> do text <- Data.Text.IO.getContents return (text, NonTransitive) @@ -867,7 +867,7 @@ command (Options {..}) = do maybeFilepath <- Dhall.Import.dependencyToFile status import_ for_ maybeFilepath $ \filepath -> - go (PossiblyTransitiveInputFile filepath Transitive) + go (InputFile filepath) NonTransitive -> return () @@ -884,12 +884,12 @@ command (Options {..}) = do case outputMode of Write -> case input of - PossiblyTransitiveInputFile file _ -> + InputFile file -> if originalText == modifiedText then return () else writeDocToFile file doc - NonTransitiveStandardInput -> + StandardInput -> renderDoc System.IO.stdout doc Check -> From e798c85c465a3298446299530a8e73df00896eb8 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 11:51:58 +0200 Subject: [PATCH 05/13] Remove unused PossiblyTransitiveInput --- dhall/src/Dhall/Main.hs | 13 ------------- dhall/src/Dhall/Util.hs | 8 -------- 2 files changed, 21 deletions(-) diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index f4e198bb7..e785ddaf6 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -65,7 +65,6 @@ import Dhall.Util , Input (..) , Output (..) , OutputMode (..) - , PossiblyTransitiveInput (..) , Transitivity (..) ) @@ -449,18 +448,6 @@ parseMode = fmap InputFile parseInplace <|> pure StandardInput - parseInplaceTransitive = - fmap (\f -> PossiblyTransitiveInputFile f NonTransitive) parseInplace - <|> fmap (\f -> PossiblyTransitiveInputFile f Transitive) parseTransitive - <|> pure NonTransitiveStandardInput - where - parseTransitive = Options.Applicative.strOption - ( Options.Applicative.long "transitive" - <> Options.Applicative.help "Modify the specified file and its transitive relative imports in-place" - <> Options.Applicative.metavar "FILE" - <> Options.Applicative.action "file" - ) - parseInput = fmap f (optional p) where f Nothing = StandardInput diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index 00cb35022..bc0aac2e6 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -10,7 +10,6 @@ module Dhall.Util , _ERROR , Censor(..) , Input(..) - , PossiblyTransitiveInput(..) , Transitivity(..) , OutputMode(..) , Output(..) @@ -145,13 +144,6 @@ data Input = StandardInput | InputFile FilePath deriving (Eq) -- | Path to input or raw input text, necessary since we can't read STDIN twice data InputOrTextFromStdin = Input_ Input | StdinText Text -{-| For utilities that may want to process transitive dependencies, like - @dhall freeze@ --} -data PossiblyTransitiveInput - = NonTransitiveStandardInput - | PossiblyTransitiveInputFile FilePath Transitivity - {-| Specifies whether or not an input's transitive dependencies should also be processed. Transitive dependencies are restricted to relative file imports. -} From b82227324ec8e3a9bac90878f8bfec79e63601ca Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 12:27:48 +0200 Subject: [PATCH 06/13] More context in CheckFailed --- dhall/src/Dhall/Util.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index bc0aac2e6..b8766424a 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -163,13 +163,13 @@ data Output = StandardOutput | OutputFile FilePath data OutputMode = Write | Check -- | Exception thrown when the @--check@ flag to a command-line subcommand fails -data CheckFailed = CheckFailed { command :: Text, modified :: Text } +data CheckFailed = CheckFailed { command :: Text, modified :: Text, input :: Input } instance Exception CheckFailed instance Show CheckFailed where show CheckFailed{..} = - _ERROR <> ": ❰dhall " <> command_ <> " --check❱ failed\n\ + _ERROR <> ": ❰dhall " <> command_ <> " --check❱ failed on " <> input_ <> "\n\ \\n\ \You ran ❰dhall " <> command_ <> " --check❱, but the input appears to have not\n\ \been " <> modified_ <> " before, or was changed since the last time the input\n\ @@ -179,6 +179,10 @@ instance Show CheckFailed where command_ = Data.Text.unpack command + input_ = case input of + StandardInput -> "(stdin)" + InputFile file -> "\"" <> file <> "\"" + -- | Convenient utility for retrieving an expression getExpression :: Censor -> Input -> IO (Expr Src Import) getExpression censor = get Dhall.Parser.exprFromText censor . Input_ From 63fdb3446fb402c8384dabfbe33249b19815fe06 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 12:32:54 +0200 Subject: [PATCH 07/13] openapi-to-dhall: Fix use of format --- dhall-openapi/openapi-to-dhall/Main.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/dhall-openapi/openapi-to-dhall/Main.hs b/dhall-openapi/openapi-to-dhall/Main.hs index 44f8df980..5154b3ab4 100644 --- a/dhall-openapi/openapi-to-dhall/Main.hs +++ b/dhall-openapi/openapi-to-dhall/Main.hs @@ -75,10 +75,9 @@ writeDhall path expr = do let outputMode = Dhall.Util.Write - let input = - Dhall.Util.PossiblyTransitiveInputFile - path - Dhall.Util.NonTransitive + let inputs = pure (Dhall.Util.InputFile path) + + let transitivity = Dhall.Util.NonTransitive let formatOptions = Dhall.Format.Format{..} From 712a8552f750d9343170685c35957ca1874844db Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Mon, 5 Apr 2021 13:37:05 +0200 Subject: [PATCH 08/13] Only throw CheckFailed after handling all inputs --- dhall/src/Dhall/Format.hs | 3 ++- dhall/src/Dhall/Freeze.hs | 3 ++- dhall/src/Dhall/Util.hs | 25 +++++++++++++++++++++++++ 3 files changed, 29 insertions(+), 2 deletions(-) diff --git a/dhall/src/Dhall/Format.hs b/dhall/src/Dhall/Format.hs index 8886247b7..274178d30 100644 --- a/dhall/src/Dhall/Format.hs +++ b/dhall/src/Dhall/Format.hs @@ -26,6 +26,7 @@ import Dhall.Util , Input (..) , OutputMode (..) , Transitivity (..) + , mapMThrowCheckFailed ) import qualified Control.Exception @@ -53,7 +54,7 @@ data Format = Format -- | Implementation of the @dhall format@ subcommand format :: Format -> IO () format (Format { inputs = inputs0, transitivity = transitivity0, ..}) = - mapM_ go inputs0 + mapMThrowCheckFailed go inputs0 where go input = do let directory = case input of diff --git a/dhall/src/Dhall/Freeze.hs b/dhall/src/Dhall/Freeze.hs index 2aefd64bf..1d3a09f8c 100644 --- a/dhall/src/Dhall/Freeze.hs +++ b/dhall/src/Dhall/Freeze.hs @@ -38,6 +38,7 @@ import Dhall.Util , Input (..) , OutputMode (..) , Transitivity (..) + , mapMThrowCheckFailed ) import System.Console.ANSI (hSupportsANSI) @@ -162,7 +163,7 @@ freezeWithManager -> Censor -> IO () freezeWithManager newManager outputMode transitivity0 inputs scope intent chosenCharacterSet censor = - mapM_ go inputs + mapMThrowCheckFailed go inputs where go input = do let directory = case input of diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index b8766424a..e00b75eab 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} -- | Shared utility functions @@ -18,11 +19,15 @@ module Dhall.Util , getExpressionAndHeaderFromStdinText , Header(..) , CheckFailed(..) + , mapMThrowCheckFailed ) where import Control.Exception (Exception (..)) import Control.Monad.IO.Class (MonadIO (..)) import Data.Bifunctor (first) +import Data.Either (lefts) +import Data.Foldable (toList) +import Data.List.NonEmpty (NonEmpty (..)) import Data.String (IsString) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty) @@ -183,6 +188,26 @@ instance Show CheckFailed where StandardInput -> "(stdin)" InputFile file -> "\"" <> file <> "\"" +-- | Exception thrown when the @--check@ flag to a command-line subcommand fails +newtype MultipleCheckFailed = MultipleCheckFailed (NonEmpty CheckFailed) + +instance Exception MultipleCheckFailed + +instance Show MultipleCheckFailed where + show (MultipleCheckFailed cfs) = unlines . map show $ toList cfs + +-- | Helper function similar to mapM_ to run multiple IO but only fail on CheckFailed after all IO is done +mapMThrowCheckFailed :: (Foldable t, Traversable t) => (a -> IO ()) -> t a -> IO () +mapMThrowCheckFailed f xs = post =<< mapM (Control.Exception.tryJust match . f) xs + where + -- Handle CheckFailed exceptions only + match = Just @CheckFailed + + post results = + case lefts (toList results) of + [] -> pure () + cf:cfs -> Control.Exception.throwIO (MultipleCheckFailed (cf:|cfs)) + -- | Convenient utility for retrieving an expression getExpression :: Censor -> Input -> IO (Expr Src Import) getExpression censor = get Dhall.Parser.exprFromText censor . Input_ From 14841a798cc07bb0c310be068ae5c6e3b2e48cf6 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Sat, 10 Apr 2021 18:46:02 +0200 Subject: [PATCH 09/13] Apply suggestions from code review Co-authored-by: Gabriel Gonzalez --- dhall/src/Dhall/Main.hs | 7 ++----- dhall/src/Dhall/Util.hs | 2 +- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index e785ddaf6..4ee7456a1 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -436,13 +436,10 @@ parseMode = <> Options.Applicative.action "file" ) - parseTransitiveSwitch = fmap f (Options.Applicative.switch + parseTransitiveSwitch = Options.Applicative.flag NonTransitive Transitive ( Options.Applicative.long "transitive" <> Options.Applicative.help "Modify the input and its transitive relative imports in-place" - )) - where - f False = NonTransitive - f True = Transitive + ) parseInplaceNonTransitive = fmap InputFile parseInplace diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index e00b75eab..371df0797 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -185,7 +185,7 @@ instance Show CheckFailed where command_ = Data.Text.unpack command input_ = case input of - StandardInput -> "(stdin)" + StandardInput -> "(input)" InputFile file -> "\"" <> file <> "\"" -- | Exception thrown when the @--check@ flag to a command-line subcommand fails From a99e29f3565f5f497070943a97f2e044bbc7b193 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Sat, 10 Apr 2021 23:32:56 +0200 Subject: [PATCH 10/13] Better format error message for MultipleChecksFailed --- dhall/src/Dhall/Format.hs | 21 ++++++------- dhall/src/Dhall/Freeze.hs | 18 +++++------ dhall/src/Dhall/Main.hs | 18 ++++++----- dhall/src/Dhall/Schemas.hs | 6 ++-- dhall/src/Dhall/Util.hs | 63 ++++++++++++++++++++++---------------- 5 files changed, 68 insertions(+), 58 deletions(-) diff --git a/dhall/src/Dhall/Format.hs b/dhall/src/Dhall/Format.hs index 274178d30..beac1afd5 100644 --- a/dhall/src/Dhall/Format.hs +++ b/dhall/src/Dhall/Format.hs @@ -26,10 +26,9 @@ import Dhall.Util , Input (..) , OutputMode (..) , Transitivity (..) - , mapMThrowCheckFailed + , handleMultipleChecksFailed ) -import qualified Control.Exception import qualified Data.Text.IO import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal @@ -54,7 +53,7 @@ data Format = Format -- | Implementation of the @dhall format@ subcommand format :: Format -> IO () format (Format { inputs = inputs0, transitivity = transitivity0, ..}) = - mapMThrowCheckFailed go inputs0 + handleMultipleChecksFailed "format" "formatted" go inputs0 where go input = do let directory = case input of @@ -102,7 +101,7 @@ format (Format { inputs = inputs0, transitivity = transitivity0, ..}) = let formattedText = Pretty.Text.renderStrict docStream case outputMode of - Write -> + Write -> do case input of InputFile file -> if originalText == formattedText @@ -120,12 +119,10 @@ format (Format { inputs = inputs0, transitivity = transitivity0, ..}) = then (fmap annToAnsiStyle docStream) else (Pretty.unAnnotateS docStream)) - Check -> - if originalText == formattedText - then return () - else do - let command = "format" - - let modified = "formatted" + return (Right ()) - Control.Exception.throwIO CheckFailed{..} + Check -> + return $ + if originalText == formattedText + then Right () + else Left CheckFailed{..} diff --git a/dhall/src/Dhall/Freeze.hs b/dhall/src/Dhall/Freeze.hs index 1d3a09f8c..187700bed 100644 --- a/dhall/src/Dhall/Freeze.hs +++ b/dhall/src/Dhall/Freeze.hs @@ -38,7 +38,7 @@ import Dhall.Util , Input (..) , OutputMode (..) , Transitivity (..) - , mapMThrowCheckFailed + , handleMultipleChecksFailed ) import System.Console.ANSI (hSupportsANSI) @@ -163,7 +163,7 @@ freezeWithManager -> Censor -> IO () freezeWithManager newManager outputMode transitivity0 inputs scope intent chosenCharacterSet censor = - mapMThrowCheckFailed go inputs + handleMultipleChecksFailed "freeze" "frozen" go inputs where go input = do let directory = case input of @@ -231,15 +231,13 @@ freezeWithManager newManager outputMode transitivity0 inputs scope intent chosen else Pretty.renderIO System.IO.stdout unAnnotated - Check -> - if originalText == modifiedText - then return () - else do - let command = "freeze" - - let modified = "frozen" + return (Right ()) - Exception.throwIO CheckFailed{..} + Check -> + return $ + if originalText == modifiedText + then Right () + else Left CheckFailed{..} {-| Slightly more pure version of the `freeze` function diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index 4ee7456a1..e71c1e8b7 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -66,6 +66,7 @@ import Dhall.Util , Output (..) , OutputMode (..) , Transitivity (..) + , handleMultipleChecksFailed ) import qualified Codec.CBOR.JSON @@ -821,7 +822,8 @@ command (Options {..}) = do Data.Text.IO.putStrLn (Dhall.Import.hashExpressionToCode normalizedExpression) - Lint { transitivity = transitivity0, ..} -> mapM_ go inputs + Lint { transitivity = transitivity0, ..} -> + handleMultipleChecksFailed "lint" "linted" go inputs where go input = do let directory = case input of @@ -866,7 +868,7 @@ command (Options {..}) = do let modifiedText = Pretty.Text.renderStrict stream <> "\n" case outputMode of - Write -> + Write -> do case input of InputFile file -> if originalText == modifiedText @@ -876,13 +878,13 @@ command (Options {..}) = do StandardInput -> renderDoc System.IO.stdout doc - Check -> - if originalText == modifiedText - then return () - else do - let modified = "linted" + return (Right ()) - Control.Exception.throwIO CheckFailed{ command = "lint", ..} + Check -> + return $ + if originalText == modifiedText + then Right () + else Left CheckFailed{..} Encode {..} -> do expression <- getExpression file diff --git a/dhall/src/Dhall/Schemas.hs b/dhall/src/Dhall/Schemas.hs index d5c370308..a6c9ce683 100644 --- a/dhall/src/Dhall/Schemas.hs +++ b/dhall/src/Dhall/Schemas.hs @@ -27,7 +27,7 @@ import Dhall.Src (Src) import Dhall.Syntax (Expr (..), Import, Var (..)) import Dhall.Util ( Censor (..) - , CheckFailed (..) + , MultipleCheckFailed (..) , Header (..) , Input (..) , OutputMode (..) @@ -115,7 +115,9 @@ schemasCommand Schemas{..} = do let modified = "rewritten" - Exception.throwIO CheckFailed{..} + let inputs = pure input + + Exception.throwIO MultipleCheckFailed{..} decodeSchema :: Expr s Void -> Maybe (Expr s Void, Map Text (Expr s Void)) decodeSchema (RecordLit m) diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index 371df0797..e1b90713a 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} @@ -19,7 +20,8 @@ module Dhall.Util , getExpressionAndHeaderFromStdinText , Header(..) , CheckFailed(..) - , mapMThrowCheckFailed + , MultipleCheckFailed(..) + , handleMultipleChecksFailed ) where import Control.Exception (Exception (..)) @@ -167,15 +169,22 @@ data Output = StandardOutput | OutputFile FilePath -} data OutputMode = Write | Check +newtype CheckFailed = CheckFailed { input :: Input } + -- | Exception thrown when the @--check@ flag to a command-line subcommand fails -data CheckFailed = CheckFailed { command :: Text, modified :: Text, input :: Input } +data MultipleCheckFailed = MultipleCheckFailed + { command :: Text + , modified :: Text + , inputs :: NonEmpty Input + } -instance Exception CheckFailed +instance Exception MultipleCheckFailed -instance Show CheckFailed where - show CheckFailed{..} = - _ERROR <> ": ❰dhall " <> command_ <> " --check❱ failed on " <> input_ <> "\n\ - \\n\ +instance Show MultipleCheckFailed where + show MultipleCheckFailed{..} = + _ERROR <> ": ❰dhall " <> command_ <> " --check❱ failed on:\n\ + \\n" <> files <> + "\n\ \You ran ❰dhall " <> command_ <> " --check❱, but the input appears to have not\n\ \been " <> modified_ <> " before, or was changed since the last time the input\n\ \was " <> modified_ <> ".\n" @@ -184,29 +193,31 @@ instance Show CheckFailed where command_ = Data.Text.unpack command - input_ = case input of - StandardInput -> "(input)" - InputFile file -> "\"" <> file <> "\"" - --- | Exception thrown when the @--check@ flag to a command-line subcommand fails -newtype MultipleCheckFailed = MultipleCheckFailed (NonEmpty CheckFailed) - -instance Exception MultipleCheckFailed - -instance Show MultipleCheckFailed where - show (MultipleCheckFailed cfs) = unlines . map show $ toList cfs - --- | Helper function similar to mapM_ to run multiple IO but only fail on CheckFailed after all IO is done -mapMThrowCheckFailed :: (Foldable t, Traversable t) => (a -> IO ()) -> t a -> IO () -mapMThrowCheckFailed f xs = post =<< mapM (Control.Exception.tryJust match . f) xs + files = unlines . map format $ toList inputs + + format input = case input of + StandardInput -> "↳ (stdin)" + InputFile file -> "↳ " <> file + +-- | Run IO for multiple inputs, then collate all the check failures before +-- throwing if there was any failure +handleMultipleChecksFailed + :: (Foldable t, Traversable t) + => Text + -> Text + -> (a -> IO (Either CheckFailed ())) + -> t a + -> IO () +handleMultipleChecksFailed command modified f xs = post =<< mapM f xs where - -- Handle CheckFailed exceptions only - match = Just @CheckFailed - post results = case lefts (toList results) of [] -> pure () - cf:cfs -> Control.Exception.throwIO (MultipleCheckFailed (cf:|cfs)) + cf:cfs -> Control.Exception.throwIO $ MultipleCheckFailed + { command + , modified + , inputs = fmap input (cf:|cfs) + } -- | Convenient utility for retrieving an expression getExpression :: Censor -> Input -> IO (Expr Src Import) From 1573bf9257aada95c7becfa7d9d866e28b608353 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Sun, 11 Apr 2021 12:08:59 +0200 Subject: [PATCH 11/13] Add missing haddock for CheckFailed --- dhall/src/Dhall/Util.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index e1b90713a..0f2ca6c93 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -169,6 +169,9 @@ data Output = StandardOutput | OutputFile FilePath -} data OutputMode = Write | Check +-- | A check failure corresponding to a single input. +-- This type is intended to be used with 'MultipleCheckFailed' for error +-- reporting. newtype CheckFailed = CheckFailed { input :: Input } -- | Exception thrown when the @--check@ flag to a command-line subcommand fails From 2d6035a62c81460fb7657aa1209679667c6f9224 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Tue, 13 Apr 2021 22:57:38 +0200 Subject: [PATCH 12/13] Keep a temporary --inplace flag with a deprecated notice --- dhall/src/Dhall/Main.hs | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs index e71c1e8b7..c828b62bc 100644 --- a/dhall/src/Dhall/Main.hs +++ b/dhall/src/Dhall/Main.hs @@ -23,6 +23,7 @@ module Dhall.Main import Control.Applicative (optional, (<|>)) import Control.Exception (Handler (..), SomeException) +import Control.Monad (when) import Data.Foldable (for_) import Data.Maybe (fromMaybe) import Data.List.NonEmpty (NonEmpty (..), nonEmpty) @@ -143,11 +144,11 @@ data Mode } | Normalize { file :: Input , alpha :: Bool } | Repl - | Format { transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } - | Freeze { transitivity :: Transitivity, all_ :: Bool, cache :: Bool, outputMode :: OutputMode, inputs :: NonEmpty Input } + | Format { deprecatedInPlace :: Bool, transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } + | Freeze { deprecatedInPlace :: Bool, transitivity :: Transitivity, all_ :: Bool, cache :: Bool, outputMode :: OutputMode, inputs :: NonEmpty Input } | Hash { file :: Input, cache :: Bool } | Diff { expr1 :: Text, expr2 :: Text } - | Lint { transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } + | Lint { deprecatedInPlace :: Bool, transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } | Tags { input :: Input , output :: Output @@ -242,17 +243,17 @@ parseMode = Manipulate "format" "Standard code formatter for the Dhall language" - (Format <$> parseTransitiveSwitch <*> parseCheck "formatted" <*> parseFiles) + (Format <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseCheck "formatted" <*> parseFiles) <|> subcommand Manipulate "freeze" "Add integrity checks to remote import statements of an expression" - (Freeze <$> parseTransitiveSwitch <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen" <*> parseFiles) + (Freeze <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen" <*> parseFiles) <|> subcommand Manipulate "lint" "Improve Dhall code by using newer language features and removing dead code" - (Lint <$> parseTransitiveSwitch <*> parseCheck "linted" <*> parseFiles) + (Lint <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseCheck "linted" <*> parseFiles) <|> subcommand Manipulate "rewrite-with-schemas" @@ -332,6 +333,12 @@ parseMode = <*> parseVersion ) where + deprecatedInPlace = + Options.Applicative.switch + ( Options.Applicative.long "inplace" + <> Options.Applicative.internal -- completely hidden from help + ) + argument = fmap Data.Text.pack . Options.Applicative.strArgument @@ -795,10 +802,16 @@ command (Options {..}) = do then return () else Exit.exitFailure - Format {..} -> + Format {..} -> do + when deprecatedInPlace $ + System.IO.hPutStrLn System.IO.stderr "Warning: the flag \"--inplace\" is deprecated" + Dhall.Format.format Dhall.Format.Format{..} Freeze {..} -> do + when deprecatedInPlace $ + System.IO.hPutStrLn System.IO.stderr "Warning: the flag \"--inplace\" is deprecated" + let scope = if all_ then AllImports else OnlyRemoteImports let intent = if cache then Cache else Secure @@ -822,7 +835,10 @@ command (Options {..}) = do Data.Text.IO.putStrLn (Dhall.Import.hashExpressionToCode normalizedExpression) - Lint { transitivity = transitivity0, ..} -> + Lint { transitivity = transitivity0, ..} -> do + when deprecatedInPlace $ + System.IO.hPutStrLn System.IO.stderr "Warning: the flag \"--inplace\" is deprecated" + handleMultipleChecksFailed "lint" "linted" go inputs where go input = do From 81f60dc3d2b9eecdb4e411e071e0865004eea724 Mon Sep 17 00:00:00 2001 From: Basile Henry Date: Tue, 13 Apr 2021 23:02:50 +0200 Subject: [PATCH 13/13] Remove mentions of '--inplace' in Dhall/Tutorial --- dhall/src/Dhall/Tutorial.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/dhall/src/Dhall/Tutorial.hs b/dhall/src/Dhall/Tutorial.hs index d55897238..ebc61f2dd 100644 --- a/dhall/src/Dhall/Tutorial.hs +++ b/dhall/src/Dhall/Tutorial.hs @@ -1619,7 +1619,7 @@ import Dhall -- > let replicate = https://prelude.dhall-lang.org/List/replicate -- > in replicate 5 -- > $ --- > $ dhall freeze --inplace ./foo.dhall +-- > $ dhall freeze ./foo.dhall -- > $ cat ./foo.dhall -- > let replicate = -- > https://prelude.dhall-lang.org/List/replicate sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 @@ -1744,10 +1744,9 @@ import Dhall -- > (List (List Natural)) -- > (replicate 5 (List Natural) (replicate 5 Natural 1)) -- --- You can also use the formatter to modify files in place using the --- @--inplace@ flag (i.e. for formatting source code): +-- You can also use the formatter to modify files in place: -- --- > $ dhall format --inplace ./unformatted +-- > $ dhall format ./unformatted -- -- Carefully note that the code formatter does not preserve all comments. -- Currently, the formatter only preserves two types of comments: