Skip to content

Commit fd391c0

Browse files
jaspervdjjaspervdj
authored
Add a cabal option to control cabal parsing
1 parent c0b1fd9 commit fd391c0

File tree

5 files changed

+138
-93
lines changed

5 files changed

+138
-93
lines changed

‎data/stylish-haskell.yaml‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -241,3 +241,9 @@ newline: native
241241
# language_extensions:
242242
# - TemplateHaskell
243243
# - QuasiQuotes
244+
245+
# Attempt to find the cabal file in ancestors of the current directory, and
246+
# parse options (currently only language extensions) from that.
247+
#
248+
# Default: true
249+
cabal: true

‎lib/Language/Haskell/Stylish/Config.hs‎

Lines changed: 14 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -16,33 +16,23 @@ import Data.Aeson (FromJSON (..)
1616
import qualified Data.Aeson as A
1717
import qualified Data.Aeson.Types as A
1818
import qualified Data.ByteString as B
19-
import Data.Either (isRight)
2019
import qualified Data.FileEmbed as FileEmbed
21-
import Data.List (concatMap,
22-
inits,
23-
intercalate,
20+
import Data.List (intercalate,
2421
nub)
2522
import Data.Map (Map)
2623
import qualified Data.Map as M
27-
import Data.Maybe (fromMaybe,
28-
maybeToList)
24+
import Data.Maybe (fromMaybe)
2925
import Data.Yaml (decodeEither',
3026
prettyPrintParseException)
31-
import qualified Distribution.PackageDescription as Cabal
32-
import qualified Distribution.PackageDescription.Parsec as Cabal
33-
import qualified Distribution.Simple.Utils as Cabal
34-
import qualified Distribution.Types.CondTree as Cabal
35-
import qualified Distribution.Verbosity as Cabal
36-
import qualified Language.Haskell.Extension as Language
3727
import System.Directory
38-
import System.FilePath (joinPath,
39-
splitPath,
40-
(</>))
28+
import System.FilePath ((</>))
4129
import qualified System.IO as IO (Newline (..),
4230
nativeNewline)
4331

4432

4533
--------------------------------------------------------------------------------
34+
import qualified Language.Haskell.Stylish.Config.Cabal as Cabal
35+
import Language.Haskell.Stylish.Config.Internal
4636
import Language.Haskell.Stylish.Step
4737
import qualified Language.Haskell.Stylish.Step.Imports as Imports
4838
import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas
@@ -64,6 +54,7 @@ data Config = Config
6454
, configColumns :: Int
6555
, configLanguageExtensions :: [String]
6656
, configNewline :: IO.Newline
57+
, configCabal :: Bool
6758
}
6859

6960

@@ -95,10 +86,6 @@ configFilePath verbose Nothing = do
9586

9687
return mbConfig
9788

98-
-- All ancestors of a dir (including that dir)
99-
ancestors :: FilePath -> [FilePath]
100-
ancestors = init . map joinPath . reverse . inits . splitPath
101-
10289
search :: Verbose -> [FilePath] -> IO (Maybe FilePath)
10390
search _ [] = return Nothing
10491
search verbose (f : fs) = do
@@ -117,75 +104,15 @@ loadConfig verbose userSpecified = do
117104
Left err -> error $
118105
"Language.Haskell.Stylish.Config.loadConfig: " ++ prettyPrintParseException err
119106
Right config -> do
120-
mbCabalFile <- cabalFilePath verbose
121-
exsFromCabal <- case mbCabalFile of
122-
Just cabalFile -> map show <$>
123-
readDefaultLanguageExtensions verbose cabalFile
124-
Nothing -> return []
125-
let exsFromConfig = configLanguageExtensions config
126-
return $ config {configLanguageExtensions = nub (exsFromConfig <> exsFromCabal)}
107+
cabalLanguageExtensions <- if configCabal config
108+
then map show <$> Cabal.findLanguageExtensions verbose
109+
else pure []
127110

128-
--------------------------------------------------------------------------------
129-
-- | Find the closest .cabal file, possibly going up the directory structure.
130-
-- It's essential that
131-
cabalFilePath :: Verbose -> IO (Maybe FilePath)
132-
cabalFilePath verbose = do
133-
potentialProjectRoots <- ancestors <$> getCurrentDirectory
134-
potentialCabalFile <- filter isRight <$>
135-
traverse Cabal.findPackageDesc potentialProjectRoots
136-
case potentialCabalFile of
137-
[Right cabalFile] -> return (Just cabalFile)
138-
_ -> do
139-
verbose $ ".cabal file not found, directories searched: " <>
140-
show potentialProjectRoots
141-
verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."
142-
return Nothing
111+
return $ config
112+
{ configLanguageExtensions = nub $
113+
configLanguageExtensions config ++ cabalLanguageExtensions
114+
}
143115

144-
--------------------------------------------------------------------------------
145-
-- | Extract @default-extensions@ fields from a @.cabal@ file
146-
readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension]
147-
readDefaultLanguageExtensions verbose cabalFile = do
148-
verbose $ "Parsing " <> cabalFile <> "..."
149-
packageDescription <- Cabal.readGenericPackageDescription Cabal.silent cabalFile
150-
let library :: [Cabal.Library]
151-
library = maybeToList $ fst . Cabal.ignoreConditions <$>
152-
Cabal.condLibrary packageDescription
153-
154-
subLibraries :: [Cabal.Library]
155-
subLibraries = fst . Cabal.ignoreConditions . snd <$>
156-
Cabal.condSubLibraries packageDescription
157-
158-
executables :: [Cabal.Executable]
159-
executables = fst . Cabal.ignoreConditions . snd <$>
160-
Cabal.condExecutables packageDescription
161-
162-
testSuites :: [Cabal.TestSuite]
163-
testSuites = fst . Cabal.ignoreConditions . snd <$>
164-
Cabal.condTestSuites packageDescription
165-
166-
benchmarks :: [Cabal.Benchmark]
167-
benchmarks = fst . Cabal.ignoreConditions . snd <$>
168-
Cabal.condBenchmarks packageDescription
169-
170-
gatherBuildInfos :: [Cabal.BuildInfo]
171-
gatherBuildInfos = map Cabal.libBuildInfo library <>
172-
map Cabal.libBuildInfo subLibraries <>
173-
map Cabal.buildInfo executables <>
174-
map Cabal.testBuildInfo testSuites <>
175-
map Cabal.benchmarkBuildInfo benchmarks
176-
177-
defaultExtensions :: [Language.KnownExtension]
178-
defaultExtensions = map fromEnabled . filter isEnabled $
179-
concatMap Cabal.defaultExtensions gatherBuildInfos
180-
where isEnabled (Language.EnableExtension _) = True
181-
isEnabled _ = False
182-
183-
fromEnabled (Language.EnableExtension x) = x
184-
fromEnabled x =
185-
error $ "Language.Haskell.Stylish.Config.readLanguageExtensions: " <>
186-
"invalid LANGUAGE pragma: " <> show x
187-
verbose $ "Gathered default-extensions: " <> show defaultExtensions
188-
pure $ nub defaultExtensions
189116

190117
--------------------------------------------------------------------------------
191118
parseConfig :: A.Value -> A.Parser Config
@@ -196,6 +123,7 @@ parseConfig (A.Object o) = do
196123
<*> (o A..:? "columns" A..!= 80)
197124
<*> (o A..:? "language_extensions" A..!= [])
198125
<*> (o A..:? "newline" >>= parseEnum newlines IO.nativeNewline)
126+
<*> (o A..:? "cabal" A..!= True)
199127

200128
-- Then fill in the steps based on the partial config we already have
201129
stepValues <- o A..: "steps" :: A.Parser [A.Value]

‎lib/Language/Haskell/Stylish/Config/Cabal.hs‎

Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
--------------------------------------------------------------------------------
2+
module Language.Haskell.Stylish.Config.Cabal
3+
( findLanguageExtensions
4+
) where
5+
6+
7+
--------------------------------------------------------------------------------
8+
import Data.Either (isRight)
9+
import Data.List (nub)
10+
import Data.Maybe (maybeToList)
11+
import qualified Distribution.PackageDescription as Cabal
12+
import qualified Distribution.PackageDescription.Parsec as Cabal
13+
import qualified Distribution.Simple.Utils as Cabal
14+
import qualified Distribution.Types.CondTree as Cabal
15+
import qualified Distribution.Verbosity as Cabal
16+
import qualified Language.Haskell.Extension as Language
17+
import Language.Haskell.Stylish.Verbose
18+
import System.Directory (getCurrentDirectory)
19+
20+
21+
--------------------------------------------------------------------------------
22+
import Language.Haskell.Stylish.Config.Internal
23+
24+
25+
--------------------------------------------------------------------------------
26+
findLanguageExtensions :: Verbose -> IO [Language.KnownExtension]
27+
findLanguageExtensions verbose =
28+
findCabalFile verbose >>=
29+
maybe (pure []) (readDefaultLanguageExtensions verbose)
30+
31+
32+
--------------------------------------------------------------------------------
33+
-- | Find the closest .cabal file, possibly going up the directory structure.
34+
findCabalFile :: Verbose -> IO (Maybe FilePath)
35+
findCabalFile verbose = do
36+
potentialProjectRoots <- ancestors <$> getCurrentDirectory
37+
potentialCabalFile <- filter isRight <$>
38+
traverse Cabal.findPackageDesc potentialProjectRoots
39+
case potentialCabalFile of
40+
[Right cabalFile] -> return (Just cabalFile)
41+
_ -> do
42+
verbose $ ".cabal file not found, directories searched: " <>
43+
show potentialProjectRoots
44+
verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files."
45+
return Nothing
46+
47+
48+
--------------------------------------------------------------------------------
49+
-- | Extract @default-extensions@ fields from a @.cabal@ file
50+
readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension]
51+
readDefaultLanguageExtensions verbose cabalFile = do
52+
verbose $ "Parsing " <> cabalFile <> "..."
53+
packageDescription <- Cabal.readGenericPackageDescription Cabal.silent cabalFile
54+
let library :: [Cabal.Library]
55+
library = maybeToList $ fst . Cabal.ignoreConditions <$>
56+
Cabal.condLibrary packageDescription
57+
58+
subLibraries :: [Cabal.Library]
59+
subLibraries = fst . Cabal.ignoreConditions . snd <$>
60+
Cabal.condSubLibraries packageDescription
61+
62+
executables :: [Cabal.Executable]
63+
executables = fst . Cabal.ignoreConditions . snd <$>
64+
Cabal.condExecutables packageDescription
65+
66+
testSuites :: [Cabal.TestSuite]
67+
testSuites = fst . Cabal.ignoreConditions . snd <$>
68+
Cabal.condTestSuites packageDescription
69+
70+
benchmarks :: [Cabal.Benchmark]
71+
benchmarks = fst . Cabal.ignoreConditions . snd <$>
72+
Cabal.condBenchmarks packageDescription
73+
74+
gatherBuildInfos :: [Cabal.BuildInfo]
75+
gatherBuildInfos = map Cabal.libBuildInfo library <>
76+
map Cabal.libBuildInfo subLibraries <>
77+
map Cabal.buildInfo executables <>
78+
map Cabal.testBuildInfo testSuites <>
79+
map Cabal.benchmarkBuildInfo benchmarks
80+
81+
defaultExtensions :: [Language.KnownExtension]
82+
defaultExtensions = map fromEnabled . filter isEnabled $
83+
concatMap Cabal.defaultExtensions gatherBuildInfos
84+
where isEnabled (Language.EnableExtension _) = True
85+
isEnabled _ = False
86+
87+
fromEnabled (Language.EnableExtension x) = x
88+
fromEnabled x =
89+
error $ "Language.Haskell.Stylish.Config.readLanguageExtensions: " <>
90+
"invalid LANGUAGE pragma: " <> show x
91+
verbose $ "Gathered default-extensions: " <> show defaultExtensions
92+
pure $ nub defaultExtensions

‎lib/Language/Haskell/Stylish/Config/Internal.hs‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
--------------------------------------------------------------------------------
2+
module Language.Haskell.Stylish.Config.Internal
3+
( ancestors
4+
) where
5+
6+
7+
--------------------------------------------------------------------------------
8+
import Data.List (inits)
9+
import System.FilePath (joinPath, splitPath)
10+
11+
12+
--------------------------------------------------------------------------------
13+
-- All ancestors of a dir (including that dir)
14+
ancestors :: FilePath -> [FilePath]
15+
ancestors = map joinPath . reverse . dropWhile null . inits . splitPath

‎stylish-haskell.cabal‎

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@ Library
4141
Language.Haskell.Stylish.Align
4242
Language.Haskell.Stylish.Block
4343
Language.Haskell.Stylish.Config
44+
Language.Haskell.Stylish.Config.Cabal
45+
Language.Haskell.Stylish.Config.Internal
4446
Language.Haskell.Stylish.Editor
4547
Language.Haskell.Stylish.Parse
4648
Language.Haskell.Stylish.Step
@@ -52,7 +54,7 @@ Library
5254
aeson >= 0.6 && < 1.5,
5355
base >= 4.8 && < 5,
5456
bytestring >= 0.9 && < 0.11,
55-
Cabal >= 2.4.0.1,
57+
Cabal >= 2.4 && < 2.5,
5658
containers >= 0.3 && < 0.7,
5759
directory >= 1.2.3 && < 1.4,
5860
filepath >= 1.1 && < 1.5,
@@ -76,8 +78,8 @@ Executable stylish-haskell
7678
aeson >= 0.6 && < 1.5,
7779
base >= 4.8 && < 5,
7880
bytestring >= 0.9 && < 0.11,
81+
Cabal >= 2.4 && < 2.5,
7982
containers >= 0.3 && < 0.7,
80-
Cabal >= 2.4.0.1,
8183
directory >= 1.2.3 && < 1.4,
8284
filepath >= 1.1 && < 1.5,
8385
file-embed >= 0.0.10 && < 0.1,
@@ -96,19 +98,21 @@ Test-suite stylish-haskell-tests
9698
Language.Haskell.Stylish.Align
9799
Language.Haskell.Stylish.Block
98100
Language.Haskell.Stylish.Config
101+
Language.Haskell.Stylish.Config.Cabal
102+
Language.Haskell.Stylish.Config.Internal
99103
Language.Haskell.Stylish.Config.Tests
100104
Language.Haskell.Stylish.Editor
101105
Language.Haskell.Stylish.Parse
102106
Language.Haskell.Stylish.Parse.Tests
103107
Language.Haskell.Stylish.Step
104-
Language.Haskell.Stylish.Step.SimpleAlign
105-
Language.Haskell.Stylish.Step.SimpleAlign.Tests
106-
Language.Haskell.Stylish.Step.Squash
107-
Language.Haskell.Stylish.Step.Squash.Tests
108108
Language.Haskell.Stylish.Step.Imports
109109
Language.Haskell.Stylish.Step.Imports.Tests
110110
Language.Haskell.Stylish.Step.LanguagePragmas
111111
Language.Haskell.Stylish.Step.LanguagePragmas.Tests
112+
Language.Haskell.Stylish.Step.SimpleAlign
113+
Language.Haskell.Stylish.Step.SimpleAlign.Tests
114+
Language.Haskell.Stylish.Step.Squash
115+
Language.Haskell.Stylish.Step.Squash.Tests
112116
Language.Haskell.Stylish.Step.Tabs
113117
Language.Haskell.Stylish.Step.Tabs.Tests
114118
Language.Haskell.Stylish.Step.TrailingWhitespace
@@ -128,8 +132,8 @@ Test-suite stylish-haskell-tests
128132
aeson >= 0.6 && < 1.5,
129133
base >= 4.8 && < 5,
130134
bytestring >= 0.9 && < 0.11,
135+
Cabal >= 2.4 && < 2.5,
131136
containers >= 0.3 && < 0.7,
132-
Cabal >= 2.4.0.1,
133137
directory >= 1.2.3 && < 1.4,
134138
filepath >= 1.1 && < 1.5,
135139
file-embed >= 0.0.10 && < 0.1,

0 commit comments

Comments
 (0)