stylish-haskell 0.14.3.0 → 0.14.4.0
raw patch · 19 files changed
+261/−158 lines, 19 filesdep ~aesondep ~ghcdep ~ghc-lib-parser
Dependency ranges changed: aeson, ghc, ghc-lib-parser, ghc-lib-parser-ex, text
Files
- CHANGELOG +6/−0
- lib/Language/Haskell/Stylish/Config.hs +4/−3
- lib/Language/Haskell/Stylish/Config/Cabal.hs +35/−13
- lib/Language/Haskell/Stylish/Module.hs +3/−0
- lib/Language/Haskell/Stylish/Ordering.hs +11/−11
- lib/Language/Haskell/Stylish/Parse.hs +35/−16
- lib/Language/Haskell/Stylish/Printer.hs +7/−9
- lib/Language/Haskell/Stylish/Step/Data.hs +8/−7
- lib/Language/Haskell/Stylish/Step/Imports.hs +7/−5
- lib/Language/Haskell/Stylish/Step/ModuleHeader.hs +2/−4
- lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +6/−6
- lib/Language/Haskell/Stylish/Step/Squash.hs +1/−1
- lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs +1/−1
- lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +4/−6
- lib/Language/Haskell/Stylish/Util.hs +5/−5
- stylish-haskell.cabal +8/−8
- tests/Language/Haskell/Stylish/Config/Tests.hs +93/−60
- tests/Language/Haskell/Stylish/Parse/Tests.hs +9/−1
- tests/Language/Haskell/Stylish/Step/Data/Tests.hs +16/−2
CHANGELOG view
@@ -1,5 +1,11 @@ # CHANGELOG +- 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+ - 0.14.3.0 (2022-09-28) * Fix parsing of NoXyz extensions * Bump `Cabal` upper bound to 4.0
lib/Language/Haskell/Stylish/Config.hs view
@@ -123,14 +123,15 @@ Left (pos, err) -> error $ prettyPosWithSource pos (fromStrict bytes) ("Language.Haskell.Stylish.Config.loadConfig: " ++ err) Right config -> do cabalLanguageExtensions <- if configCabal config- then map show <$> Cabal.findLanguageExtensions verbose+ then map toStr <$> Cabal.findLanguageExtensions verbose else pure [] return $ config { configLanguageExtensions = nub $ configLanguageExtensions config ++ cabalLanguageExtensions }-+ where toStr (ext, True) = show ext+ toStr (ext, False) = "No" ++ show ext -------------------------------------------------------------------------------- parseConfig :: A.Value -> A.Parser Config@@ -264,7 +265,7 @@ A.String "same_line" -> return Data.SameLine A.String t | "indent " `T.isPrefixOf` t -> case readMaybe (T.unpack $ T.drop 7 t) of- Just n -> return $ Data.Indent n+ Just n -> return $ Data.Indent n Nothing -> fail $ "Indent: not a number" <> T.unpack (T.drop 7 t) A.String t -> fail $ "can't parse indent setting: " <> T.unpack t _ -> fail "Expected string for indent value"
lib/Language/Haskell/Stylish/Config/Cabal.hs view
@@ -5,24 +5,30 @@ --------------------------------------------------------------------------------+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) import qualified Distribution.PackageDescription as Cabal import qualified Distribution.PackageDescription.Parsec as Cabal+import qualified Distribution.Parsec as Cabal import qualified Distribution.Simple.Utils as Cabal import qualified Distribution.Verbosity as Cabal import qualified Language.Haskell.Extension as Language import Language.Haskell.Stylish.Verbose-import System.Directory (getCurrentDirectory)+import System.Directory (doesFileExist,+ getCurrentDirectory) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Config.Internal+import GHC.Data.Maybe (mapMaybe) ---------------------------------------------------------------------------------findLanguageExtensions :: Verbose -> IO [Language.KnownExtension]+findLanguageExtensions :: Verbose -> IO [(Language.KnownExtension, Bool)] findLanguageExtensions verbose = findCabalFile verbose >>= maybe (pure []) (readDefaultLanguageExtensions verbose)@@ -46,10 +52,10 @@ -------------------------------------------------------------------------------- -- | Extract @default-extensions@ fields from a @.cabal@ file-readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension]+readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [(Language.KnownExtension, Bool)] readDefaultLanguageExtensions verbose cabalFile = do verbose $ "Parsing " <> cabalFile <> "..."- packageDescription <- Cabal.readGenericPackageDescription Cabal.silent cabalFile+ packageDescription <- readGenericPackageDescription Cabal.silent cabalFile let library :: [Cabal.Library] library = maybeToList $ fst . Cabal.ignoreConditions <$> Cabal.condLibrary packageDescription@@ -77,15 +83,31 @@ map Cabal.testBuildInfo testSuites <> map Cabal.benchmarkBuildInfo benchmarks - defaultExtensions :: [Language.KnownExtension]- defaultExtensions = map fromEnabled . filter isEnabled $+ defaultExtensions :: [(Language.KnownExtension, Bool)]+ defaultExtensions = mapMaybe toPair $ concatMap Cabal.defaultExtensions gatherBuildInfos- where isEnabled (Language.EnableExtension _) = True- isEnabled _ = False-- fromEnabled (Language.EnableExtension x) = x- fromEnabled x =- error $ "Language.Haskell.Stylish.Config.readLanguageExtensions: " <>- "invalid LANGUAGE pragma: " <> show x+ where toPair (Language.EnableExtension x) = Just (x, True)+ toPair (Language.DisableExtension x) = Just (x, False)+ toPair _ = Nothing verbose $ "Gathered default-extensions: " <> show defaultExtensions pure $ nub defaultExtensions++readGenericPackageDescription :: Cabal.Verbosity -> FilePath -> IO Cabal.GenericPackageDescription+readGenericPackageDescription = readAndParseFile Cabal.parseGenericPackageDescription+ where+ readAndParseFile parser verbosity fpath = do+ exists <- doesFileExist fpath+ unless exists $+ Cabal.die' verbosity $+ "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue."+ bs <- BS.readFile fpath+ parseString parser verbosity fpath bs++ parseString parser verbosity name bs = do+ let (warnings, result) = Cabal.runParseResult (parser bs)+ traverse_ (Cabal.warn verbosity . Cabal.showPWarning name) warnings+ case result of+ Right x -> return x+ Left (_, errors) -> do+ traverse_ (Cabal.warn verbosity . Cabal.showPError name) errors+ Cabal.die' verbosity $ "Failed parsing \"" ++ name ++ "\"."
lib/Language/Haskell/Stylish/Module.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} module Language.Haskell.Stylish.Module ( -- * Data types@@ -37,6 +38,7 @@ ImportDeclQualifiedStyle (..)) import qualified GHC.Hs as GHC import GHC.Hs.Extension (GhcPs)+import qualified GHC.Types.PkgQual as GHC import GHC.Types.SrcLoc (GenLocated (..), RealSrcSpan (..), unLoc) import qualified GHC.Types.SrcLoc as GHC@@ -50,6 +52,7 @@ -------------------------------------------------------------------------------- type Lines = [String] +deriving instance Eq GHC.RawPkgQual -------------------------------------------------------------------------------- -- | Concrete module type
lib/Language/Haskell/Stylish/Ordering.hs view
@@ -12,16 +12,16 @@ ---------------------------------------------------------------------------------import Data.Char (isUpper, toLower)-import Data.Function (on)-import Data.Ord (comparing)+import Data.Char (isUpper, toLower)+import Data.Function (on)+import Data.Ord (comparing) import GHC.Hs-import qualified GHC.Hs as GHC-import GHC.Types.Name.Reader (RdrName)-import GHC.Types.SrcLoc (unLoc)-import GHC.Utils.Outputable (Outputable)-import qualified GHC.Utils.Outputable as GHC-import Language.Haskell.Stylish.GHC (showOutputable)+import qualified GHC.Hs as GHC+import GHC.Types.Name.Reader (RdrName)+import GHC.Types.SrcLoc (unLoc)+import GHC.Utils.Outputable (Outputable)+import qualified GHC.Utils.Outputable as GHC+import Language.Haskell.Stylish.GHC (showOutputable) --------------------------------------------------------------------------------@@ -31,8 +31,8 @@ :: GHC.ImportDecl GHC.GhcPs -> GHC.ImportDecl GHC.GhcPs -> Ordering compareImports i0 i1 = ideclName i0 `compareOutputableCI` ideclName i1 <>- fmap showOutputable (ideclPkgQual i0) `compare`- fmap showOutputable (ideclPkgQual i1) <>+ showOutputable (ideclPkgQual i0) `compare`+ showOutputable (ideclPkgQual i1) <> compareOutputableCI i0 i1
lib/Language/Haskell/Stylish/Parse.hs view
@@ -5,21 +5,23 @@ --------------------------------------------------------------------------------+import Data.Char (toLower) import Data.List (foldl', stripPrefix)-import Data.Maybe (fromMaybe,+import Data.Maybe (catMaybes,+ fromMaybe, listToMaybe, mapMaybe)+import Data.Traversable (for) import qualified GHC.Data.StringBuffer as GHC+import qualified GHC.Driver.Config.Parser as GHC import GHC.Driver.Ppr as GHC import qualified GHC.Driver.Session as GHC import qualified GHC.LanguageExtensions.Type as LangExt-import qualified GHC.Parser.Errors.Ppr as GHC import qualified GHC.Parser.Header as GHC import qualified GHC.Parser.Lexer as GHC import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Utils.Error as GHC-import qualified GHC.Utils.Outputable as GHC import qualified Language.Haskell.GhclibParserEx.GHC.Driver.Session as GHCEx import qualified Language.Haskell.GhclibParserEx.GHC.Parser as GHCEx @@ -34,15 +36,30 @@ ---------------------------------------------------------------------------------parseExtension :: String -> Either String (LangExt.Extension, Bool)-parseExtension str = case GHCEx.readExtension str of- Just e -> Right (e, True)- Nothing -> case str of- 'N' : 'o' : str' -> fmap not <$> parseExtension str'- _ -> Left $ "Unknown extension: " ++ show str+data ParseExtensionResult+ -- | Actual extension, and whether we want to turn it on or off.+ = ExtensionOk LangExt.Extension Bool+ -- | Failed to parse extension.+ | ExtensionError String+ -- | Other LANGUAGE things that aren't really extensions, like 'Safe'.+ | ExtensionIgnore --------------------------------------------------------------------------------+parseExtension :: String -> ParseExtensionResult+parseExtension str+ | Just x <- GHCEx.readExtension str = ExtensionOk x True+ | 'N' : 'o' : str' <- str = case parseExtension str' of+ ExtensionOk x onOff -> ExtensionOk x (not onOff)+ result -> result+ | map toLower str `elem` ignores = ExtensionIgnore+ | otherwise = ExtensionError $+ "Unknown extension: " ++ show str+ where+ ignores = ["unsafe", "trustworthy", "safe"]+++-------------------------------------------------------------------------------- -- | Filter out lines which use CPP macros unCpp :: String -> String unCpp = unlines . go False . lines@@ -67,20 +84,23 @@ parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module parseModule externalExts0 fp string = do -- Parse extensions.- externalExts1 <- traverse parseExtension externalExts0+ externalExts1 <- fmap catMaybes . for externalExts0 $ \str -> case parseExtension str of+ ExtensionError err -> Left err+ ExtensionIgnore -> pure Nothing+ ExtensionOk x onOff -> pure $ Just (x, onOff) -- Build first dynflags. let dynFlags0 = foldl' toggleExt baseDynFlags externalExts1 -- Parse options from file- let fileOptions = fmap GHC.unLoc $ GHC.getOptions dynFlags0+ let fileOptions = fmap GHC.unLoc $ snd $ GHC.getOptions (GHC.initParserOpts dynFlags0) (GHC.stringToStringBuffer string) (fromMaybe "-" fp) fileExtensions = mapMaybe (\str -> do str' <- stripPrefix "-X" str case parseExtension str' of- Left _ -> Nothing- Right x -> pure x)+ ExtensionOk x onOff -> Just (x, onOff)+ _ -> Nothing) fileOptions -- Set further dynflags.@@ -94,9 +114,8 @@ -- Actual parse. case GHCEx.parseModule input dynFlags1 of GHC.POk _ m -> Right m- GHC.PFailed ps -> Left . withFileName . GHC.showSDoc dynFlags1 .- GHC.vcat . GHC.pprMsgEnvelopeBagWithLoc . fmap GHC.pprError . snd $- GHC.getMessages ps+ GHC.PFailed ps -> Left . withFileName . GHC.showSDoc dynFlags1 . GHC.pprMessages . snd $+ GHC.getPsMessages ps where withFileName x = maybe "" (<> ": ") fp <> x
lib/Language/Haskell/Stylish/Printer.hs view
@@ -136,14 +136,11 @@ -- | Print any comment putComment :: GHC.EpaComment -> P () putComment epaComment = case GHC.ac_tok epaComment of- GHC.EpaLineComment s -> putText s- GHC.EpaDocCommentNext s -> putText s- GHC.EpaDocCommentPrev s -> putText s- GHC.EpaDocCommentNamed s -> putText s- GHC.EpaDocSection _ s -> putText s- GHC.EpaDocOptions s -> putText s- GHC.EpaBlockComment s -> putText s- GHC.EpaEofComment -> pure ()+ GHC.EpaDocComment hs -> putText $ show hs+ 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@@ -176,6 +173,7 @@ nameAnnAdornment = \case GHC.NameAnn {..} -> fromAdornment nann_adornment GHC.NameAnnCommas {..} -> fromAdornment nann_adornment+ GHC.NameAnnBars {..} -> fromAdornment nann_adornment GHC.NameAnnOnly {..} -> fromAdornment nann_adornment GHC.NameAnnRArrow {} -> (mempty, mempty) GHC.NameAnnQuote {} -> ("'", mempty)@@ -216,7 +214,7 @@ (comma >> space) (fmap putType xs) putText ")"- GHC.HsOpTy _ lhs op rhs -> do+ GHC.HsOpTy _ _ lhs op rhs -> do putType lhs space putRdrName op
lib/Language/Haskell/Stylish/Step/Data.hs view
@@ -196,8 +196,9 @@ let derivingComments = deepAnnComments (GHC.dd_derivs defn) when (hasDeriving decl) do- if onelineEnum && null derivingComments then- space+ if onelineEnum && null derivingComments then do+ newline+ spaces cDeriving else do forM_ derivingComments $ \lc -> do newline@@ -329,7 +330,7 @@ -- Put argument to constructor first: case con_g_args of GHC.PrefixConGADT _ -> sep (comma >> space) $ fmap putRdrName con_names- GHC.RecConGADT _ -> error . mconcat $+ GHC.RecConGADT _ _ -> error . mconcat $ [ "Language.Haskell.Stylish.Step.Data.putConstructor: " , "encountered a GADT with record constructors, not supported yet" ]@@ -351,7 +352,7 @@ GHC.PrefixConGADT scaledTys -> forM_ scaledTys $ \scaledTy -> do putType $ GHC.hsScaledThing scaledTy space >> putText "->" >> space- GHC.RecConGADT _ -> error . mconcat $+ GHC.RecConGADT _ _ -> error . mconcat $ [ "Language.Haskell.Stylish.Step.Data.putConstructor: " , "encountered a GADT with record constructors, not supported yet" ]@@ -370,7 +371,7 @@ GHC.PrefixCon _tyargs args -> do putRdrName con_name unless (null args) space- sep space (fmap putOutputable args)+ sep space (fmap (putOutputable . GHC.hsScaledThing) args) GHC.RecCon largs | _ : _ <- GHC.unLoc largs -> do putRdrName con_name skipToBrace@@ -441,7 +442,7 @@ putRdrName con_name >> case con_args of GHC.PrefixCon _ args -> do unless (null args) space- sep space (fmap putOutputable args)+ sep space (fmap (putOutputable . GHC.hsScaledThing) args) GHC.RecCon largs | [firstArg] <- GHC.unLoc largs -> do space putText "{"@@ -514,7 +515,7 @@ space putType' cfg tp GHC.HsQualTy GHC.NoExtField ctx tp -> do- forM_ ctx $ putContext cfg+ putContext cfg ctx putType' cfg tp _ -> putType lty
lib/Language/Haskell/Stylish/Step/Imports.hs view
@@ -41,12 +41,13 @@ import qualified GHC.Data.FastString as GHC import qualified GHC.Hs as GHC import qualified GHC.Types.Name.Reader as GHC+import qualified GHC.Types.PkgQual as GHC import qualified GHC.Types.SourceText as GHC import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Unit.Module.Name as GHC import qualified GHC.Unit.Types as GHC-import Text.Regex.TDFA (Regex) import qualified Text.Regex.TDFA as Regex+import Text.Regex.TDFA (Regex) import Text.Regex.TDFA.ReadRegex (parseRegex) --------------------------------------------------------------------------------@@ -358,8 +359,9 @@ let module_ = do moduleNamePosition <- length <$> getCurrentLine- forM_ (GHC.ideclPkgQual decl) $ \pkg ->- putText (stringLiteral pkg) >> space+ case GHC.ideclPkgQual decl of+ GHC.NoRawPkgQual -> pure ()+ GHC.RawPkgQual pkg -> putText (stringLiteral pkg) >> space putText (importModuleName decl) -- Only print spaces if something follows.@@ -584,8 +586,8 @@ importModuleNameLength :: GHC.ImportDecl GHC.GhcPs -> Int importModuleNameLength imp = (case GHC.ideclPkgQual imp of- Nothing -> 0- Just sl -> 1 + length (stringLiteral sl)) ++ GHC.NoRawPkgQual -> 0+ GHC.RawPkgQual sl -> 1 + length (stringLiteral sl)) + (length $ importModuleName imp)
lib/Language/Haskell/Stylish/Step/ModuleHeader.hs view
@@ -69,7 +69,6 @@ printModuleHeader maxCols conf ls lmodul = let modul = GHC.unLoc lmodul name = GHC.unLoc <$> GHC.hsmodName modul- haddocks = GHC.hsmodHaddockModHeader modul startLine = fromMaybe 1 $ moduleLine <|> (fmap GHC.srcSpanStartLine . GHC.srcSpanToRealSrcSpan $@@ -108,7 +107,7 @@ printedModuleHeader = runPrinter_ (PrinterConfig maxCols) (printHeader- conf name exportGroups haddocks moduleComment whereComment)+ conf name exportGroups moduleComment whereComment) changes = Editor.changeLines (Editor.Block startLine endLine)@@ -122,11 +121,10 @@ :: Config -> Maybe GHC.ModuleName -> Maybe [CommentGroup (GHC.LIE GHC.GhcPs)]- -> Maybe GHC.LHsDocString -> Maybe GHC.LEpaComment -- Comment attached to 'module' -> Maybe GHC.LEpaComment -- Comment attached to 'where' -> P ()-printHeader conf mbName mbExps _ mbModuleComment mbWhereComment = do+printHeader conf mbName mbExps mbModuleComment mbWhereComment = do forM_ mbName $ \name -> do putText "module" space
lib/Language/Haskell/Stylish/Step/SimpleAlign.hs view
@@ -15,13 +15,13 @@ import Data.List (foldl', foldl1', sortOn) import Data.Maybe (fromMaybe) import qualified GHC.Hs as Hs-import qualified GHC.Parser.Annotation as GHC-import qualified GHC.Types.SrcLoc as GHC+import qualified GHC.Parser.Annotation as GHC+import qualified GHC.Types.SrcLoc as GHC -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Align-import qualified Language.Haskell.Stylish.Editor as Editor+import qualified Language.Haskell.Stylish.Editor as Editor import Language.Haskell.Stylish.Module import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util@@ -88,7 +88,7 @@ :: GHC.LocatedA (Hs.ConDeclField Hs.GhcPs) -> Maybe (Alignable GHC.RealSrcSpan) fieldDeclToAlignable (GHC.L matchLoc (Hs.ConDeclField _ names ty _)) = do matchPos <- GHC.srcSpanToRealSrcSpan $ GHC.locA matchLoc- leftPos <- GHC.srcSpanToRealSrcSpan $ GHC.getLoc $ last names+ leftPos <- GHC.srcSpanToRealSrcSpan $ GHC.getLocA $ last names tyPos <- GHC.srcSpanToRealSrcSpan $ GHC.getLocA ty Just $ Alignable { aContainer = matchPos@@ -162,9 +162,9 @@ -------------------------------------------------------------------------------- grhsToAlignable- :: GHC.Located (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))+ :: GHC.GenLocated (GHC.SrcSpanAnn' a) (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)) -> Maybe (Alignable GHC.RealSrcSpan)-grhsToAlignable (GHC.L grhsloc (Hs.GRHS _ guards@(_ : _) body)) = do+grhsToAlignable (GHC.L (GHC.SrcSpanAnn _ 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
@@ -37,7 +37,7 @@ -------------------------------------------------------------------------------- squashFieldDecl :: GHC.ConDeclField GHC.GhcPs -> Editor.Edits squashFieldDecl (GHC.ConDeclField ext names@(_ : _) type' _)- | Just left <- GHC.srcSpanToRealSrcSpan . GHC.getLoc $ last names+ | Just left <- GHC.srcSpanToRealSrcSpan . GHC.getLocA $ last names , Just sep <- fieldDeclSeparator ext , Just right <- GHC.srcSpanToRealSrcSpan $ GHC.getLocA type' = squash left sep <> squash sep right
lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs view
@@ -5,7 +5,7 @@ ---------------------------------------------------------------------------------import Data.Char (isSpace)+import Data.Char (isSpace) --------------------------------------------------------------------------------
lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs view
@@ -19,16 +19,14 @@ -------------------------------------------------------------------------------- hsTyReplacements :: GHC.HsType GHC.GhcPs -> Editor.Edits-hsTyReplacements (GHC.HsFunTy xann arr _ _)- | GHC.HsUnrestrictedArrow GHC.NormalSyntax <- arr- , GHC.AddRarrowAnn (GHC.EpaSpan loc) <- GHC.anns xann =- Editor.replaceRealSrcSpan loc "→"-hsTyReplacements (GHC.HsQualTy _ (Just ctx) _)+hsTyReplacements (GHC.HsFunTy _ arr _ _)+ | GHC.HsUnrestrictedArrow (GHC.L (GHC.TokenLoc epaLoc) GHC.HsNormalTok) <- 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 = Editor.replaceRealSrcSpan loc "⇒" hsTyReplacements _ = mempty- -------------------------------------------------------------------------------- hsSigReplacements :: GHC.Sig GHC.GhcPs -> Editor.Edits
lib/Language/Haskell/Stylish/Util.hs view
@@ -37,13 +37,13 @@ import Data.Typeable (cast) import Debug.Trace (trace) import qualified GHC.Hs as Hs-import qualified GHC.Types.SrcLoc as GHC-import qualified GHC.Utils.Outputable as GHC+import qualified GHC.Types.SrcLoc as GHC+import qualified GHC.Utils.Outputable as GHC --------------------------------------------------------------------------------+import Language.Haskell.Stylish.GHC (showOutputable) import Language.Haskell.Stylish.Step-import Language.Haskell.Stylish.GHC (showOutputable) --------------------------------------------------------------------------------@@ -202,8 +202,8 @@ -- first and last element. flagEnds :: [a] -> [(a, Bool, Bool)] flagEnds = \case- [] -> []- [x] -> [(x, True, True)]+ [] -> []+ [x] -> [(x, True, True)] x : y : zs -> (x, True, False) : go (y : zs) where go (x : y : zs) = (x, False, False) : go (y : zs)
stylish-haskell.cabal view
@@ -1,6 +1,6 @@ Cabal-version: 2.4 Name: stylish-haskell-Version: 0.14.3.0+Version: 0.14.4.0 Synopsis: Haskell code prettifier Homepage: https://github.com/haskell/stylish-haskell License: BSD-3-Clause@@ -34,7 +34,7 @@ Default-language: Haskell2010 Build-depends:- aeson >= 0.6 && < 2.1,+ aeson >= 0.6 && < 2.2, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.12, Cabal >= 3.4 && < 4.0,@@ -45,25 +45,25 @@ mtl >= 2.0 && < 2.3, regex-tdfa >= 1.3 && < 1.4, syb >= 0.3 && < 0.8,- text >= 1.2 && < 1.3,+ text >= 1.2 && < 2.1, HsYAML-aeson >=0.2.0 && < 0.3,- HsYAML >=0.2.0 && < 0.3+ HsYAML >=0.2.0 && < 0.3, if impl(ghc < 8.0) Build-depends: semigroups >= 0.18 && < 0.20 - if impl(ghc >= 9.2.2) && (!flag(ghc-lib))+ if impl(ghc >= 9.4.1) && (!flag(ghc-lib)) Build-depends:- ghc >= 9.2 && < 9.3,+ ghc >= 9.4 && < 9.5, ghc-boot, ghc-boot-th else Build-depends:- ghc-lib-parser >= 9.2 && < 9.3+ ghc-lib-parser >= 9.4 && < 9.5 Build-depends:- ghc-lib-parser-ex >= 9.2.0.3 && < 9.3+ ghc-lib-parser-ex >= 9.4 && < 9.5 Library Import: depends
tests/Language/Haskell/Stylish/Config/Tests.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} module Language.Haskell.Stylish.Config.Tests ( tests ) where@@ -11,7 +12,7 @@ import System.Directory import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, assert, (@?=))+import Test.HUnit (Assertion, (@?=)) --------------------------------------------------------------------------------@@ -28,6 +29,10 @@ testExtensionsFromDotStylish , testCase "Extensions extracted correctly from .stylish-haskell.yaml and .cabal files" testExtensionsFromBoth+ , testCase "NoXyz extensions from .stylish-haskell.yaml file"+ testStylishNoXyz+ , testCase "NoXyz extensions from .cabal file"+ testCabalNoXyz , testCase "Correctly read .stylish-haskell.yaml file with default max column number" testDefaultColumns , testCase "Correctly read .stylish-haskell.yaml file with specified max column number"@@ -39,75 +44,105 @@ ] + --------------------------------------------------------------------------------+type ExtensionName = String++data ConfigFile = ConfigFile+ { fileName :: FilePath+ , contents :: String+ , extensions :: [ExtensionName]+ }++stylishCfg :: ([ExtensionName] -> String) -> [ExtensionName] -> ConfigFile+stylishCfg template exts = ConfigFile+ { fileName = ".stylish-haskell.yaml"+ , contents = template exts+ , extensions = exts+ }++cabalCfg :: ([ExtensionName] -> [ExtensionName] -> String) ->+ [ExtensionName] -> [ExtensionName] -> ConfigFile+cabalCfg template exts1 exts2 = ConfigFile+ { fileName = "test.cabal"+ , contents = template exts1 exts2+ , extensions = exts1 ++ exts2+ }+++--------------------------------------------------------------------------------+testExtensions :: [ConfigFile] -> Assertion+testExtensions cfgFiles = do+ cfg' <- createFilesAndGetConfig cfgFiles+ let expected = Set.fromList (concatMap extensions cfgFiles)+ actual = Set.fromList (configLanguageExtensions cfg')+ actual @?= expected++testColumns :: Maybe Int -> [ConfigFile] -> Assertion+testColumns expected cfgFiles = do+ cfg' <- createFilesAndGetConfig cfgFiles+ let actual = configColumns cfg'+ actual @?= expected+++-------------------------------------------------------------------------------- -- | Put an example config files (.cabal/.stylish-haskell.yaml/both) -- into the current directory and extract extensions from it.-createFilesAndGetConfig :: [(FilePath, String)] -> IO Config+createFilesAndGetConfig :: [ConfigFile] -> IO Config createFilesAndGetConfig files = withTestDirTree $ do- mapM_ (\(k, v) -> writeFile k v) files+ mapM_ (\ConfigFile{..} -> writeFile fileName contents) files -- create an empty directory and change into it createDirectory "src" setCurrentDirectory "src" -- from that directory read the config file and extract extensions -- to make sure the search for .cabal file works- config <- loadConfig (const (pure ())) Nothing- pure config+ loadConfig (const (pure ())) Nothing -------------------------------------------------------------------------------- testExtensionsFromDotCabal :: Assertion-testExtensionsFromDotCabal =- assert $ (expected ==) . Set.fromList . configLanguageExtensions <$>- createFilesAndGetConfig [("test.cabal", dotCabal True)]- where- expected = Set.fromList ["ScopedTypeVariables", "DataKinds"]-+testExtensionsFromDotCabal = testExtensions+ [ cabalCfg dotCabal ["ScopedTypeVariables"] ["DataKinds"] ] -------------------------------------------------------------------------------- testExtensionsFromDotStylish :: Assertion-testExtensionsFromDotStylish =- assert $ (expected ==) . Set.fromList . configLanguageExtensions <$>- createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish)]- where- expected = Set.fromList ["TemplateHaskell", "QuasiQuotes"]-+testExtensionsFromDotStylish = testExtensions+ [ stylishCfg dotStylish ["TemplateHaskell", "QuasiQuotes"] ] -------------------------------------------------------------------------------- testExtensionsFromBoth :: Assertion-testExtensionsFromBoth =- assert $ (expected ==) . Set.fromList . configLanguageExtensions <$>- createFilesAndGetConfig [ ("test.cabal", dotCabal True)- , (".stylish-haskell.yaml", dotStylish)]- where- expected = Set.fromList- ["ScopedTypeVariables", "DataKinds", "TemplateHaskell", "QuasiQuotes"]+testExtensionsFromBoth = testExtensions+ [ cabalCfg dotCabal ["ScopedTypeVariables"] ["DataKinds"]+ , stylishCfg dotStylish ["TemplateHaskell", "QuasiQuotes"]+ ] +--------------------------------------------------------------------------------+testStylishNoXyz :: Assertion+testStylishNoXyz = testExtensions+ [ stylishCfg dotStylish ["NoStarIsType", "NoTypeOperators"] ] --------------------------------------------------------------------------------+testCabalNoXyz :: Assertion+testCabalNoXyz = testExtensions+ [ cabalCfg dotCabal ["NoStarIsType"] ["NoTypeOperators"] ]+++-------------------------------------------------------------------------------- testSpecifiedColumns :: Assertion-testSpecifiedColumns =- assert $ (expected ==) . configColumns <$>- createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish)]- where- expected = Just 110+testSpecifiedColumns = testColumns (Just 110)+ [ stylishCfg dotStylish [] ] -------------------------------------------------------------------------------- testDefaultColumns :: Assertion-testDefaultColumns =- assert $ (expected ==) . configColumns <$>- createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish2)]- where- expected = Just 80+testDefaultColumns = testColumns (Just 80)+ [ stylishCfg dotStylish2 ["DataKinds"] ] -------------------------------------------------------------------------------- testNoColumns :: Assertion-testNoColumns =- assert $ (expected ==) . configColumns <$>- createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish3)]- where- expected = Nothing+testNoColumns = testColumns Nothing+ [ stylishCfg dotStylish3 ["DataKinds"] ] --------------------------------------------------------------------------------@@ -129,8 +164,8 @@ -- | Example cabal file borrowed from -- https://www.haskell.org/cabal/users-guide/developing-packages.html -- with some default-extensions added-dotCabal :: Bool -> String-dotCabal includeExtensions = unlines $+dotCabal :: [ExtensionName] -> [ExtensionName] -> String+dotCabal exts1 exts2 = unlines $ [ "name: TestPackage" , "version: 0.0" , "synopsis: Package with library and two programs"@@ -142,22 +177,22 @@ , "library" , " build-depends: HUnit" , " exposed-modules: A, B, C"+ , " default-extensions:" ] ++- [if includeExtensions then " default-extensions: ScopedTypeVariables"- else ""]+ map (" " ++) exts1 ++ [ "" , "executable program1" , " main-is: Main.hs" , " hs-source-dirs: prog1" , " other-modules: A, B"+ , " default-extensions:" ] ++- [if includeExtensions then " default-extensions: DataKinds"- else ""]+ map (" " ++) exts2 -- | Example .stylish-haskell.yaml-dotStylish :: String-dotStylish = unlines $+dotStylish :: [ExtensionName] -> String+dotStylish exts = unlines $ [ "steps:" , " - imports:" , " align: none"@@ -177,13 +212,12 @@ , " via: \"indent 2\"" , "columns: 110" , "language_extensions:"- , " - TemplateHaskell"- , " - QuasiQuotes"- ]+ ] +++ map (" - " ++) exts -- | Example .stylish-haskell.yaml-dotStylish2 :: String-dotStylish2 = unlines $+dotStylish2 :: [ExtensionName] -> String+dotStylish2 exts = unlines $ [ "steps:" , " - imports:" , " align: none"@@ -196,13 +230,13 @@ , " remove_redundant: true" , " - trailing_whitespace: {}" , "language_extensions:"- , " - TemplateHaskell"- , " - QuasiQuotes"- ]+ ] +++ map (" - " ++) exts + -- | Example .stylish-haskell.yaml-dotStylish3 :: String-dotStylish3 = unlines $+dotStylish3 :: [ExtensionName] -> String+dotStylish3 exts = unlines $ [ "steps:" , " - imports:" , " align: none"@@ -216,6 +250,5 @@ , " - trailing_whitespace: {}" , "columns: null" , "language_extensions:"- , " - TemplateHaskell"- , " - QuasiQuotes"- ]+ ] +++ map (" - " ++) exts
tests/Language/Haskell/Stylish/Parse/Tests.hs view
@@ -31,6 +31,7 @@ , testCase "XmlSyntax regression" testXmlSyntaxRegression , testCase "MagicHash regression" testMagicHashRegression , testCase "Disabling extensions" testDisableExtensions+ , testCase "Safe extension" testSafeExtension ] --------------------------------------------------------------------------------@@ -142,7 +143,14 @@ testDisableExtensions :: Assertion testDisableExtensions = returnsRight $ parseModule ["NoImplicitPrelude"] Nothing $ unlines- [ "{-# NoStarIsType #-}"+ [ "{-# LANGUAGE NoStarIsType #-}"+ , "main = return ()"+ ]++testSafeExtension :: Assertion+testSafeExtension = returnsRight $+ parseModule ["TrustWorthy"] Nothing $ unlines+ [ "{-# LANGUAGE Safe #-}" , "main = return ()" ]
tests/Language/Haskell/Stylish/Step/Data/Tests.hs view
@@ -78,6 +78,7 @@ , testCase "case 63 (issue #338)" case63 , testCase "case 64" case64 , testCase "case 65" case65+ , testCase "case 66 (issue #411)" case66 ] case00 :: Assertion@@ -424,7 +425,8 @@ input = [ "module Herp where" , ""- , "data Tag = Title | Text deriving (Eq, Show)"+ , "data Tag = Title | Text"+ , " deriving (Eq, Show)" ] case21 :: Assertion@@ -1161,7 +1163,8 @@ case55 = assertSnippet (step sameSameNoSortStyle) input expected where input =- [ "data Foo = Foo deriving (Z, Y, X, Bar, Abcd)"+ [ "data Foo = Foo"+ , " deriving (Z, Y, X, Bar, Abcd)" ] expected = input@@ -1366,6 +1369,17 @@ , " -- ^ Second following comment" , " deriving (Show)" ]++-- | Deriving alignment for enums+--+-- Regression test for https://github.com/haskell/stylish-haskell/issues/411+case66 :: Assertion+case66 = assertSnippet (step indentIndentStyle) input input+ where+ input =+ [ "data Foo = A | B | C"+ , " deriving (Eq, Show)"+ ] sameSameStyle :: Config sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False True NoMaxColumns