{-# LANGUAGE CPP #-}

{- |
Copyright: (c) 2020 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 (..))
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 cabalPath :: FilePath
cabalPath = FilePath -> IO Bool
doesFileExist FilePath
cabalPath IO Bool
-> (Bool -> IO (Map FilePath ParsedExtensions))
-> IO (Map FilePath ParsedExtensions)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \hasCabalFile :: 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 (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 path :: FilePath
path cabal :: ByteString
cabal = do
    let (_warnings :: [PWarning]
_warnings, res :: Either (Maybe Version, [PError]) GenericPackageDescription
res) = ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, [PError]) GenericPackageDescription)
forall a.
ParseResult a -> ([PWarning], Either (Maybe Version, [PError]) a)
runParseResult (ParseResult GenericPackageDescription
 -> ([PWarning],
     Either (Maybe Version, [PError]) GenericPackageDescription))
-> ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, [PError]) GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
cabal
    case Either (Maybe Version, [PError]) GenericPackageDescription
res of
        Left (_version :: Maybe Version
_version, errors :: [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
$ [PError] -> Text
forall (f :: * -> *). Foldable f => f PError -> Text
prettyCabalErrors [PError]
errors
        Right pkgDesc :: GenericPackageDescription
pkgDesc -> GenericPackageDescription -> IO (Map FilePath ParsedExtensions)
extractCabalExtensions GenericPackageDescription
pkgDesc
  where
    prettyCabalErrors :: Foldable f => f PError -> Text
    prettyCabalErrors :: f PError -> Text
prettyCabalErrors = Text -> [Text] -> Text
Text.intercalate "\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 (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{..} = [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 (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 :: (a -> m) -> [(b, a)] -> m
foldSndMap f :: a -> m
f = ((b, a) -> m) -> [(b, 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 :: 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 :: 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 :: 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{..} -> [FilePath
modulePath]) Executable -> BuildInfo
buildInfo

    testToExtensions :: CondTree var deps TestSuite -> IO (Map FilePath ParsedExtensions)
    testToExtensions :: 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{..} = case TestSuiteInterface
testInterface of
            TestSuiteExeV10 _ path :: FilePath
path -> [FilePath
path]
            TestSuiteLibV09 _ m :: ModuleName
m    -> [ModuleName -> FilePath
toModulePath ModuleName
m]
            TestSuiteUnsupported _ -> []

    benchToExtensions :: CondTree var deps Benchmark -> IO (Map FilePath ParsedExtensions)
    benchToExtensions :: 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{..} = case BenchmarkInterface
benchmarkInterface of
            BenchmarkExeV10 _ path :: FilePath
path -> [FilePath
path]
            BenchmarkUnsupported _ -> []

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 :: (comp -> [FilePath])
-> (comp -> BuildInfo)
-> CondTree var deps comp
-> IO (Map FilePath ParsedExtensions)
condTreeToExtensions extractModules :: comp -> [FilePath]
extractModules extractBuildInfo :: comp -> BuildInfo
extractBuildInfo condTree :: 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
    let srcDirs :: [FilePath]
srcDirs = BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
buildInfo
    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 (safeExts :: [SafeHaskellExtension]
safeExts, parsedExtensionsAll :: [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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SafeHaskellExtension
forall a. Maybe a
Nothing
        [x :: SafeHaskellExtension
x]  -> Maybe SafeHaskellExtension -> IO (Maybe SafeHaskellExtension)
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
        x :: SafeHaskellExtension
x:xs :: [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 $WParsedExtensions :: [OnOffExtension] -> Maybe SafeHaskellExtension -> ParsedExtensions
ParsedExtensions{..} [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 extensions :: ParsedExtensions
extensions srcDirs :: [FilePath]
srcDirs = case [FilePath]
srcDirs of
    [] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
findTopLevel
    _  -> [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 res :: [FilePath]
res [] = Map FilePath ParsedExtensions -> IO (Map FilePath ParsedExtensions)
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 res :: [FilePath]
res (m :: FilePath
m:ms :: [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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing         -> [FilePath] -> [FilePath] -> IO (Map FilePath ParsedExtensions)
findInDirs [FilePath]
res [FilePath]
ms
        Just modulePath :: 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 modules :: [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)
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 (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 modulePath :: FilePath
modulePath = \case
        [] -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        dir :: FilePath
dir:dirs :: [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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Nothing   -> FilePath -> [FilePath] -> IO (Maybe FilePath)
findDir FilePath
modulePath [FilePath]
dirs
            Just path :: FilePath
path -> Maybe FilePath -> IO (Maybe FilePath)
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 mDir :: Maybe FilePath
mDir path :: 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 (\dir :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \isFile :: Bool
isFile ->
            if Bool
isFile
            then Maybe FilePath -> IO (Maybe FilePath)
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 (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 = ModuleName -> FilePath
toFilePath ModuleName
moduleName 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  extension :: KnownExtension
extension -> case (KnownExtension -> Maybe Extension
toGhcExtension KnownExtension
extension, KnownExtension -> Maybe SafeHaskellExtension
toSafeExtensions KnownExtension
extension) of
        (Nothing, safe :: 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
        (ghc :: Maybe Extension
ghc, _)        -> 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 extension :: 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 _ -> 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
    Cabal.OverlappingInstances       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverlappingInstances
    Cabal.UndecidableInstances       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UndecidableInstances
    Cabal.IncoherentInstances        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
IncoherentInstances
    Cabal.DoRec                      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecursiveDo
    Cabal.RecursiveDo                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecursiveDo
    Cabal.ParallelListComp           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ParallelListComp
    Cabal.MultiParamTypeClasses      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MultiParamTypeClasses
    Cabal.MonomorphismRestriction    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MonomorphismRestriction
    Cabal.FunctionalDependencies     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
FunctionalDependencies
    Cabal.Rank2Types                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RankNTypes
    Cabal.RankNTypes                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RankNTypes
    Cabal.PolymorphicComponents      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RankNTypes
    Cabal.ExistentialQuantification  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExistentialQuantification
    Cabal.ScopedTypeVariables        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ScopedTypeVariables
    Cabal.PatternSignatures          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ScopedTypeVariables
    Cabal.ImplicitParams             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ImplicitParams
    Cabal.FlexibleContexts           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
FlexibleContexts
    Cabal.FlexibleInstances          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
FlexibleInstances
    Cabal.EmptyDataDecls             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
EmptyDataDecls
    Cabal.CPP                        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
Cpp
    Cabal.KindSignatures             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
KindSignatures
    Cabal.BangPatterns               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
BangPatterns
    Cabal.TypeSynonymInstances       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeSynonymInstances
    Cabal.TemplateHaskell            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TemplateHaskell
    Cabal.ForeignFunctionInterface   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ForeignFunctionInterface
    Cabal.Arrows                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
Arrows
    Cabal.ImplicitPrelude            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ImplicitPrelude
    Cabal.PatternGuards              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PatternGuards
    Cabal.GeneralizedNewtypeDeriving -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GeneralizedNewtypeDeriving
    Cabal.GeneralisedNewtypeDeriving -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GeneralizedNewtypeDeriving
    Cabal.MagicHash                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MagicHash
    Cabal.TypeFamilies               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeFamilies
    Cabal.StandaloneDeriving         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StandaloneDeriving
    Cabal.UnicodeSyntax              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnicodeSyntax
    Cabal.UnliftedFFITypes           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnliftedFFITypes
    Cabal.InterruptibleFFI           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
InterruptibleFFI
    Cabal.CApiFFI                    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
CApiFFI
    Cabal.LiberalTypeSynonyms        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LiberalTypeSynonyms
    Cabal.TypeOperators              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeOperators
    Cabal.RecordWildCards            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecordWildCards
    Cabal.RecordPuns                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecordPuns
    Cabal.NamedFieldPuns             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RecordPuns
    Cabal.DisambiguateRecordFields   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DisambiguateRecordFields
    Cabal.TraditionalRecordSyntax    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TraditionalRecordSyntax
    Cabal.OverloadedStrings          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedStrings
    Cabal.GADTs                      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GADTs
    Cabal.GADTSyntax                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GADTSyntax
    Cabal.RelaxedPolyRec             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RelaxedPolyRec
    Cabal.ExtendedDefaultRules       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExtendedDefaultRules
    Cabal.UnboxedTuples              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnboxedTuples
    Cabal.DeriveDataTypeable         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveDataTypeable
    Cabal.AutoDeriveTypeable         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveDataTypeable
    Cabal.DeriveGeneric              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveGeneric
    Cabal.DefaultSignatures          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DefaultSignatures
    Cabal.InstanceSigs               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
InstanceSigs
    Cabal.ConstrainedClassMethods    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ConstrainedClassMethods
    Cabal.PackageImports             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PackageImports
    Cabal.ImpredicativeTypes         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ImpredicativeTypes
    Cabal.PostfixOperators           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PostfixOperators
    Cabal.QuasiQuotes                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
QuasiQuotes
    Cabal.TransformListComp          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TransformListComp
    Cabal.MonadComprehensions        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MonadComprehensions
    Cabal.ViewPatterns               -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ViewPatterns
    Cabal.TupleSections              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TupleSections
    Cabal.GHCForeignImportPrim       -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
GHCForeignImportPrim
    Cabal.NPlusKPatterns             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NPlusKPatterns
    Cabal.DoAndIfThenElse            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DoAndIfThenElse
    Cabal.MultiWayIf                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MultiWayIf
    Cabal.LambdaCase                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
LambdaCase
    Cabal.RebindableSyntax           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RebindableSyntax
    Cabal.ExplicitForAll             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExplicitForAll
    Cabal.DatatypeContexts           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DatatypeContexts
    Cabal.MonoLocalBinds             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MonoLocalBinds
    Cabal.DeriveFunctor              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveFunctor
    Cabal.DeriveTraversable          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveTraversable
    Cabal.DeriveFoldable             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveFoldable
    Cabal.NondecreasingIndentation   -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NondecreasingIndentation
    Cabal.ConstraintKinds            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ConstraintKinds
    Cabal.PolyKinds                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PolyKinds
    Cabal.DataKinds                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DataKinds
    Cabal.ParallelArrays             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ParallelArrays
    Cabal.RoleAnnotations            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
RoleAnnotations
    Cabal.OverloadedLists            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedLists
    Cabal.EmptyCase                  -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
EmptyCase
    Cabal.NegativeLiterals           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NegativeLiterals
    Cabal.BinaryLiterals             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
BinaryLiterals
    Cabal.NumDecimals                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NumDecimals
    Cabal.NullaryTypeClasses         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NullaryTypeClasses
    Cabal.ExplicitNamespaces         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ExplicitNamespaces
    Cabal.AllowAmbiguousTypes        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
AllowAmbiguousTypes
    Cabal.JavaScriptFFI              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
JavaScriptFFI
    Cabal.PatternSynonyms            -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PatternSynonyms
    Cabal.PartialTypeSignatures      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
PartialTypeSignatures
    Cabal.NamedWildCards             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NamedWildCards
    Cabal.DeriveAnyClass             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveAnyClass
    Cabal.DeriveLift                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DeriveLift
    Cabal.StaticPointers             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StaticPointers
    Cabal.StrictData                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StrictData
    Cabal.Strict                     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
Strict
    Cabal.ApplicativeDo              -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
ApplicativeDo
    Cabal.DuplicateRecordFields      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DuplicateRecordFields
    Cabal.TypeApplications           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeApplications
    Cabal.TypeInType                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeInType
    Cabal.UndecidableSuperClasses    -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UndecidableSuperClasses
    Cabal.MonadFailDesugaring        -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
MonadFailDesugaring
    Cabal.TemplateHaskellQuotes      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TemplateHaskellQuotes
    Cabal.OverloadedLabels           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
OverloadedLabels
    Cabal.TypeFamilyDependencies     -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
TypeFamilyDependencies
    Cabal.DerivingStrategies         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DerivingStrategies
    Cabal.DerivingVia                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
DerivingVia
    Cabal.UnboxedSums                -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
UnboxedSums
    Cabal.HexFloatLiterals           -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
HexFloatLiterals
    Cabal.BlockArguments             -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
BlockArguments
    Cabal.NumericUnderscores         -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
NumericUnderscores
    Cabal.QuantifiedConstraints      -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
QuantifiedConstraints
    Cabal.StarIsType                 -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
StarIsType
    Cabal.EmptyDataDeriving          -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
EmptyDataDeriving
#if __GLASGOW_HASKELL__ >= 810
    Cabal.CUSKs                    -> Just CUSKs
    Cabal.ImportQualifiedPost      -> Just ImportQualifiedPost
    Cabal.StandaloneKindSignatures -> Just StandaloneKindSignatures
    Cabal.UnliftedNewtypes         -> Just UnliftedNewtypes
#endif
    -- GHC extensions, parsed by both Cabal and GHC, but don't have an Extension constructor
    Cabal.Safe                   -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.Trustworthy            -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.Unsafe                 -> Maybe Extension
forall a. Maybe a
Nothing
    -- non-GHC extensions
    Cabal.Generics               -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.ExtensibleRecords      -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.RestrictedTypeSynonyms -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.HereDocuments          -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.MonoPatBinds           -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.XmlSyntax              -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.RegularPatterns        -> Maybe Extension
forall a. Maybe a
Nothing
    Cabal.SafeImports            -> Maybe Extension
forall a. Maybe a
Nothing
    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
    Cabal.Safe        -> SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
Safe
    Cabal.Trustworthy -> SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
Trustworthy
    Cabal.Unsafe      -> SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
Unsafe
    _                 -> Maybe SafeHaskellExtension
forall a. Maybe a
Nothing