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


--------------------------------------------------------------------------------
-- | Find the closest .cabal file, possibly going up the directory structure.
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


--------------------------------------------------------------------------------
-- | Extract @default-extensions@ fields from a @.cabal@ file
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
"\"."