{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Module.Warning
  ( ModuleWarning
  , mkModuleWarning
  ) where

import qualified GHC.Types.SourceText as GHC
import qualified GHC.Types.SrcLoc as GHC
import HIndent.Ast.Declaration.Warning.Kind
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import qualified HIndent.GhcLibParserWrapper.GHC.Unit.Module.Warnings as GHC
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
data ModuleWarning = ModuleWarning
  { ModuleWarning
-> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
messages :: [GHC.LocatedE
                   (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs)]
  , ModuleWarning -> Kind
kind :: Kind
  }
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
data ModuleWarning = ModuleWarning
  { messages :: [GHC.Located
                   (GHC.WithHsDocIdentifiers GHC.StringLiteral GHC.GhcPs)]
  , kind :: Kind
  }
#else
data ModuleWarning = ModuleWarning
  { messages :: [GHC.GenLocated GHC.SrcSpan GHC.StringLiteral]
  , kind :: Kind
  }
#endif
instance CommentExtraction ModuleWarning where
  nodeComments :: ModuleWarning -> NodeComments
nodeComments ModuleWarning
_ = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty ModuleWarning where
  pretty' :: ModuleWarning -> Printer ()
pretty' ModuleWarning {[LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
Kind
messages :: ModuleWarning
-> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
kind :: ModuleWarning -> Kind
messages :: [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
kind :: Kind
..} =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-#", Kind -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Kind
kind, Printer ()
prettyMsgs, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]
    where
      prettyMsgs :: Printer ()
prettyMsgs =
        case [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
messages of
          [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
x] -> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
x
          [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
xs -> [Printer ()] -> Printer ()
hList ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LocatedE (WithHsDocIdentifiers StringLiteral GhcPs) -> Printer ())
-> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocatedE (WithHsDocIdentifiers StringLiteral GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
xs

mkModuleWarning :: GHC.HsModule' -> Maybe (WithComments ModuleWarning)
mkModuleWarning :: HsModule' -> Maybe (WithComments ModuleWarning)
mkModuleWarning =
  (GenLocated SrcSpanAnnP WarningTxt' -> WithComments ModuleWarning)
-> Maybe (GenLocated SrcSpanAnnP WarningTxt')
-> Maybe (WithComments ModuleWarning)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnP ModuleWarning -> WithComments ModuleWarning
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnP ModuleWarning
 -> WithComments ModuleWarning)
-> (GenLocated SrcSpanAnnP WarningTxt'
    -> GenLocated SrcSpanAnnP ModuleWarning)
-> GenLocated SrcSpanAnnP WarningTxt'
-> WithComments ModuleWarning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WarningTxt' -> ModuleWarning)
-> GenLocated SrcSpanAnnP WarningTxt'
-> GenLocated SrcSpanAnnP ModuleWarning
forall a b.
(a -> b) -> GenLocated SrcSpanAnnP a -> GenLocated SrcSpanAnnP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WarningTxt' -> ModuleWarning
fromWarningTxt) (Maybe (GenLocated SrcSpanAnnP WarningTxt')
 -> Maybe (WithComments ModuleWarning))
-> (HsModule' -> Maybe (GenLocated SrcSpanAnnP WarningTxt'))
-> HsModule'
-> Maybe (WithComments ModuleWarning)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> Maybe (GenLocated SrcSpanAnnP WarningTxt')
GHC.getDeprecMessage

fromWarningTxt :: GHC.WarningTxt' -> ModuleWarning
#if MIN_VERSION_ghc_lib_parser(9, 8, 1)
fromWarningTxt :: WarningTxt' -> ModuleWarning
fromWarningTxt (GHC.WarningTxt Maybe (LocatedE InWarningCategory)
_ SourceText
_ [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
messages) = ModuleWarning {[LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
Kind
messages :: [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
kind :: Kind
messages :: [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
kind :: Kind
..}
  where
    kind :: Kind
kind = Kind
Warning
#else
fromWarningTxt (GHC.WarningTxt _ messages) = ModuleWarning {..}
  where
    kind = Warning
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
fromWarningTxt (GHC.DeprecatedTxt SourceText
_ [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
messages) = ModuleWarning {[LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
Kind
messages :: [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
kind :: Kind
messages :: [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
kind :: Kind
..}
  where
    kind :: Kind
kind = Kind
Deprecated
#else
fromWarningTxt (GHC.DeprecatedTxt _ messages) = ModuleWarning {..}
  where
    kind = Deprecated
#endif