diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,7 @@ +- 0.5.17.0 + * Remove shebang from input before attempting to extract pragmas + * Set stdin and stdout encoding to UTF-8 by default + - 0.5.16.0 * Fail if the default configuration file is not found. @@ -51,3 +55,6 @@ - 0.5.10.0 * Bump `haskell-src-exts` dependency to 1.15 * Fix test which was not run before + +- `0.5.9.0` + * Add `compact_line` setting for Language Pragma styling diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -53,7 +53,7 @@ # > import qualified Data.List as List # > (concat, foldl, foldr, head, init, last, length) # - # Default: after alias + # Default: after_alias list_align: after_alias # Long list align style takes effect when import is too long. This is diff --git a/lib/Language/Haskell/Stylish/Parse.hs b/lib/Language/Haskell/Stylish/Parse.hs --- a/lib/Language/Haskell/Stylish/Parse.hs +++ b/lib/Language/Haskell/Stylish/Parse.hs @@ -9,7 +9,6 @@ import qualified Language.Haskell.Exts.Annotated as H import Data.List (isPrefixOf) - -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Config import Language.Haskell.Stylish.Step @@ -48,9 +47,9 @@ parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module parseModule extraExts mfp string = do -- Determine the extensions: those specified in the file and the extra ones - let noBom = dropBom string + let noPrefixes = unShebang . dropBom $ string extraExts' = map H.classifyExtension extraExts - (lang, fileExts) = fromMaybe (Nothing, []) $ H.readExtensions noBom + (lang, fileExts) = fromMaybe (Nothing, []) $ H.readExtensions noPrefixes exts = fileExts ++ extraExts' -- Parsing options... @@ -64,8 +63,9 @@ } -- Preprocessing - processed = unShebang $ - if H.EnableExtension H.CPP `elem` exts then unCpp noBom else noBom + processed = if H.EnableExtension H.CPP `elem` exts + then unCpp noPrefixes + else noPrefixes case H.parseModuleWithComments mode processed of H.ParseOk md -> return md diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -6,12 +6,13 @@ -------------------------------------------------------------------------------- -import Control.Monad (forM_) -import Data.List (intercalate) -import Data.Version (Version(..)) -import System.Console.CmdArgs -import System.IO (hPutStrLn, stderr, withFile, hSetEncoding, IOMode(ReadMode), utf8) -import System.IO.Strict (hGetContents) +import Control.Monad (forM_, unless) +import Data.Monoid ((<>)) +import Data.Version (showVersion) +import qualified Options.Applicative as OA +import qualified Paths_stylish_haskell +import qualified System.IO as IO +import qualified System.IO.Strict as IO.Strict -------------------------------------------------------------------------------- @@ -20,49 +21,80 @@ -------------------------------------------------------------------------------- data StylishArgs = StylishArgs - { config :: Maybe FilePath - , verbose :: Bool - , defaults :: Bool - , inPlace :: Bool - , files :: [FilePath] - } deriving (Data, Show, Typeable) + { saConfig :: Maybe FilePath + , saVerbose :: Bool + , saDefaults :: Bool + , saInPlace :: Bool + , saNoUtf8 :: Bool + , saFiles :: [FilePath] + } deriving (Show) -------------------------------------------------------------------------------- -stylishArgs :: StylishArgs -stylishArgs = StylishArgs - { config = Nothing &= typFile &= help "Configuration file" - , verbose = False &= help "Run in verbose mode" - , defaults = False &= help "Dump default config and exit" - , inPlace = False &= help "Overwrite the given files in place" - , files = [] &= typFile &= args - } &= summary ("stylish-haskell-" ++ versionString version) - where - versionString = intercalate "." . map show . versionBranch +parseStylishArgs :: OA.Parser StylishArgs +parseStylishArgs = StylishArgs + <$> OA.optional (OA.strOption $ + OA.metavar "CONFIG" <> + OA.help "Configuration file" <> + OA.long "config" <> + OA.short 'c' <> + OA.hidden) + <*> OA.switch ( + OA.help "Run in verbose mode" <> + OA.long "verbose" <> + OA.short 'v' <> + OA.hidden) + <*> OA.switch ( + OA.help "Dump default config and exit" <> + OA.long "defaults" <> + OA.short 'd' <> + OA.hidden) + <*> OA.switch ( + OA.help "Overwrite the given files in place" <> + OA.long "inplace" <> + OA.short 'i' <> + OA.hidden) + <*> OA.switch ( + OA.help "Don't force UTF-8 stdin/stdout" <> + OA.long "no-utf8" <> + OA.hidden) + <*> OA.many (OA.strArgument $ + OA.metavar "FILENAME" <> + OA.help "Input file(s)") -------------------------------------------------------------------------------- +parserInfo :: OA.ParserInfo StylishArgs +parserInfo = OA.info (OA.helper <*> parseStylishArgs) $ + OA.fullDesc <> + OA.header ("stylish-haskell v" <> showVersion Paths_stylish_haskell.version) + + +-------------------------------------------------------------------------------- main :: IO () -main = cmdArgs stylishArgs >>= stylishHaskell +main = OA.execParser parserInfo >>= stylishHaskell -------------------------------------------------------------------------------- stylishHaskell :: StylishArgs -> IO () -stylishHaskell sa - | defaults sa = do - fileName <- defaultConfigFilePath - verbose' $ "Dumping config from " ++ fileName - readUTF8File fileName >>= putStr - | otherwise = do - conf <- loadConfig verbose' (config sa) - let steps = configSteps conf - forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" - verbose' $ "Extra language extensions: " ++ - show (configLanguageExtensions conf) - mapM_ (file sa conf) files' +stylishHaskell sa = do + unless (saNoUtf8 sa) $ + mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout] + case saDefaults sa of + True -> do + fileName <- defaultConfigFilePath + verbose' $ "Dumping config from " ++ fileName + readUTF8File fileName >>= putStr + False -> do + conf <- loadConfig verbose' (saConfig sa) + let steps = configSteps conf + forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" + verbose' $ "Extra language extensions: " ++ + show (configLanguageExtensions conf) + mapM_ (file sa conf) files' where - verbose' = makeVerbose (verbose sa) - files' = if null (files sa) then [Nothing] else map Just (files sa) + verbose' = makeVerbose (saVerbose sa) + files' = if null (saFiles sa) then [Nothing] else map Just (saFiles sa) -------------------------------------------------------------------------------- @@ -73,18 +105,18 @@ let result = runSteps (configLanguageExtensions conf) mfp (configSteps conf) $ lines contents case result of - Left err -> hPutStrLn stderr err >> write contents contents + Left err -> IO.hPutStrLn IO.stderr err >> write contents contents Right ok -> write contents $ unlines ok where write old new = case mfp of Nothing -> putStr new - Just _ | not (inPlace sa) -> putStr new + Just _ | not (saInPlace sa) -> putStr new Just path | length new /= 0 && old /= new -> writeFile path new _ -> return () readUTF8File :: FilePath -> IO String readUTF8File fp = - withFile fp ReadMode $ \h -> do - hSetEncoding h utf8 - content <- hGetContents h + IO.withFile fp IO.ReadMode $ \h -> do + IO.hSetEncoding h IO.utf8 + content <- IO.Strict.hGetContents h return content diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,5 +1,5 @@ Name: stylish-haskell -Version: 0.5.16.0 +Version: 0.5.17.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 @@ -64,8 +64,8 @@ Build-depends: stylish-haskell, - strict >= 0.3 && < 0.4, - cmdargs >= 0.9 && < 0.11, + strict >= 0.3 && < 0.4, + optparse-applicative >= 0.12 && < 0.13, -- Copied from regular dependencies... aeson >= 0.6 && < 0.12, base >= 4.8 && < 5, @@ -102,7 +102,6 @@ aeson >= 0.6 && < 0.12, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, - cmdargs >= 0.9 && < 0.11, containers >= 0.3 && < 0.6, directory >= 1.1 && < 1.3, filepath >= 1.1 && < 1.5, diff --git a/tests/Language/Haskell/Stylish/Parse/Tests.hs b/tests/Language/Haskell/Stylish/Parse/Tests.hs --- a/tests/Language/Haskell/Stylish/Parse/Tests.hs +++ b/tests/Language/Haskell/Stylish/Parse/Tests.hs @@ -1,4 +1,3 @@ --------------------------------------------------------------------------------- module Language.Haskell.Stylish.Parse.Tests ( tests ) where @@ -22,8 +21,19 @@ , testCase "Multiline CPP" testMultilineCpp , testCase "Haskell2010 extension" testHaskell2010 , testCase "Shebang" testShebang + , testCase "ShebangExt" testShebangExt ] +-------------------------------------------------------------------------------- +testShebangExt :: Assertion +testShebangExt = assert $ isRight $ parseModule [] Nothing input + where + input = unlines + [ "#!env runghc" + , "{-# LANGUAGE CPP #-}" + , "#define foo bar \\" + , " qux" + ] -------------------------------------------------------------------------------- testBom :: Assertion