1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Config.Cabal
( findLanguageExtensions
) where
--------------------------------------------------------------------------------
import Control.Monad (unless)
import qualified Data.ByteString.Char8 as BS
import Data.Either (isRight)
import Data.Foldable (traverse_)
import Data.List (nub)
import Data.Maybe (maybeToList)
import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription.Parsec as Cabal
import qualified Distribution.Parsec as Cabal
import qualified Distribution.Simple.Utils as Cabal
import qualified Distribution.Verbosity as Cabal
import qualified Language.Haskell.Extension as Language
import Language.Haskell.Stylish.Verbose
import System.Directory (doesFileExist,
getCurrentDirectory)
--------------------------------------------------------------------------------
import Language.Haskell.Stylish.Config.Internal
import GHC.Data.Maybe (mapMaybe)
--------------------------------------------------------------------------------
findLanguageExtensions :: Verbose -> IO [(Language.KnownExtension, Bool)]
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, Bool)]
readDefaultLanguageExtensions verbose cabalFile = do
verbose $ "Parsing " <> cabalFile <> "..."
packageDescription <- 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, Bool)]
defaultExtensions = mapMaybe toPair $
concatMap Cabal.defaultExtensions gatherBuildInfos
where toPair (Language.EnableExtension x) = Just (x, True)
toPair (Language.DisableExtension x) = Just (x, False)
toPair _ = Nothing
verbose $ "Gathered default-extensions: " <> show defaultExtensions
pure $ nub defaultExtensions
readGenericPackageDescription :: Cabal.Verbosity -> FilePath -> IO Cabal.GenericPackageDescription
readGenericPackageDescription = readAndParseFile Cabal.parseGenericPackageDescription
where
readAndParseFile parser verbosity fpath = do
exists <- doesFileExist fpath
unless exists $
Cabal.die' verbosity $
"Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue."
bs <- BS.readFile fpath
parseString parser verbosity fpath bs
parseString parser verbosity name bs = do
let (warnings, result) = Cabal.runParseResult (parser bs)
traverse_ (Cabal.warn verbosity . Cabal.showPWarning name) warnings
case result of
Right x -> return x
Left (_, errors) -> do
traverse_ (Cabal.warn verbosity . Cabal.showPError name) errors
Cabal.die' verbosity $ "Failed parsing \"" ++ name ++ "\"."
|
