stylish-haskell 0.14.6.0 → 0.15.1.0
raw patch · 21 files changed
Files
- CHANGELOG +36/−12
- lib/Language/Haskell/Stylish.hs +11/−8
- lib/Language/Haskell/Stylish/Comments.hs +1/−1
- lib/Language/Haskell/Stylish/Config.hs +14/−10
- lib/Language/Haskell/Stylish/Config/Cabal.hs +39/−21
- lib/Language/Haskell/Stylish/Config/Internal.hs +14/−1
- lib/Language/Haskell/Stylish/GHC.hs +2/−3
- lib/Language/Haskell/Stylish/Module.hs +1/−1
- lib/Language/Haskell/Stylish/Ordering.hs +6/−6
- lib/Language/Haskell/Stylish/Printer.hs +13/−20
- lib/Language/Haskell/Stylish/Step/Data.hs +21/−7
- lib/Language/Haskell/Stylish/Step/Imports.hs +16/−15
- lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs +2/−2
- lib/Language/Haskell/Stylish/Step/ModuleHeader.hs +9/−9
- lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +4/−4
- lib/Language/Haskell/Stylish/Step/Squash.hs +10/−12
- lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +6/−5
- src/Main.hs +2/−5
- stylish-haskell.cabal +14/−12
- tests/Language/Haskell/Stylish/Config/Tests.hs +1/−1
- tests/Language/Haskell/Stylish/Tests.hs +4/−4
CHANGELOG view
@@ -1,24 +1,48 @@ # CHANGELOG +- 0.15.1.0 (2025-04-13)+ * #491 Support GHC 9.12 (By GuillaumedeVolpiano)++- 0.15.0.1 (2025-04-13)+ * #493 Support Cabal 3.12 again (By GuillaumedeVolpiano)++- 0.15.0.0 (2025-04-13)+ * #480 Support with GHC 9.10 (By Jan Hrček)++ * #482 Add `ConfigSearchStrategy` to allow avoiding `getCurrentDirectory`+ when loading config (by Jan Hrček)++ This is breaking API change that can be fixed like this:++ ```diff+ -format Nothing maybeFile contents+ +format SearchFromCurrentDirectory maybeFile contents++ -format (Just cfgFile) maybeFile content+ +format (UseConfig cfgFile) maybeFile content+ ```++ * Bump `Cabal` lower bound to 3.14+ - 0.14.6.0 (2024-01-19)- * #471 Support GHC 9.8 (by Michael Peyton Jones)- * #440 Fix dissappearing `DEPRECATED` pragma on module (by Lev Dvorkin)- * #464 Fix compilation issue with GHC 9.4+ * #471 Support GHC 9.8 (by Michael Peyton Jones)+ * #440 Fix dissappearing `DEPRECATED` pragma on module (by Lev Dvorkin)+ * #464 Fix compilation issue with GHC 9.4 - 0.14.5.0 (2023-06-23)- * #459 Support GHC 9.6 (by Michael Peyton Jones)- * #445 Default `ghc-lib` flag to True (by amesgen)+ * #459 Support GHC 9.6 (by Michael Peyton Jones)+ * #445 Default `ghc-lib` flag to True (by amesgen) - 0.14.4.0 (2023-01-09)- * #421 Support GHC 9.4 (by Lei Zhu)- * #439 Fix NoXyz extension issues for .cabal files (by Lev Dvorkin)- * #424 Deriving alignment for enums (by Lev Dvorkin)- * #416 Support Safe/Trustworthy/Unsafe extensions+ * #421 Support GHC 9.4 (by Lei Zhu)+ * #439 Fix NoXyz extension issues for .cabal files (by Lev Dvorkin)+ * #424 Deriving alignment for enums (by Lev Dvorkin)+ * #416 Support Safe/Trustworthy/Unsafe extensions - 0.14.3.0 (2022-09-28)- * Fix parsing of NoXyz extensions- * Bump `Cabal` upper bound to 4.0- * Add option to automatically group imports (by Tikhon Jelvis)+ * Fix parsing of NoXyz extensions+ * Bump `Cabal` upper bound to 4.0+ * Add option to automatically group imports (by Tikhon Jelvis) - 0.14.2.0 (2022-04-27) * Add a build flag to force the use of ghc-lib-parser
lib/Language/Haskell/Stylish.hs view
@@ -19,7 +19,7 @@ , module Language.Haskell.Stylish.Verbose , version , format- , ConfigPath(..)+ , ConfigSearchStrategy(..) , Lines , Step ) where@@ -105,14 +105,17 @@ runSteps exts mfp steps ls = foldM (runStep exts mfp) ls steps -newtype ConfigPath = ConfigPath { unConfigPath :: FilePath } --- |Formats given contents optionally using the config provided as first param.--- The second file path is the location from which the contents were read.--- If provided, it's going to be printed out in the error message.-format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Lines)-format maybeConfigPath maybeFilePath contents = do- conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath)+-- | Formats given contents.+format ::+ ConfigSearchStrategy+ -> Maybe FilePath+ -- ^ the location from which the contents to format were read.+ -- If provided, it's going to be printed out in the error message.+ -> String -- ^ the contents to format+ -> IO (Either String Lines)+format configSearchStrategy maybeFilePath contents = do+ conf <- loadConfig (makeVerbose True) configSearchStrategy pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents
lib/Language/Haskell/Stylish/Comments.hs view
@@ -61,7 +61,7 @@ commentsWithLines :: [(LineBlock, GHC.LEpaComment)] commentsWithLines = do comment <- allComments- let s = GHC.anchor $ GHC.getLoc comment+ let s = GHC.epaLocationRealSrcSpan $ GHC.getLoc comment pure (realSrcSpanToLineBlock s, comment) work
lib/Language/Haskell/Stylish/Config.hs view
@@ -6,6 +6,7 @@ module Language.Haskell.Stylish.Config ( Extensions , Config (..)+ , ConfigSearchStrategy (..) , ExitCodeBehavior (..) , defaultConfigBytes , configFilePath@@ -95,14 +96,17 @@ ---------------------------------------------------------------------------------configFilePath :: Verbose -> Maybe FilePath -> IO (Maybe FilePath)-configFilePath _ (Just userSpecified) = return (Just userSpecified)-configFilePath verbose Nothing = do- current <- getCurrentDirectory+configFilePath :: Verbose -> ConfigSearchStrategy -> IO (Maybe FilePath)+configFilePath _ (UseConfig userSpecified) = return (Just userSpecified)+configFilePath verbose (SearchFromDirectory dir) = searchFrom verbose dir+configFilePath verbose SearchFromCurrentDirectory = searchFrom verbose =<< getCurrentDirectory++searchFrom :: Verbose -> FilePath -> IO (Maybe FilePath)+searchFrom verbose startDir = do configPath <- getXdgDirectory XdgConfig "stylish-haskell"- home <- getHomeDirectory+ home <- getHomeDirectory search verbose $- [d </> configFileName | d <- ancestors current] +++ [d </> configFileName | d <- ancestors startDir] ++ [configPath </> "config.yaml", home </> configFileName] search :: Verbose -> [FilePath] -> IO (Maybe FilePath)@@ -114,16 +118,16 @@ if exists then return (Just f) else search verbose fs ---------------------------------------------------------------------------------loadConfig :: Verbose -> Maybe FilePath -> IO Config-loadConfig verbose userSpecified = do- mbFp <- configFilePath verbose userSpecified+loadConfig :: Verbose -> ConfigSearchStrategy -> IO Config+loadConfig verbose configSearchStrategy = do+ mbFp <- configFilePath verbose configSearchStrategy verbose $ "Loading configuration at " ++ fromMaybe "<embedded>" mbFp bytes <- maybe (return defaultConfigBytes) B.readFile mbFp case decode1Strict bytes of Left (pos, err) -> error $ prettyPosWithSource pos (fromStrict bytes) ("Language.Haskell.Stylish.Config.loadConfig: " ++ err) Right config -> do cabalLanguageExtensions <- if configCabal config- then map toStr <$> Cabal.findLanguageExtensions verbose+ then map toStr <$> Cabal.findLanguageExtensions verbose configSearchStrategy else pure [] return $ config
lib/Language/Haskell/Stylish/Config/Cabal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish.Config.Cabal ( findLanguageExtensions@@ -7,7 +8,6 @@ -------------------------------------------------------------------------------- import Control.Monad (unless) import qualified Data.ByteString.Char8 as BS-import Data.Either (isRight) import Data.Foldable (traverse_) import Data.List (nub) import Data.Maybe (maybeToList)@@ -15,39 +15,57 @@ import qualified Distribution.PackageDescription.Parsec as Cabal import qualified Distribution.Parsec as Cabal import qualified Distribution.Simple.Utils as Cabal+import qualified Distribution.Utils.Path as Cabal import qualified Distribution.Verbosity as Cabal+import GHC.Data.Maybe (mapMaybe) import qualified Language.Haskell.Extension as Language+import Language.Haskell.Stylish.Config.Internal import Language.Haskell.Stylish.Verbose import System.Directory (doesFileExist, getCurrentDirectory) ---------------------------------------------------------------------------------import Language.Haskell.Stylish.Config.Internal-import GHC.Data.Maybe (mapMaybe)------------------------------------------------------------------------------------findLanguageExtensions :: Verbose -> IO [(Language.KnownExtension, Bool)]-findLanguageExtensions verbose =- findCabalFile verbose >>=+findLanguageExtensions+ :: Verbose -> ConfigSearchStrategy -> IO [(Language.KnownExtension, Bool)]+findLanguageExtensions verbose configSearchStrategy =+ findCabalFile verbose configSearchStrategy >>= maybe (pure []) (readDefaultLanguageExtensions verbose) -------------------------------------------------------------------------------- -- | Find the closest .cabal file, possibly going up the directory structure.-findCabalFile :: Verbose -> IO (Maybe FilePath)-findCabalFile verbose = do- potentialProjectRoots <- ancestors <$> getCurrentDirectory- potentialCabalFile <- filter isRight <$>- traverse Cabal.findPackageDesc potentialProjectRoots- case potentialCabalFile of- [Right cabalFile] -> return (Just cabalFile)- _ -> do- verbose $ ".cabal file not found, directories searched: " <>- show potentialProjectRoots- verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."- return Nothing+findCabalFile :: Verbose -> ConfigSearchStrategy -> IO (Maybe FilePath)+findCabalFile verbose configSearchStrategy = case configSearchStrategy of+ -- If the invocation pointed us to a specific config file, it doesn't make+ -- much sense to search for cabal files manually (the config file could be+ -- somewhere like /etc, not necessarily a Haskell project).+ UseConfig _ -> pure Nothing+ SearchFromDirectory path -> go [] $ ancestors path+ SearchFromCurrentDirectory -> getCurrentDirectory >>= go [] . ancestors+ where+ go :: [FilePath] -> [FilePath] -> IO (Maybe FilePath)+ go searched [] = do+ verbose $ ".cabal file not found, directories searched: " <>+ show searched+ verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."+ return Nothing+ go searched (p : ps) = do++#if MIN_VERSION_Cabal(3,14,0)+ let projectRoot = Just $ Cabal.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 --------------------------------------------------------------------------------
lib/Language/Haskell/Stylish/Config/Internal.hs view
@@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- module Language.Haskell.Stylish.Config.Internal- ( ancestors+ ( ConfigSearchStrategy (..)+ , ancestors ) where @@ -13,3 +14,15 @@ -- All ancestors of a dir (including that dir) ancestors :: FilePath -> [FilePath] ancestors = map joinPath . reverse . dropWhile null . inits . splitPath+++--------------------------------------------------------------------------------+data ConfigSearchStrategy+ = -- | Don't try to search, just use given config file+ UseConfig FilePath+ | -- | Search for @.stylish-haskell.yaml@ starting from given directory.+ -- If not found, try all ancestor directories, @$XDG_CONFIG\/stylish-haskell\/config.yaml@ and @$HOME\/.stylish-haskell.yaml@ in order.+ -- If no config is found, default built-in config will be used.+ SearchFromDirectory FilePath+ | -- | Like SearchFromDirectory, but using current working directory as a starting point+ SearchFromCurrentDirectory
lib/Language/Haskell/Stylish/GHC.hs view
@@ -69,7 +69,7 @@ dropBeforeAndAfter loc = dropBeforeLocated (Just loc) . dropAfterLocated (Just loc) baseDynFlags :: GHC.DynFlags-baseDynFlags = defaultDynFlags GHCEx.fakeSettings +baseDynFlags = defaultDynFlags GHCEx.fakeSettings getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs] getConDecls d@GHC.HsDataDefn {} = case GHC.dd_cons d of@@ -80,13 +80,12 @@ showOutputable = GHC.showPpr baseDynFlags epAnnComments :: GHC.EpAnn a -> [GHC.LEpaComment]-epAnnComments GHC.EpAnnNotUsed = [] epAnnComments GHC.EpAnn {..} = priorAndFollowing comments deepAnnComments :: (Data a, Typeable a) => a -> [GHC.LEpaComment] deepAnnComments = everything (++) (mkQ [] priorAndFollowing) priorAndFollowing :: GHC.EpAnnComments -> [GHC.LEpaComment]-priorAndFollowing = sortOn (GHC.anchor . GHC.getLoc) . \case+priorAndFollowing = sortOn (GHC.epaLocationRealSrcSpan . GHC.getLoc) . \case GHC.EpaComments {..} -> priorComments GHC.EpaCommentsBalanced {..} -> priorComments ++ followingComments
lib/Language/Haskell/Stylish/Module.hs view
@@ -141,7 +141,7 @@ prag comment = case GHC.ac_tok (GHC.unLoc comment) of GHC.EpaBlockComment str | lang : p1 : ps <- tokenize str, map toLower lang == "language" ->- pure (GHC.anchor (GHC.getLoc comment), p1 :| ps)+ pure (GHC.epaLocationRealSrcSpan (GHC.getLoc comment), p1 :| ps) _ -> Nothing tokenize = words .
lib/Language/Haskell/Stylish/Ordering.hs view
@@ -45,12 +45,12 @@ -- constructors first, followed by functions, and then operators. ieKey :: IE GhcPs -> (Int, String) ieKey = \case- IEVar _ n -> nameKey n- IEThingAbs _ n -> nameKey n- IEThingAll _ n -> nameKey n- IEThingWith _ n _ _ -> nameKey n- IEModuleContents _ n -> nameKey n- _ -> (2, "")+ IEVar _ n _ -> nameKey n+ IEThingAbs _ n _ -> nameKey n+ IEThingAll _ n _ -> nameKey n+ IEThingWith _ n _ _ _ -> nameKey n+ IEModuleContents _ n -> nameKey n+ _ -> (2, "") --------------------------------------------------------------------------------
lib/Language/Haskell/Stylish/Printer.hs view
@@ -53,6 +53,7 @@ import GHC.Types.Name.Reader (RdrName (..)) import GHC.Types.SrcLoc (GenLocated (..)) import qualified GHC.Types.SrcLoc as GHC+import GHC.TypeLits (symbolVal) import GHC.Utils.Outputable (Outputable) --------------------------------------------------------------------------------@@ -61,7 +62,6 @@ asks, local) import Control.Monad.State (MonadState, State, get, gets, modify, put, runState)-import Data.List (foldl') -------------------------------------------------------------------------------- import Language.Haskell.Stylish.GHC (showOutputable)@@ -138,7 +138,6 @@ GHC.EpaLineComment s -> putText s GHC.EpaDocOptions s -> putText s GHC.EpaBlockComment s -> putText s- GHC.EpaEofComment -> pure () putMaybeLineComment :: Maybe GHC.EpaComment -> P () putMaybeLineComment = \case@@ -149,8 +148,7 @@ putRdrName :: GenLocated GHC.SrcSpanAnnN RdrName -> P () putRdrName rdrName = case GHC.unLoc rdrName of Unqual name -> do- let (pre, post) = nameAnnAdornments $- GHC.epAnnAnnsL $ GHC.ann $ GHC.getLoc rdrName+ let (pre, post) = nameAnnAdornment $ GHC.anns $ GHC.getLoc rdrName putText pre putText (showOutputable name) putText post@@ -161,26 +159,21 @@ Exact name -> putText (showOutputable name) -nameAnnAdornments :: [GHC.NameAnn] -> (String, String)-nameAnnAdornments = foldl'- (\(accl, accr) nameAnn ->- let (l, r) = nameAnnAdornment nameAnn in (accl ++ l, r ++ accr))- (mempty, mempty)- nameAnnAdornment :: GHC.NameAnn -> (String, String) nameAnnAdornment = \case- GHC.NameAnn {..} -> fromAdornment nann_adornment- GHC.NameAnnCommas {..} -> fromAdornment nann_adornment- GHC.NameAnnBars {..} -> fromAdornment nann_adornment- GHC.NameAnnOnly {..} -> fromAdornment nann_adornment+ GHC.NameAnn {GHC.nann_adornment = na} -> fromAdornment na+ GHC.NameAnnCommas {GHC.nann_adornment = na} -> fromAdornment na+ GHC.NameAnnBars {GHC.nann_parensh = (o, c)} -> fromAdornment (GHC.NameParensHash o c)+ GHC.NameAnnOnly {GHC.nann_adornment = na} -> fromAdornment na GHC.NameAnnRArrow {} -> (mempty, mempty) GHC.NameAnnQuote {} -> ("'", mempty) GHC.NameAnnTrailing {} -> (mempty, mempty) where- fromAdornment GHC.NameParens = ("(", ")")- fromAdornment GHC.NameBackquotes = ("`", "`")- fromAdornment GHC.NameParensHash = ("#(", "#)")- fromAdornment GHC.NameSquare = ("[", "]")+ fromAdornment (GHC.NameParens l r) = (symbolVal l, symbolVal r)+ fromAdornment (GHC.NameBackquotes l r) = (symbolVal l, symbolVal r)+ fromAdornment (GHC.NameParensHash l r) = (symbolVal l, symbolVal r)+ fromAdornment (GHC.NameSquare l r) = (symbolVal l, symbolVal r)+ fromAdornment GHC.NameNoAdornment = (mempty, mempty) -- | Print module name putModuleName :: GHC.ModuleName -> P ()@@ -206,7 +199,7 @@ (comma >> space) (fmap putType xs) putText "]"- GHC.HsExplicitTupleTy _ xs -> do+ GHC.HsExplicitTupleTy _ _ xs -> do putText "'(" sep (comma >> space)@@ -239,7 +232,7 @@ putOutputable ltp GHC.HsQualTy {} -> putOutputable ltp- GHC.HsAppKindTy _ _ _ _ ->+ GHC.HsAppKindTy _ _ _ -> putOutputable ltp GHC.HsListTy _ _ -> putOutputable ltp
lib/Language/Haskell/Stylish/Step/Data.hs view
@@ -93,15 +93,29 @@ changes :: Module -> Editor.Edits changes = foldMap (formatDataDecl cfg) . dataDecls + getComments :: GHC.RealSrcSpan -> GHC.SrcSpanAnnA -> [GHC.LEpaComment]+ getComments declSpan declAnnos=+ filter isAfterStart $ epAnnComments declAnnos+ where+ -- workaround to make sure we don't reprint a haddock+ -- comment before a data declaration after a data+ -- declaration+ isAfterStart :: GHC.LEpaComment -> Bool+ isAfterStart (GHC.L (GHC.EpaSpan (GHC.RealSrcSpan commentSpan _)) _) =+ GHC.srcSpanStartLine commentSpan >= GHC.srcSpanStartLine declSpan+ isAfterStart (GHC.L (GHC.EpaDelta (GHC.RealSrcSpan commentSpan _) _ _) _) =+ GHC.srcSpanStartLine commentSpan >= GHC.srcSpanStartLine declSpan+ isAfterStart _ = False+ dataDecls :: Module -> [DataDecl] dataDecls m = do ldecl <- GHC.hsmodDecls $ GHC.unLoc m- GHC.TyClD _ tycld <- pure $ GHC.unLoc ldecl- loc <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl+ (GHC.L declAnnos (GHC.TyClD _ tycld)) <- pure ldecl+ declSpan <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl case tycld of GHC.DataDecl {..} -> pure $ MkDataDecl- { dataComments = epAnnComments tcdDExt- , dataLoc = loc+ { dataComments = getComments declSpan declAnnos+ , dataLoc = declSpan , dataDeclName = tcdLName , dataTypeVars = tcdTyVars , dataDefn = tcdDataDefn@@ -330,7 +344,7 @@ GHC.ConDeclGADT {..} -> do -- Put argument to constructor first: case con_g_args of- GHC.PrefixConGADT _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names+ GHC.PrefixConGADT _ _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names GHC.RecConGADT _ _ -> error . mconcat $ [ "Language.Haskell.Stylish.Step.Data.putConstructor: " , "encountered a GADT with record constructors, not supported yet"@@ -350,7 +364,7 @@ GHC.HsOuterExplicit {..} -> hso_bndrs) forM_ con_mb_cxt $ putContext cfg case con_g_args of- GHC.PrefixConGADT scaledTys -> forM_ scaledTys $ \scaledTy -> do+ GHC.PrefixConGADT _ scaledTys -> forM_ scaledTys $ \scaledTy -> do putType $ GHC.hsScaledThing scaledTy space >> putText "->" >> space GHC.RecConGADT _ _ -> error . mconcat $@@ -384,7 +398,7 @@ let commented = commentGroups (GHC.srcSpanToRealSrcSpan . GHC.getLocA) (GHC.unLoc largs)- (epAnnComments . GHC.ann $ GHC.getLoc largs)+ (epAnnComments $ GHC.getLoc largs) forM_ (flagEnds commented) $ \(CommentGroup {..}, firstCommentGroup, _) -> do
lib/Language/Haskell/Stylish/Step/Imports.hs view
@@ -23,6 +23,7 @@ ) where --------------------------------------------------------------------------------+import Control.Applicative ((<|>)) import Control.Monad (forM_, void, when) import qualified Data.Aeson as A import Data.Foldable (toList)@@ -507,11 +508,11 @@ -------------------------------------------------------------------------------- printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()-printImport _ (GHC.IEVar _ name) = do+printImport _ (GHC.IEVar _ name _) = do printIeWrappedName name-printImport _ (GHC.IEThingAbs _ name) = do+printImport _ (GHC.IEThingAbs _ name _) = do printIeWrappedName name-printImport separateLists (GHC.IEThingAll _ name) = do+printImport separateLists (GHC.IEThingAll _ name _) = do printIeWrappedName name when separateLists space putText "(..)"@@ -519,7 +520,7 @@ putText "module" space putText . GHC.moduleNameString $ GHC.unLoc modu-printImport separateLists (GHC.IEThingWith _ name wildcard imps) = do+printImport separateLists (GHC.IEThingWith _ name wildcard imps _) = do printIeWrappedName name when separateLists space let ellipsis = case wildcard of@@ -637,24 +638,24 @@ prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs prepareInner = \case -- Simplify `A ()` to `A`.- GHC.IEThingWith x n GHC.NoIEWildcard [] -> GHC.IEThingAbs x n- GHC.IEThingWith x n w ns ->- GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns)+ GHC.IEThingWith x n GHC.NoIEWildcard [] md -> GHC.IEThingAbs (fst x) n md+ GHC.IEThingWith x n w ns md ->+ GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns) md ie -> ie -- Merge two import items, assuming they have the same name. ieMerge :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs -> Maybe (GHC.IE GHC.GhcPs)- ieMerge l@(GHC.IEVar _ _) _ = Just l- ieMerge _ r@(GHC.IEVar _ _) = Just r- ieMerge (GHC.IEThingAbs _ _) r = Just r- ieMerge l (GHC.IEThingAbs _ _) = Just l- ieMerge l@(GHC.IEThingAll _ _) _ = Just l- ieMerge _ r@(GHC.IEThingAll _ _) = Just r- ieMerge (GHC.IEThingWith x0 n0 w0 ns0) (GHC.IEThingWith _ _ w1 ns1)+ ieMerge l@(GHC.IEVar _ _ _) _ = Just l+ ieMerge _ r@(GHC.IEVar _ _ _) = Just r+ ieMerge (GHC.IEThingAbs _ _ _) r = Just r+ ieMerge l (GHC.IEThingAbs _ _ _) = Just l+ ieMerge l@(GHC.IEThingAll _ _ _) _ = Just l+ ieMerge _ r@(GHC.IEThingAll _ _ _) = Just r+ ieMerge (GHC.IEThingWith x0 n0 w0 ns0 me0) (GHC.IEThingWith _ _ w1 ns1 me1) | w0 /= w1 = Nothing | otherwise = Just $ -- TODO: sort the `ns0 ++ ns1`?- GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1)+ GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1) (me0 <|> me1) ieMerge _ _ = Nothing
lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs view
@@ -198,5 +198,5 @@ getMatchStrict :: GHC.Match GHC.GhcPs (GHC.LHsExpr GHC.GhcPs) -> [()] getMatchStrict (GHC.Match _ ctx _ _) = case ctx of- GHC.FunRhs _ _ GHC.SrcStrict -> [()]- _ -> []+ GHC.FunRhs _ _ GHC.SrcStrict _ -> [()]+ _ -> []
lib/Language/Haskell/Stylish/Step/ModuleHeader.hs view
@@ -81,18 +81,18 @@ loc <- GHC.getLocA <$> GHC.hsmodExports modul GHC.srcSpanEndLine <$> GHC.srcSpanToRealSrcSpan loc) - keywordLine kw = listToMaybe $ do+ keywordLine kw = do GHC.EpAnn {..} <- pure $ GHC.hsmodAnn $ GHC.hsmodExt modul- GHC.AddEpAnn kw' (GHC.EpaSpan s _) <- GHC.am_main anns- guard $ kw == kw'- pure $ GHC.srcSpanEndLine s+ case kw anns of+ GHC.EpTok (GHC.EpaSpan (GHC.RealSrcSpan s _)) -> Just . GHC.srcSpanEndLine $ s+ _ -> Nothing - moduleLine = keywordLine GHC.AnnModule- whereLine = keywordLine GHC.AnnWhere+ moduleLine = keywordLine GHC.am_mod+ whereLine = keywordLine GHC.am_where commentOnLine l = listToMaybe $ do comment <- epAnnComments $ GHC.hsmodAnn $ GHC.hsmodExt modul- guard $ GHC.srcSpanStartLine (GHC.anchor $ GHC.getLoc comment) == l+ guard $ GHC.srcSpanStartLine (GHC.epaLocationRealSrcSpan $ GHC.getLoc comment) == l pure comment moduleComment = moduleLine >>= commentOnLine@@ -104,7 +104,7 @@ Just lexports -> Just $ doSort $ commentGroups (GHC.srcSpanToRealSrcSpan . GHC.getLocA) (GHC.unLoc lexports)- (epAnnComments . GHC.ann $ GHC.getLoc lexports)+ (epAnnComments $ GHC.getLoc lexports) printedModuleHeader = runPrinter_ (PrinterConfig maxCols)@@ -152,7 +152,7 @@ attachModuleComment Single | [egroup] <- exports , not (commentGroupHasComments egroup)- , [(export, _)] <- (cgItems egroup) -> do+ , [(export, _)] <- cgItems egroup -> do printSingleLineExportList conf [export] attachModuleComment Inline | [] <- exports -> do
lib/Language/Haskell/Stylish/Step/SimpleAlign.hs view
@@ -112,7 +112,7 @@ matchToAlignable :: GHC.LocatedA (Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)) -> Maybe (Either (Alignable GHC.RealSrcSpan) (Alignable GHC.RealSrcSpan))-matchToAlignable (GHC.L matchLoc m@(Hs.Match _ Hs.CaseAlt pats@(_ : _) grhss)) = do+matchToAlignable (GHC.L matchLoc m@(Hs.Match _ Hs.CaseAlt (GHC.L _ pats@(_ : _)) grhss)) = do let patsLocs = map GHC.getLocA pats pat = last patsLocs guards = getGuards m@@ -128,7 +128,7 @@ , aRight = rightPos , aRightLead = length "-> " }-matchToAlignable (GHC.L matchLoc (Hs.Match _ (Hs.FunRhs name _ _) pats@(_ : _) grhss)) = do+matchToAlignable (GHC.L matchLoc (Hs.Match _ (Hs.FunRhs name _ _ _) (GHC.L _ pats@(_ : _)) grhss)) = do body <- unguardedRhsBody grhss let patsLocs = map GHC.getLocA pats nameLoc = GHC.getLocA name@@ -160,9 +160,9 @@ -------------------------------------------------------------------------------- grhsToAlignable- :: GHC.GenLocated (GHC.SrcSpanAnn' a) (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))+ :: GHC.GenLocated (GHC.EpAnnCO) (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)) -> Maybe (Alignable GHC.RealSrcSpan)-grhsToAlignable (GHC.L (GHC.SrcSpanAnn _ grhsloc) (Hs.GRHS _ guards@(_ : _) body)) = do+grhsToAlignable (GHC.L (GHC.EpAnn (GHC.EpaSpan grhsloc) _ _ ) (Hs.GRHS _ guards@(_ : _) body)) = do let guardsLocs = map GHC.getLocA guards bodyLoc = GHC.getLocA $ body left = foldl1' GHC.combineSrcSpans guardsLocs
lib/Language/Haskell/Stylish/Step/Squash.hs view
@@ -1,4 +1,5 @@ --------------------------------------------------------------------------------+{-# LANGUAGE DataKinds #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-}@@ -9,7 +10,6 @@ ---------------------------------------------------------------------------------import Data.Maybe (listToMaybe) import qualified GHC.Hs as GHC import qualified GHC.Types.SrcLoc as GHC @@ -45,10 +45,8 @@ ---------------------------------------------------------------------------------fieldDeclSeparator :: GHC.EpAnn [GHC.AddEpAnn]-> Maybe GHC.RealSrcSpan-fieldDeclSeparator GHC.EpAnn {..} = listToMaybe $ do- GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan s _) <- anns- pure s+fieldDeclSeparator :: GHC.EpUniToken "::" "\8759" -> Maybe GHC.RealSrcSpan+fieldDeclSeparator (GHC.EpUniTok (GHC.EpaSpan (GHC.RealSrcSpan s _)) _) = Just s fieldDeclSeparator _ = Nothing @@ -66,23 +64,23 @@ where match = GHC.unLoc lmatch mbLeft = case match of- GHC.Match _ (GHC.FunRhs name _ _) [] _ ->+ GHC.Match _ (GHC.FunRhs name _ _ _ ) (GHC.L _ []) _ -> GHC.srcSpanToRealSrcSpan $ GHC.getLocA name- GHC.Match _ _ pats@(_ : _) _ ->+ GHC.Match _ _ (GHC.L _ pats@(_ : _)) _ -> GHC.srcSpanToRealSrcSpan . GHC.getLocA $ last pats _ -> Nothing -------------------------------------------------------------------------------- matchSeparator :: GHC.EpAnn GHC.GrhsAnn -> Maybe GHC.RealSrcSpan-matchSeparator GHC.EpAnn {..}- | GHC.AddEpAnn _ (GHC.EpaSpan s _) <- GHC.ga_sep anns = Just s-matchSeparator _ = Nothing-+matchSeparator GHC.EpAnn {..} = case GHC.ga_sep anns of+ Left (GHC.EpTok (GHC.EpaSpan (GHC.RealSrcSpan s _))) -> Just s+ Right (GHC.EpUniTok (GHC.EpaSpan (GHC.RealSrcSpan s _)) _) -> Just s+ _ -> Nothing -------------------------------------------------------------------------------- step :: Step-step = makeStep "Squash" $ \ls (module') ->+step = makeStep "Squash" $ \ls module' -> let changes = foldMap squashFieldDecl (everything module') <> foldMap squashMatch (everything module') in
lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs view
@@ -20,19 +20,20 @@ -------------------------------------------------------------------------------- hsTyReplacements :: GHC.HsType GHC.GhcPs -> Editor.Edits hsTyReplacements (GHC.HsFunTy _ arr _ _)- | GHC.HsUnrestrictedArrow (GHC.L (GHC.TokenLoc epaLoc) GHC.HsNormalTok) <- arr=+ | GHC.HsUnrestrictedArrow (GHC.EpUniTok epaLoc GHC.NormalSyntax) <- arr = Editor.replaceRealSrcSpan (GHC.epaLocationRealSrcSpan epaLoc) "→" hsTyReplacements (GHC.HsQualTy _ ctx _)- | Just arrow <- GHC.ac_darrow . GHC.anns . GHC.ann $ GHC.getLoc ctx- , (GHC.NormalSyntax, GHC.EpaSpan loc _) <- arrow =+ | Just arrow <- GHC.ac_darrow . GHC.anns $ GHC.getLoc ctx+ , (GHC.EpUniTok (GHC.EpaSpan (GHC.RealSrcSpan loc _)) GHC.NormalSyntax) <- arrow = Editor.replaceRealSrcSpan loc "⇒" hsTyReplacements _ = mempty + -------------------------------------------------------------------------------- hsSigReplacements :: GHC.Sig GHC.GhcPs -> Editor.Edits hsSigReplacements (GHC.TypeSig ann _ _)- | GHC.AddEpAnn GHC.AnnDcolon epaLoc <- GHC.asDcolon $ GHC.anns ann- , GHC.EpaSpan loc _ <- epaLoc =+ | GHC.EpUniTok epaLoc _ <- GHC.asDcolon ann+ , GHC.EpaSpan (GHC.RealSrcSpan loc _) <- epaLoc = Editor.replaceRealSrcSpan loc "∷" hsSigReplacements _ = mempty
src/Main.hs view
@@ -14,10 +14,6 @@ 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@@ -108,7 +104,8 @@ BC8.putStr defaultConfigBytes else do- conf <- loadConfig verbose' (saConfig sa)+ conf <- loadConfig verbose' $+ maybe SearchFromCurrentDirectory UseConfig (saConfig sa) filesR <- case (saRecursive sa) of True -> findHaskellFiles (saVerbose sa) (saFiles sa) _ -> return $ saFiles sa
stylish-haskell.cabal view
@@ -1,6 +1,6 @@ Cabal-version: 2.4 Name: stylish-haskell-Version: 0.14.6.0+Version: 0.15.1.0 Synopsis: Haskell code prettifier Homepage: https://github.com/haskell/stylish-haskell License: BSD-3-Clause@@ -19,10 +19,12 @@ <https://github.com/haskell/stylish-haskell/blob/master/README.markdown> Extra-source-files:- CHANGELOG, README.markdown, data/stylish-haskell.yaml +Extra-doc-files:+ CHANGELOG+ Flag ghc-lib Default: True Manual: True@@ -35,12 +37,12 @@ Build-depends: aeson >= 0.6 && < 2.3,- base >= 4.8 && < 5,+ base >= 4.19 && < 5, bytestring >= 0.9 && < 0.13,- Cabal >= 3.4 && < 4.0,- containers >= 0.3 && < 0.7,+ Cabal >= 3.10 && < 4.0,+ containers >= 0.3 && < 0.9, directory >= 1.2.3 && < 1.4,- filepath >= 1.1 && < 1.5,+ filepath >= 1.1 && < 1.6, file-embed >= 0.0.10 && < 0.1, mtl >= 2.0 && < 2.4, regex-tdfa >= 1.3 && < 1.4,@@ -54,20 +56,20 @@ semigroups >= 0.18 && < 0.20 -- Use GHC if the ghc-lib flag is not set- -- and we have a new enough GHC. Note that - -- this will only work if the user's + -- and we have a new enough GHC. Note that+ -- this will only work if the user's -- compiler is of the matching major version!- if !flag(ghc-lib) && impl(ghc >= 9.8) && impl(ghc < 9.9)+ if !flag(ghc-lib) && impl(ghc >= 9.8) && impl(ghc < 9.13) Build-depends:- ghc >= 9.8 && < 9.9,+ ghc >= 9.12 && < 9.13, ghc-boot, ghc-boot-th else Build-depends:- ghc-lib-parser >= 9.8 && < 9.9+ ghc-lib-parser >= 9.12 && < 9.13 Build-depends:- ghc-lib-parser-ex >= 9.8 && < 9.9+ ghc-lib-parser-ex >= 9.12 && < 9.13 Library Import: depends
tests/Language/Haskell/Stylish/Config/Tests.hs view
@@ -96,7 +96,7 @@ setCurrentDirectory "src" -- from that directory read the config file and extract extensions -- to make sure the search for .cabal file works- loadConfig (const (pure ())) Nothing+ loadConfig (const (pure ())) SearchFromCurrentDirectory --------------------------------------------------------------------------------
tests/Language/Haskell/Stylish/Tests.hs view
@@ -35,7 +35,7 @@ -------------------------------------------------------------------------------- case01 :: Assertion-case01 = (@?= result) =<< format Nothing Nothing input+case01 = (@?= result) =<< format SearchFromCurrentDirectory Nothing input where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" result = Right $ lines input@@ -54,7 +54,7 @@ , " via: \"indent 2\"" ] - actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input+ actual <- format (UseConfig "test-config.yaml") Nothing input actual @?= result where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }"@@ -79,7 +79,7 @@ , " via: \"indent 2\"" ] - actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input+ actual <- format (UseConfig "test-config.yaml") Nothing input actual @?= result where input = unlines [ "module Herp where"@@ -98,7 +98,7 @@ -------------------------------------------------------------------------------- case04 :: Assertion-case04 = format Nothing (Just fileLocation) input >>= \case+case04 = format SearchFromCurrentDirectory (Just fileLocation) input >>= \case Right _ -> assertFailure "expected error" Left err | fileLocation `isInfixOf` err