From a491bc5088ac962772b60dbf24095753a88fb57d Mon Sep 17 00:00:00 2001 From: Heather Date: Tue, 31 May 2016 17:18:09 +0400 Subject: [PATCH] utf8 encoding support (code with Unicode operators) --- src/Main.hs | 185 ++++++++++++++++++++++-------------------- stylish-haskell.cabal | 1 + 2 files changed, 96 insertions(+), 90 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 203ab529..4d3b83ab 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,90 +1,95 @@ --------------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable #-} -module Main - ( main - ) where - - --------------------------------------------------------------------------------- -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 Language.Haskell.Stylish - - --------------------------------------------------------------------------------- -data StylishArgs = StylishArgs - { config :: Maybe FilePath - , verbose :: Bool - , defaults :: Bool - , inPlace :: Bool - , files :: [FilePath] - } deriving (Data, Show, Typeable) - - --------------------------------------------------------------------------------- -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 - - --------------------------------------------------------------------------------- -main :: IO () -main = cmdArgs stylishArgs >>= 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' - where - verbose' = makeVerbose (verbose sa) - files' = if null (files sa) then [Nothing] else map Just (files sa) - - --------------------------------------------------------------------------------- --- | Processes a single file, or stdin if no filepath is given -file :: StylishArgs -> Config -> Maybe FilePath -> IO () -file sa conf mfp = do - contents <- maybe getContents readUTF8File mfp - let result = runSteps (configLanguageExtensions conf) - mfp (configSteps conf) $ lines contents - case result of - Left err -> hPutStrLn 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 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 - return content +-------------------------------------------------------------------------------- +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +module Main + ( main + ) where + + +-------------------------------------------------------------------------------- +import Control.Monad (forM_) +import qualified Data.ByteString.Lazy.Char8 as B +import Data.List (intercalate) +import qualified Data.Text.Lazy as T +import Data.Text.Lazy.Encoding (decodeUtf8) +import Data.Version (Version (..)) +import System.Console.CmdArgs +import System.IO (hPutStrLn, hSetEncoding, stderr, + stdin, stdout, utf8) + + +-------------------------------------------------------------------------------- +import Language.Haskell.Stylish + + +-------------------------------------------------------------------------------- +data StylishArgs = StylishArgs + { config :: Maybe FilePath + , verbose :: Bool + , defaults :: Bool + , inPlace :: Bool + , files :: [FilePath] + } deriving (Data, Show, Typeable) + + +-------------------------------------------------------------------------------- +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 + + +-------------------------------------------------------------------------------- +main :: IO () +main = do + mapM_ (`hSetEncoding` utf8) [stdin, stdout] + cmdArgs stylishArgs >>= 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' + where + verbose' = makeVerbose (verbose sa) + files' = if null (files sa) then [Nothing] else map Just (files sa) + + +-------------------------------------------------------------------------------- +-- | Processes a single file, or stdin if no filepath is given +file :: StylishArgs -> Config -> Maybe FilePath -> IO () +file sa conf mfp = do + contents <- maybe getContents readUTF8File mfp + let result = runSteps (configLanguageExtensions conf) + mfp (configSteps conf) $ lines contents + case result of + Left err -> hPutStrLn 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 path | length new /= 0 && old /= new -> writeFile path new + _ -> return () + +readUTF8File :: FilePath -> IO String +readUTF8File fp = do + content <- B.readFile fp + let utf = decodeUtf8 content + return (T.unpack utf) diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index b2273f7d..814080d0 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -70,6 +70,7 @@ Executable stylish-haskell aeson >= 0.6 && < 0.12, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, + text >= 1.0 && < 1.3, containers >= 0.3 && < 0.6, directory >= 1.1 && < 1.3, filepath >= 1.1 && < 1.5,