{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

module Ormolu.Utils.Extensions
  ( Extension (..),
    getExtensionsFromCabalFile,
    findCabalFile,
    getCabalExtensionDynOptions,
  )
where

import Control.Exception
import Control.Monad.IO.Class
import qualified Data.ByteString as B
import Data.List (find)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Maybe (maybeToList)
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Parsec
import Language.Haskell.Extension
import Ormolu.Config
import Ormolu.Exception
import System.Directory
import System.FilePath
import System.IO.Error (isDoesNotExistError)

-- | Get a map from Haskell source file paths (without any extensions)
-- to its default language extensions
getExtensionsFromCabalFile ::
  MonadIO m =>
  -- | Path to cabal file
  FilePath ->
  m (Map FilePath [DynOption])
getExtensionsFromCabalFile :: FilePath -> m (Map FilePath [DynOption])
getExtensionsFromCabalFile FilePath
cabalFile = IO (Map FilePath [DynOption]) -> m (Map FilePath [DynOption])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map FilePath [DynOption]) -> m (Map FilePath [DynOption]))
-> IO (Map FilePath [DynOption]) -> m (Map FilePath [DynOption])
forall a b. (a -> b) -> a -> b
$ do
  GenericPackageDescription {[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
[PackageFlag]
Maybe Version
Maybe (CondTree ConfVar [Dependency] Library)
PackageDescription
packageDescription :: GenericPackageDescription -> PackageDescription
gpdScannedVersion :: GenericPackageDescription -> Maybe Version
genPackageFlags :: GenericPackageDescription -> [PackageFlag]
condLibrary :: GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condSubLibraries :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condForeignLibs :: GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condExecutables :: GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condTestSuites :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condBenchmarks :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
genPackageFlags :: [PackageFlag]
gpdScannedVersion :: Maybe Version
packageDescription :: PackageDescription
..} <-
    ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe (ByteString -> Maybe GenericPackageDescription)
-> IO ByteString -> IO (Maybe GenericPackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile FilePath
cabalFile IO (Maybe GenericPackageDescription)
-> (Maybe GenericPackageDescription
    -> IO GenericPackageDescription)
-> IO GenericPackageDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just GenericPackageDescription
gpd -> GenericPackageDescription -> IO GenericPackageDescription
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenericPackageDescription
gpd
      Maybe GenericPackageDescription
Nothing -> OrmoluException -> IO GenericPackageDescription
forall e a. Exception e => e -> IO a
throwIO (OrmoluException -> IO GenericPackageDescription)
-> OrmoluException -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath -> OrmoluException
OrmoluCabalFileParsingFailed FilePath
cabalFile
  let lib :: [CondTree ConfVar [Dependency] Library]
lib = Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
maybeToList Maybe (CondTree ConfVar [Dependency] Library)
condLibrary
      sublibs :: [CondTree ConfVar [Dependency] Library]
sublibs = (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [CondTree ConfVar [Dependency] Library]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries
  Map FilePath [DynOption] -> IO (Map FilePath [DynOption])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FilePath [DynOption] -> IO (Map FilePath [DynOption]))
-> ([[Map FilePath [DynOption]]] -> Map FilePath [DynOption])
-> [[Map FilePath [DynOption]]]
-> IO (Map FilePath [DynOption])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map FilePath [DynOption]] -> Map FilePath [DynOption]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map FilePath [DynOption]] -> Map FilePath [DynOption])
-> ([[Map FilePath [DynOption]]] -> [Map FilePath [DynOption]])
-> [[Map FilePath [DynOption]]]
-> Map FilePath [DynOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Map FilePath [DynOption]]] -> [Map FilePath [DynOption]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Map FilePath [DynOption]]] -> IO (Map FilePath [DynOption]))
-> [[Map FilePath [DynOption]]] -> IO (Map FilePath [DynOption])
forall a b. (a -> b) -> a -> b
$
    [ (Library -> ([FilePath], [DynOption]))
-> CondTree ConfVar [Dependency] Library
-> Map FilePath [DynOption]
forall k t a v c.
Ord k =>
(t -> ([k], a)) -> CondTree v c t -> Map k a
buildMap Library -> ([FilePath], [DynOption])
extractFromLibrary (CondTree ConfVar [Dependency] Library -> Map FilePath [DynOption])
-> [CondTree ConfVar [Dependency] Library]
-> [Map FilePath [DynOption]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CondTree ConfVar [Dependency] Library]
lib [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
forall a. [a] -> [a] -> [a]
++ [CondTree ConfVar [Dependency] Library]
sublibs,
      (Executable -> ([FilePath], [DynOption]))
-> CondTree ConfVar [Dependency] Executable
-> Map FilePath [DynOption]
forall k t a v c.
Ord k =>
(t -> ([k], a)) -> CondTree v c t -> Map k a
buildMap Executable -> ([FilePath], [DynOption])
extractFromExecutable (CondTree ConfVar [Dependency] Executable
 -> Map FilePath [DynOption])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Map FilePath [DynOption]
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)
 -> Map FilePath [DynOption])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [Map FilePath [DynOption]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables,
      (TestSuite -> ([FilePath], [DynOption]))
-> CondTree ConfVar [Dependency] TestSuite
-> Map FilePath [DynOption]
forall k t a v c.
Ord k =>
(t -> ([k], a)) -> CondTree v c t -> Map k a
buildMap TestSuite -> ([FilePath], [DynOption])
extractFromTestSuite (CondTree ConfVar [Dependency] TestSuite
 -> Map FilePath [DynOption])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Map FilePath [DynOption]
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)
 -> Map FilePath [DynOption])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [Map FilePath [DynOption]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites,
      (Benchmark -> ([FilePath], [DynOption]))
-> CondTree ConfVar [Dependency] Benchmark
-> Map FilePath [DynOption]
forall k t a v c.
Ord k =>
(t -> ([k], a)) -> CondTree v c t -> Map k a
buildMap Benchmark -> ([FilePath], [DynOption])
extractFromBenchmark (CondTree ConfVar [Dependency] Benchmark
 -> Map FilePath [DynOption])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Map FilePath [DynOption]
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)
 -> Map FilePath [DynOption])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Map FilePath [DynOption]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks
    ]
  where
    buildMap :: (t -> ([k], a)) -> CondTree v c t -> Map k a
buildMap t -> ([k], a)
f CondTree v c t
a = let ([k]
files, a
exts) = t -> ([k], a)
f (CondTree v c t -> t
forall v c a. CondTree v c a -> a
condTreeData CondTree v c t
a) in [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, a)] -> Map k a) -> [(k, a)] -> Map k a
forall a b. (a -> b) -> a -> b
$ (,a
exts) (k -> (k, a)) -> [k] -> [(k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [k]
files

    extractFromBuildInfo :: [FilePath] -> BuildInfo -> ([FilePath], [DynOption])
extractFromBuildInfo [FilePath]
extraModules BuildInfo {Bool
[FilePath]
[(FilePath, FilePath)]
[Language]
[Extension]
[Dependency]
[ExeDependency]
[LegacyExeDependency]
[Mixin]
[ModuleName]
[PkgconfigDependency]
Maybe Language
PerCompilerFlavor [FilePath]
buildable :: BuildInfo -> Bool
buildTools :: BuildInfo -> [LegacyExeDependency]
buildToolDepends :: BuildInfo -> [ExeDependency]
cppOptions :: BuildInfo -> [FilePath]
asmOptions :: BuildInfo -> [FilePath]
cmmOptions :: BuildInfo -> [FilePath]
ccOptions :: BuildInfo -> [FilePath]
cxxOptions :: BuildInfo -> [FilePath]
ldOptions :: BuildInfo -> [FilePath]
pkgconfigDepends :: BuildInfo -> [PkgconfigDependency]
frameworks :: BuildInfo -> [FilePath]
extraFrameworkDirs :: BuildInfo -> [FilePath]
asmSources :: BuildInfo -> [FilePath]
cmmSources :: BuildInfo -> [FilePath]
cSources :: BuildInfo -> [FilePath]
cxxSources :: BuildInfo -> [FilePath]
jsSources :: BuildInfo -> [FilePath]
hsSourceDirs :: BuildInfo -> [FilePath]
otherModules :: BuildInfo -> [ModuleName]
virtualModules :: BuildInfo -> [ModuleName]
autogenModules :: BuildInfo -> [ModuleName]
defaultLanguage :: BuildInfo -> Maybe Language
otherLanguages :: BuildInfo -> [Language]
defaultExtensions :: BuildInfo -> [Extension]
otherExtensions :: BuildInfo -> [Extension]
oldExtensions :: BuildInfo -> [Extension]
extraLibs :: BuildInfo -> [FilePath]
extraGHCiLibs :: BuildInfo -> [FilePath]
extraBundledLibs :: BuildInfo -> [FilePath]
extraLibFlavours :: BuildInfo -> [FilePath]
extraDynLibFlavours :: BuildInfo -> [FilePath]
extraLibDirs :: BuildInfo -> [FilePath]
includeDirs :: BuildInfo -> [FilePath]
includes :: BuildInfo -> [FilePath]
autogenIncludes :: BuildInfo -> [FilePath]
installIncludes :: BuildInfo -> [FilePath]
options :: BuildInfo -> PerCompilerFlavor [FilePath]
profOptions :: BuildInfo -> PerCompilerFlavor [FilePath]
sharedOptions :: BuildInfo -> PerCompilerFlavor [FilePath]
staticOptions :: BuildInfo -> PerCompilerFlavor [FilePath]
customFieldsBI :: BuildInfo -> [(FilePath, FilePath)]
targetBuildDepends :: BuildInfo -> [Dependency]
mixins :: BuildInfo -> [Mixin]
mixins :: [Mixin]
targetBuildDepends :: [Dependency]
customFieldsBI :: [(FilePath, FilePath)]
staticOptions :: PerCompilerFlavor [FilePath]
sharedOptions :: PerCompilerFlavor [FilePath]
profOptions :: PerCompilerFlavor [FilePath]
options :: PerCompilerFlavor [FilePath]
installIncludes :: [FilePath]
autogenIncludes :: [FilePath]
includes :: [FilePath]
includeDirs :: [FilePath]
extraLibDirs :: [FilePath]
extraDynLibFlavours :: [FilePath]
extraLibFlavours :: [FilePath]
extraBundledLibs :: [FilePath]
extraGHCiLibs :: [FilePath]
extraLibs :: [FilePath]
oldExtensions :: [Extension]
otherExtensions :: [Extension]
defaultExtensions :: [Extension]
otherLanguages :: [Language]
defaultLanguage :: Maybe Language
autogenModules :: [ModuleName]
virtualModules :: [ModuleName]
otherModules :: [ModuleName]
hsSourceDirs :: [FilePath]
jsSources :: [FilePath]
cxxSources :: [FilePath]
cSources :: [FilePath]
cmmSources :: [FilePath]
asmSources :: [FilePath]
extraFrameworkDirs :: [FilePath]
frameworks :: [FilePath]
pkgconfigDepends :: [PkgconfigDependency]
ldOptions :: [FilePath]
cxxOptions :: [FilePath]
ccOptions :: [FilePath]
cmmOptions :: [FilePath]
asmOptions :: [FilePath]
cppOptions :: [FilePath]
buildToolDepends :: [ExeDependency]
buildTools :: [LegacyExeDependency]
buildable :: Bool
..} = (,[DynOption]
exts) ([FilePath] -> ([FilePath], [DynOption]))
-> [FilePath] -> ([FilePath], [DynOption])
forall a b. (a -> b) -> a -> b
$ do
      FilePath
m <- [FilePath]
extraModules [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (ModuleName -> FilePath
ModuleName.toFilePath (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
otherModules)
      (FilePath -> FilePath
takeDirectory FilePath
cabalFile FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
dropExtensions FilePath
m) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
hsSourceDirs
      where
        exts :: [DynOption]
exts = [DynOption]
-> (Language -> [DynOption]) -> Maybe Language -> [DynOption]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Language -> [DynOption]
langExt Maybe Language
defaultLanguage [DynOption] -> [DynOption] -> [DynOption]
forall a. [a] -> [a] -> [a]
++ (Extension -> DynOption) -> [Extension] -> [DynOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extension -> DynOption
extToDynOption [Extension]
defaultExtensions
        langExt :: Language -> [DynOption]
langExt =
          DynOption -> [DynOption]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynOption -> [DynOption])
-> (Language -> DynOption) -> Language -> [DynOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DynOption
DynOption (FilePath -> DynOption)
-> (Language -> FilePath) -> Language -> DynOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Language
Haskell98 -> FilePath
"-XHaskell98"
            Language
Haskell2010 -> FilePath
"-XHaskell2010"
            UnknownLanguage FilePath
lan -> FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
lan
        extToDynOption :: Extension -> DynOption
extToDynOption =
          FilePath -> DynOption
DynOption (FilePath -> DynOption)
-> (Extension -> FilePath) -> Extension -> DynOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            EnableExtension KnownExtension
e -> FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ KnownExtension -> FilePath
forall a. Show a => a -> FilePath
show KnownExtension
e
            DisableExtension KnownExtension
e -> FilePath
"-XNo" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ KnownExtension -> FilePath
forall a. Show a => a -> FilePath
show KnownExtension
e
            UnknownExtension FilePath
e -> FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e

    extractFromLibrary :: Library -> ([FilePath], [DynOption])
extractFromLibrary Library {Bool
[ModuleReexport]
[ModuleName]
BuildInfo
LibraryName
LibraryVisibility
libName :: Library -> LibraryName
exposedModules :: Library -> [ModuleName]
reexportedModules :: Library -> [ModuleReexport]
signatures :: Library -> [ModuleName]
libExposed :: Library -> Bool
libVisibility :: Library -> LibraryVisibility
libBuildInfo :: Library -> BuildInfo
libBuildInfo :: BuildInfo
libVisibility :: LibraryVisibility
libExposed :: Bool
signatures :: [ModuleName]
reexportedModules :: [ModuleReexport]
exposedModules :: [ModuleName]
libName :: LibraryName
..} =
      [FilePath] -> BuildInfo -> ([FilePath], [DynOption])
extractFromBuildInfo (ModuleName -> FilePath
ModuleName.toFilePath (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
exposedModules) BuildInfo
libBuildInfo
    extractFromExecutable :: Executable -> ([FilePath], [DynOption])
extractFromExecutable Executable {FilePath
BuildInfo
ExecutableScope
UnqualComponentName
exeName :: Executable -> UnqualComponentName
modulePath :: Executable -> FilePath
exeScope :: Executable -> ExecutableScope
buildInfo :: Executable -> BuildInfo
buildInfo :: BuildInfo
exeScope :: ExecutableScope
modulePath :: FilePath
exeName :: UnqualComponentName
..} =
      [FilePath] -> BuildInfo -> ([FilePath], [DynOption])
extractFromBuildInfo [FilePath
modulePath] BuildInfo
buildInfo
    extractFromTestSuite :: TestSuite -> ([FilePath], [DynOption])
extractFromTestSuite TestSuite {BuildInfo
TestSuiteInterface
UnqualComponentName
testName :: TestSuite -> UnqualComponentName
testInterface :: TestSuite -> TestSuiteInterface
testBuildInfo :: TestSuite -> BuildInfo
testBuildInfo :: BuildInfo
testInterface :: TestSuiteInterface
testName :: UnqualComponentName
..} =
      [FilePath] -> BuildInfo -> ([FilePath], [DynOption])
extractFromBuildInfo [FilePath]
mainPath BuildInfo
testBuildInfo
      where
        mainPath :: [FilePath]
mainPath = case TestSuiteInterface
testInterface of
          TestSuiteExeV10 Version
_ FilePath
p -> [FilePath
p]
          TestSuiteLibV09 Version
_ ModuleName
p -> [ModuleName -> FilePath
ModuleName.toFilePath ModuleName
p]
          TestSuiteUnsupported {} -> []
    extractFromBenchmark :: Benchmark -> ([FilePath], [DynOption])
extractFromBenchmark Benchmark {BuildInfo
BenchmarkInterface
UnqualComponentName
benchmarkName :: Benchmark -> UnqualComponentName
benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkBuildInfo :: Benchmark -> BuildInfo
benchmarkBuildInfo :: BuildInfo
benchmarkInterface :: BenchmarkInterface
benchmarkName :: UnqualComponentName
..} =
      [FilePath] -> BuildInfo -> ([FilePath], [DynOption])
extractFromBuildInfo [FilePath]
mainPath BuildInfo
benchmarkBuildInfo
      where
        mainPath :: [FilePath]
mainPath = case BenchmarkInterface
benchmarkInterface of
          BenchmarkExeV10 Version
_ FilePath
p -> [FilePath
p]
          BenchmarkUnsupported {} -> []

-- | Find the path to an appropriate .cabal file for a Haskell
-- source file, if available
findCabalFile ::
  MonadIO m =>
  -- | Absolute path to a Haskell source file in a project with a .cabal file
  FilePath ->
  m (Maybe FilePath)
findCabalFile :: FilePath -> m (Maybe FilePath)
findCabalFile FilePath
p = IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> m (Maybe FilePath))
-> IO (Maybe FilePath) -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
  let parentDir :: FilePath
parentDir = FilePath -> FilePath
takeDirectory FilePath
p
  [FilePath]
ps <-
    FilePath -> IO [FilePath]
listDirectory FilePath
parentDir IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \case
      (IOError -> Bool
isDoesNotExistError -> Bool
True) -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      IOError
e -> IOError -> IO [FilePath]
forall e a. Exception e => e -> IO a
throwIO IOError
e
  case (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".cabal") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
ps of
    Just FilePath
cabalFile -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> (FilePath -> Maybe FilePath) -> FilePath -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
parentDir FilePath -> FilePath -> FilePath
</> FilePath
cabalFile
    Maybe FilePath
Nothing ->
      if FilePath -> Bool
isDrive FilePath
parentDir
        then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        else FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findCabalFile FilePath
parentDir

-- | Get the default language extensions of a Haskell source file.
-- The .cabal file can be provided explicitly or auto-detected.
getCabalExtensionDynOptions ::
  MonadIO m =>
  -- | Haskell source file
  FilePath ->
  m [DynOption]
getCabalExtensionDynOptions :: FilePath -> m [DynOption]
getCabalExtensionDynOptions FilePath
sourceFile' = IO [DynOption] -> m [DynOption]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DynOption] -> m [DynOption])
-> IO [DynOption] -> m [DynOption]
forall a b. (a -> b) -> a -> b
$ do
  FilePath
sourceFile <- FilePath -> IO FilePath
makeAbsolute FilePath
sourceFile'
  Maybe FilePath
mCabalFile <- FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findCabalFile FilePath
sourceFile
  case Maybe FilePath
mCabalFile of
    Just FilePath
cabalFile -> do
      Map FilePath [DynOption]
extsByFile <- FilePath -> IO (Map FilePath [DynOption])
forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Map FilePath [DynOption])
getExtensionsFromCabalFile FilePath
cabalFile
      [DynOption] -> IO [DynOption]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DynOption] -> IO [DynOption]) -> [DynOption] -> IO [DynOption]
forall a b. (a -> b) -> a -> b
$ [DynOption] -> FilePath -> Map FilePath [DynOption] -> [DynOption]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] (FilePath -> FilePath
dropExtensions FilePath
sourceFile) Map FilePath [DynOption]
extsByFile
    Maybe FilePath
Nothing -> [DynOption] -> IO [DynOption]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []