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 -> IO [(KnownExtension, Bool)]
findLanguageExtensions Verbose
verbose =
Verbose -> IO (Maybe String)
findCabalFile Verbose
verbose IO (Maybe String)
-> (Maybe String -> IO [(KnownExtension, Bool)])
-> IO [(KnownExtension, Bool)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO [(KnownExtension, Bool)]
-> (String -> IO [(KnownExtension, Bool)])
-> Maybe String
-> IO [(KnownExtension, Bool)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(KnownExtension, Bool)] -> IO [(KnownExtension, Bool)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Verbose -> String -> IO [(KnownExtension, Bool)]
readDefaultLanguageExtensions Verbose
verbose)
findCabalFile :: Verbose -> IO (Maybe FilePath)
findCabalFile :: Verbose -> IO (Maybe String)
findCabalFile Verbose
verbose = do
[String]
potentialProjectRoots <- String -> [String]
ancestors (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getCurrentDirectory
[Either String String]
potentialCabalFile <- (Either String String -> Bool)
-> [Either String String] -> [Either String String]
forall a. (a -> Bool) -> [a] -> [a]
filter Either String String -> Bool
forall a b. Either a b -> Bool
isRight ([Either String String] -> [Either String String])
-> IO [Either String String] -> IO [Either String String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(String -> IO (Either String String))
-> [String] -> IO [Either String String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> IO (Either String String)
Cabal.findPackageDesc [String]
potentialProjectRoots
case [Either String String]
potentialCabalFile of
[Right String
cabalFile] -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
cabalFile)
[Either String String]
_ -> do
Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ String
".cabal file not found, directories searched: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
[String] -> String
forall a. Show a => a -> String
show [String]
potentialProjectRoots
Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ String
"Stylish Haskell will work basing on LANGUAGE pragmas in source files."
Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [(Language.KnownExtension, Bool)]
readDefaultLanguageExtensions :: Verbose -> String -> IO [(KnownExtension, Bool)]
readDefaultLanguageExtensions Verbose
verbose String
cabalFile = do
Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ String
"Parsing " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cabalFile String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"..."
GenericPackageDescription
packageDescription <- Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
Cabal.silent String
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, Bool)]
defaultExtensions :: [(KnownExtension, Bool)]
defaultExtensions = (Extension -> Maybe (KnownExtension, Bool))
-> [Extension] -> [(KnownExtension, Bool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe (KnownExtension, Bool)
toPair ([Extension] -> [(KnownExtension, Bool)])
-> [Extension] -> [(KnownExtension, Bool)]
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 toPair :: Extension -> Maybe (KnownExtension, Bool)
toPair (Language.EnableExtension KnownExtension
x) = (KnownExtension, Bool) -> Maybe (KnownExtension, Bool)
forall a. a -> Maybe a
Just (KnownExtension
x, Bool
True)
toPair (Language.DisableExtension KnownExtension
x) = (KnownExtension, Bool) -> Maybe (KnownExtension, Bool)
forall a. a -> Maybe a
Just (KnownExtension
x, Bool
False)
toPair Extension
_ = Maybe (KnownExtension, Bool)
forall a. Maybe a
Nothing
Verbose
verbose Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$ String
"Gathered default-extensions: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(KnownExtension, Bool)] -> String
forall a. Show a => a -> String
show [(KnownExtension, Bool)]
defaultExtensions
[(KnownExtension, Bool)] -> IO [(KnownExtension, Bool)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(KnownExtension, Bool)] -> IO [(KnownExtension, Bool)])
-> [(KnownExtension, Bool)] -> IO [(KnownExtension, Bool)]
forall a b. (a -> b) -> a -> b
$ [(KnownExtension, Bool)] -> [(KnownExtension, Bool)]
forall a. Eq a => [a] -> [a]
nub [(KnownExtension, Bool)]
defaultExtensions
readGenericPackageDescription :: Cabal.Verbosity -> FilePath -> IO Cabal.GenericPackageDescription
readGenericPackageDescription :: Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription = (ByteString -> ParseResult GenericPackageDescription)
-> Verbosity -> String -> IO GenericPackageDescription
forall {b}.
(ByteString -> ParseResult b) -> Verbosity -> String -> IO b
readAndParseFile ByteString -> ParseResult GenericPackageDescription
Cabal.parseGenericPackageDescription
where
readAndParseFile :: (ByteString -> ParseResult b) -> Verbosity -> String -> IO b
readAndParseFile ByteString -> ParseResult b
parser Verbosity
verbosity String
fpath = do
Bool
exists <- String -> IO Bool
doesFileExist String
fpath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> Verbose
forall a. Verbosity -> String -> IO a
Cabal.die' Verbosity
verbosity Verbose -> Verbose
forall a b. (a -> b) -> a -> b
$
String
"Error Parsing: file \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fpath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" doesn't exist. Cannot continue."
ByteString
bs <- String -> IO ByteString
BS.readFile String
fpath
(ByteString -> ParseResult b)
-> Verbosity -> String -> ByteString -> IO b
forall {p} {b}.
(p -> ParseResult b) -> Verbosity -> String -> p -> IO b
parseString ByteString -> ParseResult b
parser Verbosity
verbosity String
fpath ByteString
bs
parseString :: (p -> ParseResult b) -> Verbosity -> String -> p -> IO b
parseString p -> ParseResult b
parser Verbosity
verbosity String
name p
bs = do
let ([PWarning]
warnings, Either (Maybe Version, NonEmpty PError) b
result) = ParseResult b
-> ([PWarning], Either (Maybe Version, NonEmpty PError) b)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
Cabal.runParseResult (p -> ParseResult b
parser p
bs)
(PWarning -> IO ()) -> [PWarning] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> Verbose
Cabal.warn Verbosity
verbosity Verbose -> (PWarning -> String) -> PWarning -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PWarning -> String
Cabal.showPWarning String
name) [PWarning]
warnings
case Either (Maybe Version, NonEmpty PError) b
result of
Right b
x -> b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
Left (Maybe Version
_, NonEmpty PError
errors) -> do
(PError -> IO ()) -> NonEmpty PError -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> Verbose
Cabal.warn Verbosity
verbosity Verbose -> (PError -> String) -> PError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PError -> String
Cabal.showPError String
name) NonEmpty PError
errors
Verbosity -> String -> IO b
forall a. Verbosity -> String -> IO a
Cabal.die' Verbosity
verbosity (String -> IO b) -> String -> IO b
forall a b. (a -> b) -> a -> b
$ String
"Failed parsing \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"."