module GHC.Driver.IncludeSpecs
  ( IncludeSpecs(..)
  , addGlobalInclude
  , addQuoteInclude
  , addImplicitQuoteInclude
  , flattenIncludes
  ) where

import GHC.Prelude

-- | Used to differentiate the scope an include needs to apply to.
-- We have to split the include paths to avoid accidentally forcing recursive
-- includes since -I overrides the system search paths. See #14312.
data IncludeSpecs
  = IncludeSpecs { IncludeSpecs -> [String]
includePathsQuote  :: [String]
                 , IncludeSpecs -> [String]
includePathsGlobal :: [String]
                 -- | See Note [Implicit include paths]
                 , IncludeSpecs -> [String]
includePathsQuoteImplicit :: [String]
                 }
  deriving Int -> IncludeSpecs -> ShowS
[IncludeSpecs] -> ShowS
IncludeSpecs -> String
(Int -> IncludeSpecs -> ShowS)
-> (IncludeSpecs -> String)
-> ([IncludeSpecs] -> ShowS)
-> Show IncludeSpecs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IncludeSpecs -> ShowS
showsPrec :: Int -> IncludeSpecs -> ShowS
$cshow :: IncludeSpecs -> String
show :: IncludeSpecs -> String
$cshowList :: [IncludeSpecs] -> ShowS
showList :: [IncludeSpecs] -> ShowS
Show

-- | Append to the list of includes a path that shall be included using `-I`
-- when the C compiler is called. These paths override system search paths.
addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addGlobalInclude IncludeSpecs
spec [String]
paths  = let f :: [String]
f = IncludeSpecs -> [String]
includePathsGlobal IncludeSpecs
spec
                               in IncludeSpecs
spec { includePathsGlobal = f ++ paths }

-- | Append to the list of includes a path that shall be included using
-- `-iquote` when the C compiler is called. These paths only apply when quoted
-- includes are used. e.g. #include "foo.h"
addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addQuoteInclude IncludeSpecs
spec [String]
paths  = let f :: [String]
f = IncludeSpecs -> [String]
includePathsQuote IncludeSpecs
spec
                              in IncludeSpecs
spec { includePathsQuote = f ++ paths }

-- | These includes are not considered while fingerprinting the flags for iface
-- | See Note [Implicit include paths]
addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addImplicitQuoteInclude IncludeSpecs
spec [String]
paths  = let f :: [String]
f = IncludeSpecs -> [String]
includePathsQuoteImplicit IncludeSpecs
spec
                              in IncludeSpecs
spec { includePathsQuoteImplicit = f ++ paths }


-- | Concatenate and flatten the list of global and quoted includes returning
-- just a flat list of paths.
flattenIncludes :: IncludeSpecs -> [String]
flattenIncludes :: IncludeSpecs -> [String]
flattenIncludes IncludeSpecs
specs =
    IncludeSpecs -> [String]
includePathsQuote IncludeSpecs
specs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    IncludeSpecs -> [String]
includePathsQuoteImplicit IncludeSpecs
specs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    IncludeSpecs -> [String]
includePathsGlobal IncludeSpecs
specs