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

module HIndent.Ast.Declaration.Warning
  ( WarningDeclaration
  , mkWarningDeclaration
  ) where

import qualified GHC.Types.SourceText as GHC
import HIndent.Ast.Declaration.Warning.Kind
import HIndent.Ast.Name.Prefix
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 {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data WarningDeclaration = WarningDeclaration
  { WarningDeclaration -> [WithComments PrefixName]
names :: [WithComments PrefixName]
  , WarningDeclaration -> Kind
kind :: Kind
  , WarningDeclaration -> [WithComments StringLiteral]
reasons :: [WithComments GHC.StringLiteral]
  }

instance CommentExtraction WarningDeclaration where
  nodeComments :: WarningDeclaration -> NodeComments
nodeComments WarningDeclaration
_ = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty WarningDeclaration where
  pretty' :: WarningDeclaration -> Printer ()
pretty' WarningDeclaration {[WithComments StringLiteral]
[WithComments PrefixName]
Kind
names :: WarningDeclaration -> [WithComments PrefixName]
kind :: WarningDeclaration -> Kind
reasons :: WarningDeclaration -> [WithComments StringLiteral]
names :: [WithComments PrefixName]
kind :: Kind
reasons :: [WithComments StringLiteral]
..} = do
    [Printer ()] -> Printer ()
lined
      [ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Kind -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Kind
kind
      , [Printer ()] -> Printer ()
spaced [[Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments PrefixName -> Printer ())
-> [WithComments PrefixName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments PrefixName]
names, [Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments StringLiteral -> Printer ())
-> [WithComments StringLiteral] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments StringLiteral -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments StringLiteral]
reasons]
      , HasCallStack => String -> Printer ()
String -> Printer ()
string String
" #-}"
      ]

mkWarningDeclaration :: GHC.WarnDecl GHC.GhcPs -> WarningDeclaration
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
mkWarningDeclaration :: WarnDecl GhcPs -> WarningDeclaration
mkWarningDeclaration (GHC.Warning XWarning GhcPs
_ [LIdP GhcPs]
ns (GHC.DeprecatedTxt SourceText
_ [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
rs)) =
  WarningDeclaration {kind :: Kind
kind = Kind
Deprecated, [WithComments StringLiteral]
[WithComments PrefixName]
names :: [WithComments PrefixName]
reasons :: [WithComments StringLiteral]
names :: [WithComments PrefixName]
reasons :: [WithComments StringLiteral]
..}
  where
    names :: [WithComments PrefixName]
names = (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments PrefixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> (GenLocated SrcSpanAnnN RdrName
    -> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments PrefixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns
    reasons :: [WithComments StringLiteral]
reasons = (LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
 -> WithComments StringLiteral)
-> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
-> [WithComments StringLiteral]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated EpaLocation StringLiteral -> WithComments StringLiteral
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated EpaLocation StringLiteral
 -> WithComments StringLiteral)
-> (LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
    -> GenLocated EpaLocation StringLiteral)
-> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
-> WithComments StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral)
-> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
-> GenLocated EpaLocation StringLiteral
forall a b.
(a -> b) -> GenLocated EpaLocation a -> GenLocated EpaLocation b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
GHC.hsDocString) [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
rs
mkWarningDeclaration (GHC.Warning XWarning GhcPs
_ [LIdP GhcPs]
ns (GHC.WarningTxt Maybe (LocatedE InWarningCategory)
_ SourceText
_ [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
rs)) =
  WarningDeclaration {kind :: Kind
kind = Kind
Warning, [WithComments StringLiteral]
[WithComments PrefixName]
names :: [WithComments PrefixName]
reasons :: [WithComments StringLiteral]
names :: [WithComments PrefixName]
reasons :: [WithComments StringLiteral]
..}
  where
    names :: [WithComments PrefixName]
names = (GenLocated SrcSpanAnnN RdrName -> WithComments PrefixName)
-> [GenLocated SrcSpanAnnN RdrName] -> [WithComments PrefixName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> (GenLocated SrcSpanAnnN RdrName
    -> GenLocated SrcSpanAnnN PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> WithComments PrefixName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName) [LIdP GhcPs]
[GenLocated SrcSpanAnnN RdrName]
ns
    reasons :: [WithComments StringLiteral]
reasons = (LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
 -> WithComments StringLiteral)
-> [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
-> [WithComments StringLiteral]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated EpaLocation StringLiteral -> WithComments StringLiteral
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated EpaLocation StringLiteral
 -> WithComments StringLiteral)
-> (LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
    -> GenLocated EpaLocation StringLiteral)
-> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
-> WithComments StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral)
-> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
-> GenLocated EpaLocation StringLiteral
forall a b.
(a -> b) -> GenLocated EpaLocation a -> GenLocated EpaLocation b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithHsDocIdentifiers StringLiteral GhcPs -> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
GHC.hsDocString) [LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)]
rs
#elif MIN_VERSION_ghc_lib_parser(9, 8, 1)
mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =
  WarningDeclaration {kind = Deprecated, ..}
  where
    names = fmap (fromGenLocated . fmap mkPrefixName) ns
    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ _ rs)) =
  WarningDeclaration {kind = Warning, ..}
  where
    names = fmap (fromGenLocated . fmap mkPrefixName) ns
    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
#elif MIN_VERSION_ghc_lib_parser(9, 4, 1)
mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =
  WarningDeclaration {kind = Deprecated, ..}
  where
    names = fmap (fromGenLocated . fmap mkPrefixName) ns
    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ rs)) =
  WarningDeclaration {kind = Warning, ..}
  where
    names = fmap (fromGenLocated . fmap mkPrefixName) ns
    reasons = fmap (fromGenLocated . fmap GHC.hsDocString) rs
#else
mkWarningDeclaration (GHC.Warning _ ns (GHC.DeprecatedTxt _ rs)) =
  WarningDeclaration {kind = Deprecated, ..}
  where
    names = fmap (fromGenLocated . fmap mkPrefixName) ns
    reasons = fmap fromGenLocated rs
mkWarningDeclaration (GHC.Warning _ ns (GHC.WarningTxt _ rs)) =
  WarningDeclaration {kind = Warning, ..}
  where
    names = fmap (fromGenLocated . fmap mkPrefixName) ns
    reasons = fmap fromGenLocated rs
#endif