{-# LANGUAGE CPP #-}

{- |
Copyright: (c) 2020-2022 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Functions to extract extensions from the @.cabal@ files.
-}

module Extensions.Cabal
    ( parseCabalFileExtensions
    , parseCabalExtensions
    , extractCabalExtensions

      -- * Bridge between Cabal and GHC extensions
    , cabalToGhcExtension
    , toGhcExtension
    , toSafeExtensions
    ) where

import Control.Exception (throwIO)
import Data.ByteString (ByteString)
import Data.Either (partitionEithers)
import Data.Foldable (toList)
import Data.List (nub)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
import Data.Maybe (catMaybes, mapMaybe)
import Data.Text (Text)
import Distribution.ModuleName (ModuleName, toFilePath)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult)
import Distribution.Parsec.Error (PError, showPError)
import Distribution.Types.Benchmark (Benchmark (..))
import Distribution.Types.BenchmarkInterface (BenchmarkInterface (..))
import Distribution.Types.BuildInfo (BuildInfo (..))
import Distribution.Types.CondTree (CondTree (..))
import Distribution.Types.Executable (Executable (..))
import Distribution.Types.ForeignLib (ForeignLib (..))
import Distribution.Types.GenericPackageDescription (GenericPackageDescription (..))
import Distribution.Types.Library (Library (..))
import Distribution.Types.TestSuite (TestSuite (..))
import Distribution.Types.TestSuiteInterface (TestSuiteInterface (..))
#if MIN_VERSION_Cabal(3,6,0)
import Distribution.Utils.Path (getSymbolicPath)
#endif
import GHC.LanguageExtensions.Type (Extension (..))
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))

import Extensions.Types (CabalException (..), OnOffExtension (..), ParsedExtensions (..),
                         SafeHaskellExtension (..))

import qualified Data.ByteString as ByteString
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Language.Haskell.Extension as Cabal


{- | Parse default extensions from a @.cabal@ file under given
'FilePath'.

__Throws__:

* 'CabalException'
-}
parseCabalFileExtensions :: FilePath -> IO (Map FilePath ParsedExtensions)
parseCabalFileExtensions :: FilePath -> IO (Map FilePath ParsedExtensions)
parseCabalFileExtensions FilePath
cabalPath = FilePath -> IO Bool
doesFileExist FilePath
cabalPath IO Bool
-> (Bool -> IO (Map FilePath ParsedExtensions))
-> IO (Map FilePath ParsedExtensions)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
hasCabalFile ->
    if Bool
hasCabalFile
    then FilePath -> IO ByteString
ByteString.readFile FilePath
cabalPath IO ByteString
-> (ByteString -> IO (Map FilePath ParsedExtensions))
-> IO (Map FilePath ParsedExtensions)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> IO (Map FilePath ParsedExtensions)
parseCabalExtensions FilePath
cabalPath
    else CabalException -> IO (Map FilePath ParsedExtensions)
forall e a. Exception e => e -> IO a
throwIO (CabalException -> IO (Map FilePath ParsedExtensions))
-> CabalException -> IO (Map FilePath ParsedExtensions)
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
CabalFileNotFound FilePath
cabalPath

{- | Parse default extensions from a @.cabal@ file content. This
function takes a path to a @.cabal@ file. The path is only used for error
message. Pass empty string, if you don't have a path to @.cabal@ file.

__Throws__:

* 'CabalException'
-}
parseCabalExtensions :: FilePath -> ByteString -> IO (Map FilePath ParsedExtensions)
parseCabalExtensions :: FilePath -> ByteString -> IO (Map FilePath ParsedExtensions)
parseCabalExtensions FilePath
path ByteString
cabal = do
    let ([PWarning]
_warnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
res) = ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ParseResult GenericPackageDescription
 -> ([PWarning],
     Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
cabal
    case Either (Maybe Version, NonEmpty PError) GenericPackageDescription
res of
        Left (Maybe Version
_version, NonEmpty PError
errors) ->
            CabalException -> IO (Map FilePath ParsedExtensions)
forall e a. Exception e => e -> IO a
throwIO (CabalException -> IO (Map FilePath ParsedExtensions))
-> CabalException -> IO (Map FilePath ParsedExtensions)
forall a b. (a -> b) -> a -> b
$ Text -> CabalException
CabalParseError (Text -> CabalException) -> Text -> CabalException
forall a b. (a -> b) -> a -> b
$ NonEmpty PError -> Text
forall (f :: * -> *). Foldable f => f PError -> Text
prettyCabalErrors NonEmpty PError
errors
        Right GenericPackageDescription
pkgDesc -> GenericPackageDescription -> IO (Map FilePath ParsedExtensions)
extractCabalExtensions GenericPackageDescription
pkgDesc
  where
    prettyCabalErrors :: Foldable f => f PError -> Text
    prettyCabalErrors :: forall (f :: * -> *). Foldable f => f PError -> Text
prettyCabalErrors = Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> (f PError -> [Text]) -> f PError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PError -> Text) -> [PError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PError -> Text
errorToText ([PError] -> [Text])
-> (f PError -> [PError]) -> f PError -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f PError -> [PError]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

    errorToText :: PError -> Text
    errorToText :: PError -> Text
errorToText = FilePath -> Text
Text.pack (FilePath -> Text) -> (PError -> FilePath) -> PError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PError -> FilePath
showPError FilePath
path

{- | Extract Haskell Language extensions from a Cabal package
description.
-}
extractCabalExtensions :: GenericPackageDescription -> IO (Map FilePath ParsedExtensions)
extractCabalExtensions :: GenericPackageDescription -> IO (Map FilePath ParsedExtensions)
extractCabalExtensions GenericPackageDescription{[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
[PackageFlag]
Maybe Version
Maybe (CondTree ConfVar [Dependency] Library)
PackageDescription
packageDescription :: PackageDescription
gpdScannedVersion :: Maybe Version
genPackageFlags :: [PackageFlag]
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
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)]
..} = [IO (Map FilePath ParsedExtensions)]
-> IO (Map FilePath ParsedExtensions)
forall a. Monoid a => [a] -> a
mconcat
    [ (CondTree ConfVar [Dependency] Library
 -> IO (Map FilePath ParsedExtensions))
-> Maybe (CondTree ConfVar [Dependency] Library)
-> IO (Map FilePath ParsedExtensions)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap    CondTree ConfVar [Dependency] Library
-> IO (Map FilePath ParsedExtensions)
forall var deps.
CondTree var deps Library -> IO (Map FilePath ParsedExtensions)
libraryToExtensions Maybe (CondTree ConfVar [Dependency] Library)
condLibrary
    , (CondTree ConfVar [Dependency] Library
 -> IO (Map FilePath ParsedExtensions))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> IO (Map FilePath ParsedExtensions)
forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap CondTree ConfVar [Dependency] Library
-> IO (Map FilePath ParsedExtensions)
forall var deps.
CondTree var deps Library -> IO (Map FilePath ParsedExtensions)
libraryToExtensions [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries
    , (CondTree ConfVar [Dependency] ForeignLib
 -> IO (Map FilePath ParsedExtensions))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> IO (Map FilePath ParsedExtensions)
forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap CondTree ConfVar [Dependency] ForeignLib
-> IO (Map FilePath ParsedExtensions)
forall var deps.
CondTree var deps ForeignLib -> IO (Map FilePath ParsedExtensions)
foreignToExtensions [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs
    , (CondTree ConfVar [Dependency] Executable
 -> IO (Map FilePath ParsedExtensions))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> IO (Map FilePath ParsedExtensions)
forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap CondTree ConfVar [Dependency] Executable
-> IO (Map FilePath ParsedExtensions)
forall var deps.
CondTree var deps Executable -> IO (Map FilePath ParsedExtensions)
exeToExtensions     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables
    , (CondTree ConfVar [Dependency] TestSuite
 -> IO (Map FilePath ParsedExtensions))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> IO (Map FilePath ParsedExtensions)
forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap CondTree ConfVar [Dependency] TestSuite
-> IO (Map FilePath ParsedExtensions)
forall var deps.
CondTree var deps TestSuite -> IO (Map FilePath ParsedExtensions)
testToExtensions    [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites
    , (CondTree ConfVar [Dependency] Benchmark
 -> IO (Map FilePath ParsedExtensions))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> IO (Map FilePath ParsedExtensions)
forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap CondTree ConfVar [Dependency] Benchmark
-> IO (Map FilePath ParsedExtensions)
forall var deps.
CondTree var deps Benchmark -> IO (Map FilePath ParsedExtensions)
benchToExtensions   [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks
    ]
  where
    foldSndMap :: Monoid m => (a -> m) -> [(b, a)] -> m
    foldSndMap :: forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap a -> m
f = ((b, a) -> m) -> [(b, a)] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> ((b, a) -> a) -> (b, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, a) -> a
forall a b. (a, b) -> b
snd)

    libraryToExtensions :: CondTree var deps Library -> IO (Map FilePath ParsedExtensions)
    libraryToExtensions :: forall var deps.
CondTree var deps Library -> IO (Map FilePath ParsedExtensions)
libraryToExtensions = (Library -> [FilePath])
-> (Library -> BuildInfo)
-> CondTree var deps Library
-> IO (Map FilePath ParsedExtensions)
forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions
        ((ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FilePath
toModulePath ([ModuleName] -> [FilePath])
-> (Library -> [ModuleName]) -> Library -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> [ModuleName]
exposedModules)
        Library -> BuildInfo
libBuildInfo

    foreignToExtensions :: CondTree var deps ForeignLib -> IO (Map FilePath ParsedExtensions)
    foreignToExtensions :: forall var deps.
CondTree var deps ForeignLib -> IO (Map FilePath ParsedExtensions)
foreignToExtensions = (ForeignLib -> [FilePath])
-> (ForeignLib -> BuildInfo)
-> CondTree var deps ForeignLib
-> IO (Map FilePath ParsedExtensions)
forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions ([FilePath] -> ForeignLib -> [FilePath]
forall a b. a -> b -> a
const []) ForeignLib -> BuildInfo
foreignLibBuildInfo

    exeToExtensions :: CondTree var deps Executable -> IO (Map FilePath ParsedExtensions)
    exeToExtensions :: forall var deps.
CondTree var deps Executable -> IO (Map FilePath ParsedExtensions)
exeToExtensions = (Executable -> [FilePath])
-> (Executable -> BuildInfo)
-> CondTree var deps Executable
-> IO (Map FilePath ParsedExtensions)
forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions (\Executable{BuildInfo
UnqualComponentName
ExecutableScope
RelativePath Source 'File
exeName :: UnqualComponentName
modulePath :: RelativePath Source 'File
exeScope :: ExecutableScope
buildInfo :: BuildInfo
exeName :: Executable -> UnqualComponentName
modulePath :: Executable -> RelativePath Source 'File
exeScope :: Executable -> ExecutableScope
buildInfo :: Executable -> BuildInfo
..} -> [RelativePath Source 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath RelativePath Source 'File
modulePath]) Executable -> BuildInfo
buildInfo

    testToExtensions :: CondTree var deps TestSuite -> IO (Map FilePath ParsedExtensions)
    testToExtensions :: forall var deps.
CondTree var deps TestSuite -> IO (Map FilePath ParsedExtensions)
testToExtensions = (TestSuite -> [FilePath])
-> (TestSuite -> BuildInfo)
-> CondTree var deps TestSuite
-> IO (Map FilePath ParsedExtensions)
forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions TestSuite -> [FilePath]
testMainPath TestSuite -> BuildInfo
testBuildInfo
      where
        testMainPath :: TestSuite -> [FilePath]
        testMainPath :: TestSuite -> [FilePath]
testMainPath TestSuite{[FilePath]
BuildInfo
UnqualComponentName
TestSuiteInterface
testBuildInfo :: TestSuite -> BuildInfo
testName :: UnqualComponentName
testInterface :: TestSuiteInterface
testBuildInfo :: BuildInfo
testCodeGenerators :: [FilePath]
testName :: TestSuite -> UnqualComponentName
testInterface :: TestSuite -> TestSuiteInterface
testCodeGenerators :: TestSuite -> [FilePath]
..} = case TestSuiteInterface
testInterface of
            TestSuiteExeV10 Version
_ RelativePath Source 'File
path -> [RelativePath Source 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath RelativePath Source 'File
path]
            TestSuiteLibV09 Version
_ ModuleName
m    -> [ModuleName -> FilePath
toModulePath ModuleName
m]
            TestSuiteUnsupported TestType
_ -> []

    benchToExtensions :: CondTree var deps Benchmark -> IO (Map FilePath ParsedExtensions)
    benchToExtensions :: forall var deps.
CondTree var deps Benchmark -> IO (Map FilePath ParsedExtensions)
benchToExtensions = (Benchmark -> [FilePath])
-> (Benchmark -> BuildInfo)
-> CondTree var deps Benchmark
-> IO (Map FilePath ParsedExtensions)
forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions Benchmark -> [FilePath]
benchMainPath Benchmark -> BuildInfo
benchmarkBuildInfo
      where
        benchMainPath :: Benchmark -> [FilePath]
        benchMainPath :: Benchmark -> [FilePath]
benchMainPath Benchmark{BuildInfo
UnqualComponentName
BenchmarkInterface
benchmarkBuildInfo :: Benchmark -> BuildInfo
benchmarkName :: UnqualComponentName
benchmarkInterface :: BenchmarkInterface
benchmarkBuildInfo :: BuildInfo
benchmarkName :: Benchmark -> UnqualComponentName
benchmarkInterface :: Benchmark -> BenchmarkInterface
..} = case BenchmarkInterface
benchmarkInterface of
            BenchmarkExeV10 Version
_ RelativePath Source 'File
path -> [RelativePath Source 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath RelativePath Source 'File
path]
            BenchmarkUnsupported BenchmarkType
_ -> []

condTreeToExtensions
    :: (comp -> [FilePath])
    -- ^ Get all modules as file paths from a component, not listed in 'BuildInfo'
    -> (comp -> BuildInfo)
    -- ^ Extract 'BuildInfo' from component
    -> CondTree var deps comp
    -- ^ Cabal stanza
    -> IO (Map FilePath ParsedExtensions)
condTreeToExtensions :: forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions comp -> [FilePath]
extractModules comp -> BuildInfo
extractBuildInfo CondTree var deps comp
condTree = do
    let comp :: comp
comp = CondTree var deps comp -> comp
forall v c a. CondTree v c a -> a
condTreeData CondTree var deps comp
condTree
    let buildInfo :: BuildInfo
buildInfo = comp -> BuildInfo
extractBuildInfo comp
comp
#if MIN_VERSION_Cabal(3,6,0)
    let srcDirs :: [FilePath]
srcDirs = SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> FilePath)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
buildInfo
#else
    let srcDirs = hsSourceDirs buildInfo
#endif
    let modules :: [FilePath]
modules = comp -> [FilePath]
extractModules comp
comp [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
            (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FilePath
toModulePath (BuildInfo -> [ModuleName]
otherModules BuildInfo
buildInfo [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
autogenModules BuildInfo
buildInfo)
    let ([SafeHaskellExtension]
safeExts, [OnOffExtension]
parsedExtensionsAll) = [Either SafeHaskellExtension OnOffExtension]
-> ([SafeHaskellExtension], [OnOffExtension])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either SafeHaskellExtension OnOffExtension]
 -> ([SafeHaskellExtension], [OnOffExtension]))
-> [Either SafeHaskellExtension OnOffExtension]
-> ([SafeHaskellExtension], [OnOffExtension])
forall a b. (a -> b) -> a -> b
$ (Extension -> Maybe (Either SafeHaskellExtension OnOffExtension))
-> [Extension] -> [Either SafeHaskellExtension OnOffExtension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe (Either SafeHaskellExtension OnOffExtension)
cabalToGhcExtension ([Extension] -> [Either SafeHaskellExtension OnOffExtension])
-> [Extension] -> [Either SafeHaskellExtension OnOffExtension]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
defaultExtensions BuildInfo
buildInfo
    Maybe SafeHaskellExtension
parsedExtensionsSafe <- case [SafeHaskellExtension] -> [SafeHaskellExtension]
forall a. Eq a => [a] -> [a]
nub [SafeHaskellExtension]
safeExts of
        []   -> Maybe SafeHaskellExtension -> IO (Maybe SafeHaskellExtension)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SafeHaskellExtension
forall a. Maybe a
Nothing
        [SafeHaskellExtension
x]  -> Maybe SafeHaskellExtension -> IO (Maybe SafeHaskellExtension)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SafeHaskellExtension -> IO (Maybe SafeHaskellExtension))
-> Maybe SafeHaskellExtension -> IO (Maybe SafeHaskellExtension)
forall a b. (a -> b) -> a -> b
$ SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
x
        SafeHaskellExtension
x:[SafeHaskellExtension]
xs -> CabalException -> IO (Maybe SafeHaskellExtension)
forall e a. Exception e => e -> IO a
throwIO (CabalException -> IO (Maybe SafeHaskellExtension))
-> CabalException -> IO (Maybe SafeHaskellExtension)
forall a b. (a -> b) -> a -> b
$ NonEmpty SafeHaskellExtension -> CabalException
CabalSafeExtensionsConflict (NonEmpty SafeHaskellExtension -> CabalException)
-> NonEmpty SafeHaskellExtension -> CabalException
forall a b. (a -> b) -> a -> b
$ SafeHaskellExtension
x SafeHaskellExtension
-> [SafeHaskellExtension] -> NonEmpty SafeHaskellExtension
forall a. a -> [a] -> NonEmpty a
:| [SafeHaskellExtension]
xs

    ParsedExtensions
-> [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
modulesToExtensions ParsedExtensions{[OnOffExtension]
Maybe SafeHaskellExtension
parsedExtensionsAll :: [OnOffExtension]
parsedExtensionsSafe :: Maybe SafeHaskellExtension
parsedExtensionsAll :: [OnOffExtension]
parsedExtensionsSafe :: Maybe SafeHaskellExtension
..} [FilePath]
srcDirs [FilePath]
modules

modulesToExtensions
    :: ParsedExtensions
    -- ^ List of default extensions in the stanza
    -> [FilePath]
    -- ^ hs-src-dirs
    -> [FilePath]
    -- ^ All modules in the stanza
    -> IO (Map FilePath ParsedExtensions)
modulesToExtensions :: ParsedExtensions
-> [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
modulesToExtensions ParsedExtensions
extensions [FilePath]
srcDirs = case [FilePath]
srcDirs of
    [] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
findTopLevel
    [FilePath]
_  -> [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
findInDirs []
  where
    mapFromPaths :: [FilePath] -> Map FilePath ParsedExtensions
    mapFromPaths :: [FilePath] -> Map FilePath ParsedExtensions
mapFromPaths = [(FilePath, ParsedExtensions)] -> Map FilePath ParsedExtensions
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FilePath, ParsedExtensions)] -> Map FilePath ParsedExtensions)
-> ([FilePath] -> [(FilePath, ParsedExtensions)])
-> [FilePath]
-> Map FilePath ParsedExtensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> (FilePath, ParsedExtensions))
-> [FilePath] -> [(FilePath, ParsedExtensions)]
forall a b. (a -> b) -> [a] -> [b]
map (, ParsedExtensions
extensions)

    findInDirs :: [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
    findInDirs :: [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
findInDirs [FilePath]
res [] = Map FilePath ParsedExtensions -> IO (Map FilePath ParsedExtensions)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FilePath ParsedExtensions
 -> IO (Map FilePath ParsedExtensions))
-> Map FilePath ParsedExtensions
-> IO (Map FilePath ParsedExtensions)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Map FilePath ParsedExtensions
mapFromPaths [FilePath]
res
    findInDirs [FilePath]
res (FilePath
m:[FilePath]
ms) = FilePath -> [FilePath] -> IO (Maybe FilePath)
findDir FilePath
m [FilePath]
srcDirs IO (Maybe FilePath)
-> (Maybe FilePath -> IO (Map FilePath ParsedExtensions))
-> IO (Map FilePath ParsedExtensions)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe FilePath
Nothing         -> [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
findInDirs [FilePath]
res [FilePath]
ms
        Just FilePath
modulePath -> [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
findInDirs (FilePath
modulePath FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
res) [FilePath]
ms

    findTopLevel :: [FilePath] -> IO (Map FilePath ParsedExtensions)
    findTopLevel :: [FilePath] -> IO (Map FilePath ParsedExtensions)
findTopLevel [FilePath]
modules = do
        [Maybe FilePath]
mPaths <- (FilePath -> IO (Maybe FilePath))
-> [FilePath] -> IO [Maybe FilePath]
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 (Maybe FilePath -> FilePath -> IO (Maybe FilePath)
withDir Maybe FilePath
forall a. Maybe a
Nothing) [FilePath]
modules
        Map FilePath ParsedExtensions -> IO (Map FilePath ParsedExtensions)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FilePath ParsedExtensions
 -> IO (Map FilePath ParsedExtensions))
-> Map FilePath ParsedExtensions
-> IO (Map FilePath ParsedExtensions)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Map FilePath ParsedExtensions
mapFromPaths ([FilePath] -> Map FilePath ParsedExtensions)
-> [FilePath] -> Map FilePath ParsedExtensions
forall a b. (a -> b) -> a -> b
$ [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
mPaths

    -- Find directory where path exists and return full path
    findDir :: FilePath -> [FilePath] -> IO (Maybe FilePath)
    findDir :: FilePath -> [FilePath] -> IO (Maybe FilePath)
findDir FilePath
modulePath = \case
        [] -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        FilePath
dir:[FilePath]
dirs -> Maybe FilePath -> FilePath -> IO (Maybe FilePath)
withDir (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir) FilePath
modulePath IO (Maybe FilePath)
-> (Maybe FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe FilePath
Nothing   -> FilePath -> [FilePath] -> IO (Maybe FilePath)
findDir FilePath
modulePath [FilePath]
dirs
            Just FilePath
path -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path

    -- returns path if it exists inside optional dir
    withDir :: Maybe FilePath -> FilePath -> IO (Maybe FilePath)
    withDir :: Maybe FilePath -> FilePath -> IO (Maybe FilePath)
withDir Maybe FilePath
mDir FilePath
path = do
        let fullPath :: FilePath
fullPath = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
path (\FilePath
dir -> FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
path) Maybe FilePath
mDir
        FilePath -> IO Bool
doesFileExist FilePath
fullPath IO Bool -> (Bool -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
isFile ->
            if Bool
isFile
            then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fullPath
            else Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing

toModulePath :: ModuleName -> FilePath
toModulePath :: ModuleName -> FilePath
toModulePath ModuleName
moduleName = ModuleName -> FilePath
toFilePath ModuleName
moduleName FilePath -> FilePath -> FilePath
<.> FilePath
"hs"

-- | Convert 'Cabal.Extension' to 'OnOffExtension' or 'SafeHaskellExtension'.
cabalToGhcExtension :: Cabal.Extension -> Maybe (Either SafeHaskellExtension OnOffExtension)
cabalToGhcExtension :: Extension -> Maybe (Either SafeHaskellExtension OnOffExtension)
cabalToGhcExtension = \case
    Cabal.EnableExtension  KnownExtension
extension -> case (KnownExtension -> Maybe Extension
toGhcExtension KnownExtension
extension, KnownExtension -> Maybe SafeHaskellExtension
toSafeExtensions KnownExtension
extension) of
        (Maybe Extension
Nothing, Maybe SafeHaskellExtension
safe) -> SafeHaskellExtension -> Either SafeHaskellExtension OnOffExtension
forall a b. a -> Either a b
Left (SafeHaskellExtension
 -> Either SafeHaskellExtension OnOffExtension)
-> Maybe SafeHaskellExtension
-> Maybe (Either SafeHaskellExtension OnOffExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SafeHaskellExtension
safe
        (Maybe Extension
ghc, Maybe SafeHaskellExtension
_)        -> OnOffExtension -> Either SafeHaskellExtension OnOffExtension
forall a b. b -> Either a b
Right (OnOffExtension -> Either SafeHaskellExtension OnOffExtension)
-> (Extension -> OnOffExtension)
-> Extension
-> Either SafeHaskellExtension OnOffExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> OnOffExtension
On (Extension -> Either SafeHaskellExtension OnOffExtension)
-> Maybe Extension
-> Maybe (Either SafeHaskellExtension OnOffExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Extension
ghc
    Cabal.DisableExtension KnownExtension
extension -> OnOffExtension -> Either SafeHaskellExtension OnOffExtension
forall a b. b -> Either a b
Right (OnOffExtension -> Either SafeHaskellExtension OnOffExtension)
-> (Extension -> OnOffExtension)
-> Extension
-> Either SafeHaskellExtension OnOffExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> OnOffExtension
Off (Extension -> Either SafeHaskellExtension OnOffExtension)
-> Maybe Extension
-> Maybe (Either SafeHaskellExtension OnOffExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KnownExtension -> Maybe Extension
toGhcExtension KnownExtension
extension
    Cabal.UnknownExtension FilePath
_ -> Maybe (Either SafeHaskellExtension OnOffExtension)
forall a. Maybe a
Nothing

-- | Convert 'Cabal.KnownExtension' to 'OnOffExtension'.
toGhcExtension :: Cabal.KnownExtension -> Maybe Extension
toGhcExtension :: KnownExtension -> Maybe Extension
toGhcExtension = \case
    KnownExtension
Cabal.OverlappingInstances              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverlappingInstances
    KnownExtension
Cabal.UndecidableInstances              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UndecidableInstances
    KnownExtension
Cabal.IncoherentInstances               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
IncoherentInstances
    KnownExtension
Cabal.DoRec                             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecursiveDo
    KnownExtension
Cabal.RecursiveDo                       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecursiveDo
    KnownExtension
Cabal.ParallelListComp                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ParallelListComp
    KnownExtension
Cabal.MultiParamTypeClasses             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MultiParamTypeClasses
    KnownExtension
Cabal.MonomorphismRestriction           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MonomorphismRestriction
    KnownExtension
Cabal.FunctionalDependencies            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
FunctionalDependencies
    KnownExtension
Cabal.Rank2Types                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RankNTypes
    KnownExtension
Cabal.RankNTypes                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RankNTypes
    KnownExtension
Cabal.PolymorphicComponents             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RankNTypes
    KnownExtension
Cabal.ExistentialQuantification         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExistentialQuantification
    KnownExtension
Cabal.ScopedTypeVariables               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ScopedTypeVariables
    KnownExtension
Cabal.PatternSignatures                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ScopedTypeVariables
    KnownExtension
Cabal.ImplicitParams                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ImplicitParams
    KnownExtension
Cabal.FlexibleContexts                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
FlexibleContexts
    KnownExtension
Cabal.FlexibleInstances                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
FlexibleInstances
    KnownExtension
Cabal.EmptyDataDecls                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
EmptyDataDecls
    KnownExtension
Cabal.CPP                               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
Cpp
    KnownExtension
Cabal.KindSignatures                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
KindSignatures
    KnownExtension
Cabal.BangPatterns                      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
BangPatterns
    KnownExtension
Cabal.TypeSynonymInstances              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeSynonymInstances
    KnownExtension
Cabal.TemplateHaskell                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TemplateHaskell
    KnownExtension
Cabal.ForeignFunctionInterface          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ForeignFunctionInterface
    KnownExtension
Cabal.Arrows                            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
Arrows
    KnownExtension
Cabal.ImplicitPrelude                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ImplicitPrelude
    KnownExtension
Cabal.PatternGuards                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PatternGuards
    KnownExtension
Cabal.GeneralizedNewtypeDeriving        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GeneralizedNewtypeDeriving
    KnownExtension
Cabal.GeneralisedNewtypeDeriving        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GeneralizedNewtypeDeriving
    KnownExtension
Cabal.MagicHash                         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MagicHash
    KnownExtension
Cabal.TypeFamilies                      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeFamilies
    KnownExtension
Cabal.StandaloneDeriving                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StandaloneDeriving
    KnownExtension
Cabal.UnicodeSyntax                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnicodeSyntax
    KnownExtension
Cabal.UnliftedFFITypes                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnliftedFFITypes
    KnownExtension
Cabal.InterruptibleFFI                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
InterruptibleFFI
    KnownExtension
Cabal.CApiFFI                           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
CApiFFI
    KnownExtension
Cabal.LiberalTypeSynonyms               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LiberalTypeSynonyms
    KnownExtension
Cabal.TypeOperators                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeOperators
    KnownExtension
Cabal.RecordWildCards                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecordWildCards
#if MIN_VERSION_ghc_boot_th(9,4,1)
    KnownExtension
Cabal.RecordPuns                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NamedFieldPuns
    KnownExtension
Cabal.NamedFieldPuns                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NamedFieldPuns
#else
    Cabal.RecordPuns                        -> Just RecordPuns
    Cabal.NamedFieldPuns                    -> Just RecordPuns
#endif
    KnownExtension
Cabal.DisambiguateRecordFields          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DisambiguateRecordFields
    KnownExtension
Cabal.TraditionalRecordSyntax           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TraditionalRecordSyntax
    KnownExtension
Cabal.OverloadedStrings                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedStrings
    KnownExtension
Cabal.GADTs                             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GADTs
    KnownExtension
Cabal.GADTSyntax                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GADTSyntax
    KnownExtension
Cabal.RelaxedPolyRec                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RelaxedPolyRec
    KnownExtension
Cabal.ExtendedDefaultRules              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExtendedDefaultRules
    KnownExtension
Cabal.UnboxedTuples                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnboxedTuples
    KnownExtension
Cabal.DeriveDataTypeable                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveDataTypeable
    KnownExtension
Cabal.AutoDeriveTypeable                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveDataTypeable
    KnownExtension
Cabal.DeriveGeneric                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveGeneric
    KnownExtension
Cabal.DefaultSignatures                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DefaultSignatures
    KnownExtension
Cabal.InstanceSigs                      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
InstanceSigs
    KnownExtension
Cabal.ConstrainedClassMethods           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ConstrainedClassMethods
    KnownExtension
Cabal.PackageImports                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PackageImports
    KnownExtension
Cabal.ImpredicativeTypes                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ImpredicativeTypes
    KnownExtension
Cabal.PostfixOperators                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PostfixOperators
    KnownExtension
Cabal.QuasiQuotes                       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
QuasiQuotes
    KnownExtension
Cabal.TransformListComp                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TransformListComp
    KnownExtension
Cabal.MonadComprehensions               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MonadComprehensions
    KnownExtension
Cabal.ViewPatterns                      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ViewPatterns
    KnownExtension
Cabal.TupleSections                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TupleSections
    KnownExtension
Cabal.GHCForeignImportPrim              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GHCForeignImportPrim
    KnownExtension
Cabal.NPlusKPatterns                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NPlusKPatterns
    KnownExtension
Cabal.DoAndIfThenElse                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DoAndIfThenElse
    KnownExtension
Cabal.MultiWayIf                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MultiWayIf
    KnownExtension
Cabal.LambdaCase                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LambdaCase
    KnownExtension
Cabal.RebindableSyntax                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RebindableSyntax
    KnownExtension
Cabal.ExplicitForAll                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExplicitForAll
    KnownExtension
Cabal.DatatypeContexts                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DatatypeContexts
    KnownExtension
Cabal.MonoLocalBinds                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MonoLocalBinds
    KnownExtension
Cabal.DeriveFunctor                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveFunctor
    KnownExtension
Cabal.DeriveTraversable                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveTraversable
    KnownExtension
Cabal.DeriveFoldable                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveFoldable
    KnownExtension
Cabal.NondecreasingIndentation          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NondecreasingIndentation
    KnownExtension
Cabal.ConstraintKinds                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ConstraintKinds
    KnownExtension
Cabal.PolyKinds                         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PolyKinds
    KnownExtension
Cabal.DataKinds                         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DataKinds
    KnownExtension
Cabal.ParallelArrays                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ParallelArrays
    KnownExtension
Cabal.RoleAnnotations                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RoleAnnotations
    KnownExtension
Cabal.OverloadedLists                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedLists
    KnownExtension
Cabal.EmptyCase                         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
EmptyCase
    KnownExtension
Cabal.NegativeLiterals                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NegativeLiterals
    KnownExtension
Cabal.BinaryLiterals                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
BinaryLiterals
    KnownExtension
Cabal.NumDecimals                       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NumDecimals
    KnownExtension
Cabal.NullaryTypeClasses                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NullaryTypeClasses
    KnownExtension
Cabal.ExplicitNamespaces                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExplicitNamespaces
    KnownExtension
Cabal.AllowAmbiguousTypes               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
AllowAmbiguousTypes
    KnownExtension
Cabal.JavaScriptFFI                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
JavaScriptFFI
    KnownExtension
Cabal.PatternSynonyms                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PatternSynonyms
    KnownExtension
Cabal.PartialTypeSignatures             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PartialTypeSignatures
    KnownExtension
Cabal.NamedWildCards                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NamedWildCards
    KnownExtension
Cabal.DeriveAnyClass                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveAnyClass
    KnownExtension
Cabal.DeriveLift                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveLift
    KnownExtension
Cabal.StaticPointers                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StaticPointers
    KnownExtension
Cabal.StrictData                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StrictData
    KnownExtension
Cabal.Strict                            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
Strict
    KnownExtension
Cabal.ApplicativeDo                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ApplicativeDo
    KnownExtension
Cabal.DuplicateRecordFields             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DuplicateRecordFields
    KnownExtension
Cabal.TypeApplications                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeApplications
    KnownExtension
Cabal.TypeInType                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeInType
    KnownExtension
Cabal.UndecidableSuperClasses           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UndecidableSuperClasses
#if MIN_VERSION_ghc_boot_th(9,2,1)
    KnownExtension
Cabal.MonadFailDesugaring               -> Maybe Extension
forall a. Maybe a
Nothing
#else
    Cabal.MonadFailDesugaring               -> Just MonadFailDesugaring
#endif
    KnownExtension
Cabal.TemplateHaskellQuotes             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TemplateHaskellQuotes
    KnownExtension
Cabal.OverloadedLabels                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedLabels
    KnownExtension
Cabal.TypeFamilyDependencies            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeFamilyDependencies
    KnownExtension
Cabal.DerivingStrategies                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DerivingStrategies
    KnownExtension
Cabal.DerivingVia                       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DerivingVia
    KnownExtension
Cabal.UnboxedSums                       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnboxedSums
    KnownExtension
Cabal.HexFloatLiterals                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
HexFloatLiterals
    KnownExtension
Cabal.BlockArguments                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
BlockArguments
    KnownExtension
Cabal.NumericUnderscores                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NumericUnderscores
    KnownExtension
Cabal.QuantifiedConstraints             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
QuantifiedConstraints
    KnownExtension
Cabal.StarIsType                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StarIsType
    KnownExtension
Cabal.EmptyDataDeriving                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
EmptyDataDeriving
#if __GLASGOW_HASKELL__ >= 810
    KnownExtension
Cabal.CUSKs                             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
CUSKs
    KnownExtension
Cabal.ImportQualifiedPost               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ImportQualifiedPost
    KnownExtension
Cabal.StandaloneKindSignatures          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StandaloneKindSignatures
    KnownExtension
Cabal.UnliftedNewtypes                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnliftedNewtypes
#else
    Cabal.CUSKs                             -> Nothing
    Cabal.ImportQualifiedPost               -> Nothing
    Cabal.StandaloneKindSignatures          -> Nothing
    Cabal.UnliftedNewtypes                  -> Nothing
#endif
#if __GLASGOW_HASKELL__ >= 900
    KnownExtension
Cabal.LexicalNegation                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LexicalNegation
    KnownExtension
Cabal.QualifiedDo                       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
QualifiedDo
    KnownExtension
Cabal.LinearTypes                       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LinearTypes
#else
    Cabal.LexicalNegation                   -> Nothing
    Cabal.QualifiedDo                       -> Nothing
    Cabal.LinearTypes                       -> Nothing
#endif
#if __GLASGOW_HASKELL__ >= 902
    KnownExtension
Cabal.FieldSelectors                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
FieldSelectors
    KnownExtension
Cabal.OverloadedRecordDot               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedRecordDot
    KnownExtension
Cabal.UnliftedDatatypes                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnliftedDatatypes
#else
    Cabal.FieldSelectors                    -> Nothing
    Cabal.OverloadedRecordDot               -> Nothing
    Cabal.UnliftedDatatypes                 -> Nothing
#endif
#if __GLASGOW_HASKELL__ >= 904
    KnownExtension
Cabal.OverloadedRecordUpdate            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedRecordUpdate
    KnownExtension
Cabal.AlternativeLayoutRule             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
AlternativeLayoutRule
    KnownExtension
Cabal.AlternativeLayoutRuleTransitional -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
AlternativeLayoutRuleTransitional
    KnownExtension
Cabal.RelaxedLayout                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RelaxedLayout
#else
    Cabal.OverloadedRecordUpdate            -> Nothing
    Cabal.AlternativeLayoutRule             -> Nothing
    Cabal.AlternativeLayoutRuleTransitional -> Nothing
    Cabal.RelaxedLayout                     -> Nothing
#endif
#if __GLASGOW_HASKELL__ >= 906
    KnownExtension
Cabal.DeepSubsumption                   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeepSubsumption
    KnownExtension
Cabal.TypeData                          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeData
#else
    Cabal.DeepSubsumption                   -> Nothing
    Cabal.TypeData                          -> Nothing
#endif
#if __GLASGOW_HASKELL__ >= 908
    Cabal.TypeAbstractions                  -> Just TypeAbstractions
#else
    KnownExtension
Cabal.TypeAbstractions                  -> Maybe Extension
forall a. Maybe a
Nothing
#endif
#if __GLASGOW_HASKELL__ >= 910
    Cabal.RequiredTypeArguments             -> Just RequiredTypeArguments
    Cabal.ExtendedLiterals                  -> Just ExtendedLiterals
    Cabal.ListTuplePuns                     -> Just ListTuplePuns
#else
    KnownExtension
Cabal.RequiredTypeArguments             -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.ExtendedLiterals                  -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.ListTuplePuns                     -> Maybe Extension
forall a. Maybe a
Nothing
#endif
#if __GLASGOW_HASKELL__ >= 912
    -- This branch cannot be satisfied yet but we're including it so
    -- we don't forget to enable RequiredTypeArguments when it
    -- becomes available.
    Cabal.NamedDefaults                     -> Just NamedDefaults
    Cabal.MultilineStrings                  -> Just MultilineStrings
    Cabal.OrPatterns                        -> Just OrPatterns
#else
    KnownExtension
Cabal.NamedDefaults                     -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.MultilineStrings                  -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.OrPatterns                        -> Maybe Extension
forall a. Maybe a
Nothing
#endif
    -- GHC extensions, parsed by both Cabal and GHC, but don't have an Extension constructor
    KnownExtension
Cabal.Safe                              -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.Trustworthy                       -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.Unsafe                            -> Maybe Extension
forall a. Maybe a
Nothing
    -- non-GHC extensions
    KnownExtension
Cabal.Generics                          -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.ExtensibleRecords                 -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.RestrictedTypeSynonyms            -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.HereDocuments                     -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.MonoPatBinds                      -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.XmlSyntax                         -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.RegularPatterns                   -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.SafeImports                       -> Maybe Extension
forall a. Maybe a
Nothing
    KnownExtension
Cabal.NewQualifiedOperators             -> Maybe Extension
forall a. Maybe a
Nothing

-- | Convert 'Cabal.KnownExtension' to 'SafeHaskellExtension'.
toSafeExtensions :: Cabal.KnownExtension -> Maybe SafeHaskellExtension
toSafeExtensions :: KnownExtension -> Maybe SafeHaskellExtension
toSafeExtensions = \case
    KnownExtension
Cabal.Safe        -> SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
Safe
    KnownExtension
Cabal.Trustworthy -> SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
Trustworthy
    KnownExtension
Cabal.Unsafe      -> SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
Unsafe
    KnownExtension
_                 -> Maybe SafeHaskellExtension
forall a. Maybe a
Nothing