diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +5.2.6: + * Switch to optparse-applicative + 5.2.5: * Support get extensions from `.cabal` file diff --git a/TESTS.md b/TESTS.md --- a/TESTS.md +++ b/TESTS.md @@ -1419,6 +1419,15 @@ arbitrary = undefined ``` +cdsmith Quotes are dropped from package imports #480 + +```haskell +-- https://github.com/commercialhaskell/hindent/issues/480 +{-# LANGUAGE PackageImports #-} + +import qualified "base" Prelude as P +``` + # MINIMAL pragma Monad example diff --git a/elisp/hindent.el b/elisp/hindent.el --- a/elisp/hindent.el +++ b/elisp/hindent.el @@ -148,24 +148,25 @@ If DROP-NEWLINE is non-nil, don't require a newline at the end of the file." (interactive "r") - (if (= (save-excursion (goto-char beg) - (line-beginning-position)) - beg) - (hindent-reformat-region-as-is beg end drop-newline) - (let* ((column (- beg (line-beginning-position))) - (string (buffer-substring-no-properties beg end)) - (new-string (with-temp-buffer - (insert (make-string column ? ) string) - (hindent-reformat-region-as-is (point-min) - (point-max) - drop-newline) - (delete-region (point-min) (1+ column)) - (buffer-substring (point-min) - (point-max))))) - (save-excursion - (goto-char beg) - (delete-region beg end) - (insert new-string))))) + (let ((inhibit-read-only t)) + (if (= (save-excursion (goto-char beg) + (line-beginning-position)) + beg) + (hindent-reformat-region-as-is beg end drop-newline) + (let* ((column (- beg (line-beginning-position))) + (string (buffer-substring-no-properties beg end)) + (new-string (with-temp-buffer + (insert (make-string column ? ) string) + (hindent-reformat-region-as-is (point-min) + (point-max) + drop-newline) + (delete-region (point-min) (1+ column)) + (buffer-substring (point-min) + (point-max))))) + (save-excursion + (goto-char beg) + (delete-region beg end) + (insert new-string)))))) ;;;###autoload (define-obsolete-function-alias 'hindent/reformat-decl 'hindent-reformat-decl) diff --git a/hindent.cabal b/hindent.cabal --- a/hindent.cabal +++ b/hindent.cabal @@ -1,5 +1,5 @@ name: hindent -version: 5.2.5 +version: 5.2.6 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. . @@ -57,7 +57,6 @@ , hindent , bytestring , utf8-string - , descriptive >= 0.7 && < 0.10 , haskell-src-exts , ghc-prim , directory @@ -69,6 +68,7 @@ , path-io , transformers , exceptions + , optparse-applicative test-suite hindent-test type: exitcode-stdio-1.0 diff --git a/src/HIndent/CabalFile.hs b/src/HIndent/CabalFile.hs --- a/src/HIndent/CabalFile.hs +++ b/src/HIndent/CabalFile.hs @@ -1,14 +1,21 @@ +{-# LANGUAGE CPP #-} + module HIndent.CabalFile ( getCabalExtensionsForSourcePath ) where +import qualified Data.ByteString as BS import Data.List import Data.Maybe import Data.Traversable import Distribution.ModuleName import Distribution.PackageDescription import Distribution.PackageDescription.Configuration +#if MIN_VERSION_Cabal(2, 2, 0) +import Distribution.PackageDescription.Parsec +#else import Distribution.PackageDescription.Parse +#endif import Language.Haskell.Extension import qualified Language.Haskell.Exts.Extension as HSE import System.Directory @@ -82,6 +89,19 @@ [] -> findCabalFiles (takeDirectory dir) (takeFileName dir rel) _ -> return $ Just (fmap (\n -> dir n) cabalnames, rel) +getGenericPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription) +#if MIN_VERSION_Cabal(2, 2, 0) +getGenericPackageDescription cabalPath = do + cabaltext <- BS.readFile cabalPath + return $ parseGenericPackageDescriptionMaybe cabaltext +#else +getGenericPackageDescription cabalPath = do + cabaltext <- readFile cabalPath + case parsePackageDescription cabaltext of + ParseOk _ gpd -> return $ Just gpd + _ -> return Nothing +#endif + -- | Find the `Stanza` that refers to this source path getCabalStanza :: FilePath -> IO (Maybe Stanza) getCabalStanza srcpath = do @@ -91,10 +111,10 @@ Just (cabalpaths, relpath) -> do stanzass <- for cabalpaths $ \cabalpath -> do - cabaltext <- readFile cabalpath - case parsePackageDescription cabaltext of - ParseFailed _ -> return [] - ParseOk _ gpd -> do + genericPackageDescription <- getGenericPackageDescription cabalpath + case genericPackageDescription of + Nothing -> return [] + Just gpd -> do return $ packageStanzas $ flattenPackageDescription gpd return $ case filter (\stanza -> stanzaIsSourceFilePath stanza relpath) $ diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -1567,7 +1567,7 @@ when qualified $ write " qualified" case mpkg of Nothing -> return () - Just pkg -> space >> write pkg + Just pkg -> space >> write ("\"" ++ pkg ++ "\"") space pretty name case mas of diff --git a/src/main/Main.hs b/src/main/Main.hs --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -4,7 +4,7 @@ -- | Main entry point to hindent. -- -- hindent -module Main where +module Main (main) where import Control.Applicative import Control.Exception @@ -13,12 +13,8 @@ import qualified Data.ByteString.Builder as S import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T import Data.Version (showVersion) import qualified Data.Yaml as Y -import Descriptive -import Descriptive.Options import Foreign.C.Error import GHC.IO.Exception import HIndent @@ -30,18 +26,24 @@ import qualified Path.IO as Path import Paths_hindent (version) import qualified System.Directory as IO -import System.Environment import System.Exit (exitWith) import qualified System.IO as IO -import Text.Read +import Options.Applicative hiding (action, style) +import Data.Monoid ((<>)) +data Action = Validate | Reformat + +data RunMode = ShowVersion | Run Config [Extension] Action (Maybe FilePath) + -- | Main entry point. main :: IO () main = do - args <- getArgs config <- getConfig - case consume (options config) (map T.pack args) of - Succeeded (style, exts, action, mfilepath) -> + runMode <- execParser (info (options config <**> helper) (header "hindent - Reformat Haskell source code")) + case runMode of + ShowVersion -> + putStrLn ("hindent " ++ showVersion version) + Run style exts action mfilepath -> case mfilepath of Just filepath -> do cabalexts <- getCabalExtensionsForSourcePath filepath @@ -69,10 +71,6 @@ Nothing -> L8.interact (either error S.toLazyByteString . reformat style (Just exts) Nothing . L8.toStrict) - Failed (Wrap (Stopped Version) _) -> - putStrLn ("hindent " ++ showVersion version) - Failed (Wrap (Stopped Help) _) -> putStrLn (help defaultConfig) - _ -> error (help defaultConfig) -- | Read config from a config file, or return 'defaultConfig'. getConfig :: IO Config @@ -89,71 +87,40 @@ Left e -> error (show e) Right config -> return config --- | Help text. -help :: Config -> String -help config = - "hindent " ++ - T.unpack (textDescription (describe (options config) [])) ++ - "\nVersion " ++ - showVersion version ++ - "\n" ++ - "Default --indent-size is 2. Specify --indent-size 4 if you prefer that.\n" ++ - "-X to pass extensions e.g. -XMagicHash etc.\n" ++ - "The --style option is now ignored, but preserved for backwards-compatibility.\n" ++ - "Johan Tibell is the default and only style." - --- | Options that stop the argument parser. -data Stoppers - = Version - | Help - deriving (Show) - -data Action = Validate | Reformat - -- | Program options. -options - :: Monad m - => Config -> Consumer [Text] (Option Stoppers) m (Config, [Extension], Action, Maybe FilePath) -options config = ver *> ((,,,) <$> style <*> exts <*> action <*> file) +options :: + Config -> Parser RunMode +options config = + flag' ShowVersion ( long "version" <> help "Print the version") <|> + (Run <$> style <*> exts <*> action <*> files) where - ver = - stop (flag "version" "Print the version" Version) *> - stop (flag "help" "Show help" Help) style = - makeStyle <$> - fmap - (const config) - (optional - (constant "--style" "Style to print with" () *> anyString "STYLE")) <*> + (makeStyle config <$> lineLen <*> indentSpaces <*> trailingNewline <*> sortImports - exts = fmap getExtensions (many (prefix "X" "Language extension")) + ) <* + optional (strOption + (long "style" <> help "Style to print with (historical, now ignored)" <> metavar "STYLE") :: Parser String) + exts = fmap getExtensions (many (option auto (short 'X' <> help "Language extension" <> metavar "GHCEXT"))) indentSpaces = - fmap - (>>= (readMaybe . T.unpack)) - (optional - (arg "indent-size" "Indentation size in spaces, default: 4" <|> - arg "tab-size" "Same as --indent-size, for compatibility")) + option auto + (long "indent-size" <> help "Indentation size in spaces" <> value (configIndentSpaces config) <> showDefault) <|> + option auto (long "tab-size" <> help "Same as --indent-size, for compatibility") lineLen = - fmap - (>>= (readMaybe . T.unpack)) - (optional (arg "line-length" "Desired length of lines")) - trailingNewline = - optional - (constant "--no-force-newline" "Don't force a trailing newline" False) + option auto (long "line-length" <> help "Desired length of lines" <> value (configMaxColumns config) <> showDefault ) + trailingNewline = not <$> + flag (not (configTrailingNewline config)) (configTrailingNewline config) (long "no-force-newline" <> help "Don't force a trailing newline" <> showDefault) sortImports = - optional - (constant "--sort-imports" "Sort imports in groups" True <|> - constant "--no-sort-imports" "Don't sort imports" False) - action = fromMaybe Reformat <$> - optional (constant "--validate" "Check if files are formatted without changing them" Validate) + flag Nothing (Just True) (long "sort-imports" <> help "Sort imports in groups" <> showDefault) <|> + flag Nothing (Just False) (long "no-sort-imports" <> help "Don't sort imports") + action = flag Reformat Validate (long "validate" <> help "Check if files are formatted without changing them") makeStyle s mlen tabs trailing imports = s - { configMaxColumns = fromMaybe (configMaxColumns s) mlen - , configIndentSpaces = fromMaybe (configIndentSpaces s) tabs - , configTrailingNewline = fromMaybe (configTrailingNewline s) trailing - , configSortImports = fromMaybe (configSortImports s) imports + { configMaxColumns = mlen + , configIndentSpaces = tabs + , configTrailingNewline = trailing + , configSortImports = fromMaybe (configSortImports s) imports } - file = fmap (fmap T.unpack) (optional (anyString "[]")) + files = optional (strArgument (metavar "FILENAME"))