diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -1,6 +1,6 @@ # stylish-haskell configuration file # ================================== -# + # The stylish-haskell tool is mainly configured by specifying steps. These steps # are a list, so they have an order, and one specific step may appear more than # once (if needed). Each file is processed by these steps in the given order. @@ -53,3 +53,12 @@ # Remove trailing whitespace - trailing_whitespace: {} + +# Sometimes, language extensions are specified in a cabal file or from the +# command line instead of using language pragmas in the file. stylish-haskell +# needs to be aware of these, so it can parse the file correctly. +# +# No language extensions are enabled by default. +# language_extensions: + # - TemplateHaskell + # - QuasiQuotes diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -61,6 +61,8 @@ 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) @@ -72,6 +74,7 @@ file :: StylishArgs -> Config -> Maybe FilePath -> IO () file sa conf mfp = do contents <- maybe getContents readFile mfp - write $ unlines $ runSteps mfp (configSteps conf) $ lines contents + write $ unlines $ runSteps (configLanguageExtensions conf) + mfp (configSteps conf) $ lines contents where write = maybe putStr (if inPlace sa then writeFile else const putStr) mfp diff --git a/src/StylishHaskell.hs b/src/StylishHaskell.hs --- a/src/StylishHaskell.hs +++ b/src/StylishHaskell.hs @@ -6,17 +6,18 @@ -------------------------------------------------------------------------------- +import StylishHaskell.Config import StylishHaskell.Parse import StylishHaskell.Step -------------------------------------------------------------------------------- -runStep :: Maybe FilePath -> Step -> Lines -> Lines -runStep mfp step ls = case parseModule mfp (unlines ls) of +runStep :: Extensions -> Maybe FilePath -> Step -> Lines -> Lines +runStep exts mfp step ls = case parseModule exts mfp (unlines ls) of Left err -> error err -- TODO: maybe return original lines? Right module' -> stepFilter step ls module' -------------------------------------------------------------------------------- -runSteps :: Maybe FilePath -> [Step] -> Lines -> Lines -runSteps mfp = foldr (flip (.)) id . map (runStep mfp) +runSteps :: Extensions -> Maybe FilePath -> [Step] -> Lines -> Lines +runSteps exts mfp = foldr (flip (.)) id . map (runStep exts mfp) diff --git a/src/StylishHaskell/Config.hs b/src/StylishHaskell/Config.hs --- a/src/StylishHaskell/Config.hs +++ b/src/StylishHaskell/Config.hs @@ -1,7 +1,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module StylishHaskell.Config - ( Config (..) + ( Extensions + , Config (..) , defaultConfigFilePath , configFilePath , loadConfig @@ -35,8 +36,13 @@ -------------------------------------------------------------------------------- +type Extensions = [String] + + +-------------------------------------------------------------------------------- data Config = Config - { configSteps :: [Step] + { configSteps :: [Step] + , configLanguageExtensions :: [String] } @@ -47,7 +53,7 @@ -------------------------------------------------------------------------------- emptyConfig :: Config -emptyConfig = Config [] +emptyConfig = Config [] [] -------------------------------------------------------------------------------- @@ -101,6 +107,7 @@ parseConfig :: A.Value -> A.Parser Config parseConfig (A.Object o) = Config <$> (o A..: "steps" >>= fmap concat . mapM parseSteps) + <*> (o A..:? "language_extensions" A..!= []) parseConfig _ = mzero diff --git a/src/StylishHaskell/Parse.hs b/src/StylishHaskell/Parse.hs --- a/src/StylishHaskell/Parse.hs +++ b/src/StylishHaskell/Parse.hs @@ -5,11 +5,13 @@ -------------------------------------------------------------------------------- +import Control.Monad.Error (throwError) import Data.Maybe (fromMaybe) import qualified Language.Haskell.Exts.Annotated as H -------------------------------------------------------------------------------- +import StylishHaskell.Config import StylishHaskell.Step @@ -23,19 +25,32 @@ -------------------------------------------------------------------------------- +-- | Read an extension name from a string +parseExtension :: String -> Either String H.Extension +parseExtension str = case reads str of + [(x, "")] -> return x + _ -> throwError $ "Unknown extension: " ++ str + + +-------------------------------------------------------------------------------- -- | Abstraction over HSE's parsing -parseModule :: Maybe FilePath -> String -> Either String Module -parseModule mfp string = - let fp = fromMaybe "" mfp - -- Determine the extensions used in the file, and update the parsing - -- mode based upon those - exts = fromMaybe [] $ H.readExtensions string +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 + extraExts' <- mapM parseExtension extraExts + let fileExts = fromMaybe [] $ H.readExtensions string + exts = fileExts ++ extraExts' + + -- Parsing options... + fp = fromMaybe "" mfp mode = H.defaultParseMode {H.extensions = exts, H.fixities = Nothing} + -- Special handling for CPP, haskell-src-exts can't deal with it string' = if H.CPP `elem` exts then unCpp string else string - in case H.parseModuleWithComments mode string' of - H.ParseOk md -> Right md - err -> Left $ + + case H.parseModuleWithComments mode string' of + H.ParseOk md -> return md + err -> throwError $ "StylishHaskell.Parse.parseModule: could not parse " ++ fp ++ ": " ++ show err 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.3.0.0 +Version: 0.3.1.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 @@ -51,9 +51,10 @@ directory >= 1.1 && < 1.2, filepath >= 1.1 && < 1.4, haskell-src-exts >= 1.13 && < 1.14, + mtl >= 2.0 && < 2.2, + strict >= 0.3 && < 0.4, syb >= 0.3 && < 0.4, - yaml >= 0.7 && < 0.8, - strict >= 0.3 && < 0.4 + yaml >= 0.7 && < 0.9 Test-suite stylish-haskell-tests Ghc-options: -Wall @@ -82,9 +83,10 @@ directory >= 1.1 && < 1.2, filepath >= 1.1 && < 1.4, haskell-src-exts >= 1.13 && < 1.14, + mtl >= 2.0 && < 2.2, + strict >= 0.3 && < 0.4, syb >= 0.3 && < 0.4, - yaml >= 0.7 && < 0.8, - strict >= 0.3 && < 0.4 + yaml >= 0.7 && < 0.9 Source-repository head Type: git diff --git a/tests/StylishHaskell/Tests/Util.hs b/tests/StylishHaskell/Tests/Util.hs --- a/tests/StylishHaskell/Tests/Util.hs +++ b/tests/StylishHaskell/Tests/Util.hs @@ -10,7 +10,7 @@ -------------------------------------------------------------------------------- testStep :: Step -> String -> String -testStep step str = case parseModule Nothing str of +testStep step str = case parseModule [] Nothing str of Left err -> error err Right module' -> unlines $ stepFilter step ls module' where