From f7d5cd9c01be2bfc904d835aa5f27d63844bf6a4 Mon Sep 17 00:00:00 2001 From: GdeVolpiano Date: Mon, 14 Apr 2025 15:26:00 +0200 Subject: [PATCH 1/2] re-enabling Cabal-3.12 --- .github/workflows/ci.yml | 2 +- lib/Language/Haskell/Stylish/Config/Cabal.hs | 12 +- src/Main.hs | 230 +++++++++---------- stylish-haskell.cabal | 2 +- 4 files changed, 128 insertions(+), 118 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 75851b0d..1f561085 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -9,7 +9,7 @@ jobs: strategy: matrix: os: [ubuntu-latest, macOS-latest] - ghc: ["9.6.6", "9.8", "9.10"] + ghc: ["9.6.6", "9.8", "9.10"] #using 9.6.6 as ghc-lib-parser-9.10.1.20250103 is not compatible with ghc-9.6.7. Re-enable when sorted steps: - uses: actions/checkout@v4 diff --git a/lib/Language/Haskell/Stylish/Config/Cabal.hs b/lib/Language/Haskell/Stylish/Config/Cabal.hs index db2b6f31..b7b89afa 100644 --- a/lib/Language/Haskell/Stylish/Config/Cabal.hs +++ b/lib/Language/Haskell/Stylish/Config/Cabal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish.Config.Cabal ( findLanguageExtensions @@ -50,11 +51,20 @@ findCabalFile verbose configSearchStrategy = case configSearchStrategy of verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files." return Nothing go searched (p : ps) = do - let projectRoot = Just $ Cabal.makeSymbolicPath p + +#if MIN_VERSION_Cabal(3,14,0) + let projectRoot = Just $ makeSymbolicPath p potentialCabalFile <- Cabal.findPackageDesc projectRoot +#else + potentialCabalFile <- Cabal.findPackageDesc p +#endif case potentialCabalFile of Right cabalFile -> pure $ Just $ +#if MIN_VERSION_Cabal(3,14,0) Cabal.interpretSymbolicPath projectRoot cabalFile +#else + cabalFile +#endif _ -> go (p : searched) ps diff --git a/src/Main.hs b/src/Main.hs index 31af4169..2d9d50f0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-} + -------------------------------------------------------------------------------- module Main - ( main - ) where - + ( main + ) where -------------------------------------------------------------------------------- import Control.Monad (forM_, unless, when) @@ -15,119 +15,111 @@ import qualified System.IO as IO import qualified System.IO.Strict as IO.Strict -------------------------------------------------------------------------------- -#if __GLASGOW_HASKELL__ < 808 -import Data.Monoid ((<>)) -#endif - -------------------------------------------------------------------------------- import Language.Haskell.Stylish - -------------------------------------------------------------------------------- data StylishArgs = StylishArgs - { saVersion :: Bool - , saConfig :: Maybe FilePath - , saRecursive :: Bool - , saVerbose :: Bool - , saDefaults :: Bool - , saInPlace :: Bool - , saNoUtf8 :: Bool - , saFiles :: [FilePath] - } deriving (Show) - + { saVersion :: Bool + , saConfig :: Maybe FilePath + , saRecursive :: Bool + , saVerbose :: Bool + , saDefaults :: Bool + , saInPlace :: Bool + , saNoUtf8 :: Bool + , saFiles :: [FilePath] + } deriving (Show) -------------------------------------------------------------------------------- parseStylishArgs :: OA.Parser StylishArgs -parseStylishArgs = StylishArgs - <$> OA.switch ( - OA.help "Show version information" <> - OA.long "version" <> - OA.hidden) - <*> OA.optional (OA.strOption $ - OA.metavar "CONFIG" <> - OA.help "Configuration file" <> - OA.long "config" <> - OA.short 'c' <> - OA.hidden) - <*> OA.switch ( - OA.help "Recursive file search" <> - OA.long "recursive" <> - OA.short 'r' <> - OA.hidden) - <*> OA.switch ( - OA.help "Run in verbose mode" <> - OA.long "verbose" <> - OA.short 'v' <> - OA.hidden) - <*> OA.switch ( - OA.help "Dump default config and exit" <> - OA.long "defaults" <> - OA.short 'd' <> - OA.hidden) - <*> OA.switch ( - OA.help "Overwrite the given files in place" <> - OA.long "inplace" <> - OA.short 'i' <> - OA.hidden) - <*> OA.switch ( - OA.help "Don't force UTF-8 stdin/stdout" <> - OA.long "no-utf8" <> - OA.hidden) - <*> OA.many (OA.strArgument $ - OA.metavar "FILENAME" <> - OA.help "Input file(s)") - +parseStylishArgs = + StylishArgs + <$> OA.switch + (OA.help "Show version information" <> OA.long "version" <> OA.hidden) + <*> OA.optional + (OA.strOption + $ OA.metavar "CONFIG" + <> OA.help "Configuration file" + <> OA.long "config" + <> OA.short 'c' + <> OA.hidden) + <*> OA.switch + (OA.help "Recursive file search" + <> OA.long "recursive" + <> OA.short 'r' + <> OA.hidden) + <*> OA.switch + (OA.help "Run in verbose mode" + <> OA.long "verbose" + <> OA.short 'v' + <> OA.hidden) + <*> OA.switch + (OA.help "Dump default config and exit" + <> OA.long "defaults" + <> OA.short 'd' + <> OA.hidden) + <*> OA.switch + (OA.help "Overwrite the given files in place" + <> OA.long "inplace" + <> OA.short 'i' + <> OA.hidden) + <*> OA.switch + (OA.help "Don't force UTF-8 stdin/stdout" + <> OA.long "no-utf8" + <> OA.hidden) + <*> OA.many + (OA.strArgument $ OA.metavar "FILENAME" <> OA.help "Input file(s)") -------------------------------------------------------------------------------- stylishHaskellVersion :: String stylishHaskellVersion = "stylish-haskell " <> showVersion version - -------------------------------------------------------------------------------- parserInfo :: OA.ParserInfo StylishArgs -parserInfo = OA.info (OA.helper <*> parseStylishArgs) $ - OA.fullDesc <> - OA.header stylishHaskellVersion - +parserInfo = + OA.info (OA.helper <*> parseStylishArgs) + $ OA.fullDesc <> OA.header stylishHaskellVersion -------------------------------------------------------------------------------- main :: IO () main = OA.execParser parserInfo >>= stylishHaskell - -------------------------------------------------------------------------------- stylishHaskell :: StylishArgs -> IO () stylishHaskell sa = do - unless (saNoUtf8 sa) $ - mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout] - if saVersion sa then - putStrLn stylishHaskellVersion - - else if saDefaults sa then do - verbose' "Dumping embedded config..." - BC8.putStr defaultConfigBytes - - else do - conf <- loadConfig verbose' $ case saConfig sa of - Nothing -> SearchFromCurrentDirectory - Just fp -> UseConfig fp - filesR <- case (saRecursive sa) of - True -> findHaskellFiles (saVerbose sa) (saFiles sa) - _ -> return $ saFiles sa - let steps = configSteps conf - forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" - verbose' $ "Extra language extensions: " ++ - show (configLanguageExtensions conf) - res <- foldMap (file sa conf) (files' filesR) - - verbose' $ "Exit code behavior: " ++ show (configExitCode conf) - when (configExitCode conf == ErrorOnFormatExitBehavior && res == DidFormat) exitFailure + unless (saNoUtf8 sa) $ mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout] + if saVersion sa + then putStrLn stylishHaskellVersion + else if saDefaults sa + then do + verbose' "Dumping embedded config..." + BC8.putStr defaultConfigBytes + else do + conf <- + loadConfig verbose' + $ maybe SearchFromCurrentDirectory UseConfig (saConfig sa) + filesR <- + (if saRecursive sa + then findHaskellFiles (saVerbose sa) (saFiles sa) + else return $ saFiles sa) + let steps = configSteps conf + forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" + verbose' + $ "Extra language extensions: " + ++ show (configLanguageExtensions conf) + res <- foldMap (file sa conf) (files' filesR) + verbose' $ "Exit code behavior: " ++ show (configExitCode conf) + when + (configExitCode conf == ErrorOnFormatExitBehavior + && res == DidFormat) + exitFailure where verbose' = makeVerbose (saVerbose sa) - files' x = case (saRecursive sa, null x) of - (True,True) -> [] -- No file to format and recursive enabled. - (_,True) -> [Nothing] -- Involving IO.stdin. - (_,False) -> map Just x -- Process available files. + files' x = + case (saRecursive sa, null x) of + (True, True) -> [] -- No file to format and recursive enabled. + (_, True) -> [Nothing] -- Involving IO.stdin. + (_, False) -> map Just x -- Process available files. data FormattingResult = DidFormat @@ -137,7 +129,7 @@ data FormattingResult instance Semigroup FormattingResult where _ <> DidFormat = DidFormat DidFormat <> _ = DidFormat - _ <> _ = NoChange + _ <> _ = NoChange instance Monoid FormattingResult where mempty = NoChange @@ -146,28 +138,36 @@ instance Monoid FormattingResult where -- | Processes a single file, or stdin if no filepath is given file :: StylishArgs -> Config -> Maybe FilePath -> IO FormattingResult file sa conf mfp = do - contents <- maybe getContents readUTF8File mfp - let - inputLines = - lines contents + contents <- maybe getContents readUTF8File mfp + let inputLines = lines contents result = - runSteps (configLanguageExtensions conf) mfp (configSteps conf) inputLines - case result of - Right ok -> do - write contents (unlines ok) - pure $ if ok /= inputLines then DidFormat else NoChange - Left err -> do - IO.hPutStrLn IO.stderr err - exitFailure + runSteps + (configLanguageExtensions conf) + mfp + (configSteps conf) + inputLines + case result of + Right ok -> do + write contents (unlines ok) + pure + $ if ok /= inputLines + then DidFormat + else NoChange + Left err -> do + IO.hPutStrLn IO.stderr err + exitFailure where - write old new = case mfp of - Nothing -> putStrNewline new - Just _ | not (saInPlace sa) -> putStrNewline new - Just path | not (null new) && old /= new -> - IO.withFile path IO.WriteMode $ \h -> do - setNewlineMode h - IO.hPutStr h new - _ -> return () + write old new = + case mfp of + Nothing -> putStrNewline new + Just _ + | not (saInPlace sa) -> putStrNewline new + Just path + | not (null new) && old /= new -> + IO.withFile path IO.WriteMode $ \h -> do + setNewlineMode h + IO.hPutStr h new + _ -> return () setNewlineMode h = do let nl = configNewline conf let mode = IO.NewlineMode IO.nativeNewline nl @@ -176,6 +176,6 @@ file sa conf mfp = do readUTF8File :: FilePath -> IO String readUTF8File fp = - IO.withFile fp IO.ReadMode $ \h -> do - IO.hSetEncoding h IO.utf8 - IO.Strict.hGetContents h + IO.withFile fp IO.ReadMode $ \h -> do + IO.hSetEncoding h IO.utf8 + IO.Strict.hGetContents h diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 83f01f7b..a26174fc 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -39,7 +39,7 @@ Common depends aeson >= 0.6 && < 2.3, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.13, - Cabal >= 3.14 && < 4.0, + Cabal >= 3.10 && < 4.0, containers >= 0.3 && < 0.9, directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.6, From b400ccf96fae8683a229357e702aed0037476b6c Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 18 Apr 2025 11:19:44 +0200 Subject: [PATCH 2/2] Restore ugly formatting to minimize diff --- src/Main.hs | 227 +++++++++++++++++++++++++--------------------------- 1 file changed, 111 insertions(+), 116 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 2d9d50f0..9fea036e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-} - -------------------------------------------------------------------------------- module Main - ( main - ) where + ( main + ) where + -------------------------------------------------------------------------------- import Control.Monad (forM_, unless, when) @@ -14,112 +14,115 @@ import System.Exit (exitFailure) import qualified System.IO as IO import qualified System.IO.Strict as IO.Strict --------------------------------------------------------------------------------- + -------------------------------------------------------------------------------- import Language.Haskell.Stylish + -------------------------------------------------------------------------------- data StylishArgs = StylishArgs - { saVersion :: Bool - , saConfig :: Maybe FilePath - , saRecursive :: Bool - , saVerbose :: Bool - , saDefaults :: Bool - , saInPlace :: Bool - , saNoUtf8 :: Bool - , saFiles :: [FilePath] - } deriving (Show) + { saVersion :: Bool + , saConfig :: Maybe FilePath + , saRecursive :: Bool + , saVerbose :: Bool + , saDefaults :: Bool + , saInPlace :: Bool + , saNoUtf8 :: Bool + , saFiles :: [FilePath] + } deriving (Show) + -------------------------------------------------------------------------------- parseStylishArgs :: OA.Parser StylishArgs -parseStylishArgs = - StylishArgs - <$> OA.switch - (OA.help "Show version information" <> OA.long "version" <> OA.hidden) - <*> OA.optional - (OA.strOption - $ OA.metavar "CONFIG" - <> OA.help "Configuration file" - <> OA.long "config" - <> OA.short 'c' - <> OA.hidden) - <*> OA.switch - (OA.help "Recursive file search" - <> OA.long "recursive" - <> OA.short 'r' - <> OA.hidden) - <*> OA.switch - (OA.help "Run in verbose mode" - <> OA.long "verbose" - <> OA.short 'v' - <> OA.hidden) - <*> OA.switch - (OA.help "Dump default config and exit" - <> OA.long "defaults" - <> OA.short 'd' - <> OA.hidden) - <*> OA.switch - (OA.help "Overwrite the given files in place" - <> OA.long "inplace" - <> OA.short 'i' - <> OA.hidden) - <*> OA.switch - (OA.help "Don't force UTF-8 stdin/stdout" - <> OA.long "no-utf8" - <> OA.hidden) - <*> OA.many - (OA.strArgument $ OA.metavar "FILENAME" <> OA.help "Input file(s)") +parseStylishArgs = StylishArgs + <$> OA.switch ( + OA.help "Show version information" <> + OA.long "version" <> + OA.hidden) + <*> OA.optional (OA.strOption $ + OA.metavar "CONFIG" <> + OA.help "Configuration file" <> + OA.long "config" <> + OA.short 'c' <> + OA.hidden) + <*> OA.switch ( + OA.help "Recursive file search" <> + OA.long "recursive" <> + OA.short 'r' <> + OA.hidden) + <*> OA.switch ( + OA.help "Run in verbose mode" <> + OA.long "verbose" <> + OA.short 'v' <> + OA.hidden) + <*> OA.switch ( + OA.help "Dump default config and exit" <> + OA.long "defaults" <> + OA.short 'd' <> + OA.hidden) + <*> OA.switch ( + OA.help "Overwrite the given files in place" <> + OA.long "inplace" <> + OA.short 'i' <> + OA.hidden) + <*> OA.switch ( + OA.help "Don't force UTF-8 stdin/stdout" <> + OA.long "no-utf8" <> + OA.hidden) + <*> OA.many (OA.strArgument $ + OA.metavar "FILENAME" <> + OA.help "Input file(s)") + -------------------------------------------------------------------------------- stylishHaskellVersion :: String stylishHaskellVersion = "stylish-haskell " <> showVersion version + -------------------------------------------------------------------------------- parserInfo :: OA.ParserInfo StylishArgs -parserInfo = - OA.info (OA.helper <*> parseStylishArgs) - $ OA.fullDesc <> OA.header stylishHaskellVersion +parserInfo = OA.info (OA.helper <*> parseStylishArgs) $ + OA.fullDesc <> + OA.header stylishHaskellVersion + -------------------------------------------------------------------------------- main :: IO () main = OA.execParser parserInfo >>= stylishHaskell + -------------------------------------------------------------------------------- stylishHaskell :: StylishArgs -> IO () stylishHaskell sa = do - unless (saNoUtf8 sa) $ mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout] - if saVersion sa - then putStrLn stylishHaskellVersion - else if saDefaults sa - then do - verbose' "Dumping embedded config..." - BC8.putStr defaultConfigBytes - else do - conf <- - loadConfig verbose' - $ maybe SearchFromCurrentDirectory UseConfig (saConfig sa) - filesR <- - (if saRecursive sa - then findHaskellFiles (saVerbose sa) (saFiles sa) - else return $ saFiles sa) - let steps = configSteps conf - forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" - verbose' - $ "Extra language extensions: " - ++ show (configLanguageExtensions conf) - res <- foldMap (file sa conf) (files' filesR) - verbose' $ "Exit code behavior: " ++ show (configExitCode conf) - when - (configExitCode conf == ErrorOnFormatExitBehavior - && res == DidFormat) - exitFailure + unless (saNoUtf8 sa) $ + mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout] + if saVersion sa then + putStrLn stylishHaskellVersion + + else if saDefaults sa then do + verbose' "Dumping embedded config..." + BC8.putStr defaultConfigBytes + + else do + conf <- loadConfig verbose' $ + maybe SearchFromCurrentDirectory UseConfig (saConfig sa) + filesR <- case (saRecursive sa) of + True -> findHaskellFiles (saVerbose sa) (saFiles sa) + _ -> return $ saFiles sa + let steps = configSteps conf + forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" + verbose' $ "Extra language extensions: " ++ + show (configLanguageExtensions conf) + res <- foldMap (file sa conf) (files' filesR) + + verbose' $ "Exit code behavior: " ++ show (configExitCode conf) + when (configExitCode conf == ErrorOnFormatExitBehavior && res == DidFormat) exitFailure where verbose' = makeVerbose (saVerbose sa) - files' x = - case (saRecursive sa, null x) of - (True, True) -> [] -- No file to format and recursive enabled. - (_, True) -> [Nothing] -- Involving IO.stdin. - (_, False) -> map Just x -- Process available files. + files' x = case (saRecursive sa, null x) of + (True,True) -> [] -- No file to format and recursive enabled. + (_,True) -> [Nothing] -- Involving IO.stdin. + (_,False) -> map Just x -- Process available files. data FormattingResult = DidFormat @@ -129,7 +132,7 @@ data FormattingResult instance Semigroup FormattingResult where _ <> DidFormat = DidFormat DidFormat <> _ = DidFormat - _ <> _ = NoChange + _ <> _ = NoChange instance Monoid FormattingResult where mempty = NoChange @@ -138,36 +141,28 @@ instance Monoid FormattingResult where -- | Processes a single file, or stdin if no filepath is given file :: StylishArgs -> Config -> Maybe FilePath -> IO FormattingResult file sa conf mfp = do - contents <- maybe getContents readUTF8File mfp - let inputLines = lines contents + contents <- maybe getContents readUTF8File mfp + let + inputLines = + lines contents result = - runSteps - (configLanguageExtensions conf) - mfp - (configSteps conf) - inputLines - case result of - Right ok -> do - write contents (unlines ok) - pure - $ if ok /= inputLines - then DidFormat - else NoChange - Left err -> do - IO.hPutStrLn IO.stderr err - exitFailure + runSteps (configLanguageExtensions conf) mfp (configSteps conf) inputLines + case result of + Right ok -> do + write contents (unlines ok) + pure $ if ok /= inputLines then DidFormat else NoChange + Left err -> do + IO.hPutStrLn IO.stderr err + exitFailure where - write old new = - case mfp of - Nothing -> putStrNewline new - Just _ - | not (saInPlace sa) -> putStrNewline new - Just path - | not (null new) && old /= new -> - IO.withFile path IO.WriteMode $ \h -> do - setNewlineMode h - IO.hPutStr h new - _ -> return () + write old new = case mfp of + Nothing -> putStrNewline new + Just _ | not (saInPlace sa) -> putStrNewline new + Just path | not (null new) && old /= new -> + IO.withFile path IO.WriteMode $ \h -> do + setNewlineMode h + IO.hPutStr h new + _ -> return () setNewlineMode h = do let nl = configNewline conf let mode = IO.NewlineMode IO.nativeNewline nl @@ -176,6 +171,6 @@ file sa conf mfp = do readUTF8File :: FilePath -> IO String readUTF8File fp = - IO.withFile fp IO.ReadMode $ \h -> do - IO.hSetEncoding h IO.utf8 - IO.Strict.hGetContents h + IO.withFile fp IO.ReadMode $ \h -> do + IO.hSetEncoding h IO.utf8 + IO.Strict.hGetContents h