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 -> 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)
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
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