From 52ba1eedc533c30fdb5fb1a5c4d32c1bfba9a3c2 Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Mon, 17 Jun 2024 20:10:00 +0200 Subject: [PATCH 1/8] Conditional import of Data.Monoid for older GHC versions. --- src/Floskell/Printers.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Floskell/Printers.hs b/src/Floskell/Printers.hs index e24d535c..63d026aa 100644 --- a/src/Floskell/Printers.hs +++ b/src/Floskell/Printers.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Floskell.Printers @@ -65,7 +66,9 @@ import Control.Monad.State.Strict ( get, gets, modify ) import Data.List ( intersperse ) import qualified Data.Map.Strict as Map +#if __GLASGOW_HASKELL__ <= 802 import Data.Monoid ( (<>) ) +#endif import Data.Text ( Text ) import qualified Data.Text as T From eca512d1838240ca5fe4a610f6c9b374b881bdf6 Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Mon, 17 Jun 2024 20:21:25 +0200 Subject: [PATCH 2/8] Tabstop aligment for guards. --- src/Floskell/Pretty.hs | 40 ++++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs index 72fb4481..b662d62c 100644 --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -414,7 +414,9 @@ measure' :: Printer a -> Printer (Maybe [Int]) measure' p = fmap (: []) <$> measure p measureMatch :: Match NodeInfo -> Printer (Maybe [Int]) -measureMatch (Match _ name pats _ Nothing) = measure' (prettyApp name pats) +measureMatch (Match _ name pats rhs _) = case rhs of + UnGuardedRhs _ _ -> measure' (prettyApp name pats) + GuardedRhss _ grhss -> fmap sequence (mapM measureGuardedRhs grhss) measureMatch (InfixMatch _ pat name pats _ Nothing) = measure' go where go = do @@ -426,6 +428,12 @@ measureMatch (InfixMatch _ pat name pats _ Nothing) = measure' go inter spaceOrNewline $ map pretty pats measureMatch _ = return Nothing +measureGuardedRhs :: GuardedRhs NodeInfo -> Printer (Maybe Int) +measureGuardedRhs (GuardedRhs _ stmts _) = measure $ + withIndentConfig cfgIndentMultiIf (space >> aligned p) (flip indented p) + where + p = prettyGuard stmts + measureDecl :: Decl NodeInfo -> Printer (Maybe [Int]) measureDecl (PatBind _ pat _ Nothing) = measure' (pretty pat) measureDecl (FunBind _ matches) = @@ -712,6 +720,16 @@ prettyBinds binds = withIndentBy cfgIndentWhere $ do write "where" withIndent cfgIndentWhereBinds $ pretty binds +prettyGuard :: [Stmt NodeInfo] -> Printer () +prettyGuard stmts = do + operatorSectionR Pattern "|" $ write "|" + withLayout cfgLayoutDeclaration flex vertical + where + flex = listAutoWrap' pat sep stmts + vertical = list' pat sep stmts + pat = Pattern + sep = "," + instance Pretty Module where prettyPrint (Module _ mhead pragmas imports decls) = inter blankline $ catMaybes [ ifNotEmpty prettyPragmas pragmas @@ -1294,20 +1312,14 @@ instance Pretty Rhs where withIndent cfgIndentMultiIf $ linedOnside guardedrhss instance Pretty GuardedRhs where - prettyPrint (GuardedRhs _ stmts expr) = - withLayout cfgLayoutDeclaration flex vertical + prettyPrint (GuardedRhs _ stmts expr) = do + prettyGuard stmts + atTabStop stopRhs + withLayout cfgLayoutDeclaration (operator d op) (operatorV d op) + pretty expr where - flex = do - operatorSectionR Pattern "|" $ write "|" - listAutoWrap' Pattern "," stmts - operator Declaration "=" - pretty expr - - vertical = do - operatorSectionR Pattern "|" $ write "|" - list' Pattern "," stmts - operatorV Declaration "=" - pretty expr + d = Declaration + op = "=" instance Pretty Context where prettyPrint (CxSingle _ asst) = do From e1b54677cd80cd245f282d1968a7448e6a43d664 Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Thu, 20 Jun 2024 13:59:56 +0200 Subject: [PATCH 3/8] Don't take trailing line comment into account when pretty printing. --- src/Floskell/Pretty.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs index b662d62c..8bd55920 100644 --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -111,7 +111,7 @@ prettyOnside ast = do if nl then do printCommentsBefore True ast - onside $ prettyPrint ast + onside $ cut $ prettyPrint ast printCommentsAfter ast else onside $ pretty ast From b89f39b58defbee936c552b089f98e4a9c0d4c35 Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Thu, 20 Jun 2024 20:18:53 +0200 Subject: [PATCH 4/8] Don't add a blank line between pattern bindings. --- src/Floskell/Pretty.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs index 8bd55920..c7fb6d89 100644 --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -532,7 +532,9 @@ skipBlankAfterDecl a = case a of _ -> False skipBlankDecl :: Decl NodeInfo -> Decl NodeInfo -> Bool -skipBlankDecl a _ = skipBlankAfterDecl a +skipBlankDecl a b = case (a, b) of + (PatBind{}, PatBind{}) -> True + _ -> skipBlankAfterDecl a skipBlankClassDecl :: ClassDecl NodeInfo -> ClassDecl NodeInfo -> Bool skipBlankClassDecl a _ = case a of From 1457fed76d51d9ff96ddb4e0aea00e0b7e74b29e Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Tue, 24 Mar 2026 14:03:04 +0100 Subject: [PATCH 5/8] Fix declaration spacing regression and modernize CLI pretty printing --- src/Floskell/Pretty.hs | 4 +--- src/main/Main.hs | 44 ++++++++++++++++++++++++------------------ src/main/Markdone.hs | 2 -- 3 files changed, 26 insertions(+), 24 deletions(-) diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs index c7fb6d89..8bd55920 100644 --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -532,9 +532,7 @@ skipBlankAfterDecl a = case a of _ -> False skipBlankDecl :: Decl NodeInfo -> Decl NodeInfo -> Bool -skipBlankDecl a b = case (a, b) of - (PatBind{}, PatBind{}) -> True - _ -> skipBlankAfterDecl a +skipBlankDecl a _ = skipBlankAfterDecl a skipBlankClassDecl :: ClassDecl NodeInfo -> ClassDecl NodeInfo -> Bool skipBlankClassDecl a _ = case a of diff --git a/src/main/Main.hs b/src/main/Main.hs index da2efbd6..427d85b9 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -11,7 +11,6 @@ import qualified Data.Aeson.Encode.Pretty as JSON ( encodePretty ) import qualified Data.ByteString.Lazy as BL import Data.List ( sort ) import Data.Maybe ( isJust ) -import Data.Monoid ( (<>) ) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TIO @@ -39,12 +38,12 @@ import Options.Applicative import Paths_floskell ( version ) import System.Directory - ( copyFile, copyPermissions, getTemporaryDirectory, removeFile - , renameFile ) + ( copyFile, copyPermissions, getTemporaryDirectory, removeFile + , renameFile ) import System.IO - ( FilePath, hClose, hFlush, openTempFile, stdout ) + ( hClose, hFlush, openTempFile, stdout ) -import qualified Text.PrettyPrint.ANSI.Leijen as PP +import qualified Options.Applicative.Help.Pretty as PP -- | Program options. data Options = Options { optStyle :: Maybe String @@ -70,18 +69,19 @@ main = do Nothing -> return defaultAppConfig let config = mergeAppConfig baseConfig opts if optPrintFixities opts - then PP.displayIO stdout . PP.renderPretty 1.0 80 $ - docFixities packageFixities <> PP.linebreak + then PP.hPutDoc stdout $ docFixities packageFixities <> PP.hardline else if optPrintConfig opts then BL.putStr $ JSON.encodePretty config else run config (optFiles opts) where parser = info (helper <*> versioner <*> options) - (fullDesc - <> progDesc "Floskell reformats one or more Haskell modules." - <> header "floskell - A Haskell Source Code Pretty Printer" - <> footerDoc (Just (footerStyles PP.<$$> footerLanguages - PP.<$$> footerExtensions))) + (fullDesc + <> progDesc "Floskell reformats one or more Haskell modules." + <> header "floskell - A Haskell Source Code Pretty Printer" + <> footerDoc (Just (PP.vsep [ footerStyles + , footerLanguages + , footerExtensions + ]))) versioner = abortOption (InfoMsg $ "floskell " ++ showVersion version) (long "version" @@ -120,17 +120,23 @@ main = do makeFooter "Supported extensions:" [ show e | EnableExtension e <- knownExtensions ] + makeFooter :: String -> [String] -> PP.Doc makeFooter hdr xs = - PP.empty PP.<$$> PP.text hdr PP.<$$> (PP.indent 2 . PP.fillSep - . PP.punctuate PP.comma - . map PP.text $ sort xs) + PP.vsep [ PP.emptyDoc + , PP.pretty hdr + , PP.indent 2 . PP.fillSep . PP.punctuate PP.comma + . map PP.pretty $ sort xs + ] - docFixities = PP.vcat . PP.punctuate PP.linebreak + docFixities = PP.vcat . PP.punctuate PP.hardline . map (uncurry docPackageFixities) - docPackageFixities p fs = PP.text (p ++ ":") - PP.<$$> (PP.indent 2 . PP.fillSep . PP.punctuate PP.comma - . map (PP.text . showFixity) $ sort fs) + docPackageFixities p fs = PP.vsep + [ PP.pretty (p ++ ":") + , PP.indent 2 . PP.fillSep . PP.punctuate PP.comma + . map (PP.pretty . showFixity) $ sort fs + ] + -- | Reformat files or stdin based on provided configuration. run :: AppConfig -> [FilePath] -> IO () diff --git a/src/main/Markdone.hs b/src/main/Markdone.hs index 5b583cf6..5b5cb7e8 100644 --- a/src/main/Markdone.hs +++ b/src/main/Markdone.hs @@ -14,11 +14,9 @@ import Control.DeepSeq import Control.Monad.Catch import Data.Char -import Data.Monoid ( (<>) ) import Data.Text.Lazy ( Text ) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB -import qualified Data.Text.Lazy.IO as TIO import Data.Typeable import GHC.Generics From 9d26a600a7772544d5bc292de4ed565d6c53b8d2 Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Tue, 24 Mar 2026 14:33:48 +0100 Subject: [PATCH 6/8] Support post-qualified imports and project defaults --- AGENTS.md | 157 +++++++++++++++++++++++++++++++++++++ TEST.md | 1 + src/Floskell.hs | 131 ++++++++++++++++++++++++++++++- src/Floskell/Comments.hs | 2 +- src/Floskell/ConfigFile.hs | 31 ++++++-- src/Floskell/Pretty.hs | 8 +- src/Floskell/Types.hs | 3 +- styles/base.md | 1 + styles/chris-done.md | 1 + styles/cramer.md | 1 + styles/gibiansky.md | 1 + styles/johan-tibell.md | 1 + 12 files changed, 327 insertions(+), 11 deletions(-) create mode 100644 AGENTS.md diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 00000000..1fecbc4a --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,157 @@ +# AGENTS.md + +This file is for coding agents working in `floskell`. + +## Scope + +- Repository: `floskell`, a Haskell source formatter / pretty printer. +- Build systems present: `cabal` and `stack`. +- CI uses `cabal` on macOS and Linux, across multiple GHC versions. +- No Cursor rules were found in `.cursor/rules/`. +- No `.cursorrules` file was found. +- No Copilot instructions were found at `.github/copilot-instructions.md`. + +## Repository Layout + +- `src/Floskell*.hs`: library modules. +- `src/main/Main.hs`: CLI executable. +- `src/main/Test.hs`: Hspec test runner. +- `src/main/Benchmark.hs`: Criterion benchmarks. +- `src/main/Markdone.hs`: markdown parsing support used by tests and benches. +- `TEST.md`: canonical markdown-based regression input. +- `styles/*.md`: expected formatter output for each predefined style. +- `floskell.cabal`: authoritative target definitions and dependencies. +- `.github/workflows/ci.yml`: authoritative CI commands. + +## Preferred Workflow + +- Prefer `cabal` for build, test, and verification because CI uses it. +- Use `stack` only when you specifically need the repo's resolver workflow. +- Keep changes compatible with a broad GHC range; the codebase actively supports older compilers and multiple `haskell-src-exts` versions. +- Expect CPP guards around dependency and parser-version differences. + +## Build Commands + +- Build everything: `cabal build all` +- Build library only: `cabal build floskell` +- Build executable only: `cabal build exe:floskell` +- Build tests only: `cabal build test:floskell-test` +- Build benchmarks only: `cabal build bench:floskell-bench` +- Configure tests and benches explicitly: `cabal configure --enable-test --enable-benchmarks --disable-documentation` +- Check install plan without building: `cabal build --dry-run` +- Open a REPL for the library: `cabal repl floskell` + +## Lint / Static Checks + +- There is no dedicated linter config in the repo for `hlint`, `ormolu`, `fourmolu`, or `stylish-haskell`. +- The main static baseline is a warning-clean build with `-Wall` enabled in the Cabal targets. +- Treat `cabal build all` as the most important local lint check. +- Run Cabal package validation with `cabal check`. +- If you touch public metadata or dependencies, run both `cabal check` and `cabal build all`. + +## Test Commands + +- Run the full test suite: `cabal test all` +- Run only the main test suite target: `cabal test floskell-test` +- Run tests with direct output: `cabal test floskell-test --test-show-details=direct` +- Run benchmarks: `cabal bench floskell-bench` +- Run the executable on a file: `cabal run floskell -- path/to/File.hs` +- Run the executable on stdin: `cabal run floskell < path/to/File.hs` + +## Running A Single Test + +The test suite uses Hspec from `src/main/Test.hs`, so use Hspec's match filtering. + +- Run one example by exact or partial test name: + `cabal test floskell-test --test-show-details=direct --test-options='--match "Snippet 1"'` +- Run a narrower test: + `cabal test floskell-test --test-show-details=direct --test-options='--match "formats as expected"'` +- Run one section: + `cabal test floskell-test --test-show-details=direct --test-options='--match "ImportDecl"'` +- Stack equivalent: + `stack test --test-arguments='--match "Snippet 1"'` + +Notes: + +- Test names are generated from markdown sections plus snippet numbers. +- If you are unsure of the exact name, inspect `src/main/Test.hs` and `TEST.md` first. + +## High-Value Verification Paths + +- Formatter logic changed: run `cabal test floskell-test`. +- CLI behavior changed: run `cabal build exe:floskell` and at least one `cabal run floskell -- ...` smoke test. +- Config or JSON parsing changed: run `cabal test floskell-test` and exercise `--print-config`. +- Performance-sensitive pretty-printing changed: consider `cabal bench floskell-bench`. +- Packaging changed: run `cabal check`. + +## Test Architecture + +- Regression tests are markdown-driven. +- `TEST.md` is the canonical input corpus. +- Each file in `styles/*.md` stores the expected rendering for a predefined style. +- Many failures are easiest to diagnose by locating the referenced markdown section/snippet. + +## Source Style + +Follow the existing Haskell style in the repository rather than introducing a new formatter style. + +- Use 4-space indentation. +- Prefer hanging indentation for long signatures, records, and import lists. +- Preserve the import grouping style: standard/library imports, then local imports, separated by blank lines. +- Keep alignment conservative and readable; do not introduce decorative alignment that the surrounding file does not use. + +## Imports + +- Use explicit import lists for external modules when only a few names are needed. +- Use `qualified` imports for modules like `Data.Text`, `Data.Map.Strict`, and similar namespaces. +- Use short, conventional aliases already common in the codebase: `T`, `TL`, `TB`, `TIO`, `Map`, `M`, `JSON`, `PP`. +- Open imports are acceptable for internal modules when that is already the local convention. +- Keep imports sorted/grouped consistently with the surrounding file; avoid churn-only reorderings. + +## Language Pragmas And CPP + +- Keep pragmas file-local and minimal. +- Common pragmas here include `CPP`, `OverloadedStrings`, `RecordWildCards`, `LambdaCase`, and targeted feature flags. +- Preserve existing CPP compatibility guards. +- When changing parser- or dependency-sensitive code, check for version branches before simplifying. +- Prefer small, localized `#if` blocks over duplicating large amounts of logic unless parser compatibility requires it. + +## Types And Signatures + +- Give top-level functions explicit type signatures. +- Keep helper signatures when they clarify polymorphism, laziness/strictness, or error types. +- Use `newtype` when representing a single wrapped concept. +- Prefer records for configuration and state structures. +- Prefer record updates over positional reconstruction. + +## Naming + +- Modules, types, and constructors use `CamelCase`. +- Functions and values use `camelCase`. +- Record fields usually carry a domain prefix, e.g. `cfg*`, `ps*`, `style*`. +- Match existing terminology: `reformat`, `pretty`, `style`, `config`, `fixities`, `imports`, `comments`. + +## Error Handling + +- In library-style code, prefer returning `Either String a` or `Maybe a` for expected failures. +- Keep pure formatting/parsing paths explicit about failure, as `reformat` already does. +- It is acceptable to keep `error` for test-only code and genuinely impossible internal states if the surrounding module already uses that pattern. +- IO boundary code may catch and rethrow exceptions when handling filesystem edge cases, as in `src/main/Main.hs`. + +## Comments And Documentation + +- Use Haddock-style module or declaration comments for exported APIs and non-obvious internals. +- Preserve carefully placed comments in tests and markdown fixtures; they are often part of regression coverage. + +## Testing Conventions + +- If you change formatter behavior, expect corresponding updates to style reference outputs. +- Prefer minimal changes to `TEST.md` and `styles/*.md`; broad fixture churn is hard to review. +- Test descriptions are generated, so clear section headings in markdown matter. + +## Agent-Specific Guidance + +- Before editing, inspect the target file's surrounding style and match it. +- Avoid repo-wide formatting passes; this project is intentionally style-sensitive. +- Keep diffs small in generated reference markdown unless the behavior change truly affects many styles. +- When in doubt, trust `floskell.cabal`, `src/main/Test.hs`, `TEST.md`, and `.github/workflows/ci.yml` over assumptions. diff --git a/TEST.md b/TEST.md index 63eeb232..6f58e290 100644 --- a/TEST.md +++ b/TEST.md @@ -153,6 +153,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text (Text) import qualified Data.Text as T +import Data.Text qualified as Text import qualified Data.ByteString (ByteString,pack,unpack) import qualified Data.ByteString as BS (pack, unpack) import Control.Monad hiding (forM) diff --git a/src/Floskell.hs b/src/Floskell.hs index e3ae1c91..e9832d2b 100644 --- a/src/Floskell.hs +++ b/src/Floskell.hs @@ -24,11 +24,13 @@ module Floskell , defaultExtensions ) where +import Control.Monad ( guard ) import Data.List import Data.Maybe #if __GLASGOW_HASKELL__ <= 802 import Data.Monoid #endif +import Data.Char ( isSpace ) import Data.Text.Lazy ( Text ) import qualified Data.Text.Lazy as TL @@ -154,7 +156,8 @@ reformatBlock mode config (lines, cpp) = case parseModuleWithComments mode code of ParseOk (m, comments') -> let comments = map makeComment comments' - ast = annotateWithComments m (mergeComments comments cpp) + ast = markImportQualifiedPost lines + $ annotateWithComments m (mergeComments comments cpp) in case prettyPrint (pretty ast) config of Nothing -> Left "Printer failed with mzero call." @@ -162,7 +165,7 @@ reformatBlock mode config (lines, cpp) = ParseFailed loc e -> Left $ Exts.prettyPrint (loc { srcLine = srcLine loc }) ++ ": " ++ e where - code = TL.unpack $ TL.intercalate "\n" lines + code = TL.unpack $ TL.intercalate "\n" $ map rewriteImportQualifiedPost lines makeComment (Exts.Comment inline span text) = Comment (if inline then InlineComment else LineComment) span text @@ -174,6 +177,130 @@ reformatBlock mode config (lines, cpp) = then x : mergeComments xs' ys else y : mergeComments xs ys' +markImportQualifiedPost :: [Text] -> Module NodeInfo -> Module NodeInfo +markImportQualifiedPost input (Module l mhead pragmas imports decls) = + Module l mhead pragmas (map markImport imports) decls + where + markImport imp = + if importDeclUsesQualifiedPost input imp + then amap (\n -> n { nodeInfoImportQualifiedPost = True }) imp + else imp +markImportQualifiedPost _ ast@XmlPage{} = ast +markImportQualifiedPost _ ast@XmlHybrid{} = ast + +importDeclUsesQualifiedPost :: [Text] -> ImportDecl NodeInfo -> Bool +importDeclUsesQualifiedPost input = hasImportQualifiedPost + . TL.unpack + . spanText input + . nodeSpan + +spanText :: [Text] -> SrcSpan -> Text +spanText input span + | startLine == endLine = + slice startCol endCol $ getLine startLine + | otherwise = TL.intercalate "\n" + $ [ TL.drop (fromIntegral $ startCol - 1) (getLine startLine) ] + ++ middleLines + ++ [ TL.take (fromIntegral endCol) (getLine endLine) ] + where + startLine = srcSpanStartLine span + startCol = srcSpanStartColumn span + endLine = srcSpanEndLine span + endCol = srcSpanEndColumn span + + getLine n = fromMaybe "" $ atMay input (n - 1) + + middleLines = take (endLine - startLine - 1) $ drop startLine input + + slice a b = TL.take (fromIntegral $ max 0 $ b - a + 1) + . TL.drop (fromIntegral $ max 0 $ a - 1) + +rewriteImportQualifiedPost :: Text -> Text +rewriteImportQualifiedPost = TL.pack . rewriteImportQualifiedPostString . TL.unpack + +rewriteImportQualifiedPostString :: String -> String +rewriteImportQualifiedPostString line = case findPostQualifiedImport line of + Just (moduleToken, qualifiedToken) -> + swapTokens moduleToken qualifiedToken line + Nothing -> line + +hasImportQualifiedPost :: String -> Bool +hasImportQualifiedPost = isJust . findPostQualifiedImport + +findPostQualifiedImport :: String -> Maybe (ImportToken, ImportToken) +findPostQualifiedImport line = do + let tokens = tokenize line + (importToken, rest) <- uncons tokens + guard $ tokenText importToken == "import" + let rest' = skipImportModifiers rest + (moduleToken, afterModule) <- uncons rest' + qualifiedToken <- listToMaybe afterModule + guard $ tokenText qualifiedToken == "qualified" + return (moduleToken, qualifiedToken) + +skipImportModifiers :: [ImportToken] -> [ImportToken] +skipImportModifiers + ( ImportToken _ _ "{-#" + : ImportToken _ _ "SOURCE" + : ImportToken _ _ "#-}" + : xs + ) = + skipImportModifiers xs +skipImportModifiers (tok : xs) + | tokenText tok == "safe" = skipImportModifiers xs + | isPackageToken tok = skipImportModifiers xs +skipImportModifiers xs = xs + +isPackageToken :: ImportToken -> Bool +isPackageToken tok = case tokenText tok of + '"' : _ -> True + _ -> False + +swapTokens :: ImportToken -> ImportToken -> String -> String +swapTokens moduleToken qualifiedToken line = + prefix ++ tokenText qualifiedToken ++ middle ++ tokenText moduleToken ++ suffix + where + prefix = take (tokenStart moduleToken) line + middle = take (tokenStart qualifiedToken - tokenEnd moduleToken) + $ drop (tokenEnd moduleToken) line + suffix = drop (tokenEnd qualifiedToken) line + +data ImportToken = ImportToken + { tokenStart :: Int + , tokenEnd :: Int + , tokenText :: String + } + +tokenize :: String -> [ImportToken] +tokenize = go 0 + where + go _ [] = [] + go i xs@(x : xs') + | isSpace x = go (i + 1) xs' + | x == '"' = + let (tok, rest) = spanString xs + len = length tok + in + ImportToken i (i + len) tok : go (i + len) rest + | otherwise = + let (tok, rest) = break isSpace xs + len = length tok + in + ImportToken i (i + len) tok : go (i + len) rest + + spanString [] = ([], []) + spanString (x : xs) = firstChar [x] xs + + firstChar acc [] = (reverse acc, []) + firstChar acc (x : xs) + | x == '"' = (reverse (x : acc), xs) + | otherwise = firstChar (x : acc) xs + +atMay :: [a] -> Int -> Maybe a +atMay xs n + | n < 0 = Nothing + | otherwise = listToMaybe $ drop n xs + prettyPrint :: Printer a -> Config -> Maybe Text prettyPrint printer = fmap (Buffer.toLazyText . psBuffer . snd) . execPrinter printer . initialPrintState diff --git a/src/Floskell/Comments.hs b/src/Floskell/Comments.hs index 15608b8f..3393d3ff 100644 --- a/src/Floskell/Comments.hs +++ b/src/Floskell/Comments.hs @@ -189,7 +189,7 @@ annotateWithComments src comments = -- SrcSpan. Make sure we assign comments to only one of -- them. modify $ M.insert ssi ([], []) - return $ NodeInfo (srcInfoSpan ssi) (reverse c) (reverse c') + return $ NodeInfo (srcInfoSpan ssi) (reverse c) (reverse c') False surrounding (Comment _ ss _) = (nodeBefore ss, nodeAfter ss) diff --git a/src/Floskell/ConfigFile.hs b/src/Floskell/ConfigFile.hs index 49e593f8..64e03926 100644 --- a/src/Floskell/ConfigFile.hs +++ b/src/Floskell/ConfigFile.hs @@ -33,7 +33,7 @@ import qualified Data.Aeson.Types as JSON ( typeMismatch ) import qualified Data.Attoparsec.ByteString as AP import qualified Data.ByteString as BS import Data.Char ( isLetter, isSpace ) -import Data.List ( inits ) +import Data.List ( (\\), inits ) import qualified Data.Text as T import Floskell.Attoparsec ( parseOnly ) @@ -42,8 +42,9 @@ import Floskell.Styles ( Style(..), styles ) import GHC.Generics ( Generic ) import Language.Haskell.Exts - ( Extension(..), Fixity(..), Language(..), classifyExtension - , classifyLanguage ) + ( Extension(..), Fixity(..), KnownExtension(..) + , Language(..), classifyExtension, classifyLanguage + , knownExtensions ) import qualified Language.Haskell.Exts as HSE import System.Directory @@ -83,7 +84,8 @@ instance FromJSON AppConfig where language <- maybe (appLanguage defaultAppConfig) lookupLanguage <$> o .:? "language" extensions <- maybe (appExtensions defaultAppConfig) - (map lookupExtension) <$> o .:? "extensions" + ((appExtensions defaultAppConfig ++) . map lookupExtension) + <$> o .:? "extensions" fixities <- maybe (appFixities defaultAppConfig) (map lookupFixity) <$> o .:? "fixities" let fmt = styleConfig style @@ -105,7 +107,24 @@ instance FromJSON AppConfig where -- | Default program configuration. defaultAppConfig :: AppConfig -defaultAppConfig = AppConfig (head styles) Haskell2010 [] [] +defaultAppConfig = AppConfig (head styles) Haskell2010 defaultExtensions [] + +defaultExtensions :: [Extension] +defaultExtensions = [ e | e@EnableExtension{} <- knownExtensions ] + \\ map EnableExtension badExtensions + +badExtensions :: [KnownExtension] +badExtensions = + [ Arrows -- steals proc + , TransformListComp -- steals the group keyword + , XmlSyntax + , RegularPatterns -- steals a-b + , UnboxedTuples -- breaks (#) lens operator + , PatternSynonyms -- steals the pattern keyword + , RecursiveDo -- steals the rec keyword + , DoRec -- same + , TypeApplications -- since GHC 8 and haskell-src-exts-1.19 + ] -- | Show name of a style. showStyle :: Style -> String @@ -148,6 +167,8 @@ lookupLanguage name = case classifyLanguage name of -- | Lookup an extension by name. lookupExtension :: String -> Extension +lookupExtension "ImportQualifiedPost" = UnknownExtension "ImportQualifiedPost" +lookupExtension "NoImportQualifiedPost" = UnknownExtension "NoImportQualifiedPost" lookupExtension name = case classifyExtension name of UnknownExtension _ -> error $ "Unkown extension: " ++ name x -> x diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs index 8bd55920..53dbe652 100644 --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -771,18 +771,22 @@ instance Pretty WarningText where instance Pretty ExportSpec instance Pretty ImportDecl where - prettyPrint ImportDecl{..} = do + prettyPrint imp@ImportDecl{..} = do + let postQualified = importQualified && nodeInfoImportQualifiedPost (ann imp) inter space . map string $ filter (not . null) [ "import" , if importSrc then "{-# SOURCE #-}" else "" , if importSafe then "safe" else "" - , if importQualified then "qualified" else "" + , if importQualified && not postQualified + then "qualified" + else "" , maybe "" show importPkg ] atTabStop stopImportModule space string $ moduleName importModule + when postQualified $ write " qualified" mayM_ importAs $ \name -> do atTabStop stopImportSpec write " as " diff --git a/src/Floskell/Types.hs b/src/Floskell/Types.hs index 4969f1bd..c4960eda 100644 --- a/src/Floskell/Types.hs +++ b/src/Floskell/Types.hs @@ -116,12 +116,13 @@ data NodeInfo = NodeInfo { nodeInfoSpan :: !SrcSpan -- ^ Location info from the parser. , nodeInfoLeadingComments :: ![Comment] -- ^ Leading comments attached to this node. , nodeInfoTrailingComments :: ![Comment] -- ^ Trailing comments attached to this node. + , nodeInfoImportQualifiedPost :: !Bool } deriving ( Show ) -- | Empty NodeInfo noNodeInfo :: NodeInfo -noNodeInfo = NodeInfo (mkSrcSpan noLoc noLoc) [] [] +noNodeInfo = NodeInfo (mkSrcSpan noLoc noLoc) [] [] False nodeSpan :: Annotated ast => ast NodeInfo -> SrcSpan nodeSpan = nodeInfoSpan . ann diff --git a/styles/base.md b/styles/base.md index 25a23c46..1b14f107 100644 --- a/styles/base.md +++ b/styles/base.md @@ -157,6 +157,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text ( Text ) import qualified Data.Text as T +import Data.Text qualified as Text import qualified Data.ByteString ( ByteString, pack, unpack ) import qualified Data.ByteString as BS ( pack, unpack ) import Control.Monad hiding ( forM ) diff --git a/styles/chris-done.md b/styles/chris-done.md index 8801e3cd..5343b334 100644 --- a/styles/chris-done.md +++ b/styles/chris-done.md @@ -177,6 +177,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text (Text) import qualified Data.Text as T +import Data.Text qualified as Text import qualified Data.ByteString (ByteString,pack,unpack) import qualified Data.ByteString as BS (pack,unpack) import Control.Monad hiding (forM) diff --git a/styles/cramer.md b/styles/cramer.md index 877bc4a8..cd56ec04 100644 --- a/styles/cramer.md +++ b/styles/cramer.md @@ -168,6 +168,7 @@ import qualified Data.ByteString ( ByteString, pack, unpack ) import qualified Data.ByteString as BS ( pack, unpack ) import Data.Text ( Text ) import qualified Data.Text as T +import Data.Text qualified as Text import {-# SOURCE #-} safe qualified "foo" Foo as F diff --git a/styles/gibiansky.md b/styles/gibiansky.md index edff642b..dfd7b53b 100644 --- a/styles/gibiansky.md +++ b/styles/gibiansky.md @@ -167,6 +167,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text (Text) import qualified Data.Text as T +import Data.Text qualified as Text import qualified Data.ByteString (ByteString, pack, unpack) import qualified Data.ByteString as BS (pack, unpack) import Control.Monad hiding (forM) diff --git a/styles/johan-tibell.md b/styles/johan-tibell.md index 0532f561..fb6d10ad 100644 --- a/styles/johan-tibell.md +++ b/styles/johan-tibell.md @@ -181,6 +181,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text (Text) import qualified Data.Text as T +import Data.Text qualified as Text import qualified Data.ByteString (ByteString,pack,unpack) import qualified Data.ByteString as BS (pack,unpack) import Control.Monad hiding (forM) From d6020e44224f1bca08c5d9d5496b2763e7cac723 Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Tue, 24 Mar 2026 14:43:54 +0100 Subject: [PATCH 7/8] Normalize qualified import output --- src/Floskell.hs | 49 +--------------------------------------- src/Floskell/Comments.hs | 2 +- src/Floskell/Pretty.hs | 8 ++----- src/Floskell/Types.hs | 3 +-- styles/base.md | 2 +- styles/chris-done.md | 2 +- styles/cramer.md | 2 +- styles/gibiansky.md | 2 +- styles/johan-tibell.md | 2 +- 9 files changed, 10 insertions(+), 62 deletions(-) diff --git a/src/Floskell.hs b/src/Floskell.hs index e9832d2b..887de446 100644 --- a/src/Floskell.hs +++ b/src/Floskell.hs @@ -156,8 +156,7 @@ reformatBlock mode config (lines, cpp) = case parseModuleWithComments mode code of ParseOk (m, comments') -> let comments = map makeComment comments' - ast = markImportQualifiedPost lines - $ annotateWithComments m (mergeComments comments cpp) + ast = annotateWithComments m (mergeComments comments cpp) in case prettyPrint (pretty ast) config of Nothing -> Left "Printer failed with mzero call." @@ -177,44 +176,6 @@ reformatBlock mode config (lines, cpp) = then x : mergeComments xs' ys else y : mergeComments xs ys' -markImportQualifiedPost :: [Text] -> Module NodeInfo -> Module NodeInfo -markImportQualifiedPost input (Module l mhead pragmas imports decls) = - Module l mhead pragmas (map markImport imports) decls - where - markImport imp = - if importDeclUsesQualifiedPost input imp - then amap (\n -> n { nodeInfoImportQualifiedPost = True }) imp - else imp -markImportQualifiedPost _ ast@XmlPage{} = ast -markImportQualifiedPost _ ast@XmlHybrid{} = ast - -importDeclUsesQualifiedPost :: [Text] -> ImportDecl NodeInfo -> Bool -importDeclUsesQualifiedPost input = hasImportQualifiedPost - . TL.unpack - . spanText input - . nodeSpan - -spanText :: [Text] -> SrcSpan -> Text -spanText input span - | startLine == endLine = - slice startCol endCol $ getLine startLine - | otherwise = TL.intercalate "\n" - $ [ TL.drop (fromIntegral $ startCol - 1) (getLine startLine) ] - ++ middleLines - ++ [ TL.take (fromIntegral endCol) (getLine endLine) ] - where - startLine = srcSpanStartLine span - startCol = srcSpanStartColumn span - endLine = srcSpanEndLine span - endCol = srcSpanEndColumn span - - getLine n = fromMaybe "" $ atMay input (n - 1) - - middleLines = take (endLine - startLine - 1) $ drop startLine input - - slice a b = TL.take (fromIntegral $ max 0 $ b - a + 1) - . TL.drop (fromIntegral $ max 0 $ a - 1) - rewriteImportQualifiedPost :: Text -> Text rewriteImportQualifiedPost = TL.pack . rewriteImportQualifiedPostString . TL.unpack @@ -224,9 +185,6 @@ rewriteImportQualifiedPostString line = case findPostQualifiedImport line of swapTokens moduleToken qualifiedToken line Nothing -> line -hasImportQualifiedPost :: String -> Bool -hasImportQualifiedPost = isJust . findPostQualifiedImport - findPostQualifiedImport :: String -> Maybe (ImportToken, ImportToken) findPostQualifiedImport line = do let tokens = tokenize line @@ -296,11 +254,6 @@ tokenize = go 0 | x == '"' = (reverse (x : acc), xs) | otherwise = firstChar (x : acc) xs -atMay :: [a] -> Int -> Maybe a -atMay xs n - | n < 0 = Nothing - | otherwise = listToMaybe $ drop n xs - prettyPrint :: Printer a -> Config -> Maybe Text prettyPrint printer = fmap (Buffer.toLazyText . psBuffer . snd) . execPrinter printer . initialPrintState diff --git a/src/Floskell/Comments.hs b/src/Floskell/Comments.hs index 3393d3ff..15608b8f 100644 --- a/src/Floskell/Comments.hs +++ b/src/Floskell/Comments.hs @@ -189,7 +189,7 @@ annotateWithComments src comments = -- SrcSpan. Make sure we assign comments to only one of -- them. modify $ M.insert ssi ([], []) - return $ NodeInfo (srcInfoSpan ssi) (reverse c) (reverse c') False + return $ NodeInfo (srcInfoSpan ssi) (reverse c) (reverse c') surrounding (Comment _ ss _) = (nodeBefore ss, nodeAfter ss) diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs index 53dbe652..8bd55920 100644 --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -771,22 +771,18 @@ instance Pretty WarningText where instance Pretty ExportSpec instance Pretty ImportDecl where - prettyPrint imp@ImportDecl{..} = do - let postQualified = importQualified && nodeInfoImportQualifiedPost (ann imp) + prettyPrint ImportDecl{..} = do inter space . map string $ filter (not . null) [ "import" , if importSrc then "{-# SOURCE #-}" else "" , if importSafe then "safe" else "" - , if importQualified && not postQualified - then "qualified" - else "" + , if importQualified then "qualified" else "" , maybe "" show importPkg ] atTabStop stopImportModule space string $ moduleName importModule - when postQualified $ write " qualified" mayM_ importAs $ \name -> do atTabStop stopImportSpec write " as " diff --git a/src/Floskell/Types.hs b/src/Floskell/Types.hs index c4960eda..4969f1bd 100644 --- a/src/Floskell/Types.hs +++ b/src/Floskell/Types.hs @@ -116,13 +116,12 @@ data NodeInfo = NodeInfo { nodeInfoSpan :: !SrcSpan -- ^ Location info from the parser. , nodeInfoLeadingComments :: ![Comment] -- ^ Leading comments attached to this node. , nodeInfoTrailingComments :: ![Comment] -- ^ Trailing comments attached to this node. - , nodeInfoImportQualifiedPost :: !Bool } deriving ( Show ) -- | Empty NodeInfo noNodeInfo :: NodeInfo -noNodeInfo = NodeInfo (mkSrcSpan noLoc noLoc) [] [] False +noNodeInfo = NodeInfo (mkSrcSpan noLoc noLoc) [] [] nodeSpan :: Annotated ast => ast NodeInfo -> SrcSpan nodeSpan = nodeInfoSpan . ann diff --git a/styles/base.md b/styles/base.md index 1b14f107..08705f3c 100644 --- a/styles/base.md +++ b/styles/base.md @@ -157,7 +157,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text ( Text ) import qualified Data.Text as T -import Data.Text qualified as Text +import qualified Data.Text as Text import qualified Data.ByteString ( ByteString, pack, unpack ) import qualified Data.ByteString as BS ( pack, unpack ) import Control.Monad hiding ( forM ) diff --git a/styles/chris-done.md b/styles/chris-done.md index 5343b334..86606f38 100644 --- a/styles/chris-done.md +++ b/styles/chris-done.md @@ -177,7 +177,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text (Text) import qualified Data.Text as T -import Data.Text qualified as Text +import qualified Data.Text as Text import qualified Data.ByteString (ByteString,pack,unpack) import qualified Data.ByteString as BS (pack,unpack) import Control.Monad hiding (forM) diff --git a/styles/cramer.md b/styles/cramer.md index cd56ec04..e34078b6 100644 --- a/styles/cramer.md +++ b/styles/cramer.md @@ -168,7 +168,7 @@ import qualified Data.ByteString ( ByteString, pack, unpack ) import qualified Data.ByteString as BS ( pack, unpack ) import Data.Text ( Text ) import qualified Data.Text as T -import Data.Text qualified as Text +import qualified Data.Text as Text import {-# SOURCE #-} safe qualified "foo" Foo as F diff --git a/styles/gibiansky.md b/styles/gibiansky.md index dfd7b53b..1f1530e6 100644 --- a/styles/gibiansky.md +++ b/styles/gibiansky.md @@ -167,7 +167,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text (Text) import qualified Data.Text as T -import Data.Text qualified as Text +import qualified Data.Text as Text import qualified Data.ByteString (ByteString, pack, unpack) import qualified Data.ByteString as BS (pack, unpack) import Control.Monad hiding (forM) diff --git a/styles/johan-tibell.md b/styles/johan-tibell.md index fb6d10ad..d006190a 100644 --- a/styles/johan-tibell.md +++ b/styles/johan-tibell.md @@ -181,7 +181,7 @@ module Main {-# WARNING "do not use" #-} where import Prelude import Data.Text (Text) import qualified Data.Text as T -import Data.Text qualified as Text +import qualified Data.Text as Text import qualified Data.ByteString (ByteString,pack,unpack) import qualified Data.ByteString as BS (pack,unpack) import Control.Monad hiding (forM) From 4755319c20136efe3da7d1dcb4f336d27ef78093 Mon Sep 17 00:00:00 2001 From: Alex Gerdes Date: Fri, 27 Mar 2026 17:00:03 +0100 Subject: [PATCH 8/8] Adjust import alignment without qualified imports --- TEST.md | 6 ++++++ src/Floskell/Pretty.hs | 5 ++++- styles/base.md | 6 ++++++ styles/chris-done.md | 6 ++++++ styles/cramer.md | 10 +++++++++- styles/gibiansky.md | 8 +++++++- styles/johan-tibell.md | 6 ++++++ 7 files changed, 44 insertions(+), 3 deletions(-) diff --git a/TEST.md b/TEST.md index 6f58e290..7421dcdc 100644 --- a/TEST.md +++ b/TEST.md @@ -160,6 +160,12 @@ import Control.Monad hiding (forM) import {-# SOURCE #-} safe qualified "foo" Foo as F ``` +``` haskell +import Prelude +import Data.Text (Text) +import Control.Monad hiding (forM) +``` + ## Decl ### TypeDecl diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs index 8bd55920..966e9e74 100644 --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -503,7 +503,10 @@ prettyImports is = do alignModuleP <- getConfig (cfgAlignImportModule . cfgAlign) alignSpecP <- getConfig (cfgAlignImportSpec . cfgAlign) let maxNameLength = maximum $ map (length . moduleName . importModule) is - alignModule = if alignModuleP then Just 16 else Nothing + hasQualifiedImport = any importQualified is + alignModule = if alignModuleP && hasQualifiedImport + then Just 16 + else Nothing alignSpec = if alignSpecP then Just (fromMaybe 0 alignModule + 1 + maxNameLength) else Nothing diff --git a/styles/base.md b/styles/base.md index 08705f3c..50e62230 100644 --- a/styles/base.md +++ b/styles/base.md @@ -164,6 +164,12 @@ import Control.Monad hiding ( forM ) import {-# SOURCE #-} safe qualified "foo" Foo as F ``` +``` haskell +import Prelude +import Data.Text ( Text ) +import Control.Monad hiding ( forM ) +``` + ## Decl ### TypeDecl diff --git a/styles/chris-done.md b/styles/chris-done.md index 86606f38..96659546 100644 --- a/styles/chris-done.md +++ b/styles/chris-done.md @@ -184,6 +184,12 @@ import Control.Monad hiding (forM) import {-# SOURCE #-} safe qualified "foo" Foo as F ``` +``` haskell +import Prelude +import Data.Text (Text) +import Control.Monad hiding (forM) +``` + ## Decl ### TypeDecl diff --git a/styles/cramer.md b/styles/cramer.md index e34078b6..0541dcaa 100644 --- a/styles/cramer.md +++ b/styles/cramer.md @@ -175,6 +175,14 @@ import {-# SOURCE #-} safe qualified "foo" Foo as F import Prelude ``` +``` haskell +import Control.Monad hiding ( forM ) + +import Data.Text ( Text ) + +import Prelude +``` + ## Decl ### TypeDecl @@ -1042,7 +1050,7 @@ Ignore shebang lines module Main where - import Shower + import Shower main :: IO () main = printer "Hello" diff --git a/styles/gibiansky.md b/styles/gibiansky.md index 1f1530e6..74788f5d 100644 --- a/styles/gibiansky.md +++ b/styles/gibiansky.md @@ -174,6 +174,12 @@ import Control.Monad hiding (forM) import {-# SOURCE #-} safe qualified "foo" Foo as F ``` +``` haskell +import Prelude +import Data.Text (Text) +import Control.Monad hiding (forM) +``` + ## Decl ### TypeDecl @@ -1033,7 +1039,7 @@ Ignore shebang lines module Main where - import Shower + import Shower main :: IO () main = printer "Hello" diff --git a/styles/johan-tibell.md b/styles/johan-tibell.md index d006190a..44a3f872 100644 --- a/styles/johan-tibell.md +++ b/styles/johan-tibell.md @@ -188,6 +188,12 @@ import Control.Monad hiding (forM) import {-# SOURCE #-} safe qualified "foo" Foo as F ``` +``` haskell +import Prelude +import Data.Text (Text) +import Control.Monad hiding (forM) +``` + ## Decl ### TypeDecl