1--------------------------------------------------------------------------------
2module Language.Haskell.Stylish.Config.Cabal
3    ( findLanguageExtensions
4    ) where
5
6
7--------------------------------------------------------------------------------
8import           Data.Either                              (isRight)
9import           Data.List                                (nub)
10import           Data.Maybe                               (maybeToList)
11import qualified Distribution.PackageDescription          as Cabal
12import qualified Distribution.PackageDescription.Parsec   as Cabal
13import qualified Distribution.Simple.Utils                as Cabal
14import qualified Distribution.Types.CondTree              as Cabal
15import qualified Distribution.Verbosity                   as Cabal
16import qualified Language.Haskell.Extension               as Language
17import           Language.Haskell.Stylish.Verbose
18import           System.Directory                         (getCurrentDirectory)
19
20
21--------------------------------------------------------------------------------
22import           Language.Haskell.Stylish.Config.Internal
23
24
25--------------------------------------------------------------------------------
26findLanguageExtensions :: Verbose -> IO [Language.KnownExtension]
27findLanguageExtensions verbose =
28    findCabalFile verbose >>=
29    maybe (pure []) (readDefaultLanguageExtensions verbose)
30
31
32--------------------------------------------------------------------------------
33-- | Find the closest .cabal file, possibly going up the directory structure.
34findCabalFile :: Verbose -> IO (Maybe FilePath)
35findCabalFile 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
50readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension]
51readDefaultLanguageExtensions 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
93