module GHC.Driver.Config.Parser
  ( initParserOpts
  )
where

import GHC.Prelude
import GHC.Platform

import GHC.Driver.Session
import GHC.Driver.Config.Diagnostic

import GHC.Parser.Lexer

-- | Extracts the flags needed for parsing
initParserOpts :: DynFlags -> ParserOpts
initParserOpts :: DynFlags -> ParserOpts
initParserOpts =
  EnumSet Extension
-> DiagOpts
-> [String]
-> Bool
-> Bool
-> Bool
-> Bool
-> ParserOpts
mkParserOpts
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> EnumSet Extension
extensionFlags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DynFlags -> DiagOpts
initDiagOpts
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ArchOS -> [String]
supportedLanguagesAndExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> ArchOS
platformArchOS forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Platform
targetPlatform)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DynFlags -> Bool
safeImportsOn
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Haddock
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_KeepRawTokenStream
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. a -> b -> a
const Bool
True -- use LINE/COLUMN to update the internal location