From 5197313eb5034417730fd2cc6565a004ba7c28c0 Mon Sep 17 00:00:00 2001 From: Merijn Verstraaten Date: Mon, 21 Dec 2020 14:34:49 +0100 Subject: [PATCH 1/4] Generate a diff between two sets of options. --- haskell-ci.cabal | 1 + src/HaskellCI.hs | 32 +++++++++ src/HaskellCI/Cli.hs | 8 +++ src/HaskellCI/Config/Diff.hs | 136 +++++++++++++++++++++++++++++++++++ 4 files changed, 177 insertions(+) create mode 100644 src/HaskellCI/Config/Diff.hs diff --git a/haskell-ci.cabal b/haskell-ci.cabal index 32a48d64..69f1958f 100644 --- a/haskell-ci.cabal +++ b/haskell-ci.cabal @@ -92,6 +92,7 @@ library haskell-ci-internal HaskellCI.Config.CopyFields HaskellCI.Config.Docspec HaskellCI.Config.Doctest + HaskellCI.Config.Diff HaskellCI.Config.Dump HaskellCI.Config.Empty HaskellCI.Config.Folds diff --git a/src/HaskellCI.hs b/src/HaskellCI.hs index 705a2a3e..01db08ed 100644 --- a/src/HaskellCI.hs +++ b/src/HaskellCI.hs @@ -56,6 +56,7 @@ import HaskellCI.Bash import HaskellCI.Cli import HaskellCI.Compiler import HaskellCI.Config +import HaskellCI.Config.Diff import HaskellCI.Config.Dump import HaskellCI.Diagnostics import HaskellCI.GitConfig @@ -87,6 +88,17 @@ main = do CommandDumpConfig -> do putStr $ unlines $ runDG configGrammar + CommandDiffConfig cfg fp Nothing -> do + newConfig <- configFromRegenOrConfigFile fp + + let oldConfig = optConfigMorphism opts emptyConfig + putStr . unlines $ diffConfigs cfg configGrammar oldConfig newConfig + + CommandDiffConfig cfg oldConfigFp (Just newConfigFp) -> do + oldConfig <- configFromRegenOrConfigFile oldConfigFp + newConfig <- configFromRegenOrConfigFile newConfigFp + putStr . unlines $ diffConfigs cfg configGrammar oldConfig newConfig + CommandRegenerate -> do regenerateBash opts regenerateGitHub opts @@ -113,6 +125,26 @@ main = do ifor_ :: Map.Map k v -> (k -> v -> IO a) -> IO () ifor_ xs f = Map.foldlWithKey' (\m k a -> m >> void (f k a)) (return ()) xs +------------------------------------------------------------------------------- +-- Diffing +------------------------------------------------------------------------------- +configFromRegenOrConfigFile :: FilePath -> IO Config +configFromRegenOrConfigFile fp = do + withContents fp noFile $ \contents -> case findRegendataArgv contents of + Nothing -> readConfigFile fp + Just (mversion, argv) -> do + -- warn if we regenerate using older haskell-ci + for_ mversion $ \version -> for_ (simpleParsec haskellCIVerStr) $ \haskellCIVer -> + when (haskellCIVer < version) $ do + putStrLnWarn $ "Regenerating using older haskell-ci-" ++ haskellCIVerStr + putStrLnWarn $ "File generated using haskell-ci-" ++ prettyShow version + + opts <- snd <$> parseOptions argv + optConfigMorphism opts <$> findConfigFile (optConfig opts) + where + noFile :: IO Config + noFile = putStrLnErr $ "No file named \"" ++ fp ++ "\" exists." + ------------------------------------------------------------------------------- -- Travis ------------------------------------------------------------------------------- diff --git a/src/HaskellCI/Cli.hs b/src/HaskellCI/Cli.hs index ce10fea8..7aafd082 100644 --- a/src/HaskellCI/Cli.hs +++ b/src/HaskellCI/Cli.hs @@ -12,6 +12,7 @@ import System.IO (hPutStrLn, stderr) import qualified Options.Applicative as O import HaskellCI.Config +import HaskellCI.Config.Diff (DiffConfig, defaultDiffConfig, diffConfigGrammar) import HaskellCI.OptparseGrammar import HaskellCI.VersionInfo @@ -26,6 +27,7 @@ data Command | CommandRegenerate | CommandListGHC | CommandDumpConfig + | CommandDiffConfig DiffConfig FilePath (Maybe FilePath) | CommandVersionInfo deriving Show @@ -135,6 +137,7 @@ cliParserInfo = O.info ((,) <$> cmdP <*> optionsP O.<**> versionP O.<**> O.helpe , O.command "github" $ O.info githubP $ O.progDesc "Generate GitHub Actions config" , O.command "list-ghc" $ O.info (pure CommandListGHC) $ O.progDesc "List known GHC versions" , O.command "dump-config" $ O.info (pure CommandDumpConfig) $ O.progDesc "Dump cabal.haskell-ci config with default values" + , O.command "diff-config" $ O.info diffP $ O.progDesc "" , O.command "version-info" $ O.info (pure CommandVersionInfo) $ O.progDesc "Print versions info haskell-ci was compiled with" ]) <|> travisP @@ -147,6 +150,11 @@ cliParserInfo = O.info ((,) <$> cmdP <*> optionsP O.<**> versionP O.<**> O.helpe githubP = CommandGitHub <$> O.strArgument (O.metavar "CABAL.FILE" <> O.action "file" <> O.help "Either or cabal.project") + diffP = CommandDiffConfig + <$> (runOptparseGrammar diffConfigGrammar <*> pure defaultDiffConfig) + <*> O.strArgument (O.metavar "FILE" <> O.action "file" <> O.help "Either a generated CI file or Haskell-CI config file.") + <*> O.optional (O.strArgument (O.metavar "FILE" <> O.action "file" <> O.help "Either a generated CI file or Haskell-CI config file.")) + ------------------------------------------------------------------------------- -- Parsing helpers ------------------------------------------------------------------------------- diff --git a/src/HaskellCI/Config/Diff.hs b/src/HaskellCI/Config/Diff.hs new file mode 100644 index 00000000..5262483a --- /dev/null +++ b/src/HaskellCI/Config/Diff.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module HaskellCI.Config.Diff where + +import HaskellCI.Prelude + +import Distribution.Fields.Field (FieldName) +import Distribution.Utils.ShortText (fromShortText) + +import qualified Distribution.Compat.Lens as L +import qualified Distribution.Compat.CharParsing as C +import qualified Distribution.FieldGrammar as C +import qualified Distribution.Parsec as C +import qualified Distribution.Pretty as C +import qualified Text.PrettyPrint as PP + +import HaskellCI.OptionsGrammar +import HaskellCI.Config.Empty (runEG) + +data ShowDiffOptions = ShowAllOptions | ShowChangedOptions + deriving (Eq, Show, Generic, Binary) + +instance C.Parsec ShowDiffOptions where + parsec = ShowAllOptions <$ C.string "all" + <|> ShowChangedOptions <$ C.string "changed" + +instance C.Pretty ShowDiffOptions where + pretty ShowAllOptions = PP.text "all" + pretty ShowChangedOptions = PP.text "changed" + +data DiffConfig = DiffConfig + { diffShowOptions :: ShowDiffOptions + , diffShowOld :: Bool + } deriving (Show, Generic, Binary) + +diffConfigGrammar + :: ( OptionsGrammar c g + , Applicative (g DiffConfig) + , c (Identity ShowDiffOptions)) + => g DiffConfig DiffConfig +diffConfigGrammar = DiffConfig + <$> C.optionalFieldDef "diff-show-options" (field @"diffShowOptions") ShowChangedOptions + ^^^ help "Which fields to show" + <*> C.booleanFieldDef "diff-show-old" (field @"diffShowOld") False + ^^^ help "Show the old values for every field" + +defaultDiffConfig :: DiffConfig +defaultDiffConfig = case runEG diffConfigGrammar of + Left xs -> error $ "Required fields: " ++ show xs + Right x -> x + +newtype DiffOptions s a = + DiffOptions { runDiffOptions :: (s, s) -> DiffConfig -> [String] } + deriving Functor + +instance Applicative (DiffOptions s) where + pure _ = DiffOptions $ \_ _ -> [] + DiffOptions f <*> DiffOptions x = DiffOptions (f <> x) + +diffConfigs :: DiffConfig -> DiffOptions a a -> a -> a -> [String] +diffConfigs config grammar oldVal newVal = + runDiffOptions grammar (oldVal, newVal) config + +diffUnique + :: Eq b + => (a -> b) + -> (a -> String) + -> FieldName + -> L.ALens' s a + -> (s, s) + -> DiffConfig + -> [String] +diffUnique project render fn lens (diffOld, diffNew) opts = + case diffShowOptions opts of + ShowChangedOptions | notEqual -> [] + ShowAllOptions | notEqual -> newLine + _ -> oldLine ++ newLine + where + notEqual = project oldValue == project newValue + oldValue = L.aview lens $ diffOld + newValue = L.aview lens $ diffNew + + oldLine + | diffShowOld opts = ["-- " ++ fromUTF8BS fn ++ ": " ++ render oldValue] + | otherwise = [] + + newLine = [ fromUTF8BS fn ++ ": " ++ render newValue, ""] + + +instance C.FieldGrammar C.Pretty DiffOptions where + blurFieldGrammar lens (DiffOptions diff) = + DiffOptions $ diff . bimap (L.aview lens) (L.aview lens) + + uniqueFieldAla fn pack valueLens = DiffOptions $ + diffUnique (C.prettyShow . pack) (C.prettyShow . pack) fn valueLens + + booleanFieldDef fn valueLens _ = DiffOptions $ + diffUnique id C.prettyShow fn valueLens + + optionalFieldAla fn pack valueLens = DiffOptions $ + diffUnique toPretty toPretty fn valueLens + where + toPretty = maybe "" (C.prettyShow . pack) + + optionalFieldDefAla fn pack valueLens _ = DiffOptions $ + diffUnique id (C.prettyShow . pack) fn valueLens + + monoidalFieldAla fn pack valueLens = DiffOptions $ + diffUnique (C.prettyShow . pack) (C.prettyShow . pack) fn valueLens + + freeTextField fn valueLens = DiffOptions $ + diffUnique id (fromMaybe "") fn valueLens + + freeTextFieldDef fn valueLens = DiffOptions $ + diffUnique id id fn valueLens + + freeTextFieldDefST fn valueLens = DiffOptions $ + diffUnique id fromShortText fn valueLens + + prefixedFields _ _ = pure [] + knownField _ = pure () + deprecatedSince _ _ = id + availableSince _ _ = id + removedIn _ _ = id + hiddenField = id + +instance OptionsGrammar C.Pretty DiffOptions where + metahelp _ = help + + help h (DiffOptions xs) = DiffOptions $ \vals config -> + case xs vals config of + [] -> [] + diffString -> ("-- " ++ h) : diffString From 700e397bc1ac7891357994d872308d7f56d99b52 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 8 Apr 2024 13:24:10 +0300 Subject: [PATCH 2/4] simplify diff --- src/HaskellCI.hs | 12 ++++++ src/HaskellCI/Cli.hs | 8 ++-- src/HaskellCI/Config/Diff.hs | 73 ++++++++---------------------------- 3 files changed, 31 insertions(+), 62 deletions(-) diff --git a/src/HaskellCI.hs b/src/HaskellCI.hs index 01db08ed..7aa27ce8 100644 --- a/src/HaskellCI.hs +++ b/src/HaskellCI.hs @@ -88,6 +88,14 @@ main = do CommandDumpConfig -> do putStr $ unlines $ runDG configGrammar + CommandDiffConfig _Nothing __Nothing -> do + let oldConfig = emptyConfig -- default + newConfig' <- findConfigFile (optConfig opts) + let newConfig = optConfigMorphism opts newConfig' + putStr $ unlines $ diffConfigs configGrammar oldConfig newConfig + + +{- CommandDiffConfig cfg fp Nothing -> do newConfig <- configFromRegenOrConfigFile fp @@ -98,6 +106,7 @@ main = do oldConfig <- configFromRegenOrConfigFile oldConfigFp newConfig <- configFromRegenOrConfigFile newConfigFp putStr . unlines $ diffConfigs cfg configGrammar oldConfig newConfig +-} CommandRegenerate -> do regenerateBash opts @@ -128,6 +137,8 @@ main = do ------------------------------------------------------------------------------- -- Diffing ------------------------------------------------------------------------------- + +{- configFromRegenOrConfigFile :: FilePath -> IO Config configFromRegenOrConfigFile fp = do withContents fp noFile $ \contents -> case findRegendataArgv contents of @@ -144,6 +155,7 @@ configFromRegenOrConfigFile fp = do where noFile :: IO Config noFile = putStrLnErr $ "No file named \"" ++ fp ++ "\" exists." +-} ------------------------------------------------------------------------------- -- Travis diff --git a/src/HaskellCI/Cli.hs b/src/HaskellCI/Cli.hs index 7aafd082..5d0aa932 100644 --- a/src/HaskellCI/Cli.hs +++ b/src/HaskellCI/Cli.hs @@ -12,7 +12,6 @@ import System.IO (hPutStrLn, stderr) import qualified Options.Applicative as O import HaskellCI.Config -import HaskellCI.Config.Diff (DiffConfig, defaultDiffConfig, diffConfigGrammar) import HaskellCI.OptparseGrammar import HaskellCI.VersionInfo @@ -27,7 +26,7 @@ data Command | CommandRegenerate | CommandListGHC | CommandDumpConfig - | CommandDiffConfig DiffConfig FilePath (Maybe FilePath) + | CommandDiffConfig (Maybe FilePath) (Maybe FilePath) | CommandVersionInfo deriving Show @@ -137,7 +136,7 @@ cliParserInfo = O.info ((,) <$> cmdP <*> optionsP O.<**> versionP O.<**> O.helpe , O.command "github" $ O.info githubP $ O.progDesc "Generate GitHub Actions config" , O.command "list-ghc" $ O.info (pure CommandListGHC) $ O.progDesc "List known GHC versions" , O.command "dump-config" $ O.info (pure CommandDumpConfig) $ O.progDesc "Dump cabal.haskell-ci config with default values" - , O.command "diff-config" $ O.info diffP $ O.progDesc "" + , O.command "diff-config" $ O.info diffP $ O.progDesc "Diff between configuration files" , O.command "version-info" $ O.info (pure CommandVersionInfo) $ O.progDesc "Print versions info haskell-ci was compiled with" ]) <|> travisP @@ -151,8 +150,7 @@ cliParserInfo = O.info ((,) <$> cmdP <*> optionsP O.<**> versionP O.<**> O.helpe <$> O.strArgument (O.metavar "CABAL.FILE" <> O.action "file" <> O.help "Either or cabal.project") diffP = CommandDiffConfig - <$> (runOptparseGrammar diffConfigGrammar <*> pure defaultDiffConfig) - <*> O.strArgument (O.metavar "FILE" <> O.action "file" <> O.help "Either a generated CI file or Haskell-CI config file.") + <$> O.optional (O.strArgument (O.metavar "FILE" <> O.action "file" <> O.help "Either a generated CI file or Haskell-CI config file.")) <*> O.optional (O.strArgument (O.metavar "FILE" <> O.action "file" <> O.help "Either a generated CI file or Haskell-CI config file.")) ------------------------------------------------------------------------------- diff --git a/src/HaskellCI/Config/Diff.hs b/src/HaskellCI/Config/Diff.hs index 5262483a..64238869 100644 --- a/src/HaskellCI/Config/Diff.hs +++ b/src/HaskellCI/Config/Diff.hs @@ -11,58 +11,22 @@ import Distribution.Fields.Field (FieldName) import Distribution.Utils.ShortText (fromShortText) import qualified Distribution.Compat.Lens as L -import qualified Distribution.Compat.CharParsing as C import qualified Distribution.FieldGrammar as C -import qualified Distribution.Parsec as C import qualified Distribution.Pretty as C -import qualified Text.PrettyPrint as PP import HaskellCI.OptionsGrammar -import HaskellCI.Config.Empty (runEG) - -data ShowDiffOptions = ShowAllOptions | ShowChangedOptions - deriving (Eq, Show, Generic, Binary) - -instance C.Parsec ShowDiffOptions where - parsec = ShowAllOptions <$ C.string "all" - <|> ShowChangedOptions <$ C.string "changed" - -instance C.Pretty ShowDiffOptions where - pretty ShowAllOptions = PP.text "all" - pretty ShowChangedOptions = PP.text "changed" - -data DiffConfig = DiffConfig - { diffShowOptions :: ShowDiffOptions - , diffShowOld :: Bool - } deriving (Show, Generic, Binary) - -diffConfigGrammar - :: ( OptionsGrammar c g - , Applicative (g DiffConfig) - , c (Identity ShowDiffOptions)) - => g DiffConfig DiffConfig -diffConfigGrammar = DiffConfig - <$> C.optionalFieldDef "diff-show-options" (field @"diffShowOptions") ShowChangedOptions - ^^^ help "Which fields to show" - <*> C.booleanFieldDef "diff-show-old" (field @"diffShowOld") False - ^^^ help "Show the old values for every field" - -defaultDiffConfig :: DiffConfig -defaultDiffConfig = case runEG diffConfigGrammar of - Left xs -> error $ "Required fields: " ++ show xs - Right x -> x newtype DiffOptions s a = - DiffOptions { runDiffOptions :: (s, s) -> DiffConfig -> [String] } + DiffOptions { runDiffOptions :: (s, s) -> [String] } deriving Functor instance Applicative (DiffOptions s) where - pure _ = DiffOptions $ \_ _ -> [] + pure _ = DiffOptions $ \_ -> [] DiffOptions f <*> DiffOptions x = DiffOptions (f <> x) -diffConfigs :: DiffConfig -> DiffOptions a a -> a -> a -> [String] -diffConfigs config grammar oldVal newVal = - runDiffOptions grammar (oldVal, newVal) config +diffConfigs :: DiffOptions a a -> a -> a -> [String] +diffConfigs grammar oldVal newVal = + runDiffOptions grammar (oldVal, newVal) diffUnique :: Eq b @@ -71,25 +35,20 @@ diffUnique -> FieldName -> L.ALens' s a -> (s, s) - -> DiffConfig -> [String] -diffUnique project render fn lens (diffOld, diffNew) opts = - case diffShowOptions opts of - ShowChangedOptions | notEqual -> [] - ShowAllOptions | notEqual -> newLine - _ -> oldLine ++ newLine +diffUnique project render fn lens (diffOld, diffNew) + | notEqual = + [ "-" ++ fromUTF8BS fn ++ ": " ++ render oldValue + , "+" ++ fromUTF8BS fn ++ ": " ++ render newValue + , "" + ] + + | otherwise = [] where - notEqual = project oldValue == project newValue + notEqual = project oldValue /= project newValue oldValue = L.aview lens $ diffOld newValue = L.aview lens $ diffNew - oldLine - | diffShowOld opts = ["-- " ++ fromUTF8BS fn ++ ": " ++ render oldValue] - | otherwise = [] - - newLine = [ fromUTF8BS fn ++ ": " ++ render newValue, ""] - - instance C.FieldGrammar C.Pretty DiffOptions where blurFieldGrammar lens (DiffOptions diff) = DiffOptions $ diff . bimap (L.aview lens) (L.aview lens) @@ -130,7 +89,7 @@ instance C.FieldGrammar C.Pretty DiffOptions where instance OptionsGrammar C.Pretty DiffOptions where metahelp _ = help - help h (DiffOptions xs) = DiffOptions $ \vals config -> - case xs vals config of + help h (DiffOptions xs) = DiffOptions $ \vals -> + case xs vals of [] -> [] diffString -> ("-- " ++ h) : diffString From f2c1d55c1f4ccecfb0b79b73dcf1d69ce6ba5898 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 8 Apr 2024 13:25:16 +0300 Subject: [PATCH 3/4] foo --- src/HaskellCI.hs | 2 +- src/HaskellCI/Cli.hs | 8 +++----- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/HaskellCI.hs b/src/HaskellCI.hs index 7aa27ce8..6722686d 100644 --- a/src/HaskellCI.hs +++ b/src/HaskellCI.hs @@ -88,7 +88,7 @@ main = do CommandDumpConfig -> do putStr $ unlines $ runDG configGrammar - CommandDiffConfig _Nothing __Nothing -> do + CommandDiffConfig -> do let oldConfig = emptyConfig -- default newConfig' <- findConfigFile (optConfig opts) let newConfig = optConfigMorphism opts newConfig' diff --git a/src/HaskellCI/Cli.hs b/src/HaskellCI/Cli.hs index 5d0aa932..1f2872c5 100644 --- a/src/HaskellCI/Cli.hs +++ b/src/HaskellCI/Cli.hs @@ -26,7 +26,7 @@ data Command | CommandRegenerate | CommandListGHC | CommandDumpConfig - | CommandDiffConfig (Maybe FilePath) (Maybe FilePath) + | CommandDiffConfig | CommandVersionInfo deriving Show @@ -136,7 +136,7 @@ cliParserInfo = O.info ((,) <$> cmdP <*> optionsP O.<**> versionP O.<**> O.helpe , O.command "github" $ O.info githubP $ O.progDesc "Generate GitHub Actions config" , O.command "list-ghc" $ O.info (pure CommandListGHC) $ O.progDesc "List known GHC versions" , O.command "dump-config" $ O.info (pure CommandDumpConfig) $ O.progDesc "Dump cabal.haskell-ci config with default values" - , O.command "diff-config" $ O.info diffP $ O.progDesc "Diff between configuration files" + , O.command "diff-config" $ O.info diffP $ O.progDesc "Diff between default and current configuration" , O.command "version-info" $ O.info (pure CommandVersionInfo) $ O.progDesc "Print versions info haskell-ci was compiled with" ]) <|> travisP @@ -149,9 +149,7 @@ cliParserInfo = O.info ((,) <$> cmdP <*> optionsP O.<**> versionP O.<**> O.helpe githubP = CommandGitHub <$> O.strArgument (O.metavar "CABAL.FILE" <> O.action "file" <> O.help "Either or cabal.project") - diffP = CommandDiffConfig - <$> O.optional (O.strArgument (O.metavar "FILE" <> O.action "file" <> O.help "Either a generated CI file or Haskell-CI config file.")) - <*> O.optional (O.strArgument (O.metavar "FILE" <> O.action "file" <> O.help "Either a generated CI file or Haskell-CI config file.")) + diffP = pure CommandDiffConfig ------------------------------------------------------------------------------- -- Parsing helpers From 5ed322ee8269c52a935e3d2640ac983853f4380c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 8 Apr 2024 13:25:50 +0300 Subject: [PATCH 4/4] foo --- src/HaskellCI.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/HaskellCI.hs b/src/HaskellCI.hs index 6722686d..17d4d89e 100644 --- a/src/HaskellCI.hs +++ b/src/HaskellCI.hs @@ -94,20 +94,6 @@ main = do let newConfig = optConfigMorphism opts newConfig' putStr $ unlines $ diffConfigs configGrammar oldConfig newConfig - -{- - CommandDiffConfig cfg fp Nothing -> do - newConfig <- configFromRegenOrConfigFile fp - - let oldConfig = optConfigMorphism opts emptyConfig - putStr . unlines $ diffConfigs cfg configGrammar oldConfig newConfig - - CommandDiffConfig cfg oldConfigFp (Just newConfigFp) -> do - oldConfig <- configFromRegenOrConfigFile oldConfigFp - newConfig <- configFromRegenOrConfigFile newConfigFp - putStr . unlines $ diffConfigs cfg configGrammar oldConfig newConfig --} - CommandRegenerate -> do regenerateBash opts regenerateGitHub opts