simplify diff

Author: phadej

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

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 <pkg.cabal> 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."))
 
 -------------------------------------------------------------------------------

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