{-# LANGUAGE CPP #-}
-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | This module provides combinators for constructing Haskell modules,
-- including import and export statements.
module GHC.SourceGen.Module
    ( -- * HsModule'
      HsModule'
    , module'
      -- * Import declarations
    , ImportDecl'
    , qualified'
    , as'
    , import'
    , exposing
    , hiding
    , source
      -- * Imported/exported things
    , IE'
    , thingAll
    , thingWith
    , moduleContents
    )  where

import GHC.Hs.ImpExp (LIEWrappedName, IEWildcard(..), IEWrappedName(..), IE(..))
import GHC.Hs
    ( HsModule(..)
    , ImportDecl(..)
#if MIN_VERSION_ghc(8,10,0)
    , ImportDeclQualifiedStyle(..)
#endif
#if MIN_VERSION_ghc(9,2,0)
    , EpAnn(..)
#endif
    )
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc (LayoutInfo(..))
import GHC.Unit.Module (IsBootInterface(..))
import GHC.Types.Name.Reader (RdrName)
#else
import RdrName (RdrName)
#endif

import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Name
import GHC.SourceGen.Name.Internal
import GHC.SourceGen.Lit.Internal (noSourceText)

module'
    :: Maybe ModuleNameStr
    -> Maybe [IE'] -- ^ Exports
    -> [ImportDecl']
    -> [HsDecl']
    -> HsModule'
module' :: Maybe ModuleNameStr
-> Maybe [IE'] -> [ImportDecl'] -> [HsDecl'] -> HsModule'
module' Maybe ModuleNameStr
name Maybe [IE']
exports [ImportDecl']
imports [HsDecl']
decls = HsModule :: forall pass.
Maybe (Located ModuleName)
-> Maybe (Located [LIE pass])
-> [LImportDecl pass]
-> [LHsDecl pass]
-> Maybe (Located WarningTxt)
-> Maybe LHsDocString
-> HsModule pass
HsModule
    { hsmodName :: Maybe (Located ModuleName)
hsmodName = (ModuleNameStr -> Located ModuleName)
-> Maybe ModuleNameStr -> Maybe (Located ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName -> Located ModuleName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (ModuleName -> Located ModuleName)
-> (ModuleNameStr -> ModuleName)
-> ModuleNameStr
-> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleNameStr -> ModuleName
unModuleNameStr) Maybe ModuleNameStr
name
    , hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodExports = ([IE'] -> Located [LIE GhcPs])
-> Maybe [IE'] -> Maybe (Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([LIE GhcPs] -> Located [LIE GhcPs]
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated ([LIE GhcPs] -> Located [LIE GhcPs])
-> ([IE'] -> [LIE GhcPs]) -> [IE'] -> Located [LIE GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IE' -> LIE GhcPs) -> [IE'] -> [LIE GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map IE' -> LIE GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated) Maybe [IE']
exports
    , hsmodImports :: [LImportDecl GhcPs]
hsmodImports = (ImportDecl' -> LImportDecl GhcPs)
-> [ImportDecl'] -> [LImportDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl' -> LImportDecl GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated [ImportDecl']
imports
    , hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls = (HsDecl' -> LHsDecl GhcPs) -> [HsDecl'] -> [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsDecl' -> LHsDecl GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated [HsDecl']
decls
    , hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDeprecMessage = Maybe (Located WarningTxt)
forall a. Maybe a
Nothing
    , hsmodHaddockModHeader :: Maybe LHsDocString
hsmodHaddockModHeader = Maybe LHsDocString
forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,0,0)
    , hsmodLayout = NoLayoutInfo
#endif
#if MIN_VERSION_ghc(9,2,0)
    , hsmodAnn = EpAnnNotUsed
#endif
    }

qualified' :: ImportDecl' -> ImportDecl'
qualified' :: ImportDecl' -> ImportDecl'
qualified' ImportDecl'
d = ImportDecl'
d { ideclQualified :: ImportDeclQualifiedStyle
ideclQualified =
#if MIN_VERSION_ghc(8,10,0)
    ImportDeclQualifiedStyle
QualifiedPre
#else
    True
#endif
}

as' :: ImportDecl' -> ModuleNameStr -> ImportDecl'
as' :: ImportDecl' -> ModuleNameStr -> ImportDecl'
as' ImportDecl'
d ModuleNameStr
m = ImportDecl'
d { ideclAs :: Maybe (Located ModuleName)
ideclAs = Located ModuleName -> Maybe (Located ModuleName)
forall a. a -> Maybe a
Just (ModuleName -> Located ModuleName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (ModuleName -> Located ModuleName)
-> ModuleName -> Located ModuleName
forall a b. (a -> b) -> a -> b
$ ModuleNameStr -> ModuleName
unModuleNameStr ModuleNameStr
m) }

import' :: ModuleNameStr -> ImportDecl'
import' :: ModuleNameStr -> ImportDecl'
import' ModuleNameStr
m = (SourceText
 -> Located ModuleName
 -> Maybe StringLiteral
 -> Bool
 -> Bool
 -> ImportDeclQualifiedStyle
 -> Bool
 -> Maybe (Located ModuleName)
 -> Maybe (Bool, Located [LIE GhcPs])
 -> ImportDecl')
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE GhcPs])
-> ImportDecl'
forall a. (SourceText -> a) -> a
noSourceText ((NoExtField
 -> SourceText
 -> Located ModuleName
 -> Maybe StringLiteral
 -> Bool
 -> Bool
 -> ImportDeclQualifiedStyle
 -> Bool
 -> Maybe (Located ModuleName)
 -> Maybe (Bool, Located [LIE GhcPs])
 -> ImportDecl')
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE GhcPs])
-> ImportDecl'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE GhcPs])
-> ImportDecl'
forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl)
            (ModuleName -> Located ModuleName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (ModuleName -> Located ModuleName)
-> ModuleName -> Located ModuleName
forall a b. (a -> b) -> a -> b
$ ModuleNameStr -> ModuleName
unModuleNameStr ModuleNameStr
m)
            Maybe StringLiteral
forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,0,0)
            NotBoot
#else
            Bool
False
#endif
            Bool
False
#if MIN_VERSION_ghc(8,10,0)
            ImportDeclQualifiedStyle
NotQualified
#else
            False
#endif
            Bool
False Maybe (Located ModuleName)
forall a. Maybe a
Nothing Maybe (Bool, Located [LIE GhcPs])
forall a. Maybe a
Nothing

exposing :: ImportDecl' -> [IE'] -> ImportDecl'
exposing :: ImportDecl' -> [IE'] -> ImportDecl'
exposing ImportDecl'
d [IE']
ies = ImportDecl'
d
    { ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
False, [LIE GhcPs] -> Located [LIE GhcPs]
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ (IE' -> LIE GhcPs) -> [IE'] -> [LIE GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map IE' -> LIE GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated [IE']
ies) }

hiding :: ImportDecl' -> [IE'] -> ImportDecl'
hiding :: ImportDecl' -> [IE'] -> ImportDecl'
hiding ImportDecl'
d [IE']
ies = ImportDecl'
d
    { ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
True, [LIE GhcPs] -> Located [LIE GhcPs]
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ (IE' -> LIE GhcPs) -> [IE'] -> [LIE GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map IE' -> LIE GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated [IE']
ies) }

-- | Adds the @{-# SOURCE #-}@ pragma to an import.
source :: ImportDecl' -> ImportDecl'
source :: ImportDecl' -> ImportDecl'
source ImportDecl'
d = ImportDecl'
d { ideclSource :: Bool
ideclSource =
#if MIN_VERSION_ghc(9,0,0)
    IsBoot
#else
    Bool
True
#endif
}

-- | Exports all methods and/or constructors.
--
-- > A(..)
-- > =====
-- > thingAll "A"
thingAll :: RdrNameStr -> IE'
thingAll :: RdrNameStr -> IE'
thingAll = (NoExtField -> LIEWrappedName RdrName -> IE')
-> LIEWrappedName RdrName -> IE'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LIEWrappedName RdrName -> IE'
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll (LIEWrappedName RdrName -> IE')
-> (RdrNameStr -> LIEWrappedName RdrName) -> RdrNameStr -> IE'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LIEWrappedName RdrName
wrappedName

-- | Exports specific methods and/or constructors.
--
-- > A(b, C)
-- > =====
-- > thingWith "A" ["b", "C"]
thingWith :: RdrNameStr -> [OccNameStr] -> IE'
thingWith :: RdrNameStr -> [OccNameStr] -> IE'
thingWith RdrNameStr
n [OccNameStr]
cs = (NoExtField
 -> LIEWrappedName RdrName
 -> IEWildcard
 -> [LIEWrappedName RdrName]
 -> [Located (FieldLbl RdrName)]
 -> IE')
-> LIEWrappedName RdrName
-> IEWildcard
-> [LIEWrappedName RdrName]
-> [Located (FieldLbl RdrName)]
-> IE'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField
-> LIEWrappedName RdrName
-> IEWildcard
-> [LIEWrappedName RdrName]
-> [Located (FieldLbl RdrName)]
-> IE'
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith (RdrNameStr -> LIEWrappedName RdrName
wrappedName RdrNameStr
n) IEWildcard
NoIEWildcard
                    ((OccNameStr -> LIEWrappedName RdrName)
-> [OccNameStr] -> [LIEWrappedName RdrName]
forall a b. (a -> b) -> [a] -> [b]
map (RdrNameStr -> LIEWrappedName RdrName
wrappedName (RdrNameStr -> LIEWrappedName RdrName)
-> (OccNameStr -> RdrNameStr)
-> OccNameStr
-> LIEWrappedName RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
unqual) [OccNameStr]
cs)
#if !MIN_VERSION_ghc(9,2,0)
                    -- The parsing step leaves the list of fields empty
                    -- and lumps them all together with the above list of
                    -- constructors.
                    []
#endif

-- TODO: support "mixed" syntax with both ".." and explicit names.

wrappedName :: RdrNameStr -> LIEWrappedName RdrName
wrappedName :: RdrNameStr -> LIEWrappedName RdrName
wrappedName = IEWrappedName RdrName -> LIEWrappedName RdrName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (IEWrappedName RdrName -> LIEWrappedName RdrName)
-> (RdrNameStr -> IEWrappedName RdrName)
-> RdrNameStr
-> LIEWrappedName RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName (Located RdrName -> IEWrappedName RdrName)
-> (RdrNameStr -> Located RdrName)
-> RdrNameStr
-> IEWrappedName RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> Located RdrName
exportRdrName

-- | Exports an entire module.
--
-- Note: this is not valid inside of an import list.
--
-- > module M
-- > =====
-- > moduleContents "M"
moduleContents :: ModuleNameStr -> IE'
moduleContents :: ModuleNameStr -> IE'
moduleContents = (NoExtField -> Located ModuleName -> IE')
-> Located ModuleName -> IE'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> Located ModuleName -> IE'
forall pass.
XIEModuleContents pass -> Located ModuleName -> IE pass
IEModuleContents (Located ModuleName -> IE')
-> (ModuleNameStr -> Located ModuleName) -> ModuleNameStr -> IE'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Located ModuleName
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (ModuleName -> Located ModuleName)
-> (ModuleNameStr -> ModuleName)
-> ModuleNameStr
-> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleNameStr -> ModuleName
unModuleNameStr