Add a cabal option to control cabal parsing

5 files changed, 138 insertions, 93 deletions

diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml
index 4677b4a..401d384 100644
--- a/data/stylish-haskell.yaml
+++ b/data/stylish-haskell.yaml
@@ -241,3 +241,9 @@ newline: native
 # language_extensions:
   # - TemplateHaskell
   # - QuasiQuotes
+
+# Attempt to find the cabal file in ancestors of the current directory, and
+# parse options (currently only language extensions) from that.
+#
+# Default: true
+cabal: true
diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs
index b7ada3b..8f43131 100644
--- a/lib/Language/Haskell/Stylish/Config.hs
+++ b/lib/Language/Haskell/Stylish/Config.hs
@@ -16,33 +16,23 @@ import           Data.Aeson                                       (FromJSON (..)
 import qualified Data.Aeson                                       as A
 import qualified Data.Aeson.Types                                 as A
 import qualified Data.ByteString                                  as B
-import           Data.Either                                      (isRight)
 import qualified Data.FileEmbed                                   as FileEmbed
-import           Data.List                                        (concatMap,
-                                                                   inits,
-                                                                   intercalate,
+import           Data.List                                        (intercalate,
                                                                    nub)
 import           Data.Map                                         (Map)
 import qualified Data.Map                                         as M
-import           Data.Maybe                                       (fromMaybe,
-                                                                   maybeToList)
+import           Data.Maybe                                       (fromMaybe)
 import           Data.Yaml                                        (decodeEither',
                                                                    prettyPrintParseException)
-import qualified Distribution.PackageDescription                  as Cabal
-import qualified Distribution.PackageDescription.Parsec           as Cabal
-import qualified Distribution.Simple.Utils                        as Cabal
-import qualified Distribution.Types.CondTree                      as Cabal
-import qualified Distribution.Verbosity                           as Cabal
-import qualified Language.Haskell.Extension                       as Language
 import           System.Directory
-import           System.FilePath                                  (joinPath,
-                                                                   splitPath,
-                                                                   (</>))
+import           System.FilePath                                  ((</>))
 import qualified System.IO                                        as IO (Newline (..),
                                                                          nativeNewline)
 
 
 --------------------------------------------------------------------------------
+import qualified Language.Haskell.Stylish.Config.Cabal            as Cabal
+import           Language.Haskell.Stylish.Config.Internal
 import           Language.Haskell.Stylish.Step
 import qualified Language.Haskell.Stylish.Step.Imports            as Imports
 import qualified Language.Haskell.Stylish.Step.LanguagePragmas    as LanguagePragmas
@@ -64,6 +54,7 @@ data Config = Config
     , configColumns            :: Int
     , configLanguageExtensions :: [String]
     , configNewline            :: IO.Newline
+    , configCabal              :: Bool
     }
 
 
@@ -95,10 +86,6 @@ configFilePath verbose Nothing              = do
 
     return mbConfig
 
--- All ancestors of a dir (including that dir)
-ancestors :: FilePath -> [FilePath]
-ancestors = init . map joinPath . reverse . inits . splitPath
-
 search :: Verbose -> [FilePath] -> IO (Maybe FilePath)
 search _ []             = return Nothing
 search verbose (f : fs) = do
@@ -117,75 +104,15 @@ loadConfig verbose userSpecified = do
         Left err     -> error $
             "Language.Haskell.Stylish.Config.loadConfig: " ++ prettyPrintParseException err
         Right config -> do
-          mbCabalFile <- cabalFilePath verbose
-          exsFromCabal <- case mbCabalFile of
-                            Just cabalFile -> map show <$>
-                              readDefaultLanguageExtensions verbose cabalFile
-                            Nothing -> return []
-          let exsFromConfig = configLanguageExtensions config
-          return $ config {configLanguageExtensions = nub (exsFromConfig <> exsFromCabal)}
+          cabalLanguageExtensions <- if configCabal config
+            then map show <$> Cabal.findLanguageExtensions verbose
+            else pure []
 
---------------------------------------------------------------------------------
--- | Find the closest .cabal file, possibly going up the directory structure.
---   It's essential that
-cabalFilePath :: Verbose -> IO (Maybe FilePath)
-cabalFilePath verbose = do
-  potentialProjectRoots <- ancestors <$> getCurrentDirectory
-  potentialCabalFile <- filter isRight <$>
-    traverse Cabal.findPackageDesc potentialProjectRoots
-  case potentialCabalFile of
-    [Right cabalFile] -> return (Just cabalFile)
-    _ -> do
-      verbose $ ".cabal file not found, directories searched: " <>
-        show potentialProjectRoots
-      verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."
-      return Nothing
+          return $ config
+            { configLanguageExtensions = nub $
+                configLanguageExtensions config ++ cabalLanguageExtensions
+            }
 
---------------------------------------------------------------------------------
--- | Extract @default-extensions@ fields from a @.cabal@ file
-readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension]
-readDefaultLanguageExtensions verbose cabalFile = do
-  verbose $ "Parsing " <> cabalFile <> "..."
-  packageDescription <- Cabal.readGenericPackageDescription Cabal.silent cabalFile
-  let library :: [Cabal.Library]
-      library = maybeToList $ fst . Cabal.ignoreConditions <$>
-        Cabal.condLibrary packageDescription
-
-      subLibraries :: [Cabal.Library]
-      subLibraries = fst . Cabal.ignoreConditions . snd <$>
-        Cabal.condSubLibraries packageDescription
-
-      executables :: [Cabal.Executable]
-      executables = fst . Cabal.ignoreConditions . snd <$>
-        Cabal.condExecutables packageDescription
-
-      testSuites :: [Cabal.TestSuite]
-      testSuites = fst . Cabal.ignoreConditions . snd <$>
-        Cabal.condTestSuites packageDescription
-
-      benchmarks :: [Cabal.Benchmark]
-      benchmarks = fst . Cabal.ignoreConditions . snd <$>
-        Cabal.condBenchmarks packageDescription
-
-      gatherBuildInfos :: [Cabal.BuildInfo]
-      gatherBuildInfos = map Cabal.libBuildInfo library <>
-                         map Cabal.libBuildInfo subLibraries <>
-                         map Cabal.buildInfo executables <>
-                         map Cabal.testBuildInfo testSuites <>
-                         map Cabal.benchmarkBuildInfo benchmarks
-
-      defaultExtensions :: [Language.KnownExtension]
-      defaultExtensions = map fromEnabled . filter isEnabled $
-        concatMap Cabal.defaultExtensions gatherBuildInfos
-        where isEnabled (Language.EnableExtension _) = True
-              isEnabled _                            = False
-
-              fromEnabled (Language.EnableExtension x) = x
-              fromEnabled x                             =
-                error $ "Language.Haskell.Stylish.Config.readLanguageExtensions: " <>
-                        "invalid LANGUAGE pragma:  " <> show x
-  verbose $ "Gathered default-extensions: " <> show defaultExtensions
-  pure $ nub defaultExtensions
 
 --------------------------------------------------------------------------------
 parseConfig :: A.Value -> A.Parser Config
@@ -196,6 +123,7 @@ parseConfig (A.Object o) = do
         <*> (o A..:? "columns"             A..!= 80)
         <*> (o A..:? "language_extensions" A..!= [])
         <*> (o A..:? "newline"             >>= parseEnum newlines IO.nativeNewline)
+        <*> (o A..:? "cabal"               A..!= True)
 
     -- Then fill in the steps based on the partial config we already have
     stepValues <- o A..: "steps" :: A.Parser [A.Value]
diff --git a/lib/Language/Haskell/Stylish/Config/Cabal.hs b/lib/Language/Haskell/Stylish/Config/Cabal.hs
new file mode 100644
index 0000000..0160af4
--- /dev/null
+++ b/lib/Language/Haskell/Stylish/Config/Cabal.hs
@@ -0,0 +1,92 @@
+--------------------------------------------------------------------------------
+module Language.Haskell.Stylish.Config.Cabal
+    ( findLanguageExtensions
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Data.Either                              (isRight)
+import           Data.List                                (nub)
+import           Data.Maybe                               (maybeToList)
+import qualified Distribution.PackageDescription          as Cabal
+import qualified Distribution.PackageDescription.Parsec   as Cabal
+import qualified Distribution.Simple.Utils                as Cabal
+import qualified Distribution.Types.CondTree              as Cabal
+import qualified Distribution.Verbosity                   as Cabal
+import qualified Language.Haskell.Extension               as Language
+import           Language.Haskell.Stylish.Verbose
+import           System.Directory                         (getCurrentDirectory)
+
+
+--------------------------------------------------------------------------------
+import           Language.Haskell.Stylish.Config.Internal
+
+
+--------------------------------------------------------------------------------
+findLanguageExtensions :: Verbose -> IO [Language.KnownExtension]
+findLanguageExtensions verbose =
+    findCabalFile verbose >>=
+    maybe (pure []) (readDefaultLanguageExtensions verbose)
+
+
+--------------------------------------------------------------------------------
+-- | Find the closest .cabal file, possibly going up the directory structure.
+findCabalFile :: Verbose -> IO (Maybe FilePath)
+findCabalFile verbose = do
+  potentialProjectRoots <- ancestors <$> getCurrentDirectory
+  potentialCabalFile <- filter isRight <$>
+    traverse Cabal.findPackageDesc potentialProjectRoots
+  case potentialCabalFile of
+    [Right cabalFile] -> return (Just cabalFile)
+    _ -> do
+      verbose $ ".cabal file not found, directories searched: " <>
+        show potentialProjectRoots
+      verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."
+      return Nothing
+
+
+--------------------------------------------------------------------------------
+-- | Extract @default-extensions@ fields from a @.cabal@ file
+readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension]
+readDefaultLanguageExtensions verbose cabalFile = do
+  verbose $ "Parsing " <> cabalFile <> "..."
+  packageDescription <- Cabal.readGenericPackageDescription Cabal.silent cabalFile
+  let library :: [Cabal.Library]
+      library = maybeToList $ fst . Cabal.ignoreConditions <$>
+        Cabal.condLibrary packageDescription
+
+      subLibraries :: [Cabal.Library]
+      subLibraries = fst . Cabal.ignoreConditions . snd <$>
+        Cabal.condSubLibraries packageDescription
+
+      executables :: [Cabal.Executable]
+      executables = fst . Cabal.ignoreConditions . snd <$>
+        Cabal.condExecutables packageDescription
+
+      testSuites :: [Cabal.TestSuite]
+      testSuites = fst . Cabal.ignoreConditions . snd <$>
+        Cabal.condTestSuites packageDescription
+
+      benchmarks :: [Cabal.Benchmark]
+      benchmarks = fst . Cabal.ignoreConditions . snd <$>
+        Cabal.condBenchmarks packageDescription
+
+      gatherBuildInfos :: [Cabal.BuildInfo]
+      gatherBuildInfos = map Cabal.libBuildInfo library <>
+                         map Cabal.libBuildInfo subLibraries <>
+                         map Cabal.buildInfo executables <>
+                         map Cabal.testBuildInfo testSuites <>
+                         map Cabal.benchmarkBuildInfo benchmarks
+
+      defaultExtensions :: [Language.KnownExtension]
+      defaultExtensions = map fromEnabled . filter isEnabled $
+        concatMap Cabal.defaultExtensions gatherBuildInfos
+        where isEnabled (Language.EnableExtension _) = True
+              isEnabled _                            = False
+
+              fromEnabled (Language.EnableExtension x) = x
+              fromEnabled x                             =
+                error $ "Language.Haskell.Stylish.Config.readLanguageExtensions: " <>
+                        "invalid LANGUAGE pragma:  " <> show x
+  verbose $ "Gathered default-extensions: " <> show defaultExtensions
+  pure $ nub defaultExtensions
diff --git a/lib/Language/Haskell/Stylish/Config/Internal.hs b/lib/Language/Haskell/Stylish/Config/Internal.hs
new file mode 100644
index 0000000..b6160f9
--- /dev/null
+++ b/lib/Language/Haskell/Stylish/Config/Internal.hs
@@ -0,0 +1,15 @@
+--------------------------------------------------------------------------------
+module Language.Haskell.Stylish.Config.Internal
+    ( ancestors
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Data.List       (inits)
+import           System.FilePath (joinPath, splitPath)
+
+
+--------------------------------------------------------------------------------
+-- All ancestors of a dir (including that dir)
+ancestors :: FilePath -> [FilePath]
+ancestors = map joinPath . reverse . dropWhile null . inits . splitPath
diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal
index 9de3eb6..ade40ba 100644
--- a/stylish-haskell.cabal
+++ b/stylish-haskell.cabal
@@ -41,6 +41,8 @@ Library
     Language.Haskell.Stylish.Align
     Language.Haskell.Stylish.Block
     Language.Haskell.Stylish.Config
+    Language.Haskell.Stylish.Config.Cabal
+    Language.Haskell.Stylish.Config.Internal
     Language.Haskell.Stylish.Editor
     Language.Haskell.Stylish.Parse
     Language.Haskell.Stylish.Step
@@ -52,7 +54,7 @@ Library
     aeson            >= 0.6    && < 1.5,
     base             >= 4.8    && < 5,
     bytestring       >= 0.9    && < 0.11,
-    Cabal            >= 2.4.0.1,
+    Cabal            >= 2.4    && < 2.5,
     containers       >= 0.3    && < 0.7,
     directory        >= 1.2.3  && < 1.4,
     filepath         >= 1.1    && < 1.5,
@@ -76,8 +78,8 @@ Executable stylish-haskell
     aeson            >= 0.6    && < 1.5,
     base             >= 4.8    && < 5,
     bytestring       >= 0.9    && < 0.11,
+    Cabal            >= 2.4    && < 2.5,
     containers       >= 0.3    && < 0.7,
-    Cabal            >= 2.4.0.1,
     directory        >= 1.2.3  && < 1.4,
     filepath         >= 1.1    && < 1.5,
     file-embed       >= 0.0.10 && < 0.1,
@@ -96,19 +98,21 @@ Test-suite stylish-haskell-tests
     Language.Haskell.Stylish.Align
     Language.Haskell.Stylish.Block
     Language.Haskell.Stylish.Config
+    Language.Haskell.Stylish.Config.Cabal
+    Language.Haskell.Stylish.Config.Internal
     Language.Haskell.Stylish.Config.Tests
     Language.Haskell.Stylish.Editor
     Language.Haskell.Stylish.Parse
     Language.Haskell.Stylish.Parse.Tests
     Language.Haskell.Stylish.Step
-    Language.Haskell.Stylish.Step.SimpleAlign
-    Language.Haskell.Stylish.Step.SimpleAlign.Tests
-    Language.Haskell.Stylish.Step.Squash
-    Language.Haskell.Stylish.Step.Squash.Tests
     Language.Haskell.Stylish.Step.Imports
     Language.Haskell.Stylish.Step.Imports.Tests
     Language.Haskell.Stylish.Step.LanguagePragmas
     Language.Haskell.Stylish.Step.LanguagePragmas.Tests
+    Language.Haskell.Stylish.Step.SimpleAlign
+    Language.Haskell.Stylish.Step.SimpleAlign.Tests
+    Language.Haskell.Stylish.Step.Squash
+    Language.Haskell.Stylish.Step.Squash.Tests
     Language.Haskell.Stylish.Step.Tabs
     Language.Haskell.Stylish.Step.Tabs.Tests
     Language.Haskell.Stylish.Step.TrailingWhitespace
@@ -128,8 +132,8 @@ Test-suite stylish-haskell-tests
     aeson            >= 0.6    && < 1.5,
     base             >= 4.8    && < 5,
     bytestring       >= 0.9    && < 0.11,
+    Cabal            >= 2.4    && < 2.5,
     containers       >= 0.3    && < 0.7,
-    Cabal            >= 2.4.0.1,
     directory        >= 1.2.3  && < 1.4,
     filepath         >= 1.1    && < 1.5,
     file-embed       >= 0.0.10 && < 0.1,