--------------------------------------------------------------------------------
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.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 -> IO [KnownExtension]
findLanguageExtensions Verbose
verbose =
    Verbose -> IO (Maybe FilePath)
findCabalFile Verbose
verbose IO (Maybe FilePath)
-> (Maybe FilePath -> IO [KnownExtension]) -> IO [KnownExtension]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    IO [KnownExtension]
-> (FilePath -> IO [KnownExtension])
-> Maybe FilePath
-> IO [KnownExtension]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([KnownExtension] -> IO [KnownExtension]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Verbose -> FilePath -> IO [KnownExtension]
readDefaultLanguageExtensions Verbose
verbose)


--------------------------------------------------------------------------------
-- | Find the closest .cabal file, possibly going up the directory structure.
findCabalFile :: Verbose -> IO (Maybe FilePath)
findCabalFile :: Verbose -> IO (Maybe FilePath)
findCabalFile Verbose
verbose = do
  [FilePath]
potentialProjectRoots <- FilePath -> [FilePath]
ancestors (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory
  [Either FilePath FilePath]
potentialCabalFile <- (Either FilePath FilePath -> Bool)
-> [Either FilePath FilePath] -> [Either FilePath FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter Either FilePath FilePath -> Bool
forall a b. Either a b -> Bool
isRight ([Either FilePath FilePath] -> [Either FilePath FilePath])
-> IO [Either FilePath FilePath] -> IO [Either FilePath FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (FilePath -> IO (Either FilePath FilePath))
-> [FilePath] -> IO [Either FilePath FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Either FilePath FilePath)
Cabal.findPackageDesc [FilePath]
potentialProjectRoots
  case [Either FilePath FilePath]
potentialCabalFile of
    [Right FilePath
cabalFile] -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
cabalFile)
    [Either FilePath FilePath]
_ -> do
      Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ FilePath
".cabal file not found, directories searched: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
        [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
potentialProjectRoots
      Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ FilePath
"Stylish Haskell will work basing on LANGUAGE pragmas in source files."
      Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
-- | Extract @default-extensions@ fields from a @.cabal@ file
readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension]
readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [KnownExtension]
readDefaultLanguageExtensions Verbose
verbose FilePath
cabalFile = do
  Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ FilePath
"Parsing " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cabalFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"..."
  GenericPackageDescription
packageDescription <- Verbosity -> FilePath -> IO GenericPackageDescription
Cabal.readGenericPackageDescription Verbosity
Cabal.silent FilePath
cabalFile
  let library :: [Cabal.Library]
      library :: [Library]
library = Maybe Library -> [Library]
forall a. Maybe a -> [a]
maybeToList (Maybe Library -> [Library]) -> Maybe Library -> [Library]
forall a b. (a -> b) -> a -> b
$ (Library, [Dependency]) -> Library
forall a b. (a, b) -> a
fst ((Library, [Dependency]) -> Library)
-> (CondTree ConfVar [Dependency] Library
    -> (Library, [Dependency]))
-> CondTree ConfVar [Dependency] Library
-> Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Library -> (Library, [Dependency])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
Cabal.ignoreConditions (CondTree ConfVar [Dependency] Library -> Library)
-> Maybe (CondTree ConfVar [Dependency] Library) -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
Cabal.condLibrary GenericPackageDescription
packageDescription

      subLibraries :: [Cabal.Library]
      subLibraries :: [Library]
subLibraries = (Library, [Dependency]) -> Library
forall a b. (a, b) -> a
fst ((Library, [Dependency]) -> Library)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> (Library, [Dependency]))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Library -> (Library, [Dependency])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
Cabal.ignoreConditions (CondTree ConfVar [Dependency] Library -> (Library, [Dependency]))
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> (Library, [Dependency])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [Library]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
Cabal.condSubLibraries GenericPackageDescription
packageDescription

      executables :: [Cabal.Executable]
      executables :: [Executable]
executables = (Executable, [Dependency]) -> Executable
forall a b. (a, b) -> a
fst ((Executable, [Dependency]) -> Executable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> (Executable, [Dependency]))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Executable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Executable
-> (Executable, [Dependency])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
Cabal.ignoreConditions (CondTree ConfVar [Dependency] Executable
 -> (Executable, [Dependency]))
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (Executable, [Dependency])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [Executable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
Cabal.condExecutables GenericPackageDescription
packageDescription

      testSuites :: [Cabal.TestSuite]
      testSuites :: [TestSuite]
testSuites = (TestSuite, [Dependency]) -> TestSuite
forall a b. (a, b) -> a
fst ((TestSuite, [Dependency]) -> TestSuite)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> (TestSuite, [Dependency]))
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> TestSuite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] TestSuite
-> (TestSuite, [Dependency])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
Cabal.ignoreConditions (CondTree ConfVar [Dependency] TestSuite
 -> (TestSuite, [Dependency]))
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (TestSuite, [Dependency])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [TestSuite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
Cabal.condTestSuites GenericPackageDescription
packageDescription

      benchmarks :: [Cabal.Benchmark]
      benchmarks :: [Benchmark]
benchmarks = (Benchmark, [Dependency]) -> Benchmark
forall a b. (a, b) -> a
fst ((Benchmark, [Dependency]) -> Benchmark)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> (Benchmark, [Dependency]))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Benchmark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Benchmark
-> (Benchmark, [Dependency])
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
Cabal.ignoreConditions (CondTree ConfVar [Dependency] Benchmark
 -> (Benchmark, [Dependency]))
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> (Benchmark, [Dependency])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Benchmark]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
Cabal.condBenchmarks GenericPackageDescription
packageDescription

      gatherBuildInfos :: [Cabal.BuildInfo]
      gatherBuildInfos :: [BuildInfo]
gatherBuildInfos = (Library -> BuildInfo) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Library -> BuildInfo
Cabal.libBuildInfo [Library]
library [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. Semigroup a => a -> a -> a
<>
                         (Library -> BuildInfo) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Library -> BuildInfo
Cabal.libBuildInfo [Library]
subLibraries [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. Semigroup a => a -> a -> a
<>
                         (Executable -> BuildInfo) -> [Executable] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> BuildInfo
Cabal.buildInfo [Executable]
executables [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. Semigroup a => a -> a -> a
<>
                         (TestSuite -> BuildInfo) -> [TestSuite] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> BuildInfo
Cabal.testBuildInfo [TestSuite]
testSuites [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. Semigroup a => a -> a -> a
<>
                         (Benchmark -> BuildInfo) -> [Benchmark] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> BuildInfo
Cabal.benchmarkBuildInfo [Benchmark]
benchmarks

      defaultExtensions :: [Language.KnownExtension]
      defaultExtensions :: [KnownExtension]
defaultExtensions = (Extension -> KnownExtension) -> [Extension] -> [KnownExtension]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> KnownExtension
fromEnabled ([Extension] -> [KnownExtension])
-> ([Extension] -> [Extension]) -> [Extension] -> [KnownExtension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension -> Bool) -> [Extension] -> [Extension]
forall a. (a -> Bool) -> [a] -> [a]
filter Extension -> Bool
isEnabled ([Extension] -> [KnownExtension])
-> [Extension] -> [KnownExtension]
forall a b. (a -> b) -> a -> b
$
        (BuildInfo -> [Extension]) -> [BuildInfo] -> [Extension]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Extension]
Cabal.defaultExtensions [BuildInfo]
gatherBuildInfos
        where isEnabled :: Extension -> Bool
isEnabled (Language.EnableExtension KnownExtension
_) = Bool
True
              isEnabled Extension
_                            = Bool
False

              fromEnabled :: Extension -> KnownExtension
fromEnabled (Language.EnableExtension KnownExtension
x) = KnownExtension
x
              fromEnabled Extension
x                             =
                FilePath -> KnownExtension
forall a. HasCallStack => FilePath -> a
error (FilePath -> KnownExtension) -> FilePath -> KnownExtension
forall a b. (a -> b) -> a -> b
$ FilePath
"Language.Haskell.Stylish.Config.readLanguageExtensions: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
                        FilePath
"invalid LANGUAGE pragma:  " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Extension -> FilePath
forall a. Show a => a -> FilePath
show Extension
x
  Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ FilePath
"Gathered default-extensions: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [KnownExtension] -> FilePath
forall a. Show a => a -> FilePath
show [KnownExtension]
defaultExtensions
  [KnownExtension] -> IO [KnownExtension]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([KnownExtension] -> IO [KnownExtension])
-> [KnownExtension] -> IO [KnownExtension]
forall a b. (a -> b) -> a -> b
$ [KnownExtension] -> [KnownExtension]
forall a. Eq a => [a] -> [a]
nub [KnownExtension]
defaultExtensions