{-# LANGUAGE CPP #-}

module HIndent.Ast.Module.Export.Entry
  ( ExportEntry
  , mkExportEntry
  ) where

import GHC.Stack
import qualified GHC.Unit as GHC
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
data ExportEntry
  = SingleIdentifier (WithComments (GHC.IEWrappedName GHC.GhcPs))
  | WithSpecificConstructors
      (WithComments (GHC.IEWrappedName GHC.GhcPs))
      [WithComments (GHC.IEWrappedName GHC.GhcPs)]
  | WithAllConstructors (WithComments (GHC.IEWrappedName GHC.GhcPs))
  | ByModule (WithComments GHC.ModuleName)
#else
data ExportEntry
  = SingleIdentifier (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs)))
  | WithSpecificConstructors
      (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs)))
      [WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs))]
  | WithAllConstructors (WithComments (GHC.IEWrappedName (GHC.IdP GHC.GhcPs)))
  | ByModule (WithComments GHC.ModuleName)
#endif
instance CommentExtraction ExportEntry where
  nodeComments :: ExportEntry -> NodeComments
nodeComments SingleIdentifier {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments WithSpecificConstructors {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments WithAllConstructors {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments ByModule {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty ExportEntry where
  pretty' :: ExportEntry -> Printer ()
pretty' (SingleIdentifier WithComments (IEWrappedName GhcPs)
s) = WithComments (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments (IEWrappedName GhcPs)
s
  pretty' (WithSpecificConstructors WithComments (IEWrappedName GhcPs)
s [WithComments (IEWrappedName GhcPs)]
xs) = WithComments (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments (IEWrappedName GhcPs)
s Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Printer ()] -> Printer ()
hTuple ((WithComments (IEWrappedName GhcPs) -> Printer ())
-> [WithComments (IEWrappedName GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments (IEWrappedName GhcPs)]
xs)
  pretty' (WithAllConstructors WithComments (IEWrappedName GhcPs)
s) = WithComments (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments (IEWrappedName GhcPs)
s Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(..)"
  pretty' (ByModule WithComments ModuleName
s) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"module " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WithComments ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments ModuleName
s

mkExportEntry :: GHC.IE GHC.GhcPs -> ExportEntry
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
mkExportEntry :: IE GhcPs -> ExportEntry
mkExportEntry (GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = WithComments (IEWrappedName GhcPs) -> ExportEntry
SingleIdentifier (WithComments (IEWrappedName GhcPs) -> ExportEntry)
-> WithComments (IEWrappedName GhcPs) -> ExportEntry
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> WithComments (IEWrappedName GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name
mkExportEntry (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = WithComments (IEWrappedName GhcPs) -> ExportEntry
SingleIdentifier (WithComments (IEWrappedName GhcPs) -> ExportEntry)
-> WithComments (IEWrappedName GhcPs) -> ExportEntry
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> WithComments (IEWrappedName GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name
mkExportEntry (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) =
  WithComments (IEWrappedName GhcPs) -> ExportEntry
WithAllConstructors (WithComments (IEWrappedName GhcPs) -> ExportEntry)
-> WithComments (IEWrappedName GhcPs) -> ExportEntry
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> WithComments (IEWrappedName GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name
mkExportEntry (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
name IEWildcard
_ [LIEWrappedName GhcPs]
constructors Maybe (ExportDoc GhcPs)
_) =
  WithComments (IEWrappedName GhcPs)
-> [WithComments (IEWrappedName GhcPs)] -> ExportEntry
WithSpecificConstructors
    (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> WithComments (IEWrappedName GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name)
    ((GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
 -> WithComments (IEWrappedName GhcPs))
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [WithComments (IEWrappedName GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> WithComments (IEWrappedName GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
constructors)
#else
mkExportEntry (GHC.IEVar _ name) = SingleIdentifier $ fromGenLocated name
mkExportEntry (GHC.IEThingAbs _ name) = SingleIdentifier $ fromGenLocated name
mkExportEntry (GHC.IEThingAll _ name) =
  WithAllConstructors $ fromGenLocated name
mkExportEntry (GHC.IEThingWith _ name _ constructors) =
  WithSpecificConstructors
    (fromGenLocated name)
    (fmap fromGenLocated constructors)
#endif
mkExportEntry (GHC.IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
name) = WithComments ModuleName -> ExportEntry
ByModule (WithComments ModuleName -> ExportEntry)
-> WithComments ModuleName -> ExportEntry
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> WithComments ModuleName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
name
mkExportEntry GHC.IEGroup {} = ExportEntry
forall a. HasCallStack => a
neverAppears
mkExportEntry GHC.IEDoc {} = ExportEntry
forall a. HasCallStack => a
neverAppears
mkExportEntry GHC.IEDocNamed {} = ExportEntry
forall a. HasCallStack => a
neverAppears

neverAppears :: HasCallStack => a
neverAppears :: forall a. HasCallStack => a
neverAppears =
  String -> a
forall a. HasCallStack => String -> a
error
    String
"This AST node should never appear in the GHC AST. If you see this error message, please report a bug to the HIndent maintainers."