{-# 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 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> IO (Map FilePath ParsedExtensions)
parseCabalExtensions FilePath
cabalPath
    else forall e a. Exception e => e -> IO a
throwIO 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) = forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult 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) ->
            forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> CabalException
CabalParseError forall a b. (a -> b) -> a -> b
$ 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PError -> Text
errorToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

    errorToText :: PError -> Text
    errorToText :: PError -> Text
errorToText = FilePath -> Text
Text.pack 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] 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
condBenchmarks :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condExecutables :: GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condForeignLibs :: GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condLibrary :: GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condSubLibraries :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condTestSuites :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
genPackageFlags :: GenericPackageDescription -> [PackageFlag]
gpdScannedVersion :: GenericPackageDescription -> Maybe Version
packageDescription :: GenericPackageDescription -> PackageDescription
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
..} = forall a. Monoid a => [a] -> a
mconcat
    [ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap    forall var deps.
CondTree var deps Library -> IO (Map FilePath ParsedExtensions)
libraryToExtensions Maybe (CondTree ConfVar [Dependency] Library)
condLibrary
    , forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap forall var deps.
CondTree var deps Library -> IO (Map FilePath ParsedExtensions)
libraryToExtensions [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries
    , forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap forall var deps.
CondTree var deps ForeignLib -> IO (Map FilePath ParsedExtensions)
foreignToExtensions [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs
    , forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap forall var deps.
CondTree var deps Executable -> IO (Map FilePath ParsedExtensions)
exeToExtensions     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables
    , forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap forall var deps.
CondTree var deps TestSuite -> IO (Map FilePath ParsedExtensions)
testToExtensions    [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites
    , forall m a b. Monoid m => (a -> m) -> [(b, a)] -> m
foldSndMap 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions
        (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FilePath
toModulePath 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 = forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions (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 = forall comp var deps.
(comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions (\Executable{FilePath
BuildInfo
ExecutableScope
UnqualComponentName
buildInfo :: Executable -> BuildInfo
exeName :: Executable -> UnqualComponentName
exeScope :: Executable -> ExecutableScope
modulePath :: Executable -> FilePath
buildInfo :: BuildInfo
exeScope :: ExecutableScope
modulePath :: FilePath
exeName :: UnqualComponentName
..} -> [FilePath
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 = 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{BuildInfo
TestSuiteInterface
UnqualComponentName
testInterface :: TestSuite -> TestSuiteInterface
testName :: TestSuite -> UnqualComponentName
testBuildInfo :: BuildInfo
testInterface :: TestSuiteInterface
testName :: UnqualComponentName
testBuildInfo :: TestSuite -> BuildInfo
..} = case TestSuiteInterface
testInterface of
            TestSuiteExeV10 Version
_ FilePath
path -> [FilePath
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 = 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
BenchmarkInterface
UnqualComponentName
benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkName :: Benchmark -> UnqualComponentName
benchmarkBuildInfo :: BuildInfo
benchmarkInterface :: BenchmarkInterface
benchmarkName :: UnqualComponentName
benchmarkBuildInfo :: Benchmark -> BuildInfo
..} = case BenchmarkInterface
benchmarkInterface of
            BenchmarkExeV10 Version
_ FilePath
path -> [FilePath
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 = 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 = forall from to. SymbolicPath from to -> FilePath
getSymbolicPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
buildInfo
#else
    let srcDirs = hsSourceDirs buildInfo
#endif
    let modules :: [FilePath]
modules = comp -> [FilePath]
extractModules comp
comp forall a. [a] -> [a] -> [a]
++
            forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FilePath
toModulePath (BuildInfo -> [ModuleName]
otherModules BuildInfo
buildInfo forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
autogenModules BuildInfo
buildInfo)
    let ([SafeHaskellExtension]
safeExts, [OnOffExtension]
parsedExtensionsAll) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe (Either SafeHaskellExtension OnOffExtension)
cabalToGhcExtension forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
defaultExtensions BuildInfo
buildInfo
    Maybe SafeHaskellExtension
parsedExtensionsSafe <- case forall a. Eq a => [a] -> [a]
nub [SafeHaskellExtension]
safeExts of
        []   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        [SafeHaskellExtension
x]  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SafeHaskellExtension
x
        SafeHaskellExtension
x:[SafeHaskellExtension]
xs -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ NonEmpty SafeHaskellExtension -> CabalException
CabalSafeExtensionsConflict forall a b. (a -> b) -> a -> b
$ SafeHaskellExtension
x forall a. a -> [a] -> NonEmpty a
:| [SafeHaskellExtension]
xs

    ParsedExtensions
-> [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
modulesToExtensions ParsedExtensions{[OnOffExtension]
Maybe SafeHaskellExtension
parsedExtensionsSafe :: Maybe SafeHaskellExtension
parsedExtensionsAll :: [OnOffExtension]
parsedExtensionsSafe :: Maybe SafeHaskellExtension
parsedExtensionsAll :: [OnOffExtension]
..} [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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 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 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Maybe FilePath -> FilePath -> IO (Maybe FilePath)
withDir forall a. Maybe a
Nothing) [FilePath]
modules
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FilePath] -> Map FilePath ParsedExtensions
mapFromPaths forall a b. (a -> b) -> a -> b
$ 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
        [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        FilePath
dir:[FilePath]
dirs -> Maybe FilePath -> FilePath -> IO (Maybe FilePath)
withDir (forall a. a -> Maybe a
Just FilePath
dir) FilePath
modulePath 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
isFile ->
            if Bool
isFile
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FilePath
fullPath
            else forall (f :: * -> *) a. Applicative f => a -> f a
pure 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) -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SafeHaskellExtension
safe
        (Maybe Extension
ghc, Maybe SafeHaskellExtension
_)        -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> OnOffExtension
On forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Extension
ghc
    Cabal.DisableExtension KnownExtension
extension -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> OnOffExtension
Off forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KnownExtension -> Maybe Extension
toGhcExtension KnownExtension
extension
    Cabal.UnknownExtension FilePath
_ -> forall a. Maybe a
Nothing

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

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