Merge tag '0.5.17.0'

0.5.17.0

7 files changed, 101 insertions, 59 deletions

diff --git a/CHANGELOG b/CHANGELOG
index d8f24d7..a6b87c2 100644
--- 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/README.markdown b/README.markdown
index 857f731..841198b 100644
--- a/README.markdown
+++ b/README.markdown
@@ -136,9 +136,3 @@ Contributors:
 - Leonid Onokhov
 - Michael Snoyman
 - Mikhail Glushenkov
-
-Changelog
----------
-
-- `0.5.9.0`
-    * Add `compact_line` setting for Language Pragma styling
diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml
index efc5695..fb12606 100644
--- a/data/stylish-haskell.yaml
+++ b/data/stylish-haskell.yaml
@@ -53,7 +53,7 @@ steps:
       #   > 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
index f8e24a6..3118380 100644
--- a/lib/Language/Haskell/Stylish/Parse.hs
+++ b/lib/Language/Haskell/Stylish/Parse.hs
@@ -9,7 +9,6 @@ import           Data.Maybe                      (fromMaybe, listToMaybe)
 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 @@ dropBom str              = str
 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 @@ parseModule extraExts mfp string = do
             }
 
         -- 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
index 203ab52..32d4780 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,12 +6,13 @@ module Main
 
 
 --------------------------------------------------------------------------------
-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 @@ import           Language.Haskell.Stylish
 
 --------------------------------------------------------------------------------
 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 @@ file sa conf mfp = do
     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
index b2273f7..2fed0d1 100644
--- 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 @@ Executable stylish-haskell
 
   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 @@ Test-suite stylish-haskell-tests
     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
index d5f3c1d..87c0a51 100644
--- 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 @@ tests = testGroup "Language.Haskell.Stylish.Parse"
     , 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