{-# LANGUAGE CPP #-}

module HIndent.Ast.Expression.Bracket
  ( Bracket
  , mkBracket
  ) where

import HIndent.Ast.Declaration
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data Bracket
  = TypedExpression (GHC.LHsExpr GHC.GhcPs)
  | UntypedExpression (GHC.LHsExpr GHC.GhcPs)
  | Pattern (GHC.LPat GHC.GhcPs)
  | Declaration [WithComments Declaration]
  | Type (GHC.LHsType GHC.GhcPs)
  | Variable Bool (WithComments PrefixName)

instance CommentExtraction Bracket where
  nodeComments :: Bracket -> NodeComments
nodeComments TypedExpression {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments UntypedExpression {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Pattern {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Declaration {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Type {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Variable {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty Bracket where
  pretty' :: Bracket -> Printer ()
pretty' (TypedExpression LHsExpr GhcPs
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
typedBrackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
  pretty' (UntypedExpression LHsExpr GhcPs
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer ()
forall a. Printer a -> Printer a
wrapWithBars (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
  pretty' (Pattern LPat GhcPs
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"p" 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 ()
forall a. Printer a -> Printer a
wrapWithBars (GenLocated SrcSpanAnnA (Pat GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x)
  pretty' (Declaration [WithComments Declaration]
decls) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"d| " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
lined ((WithComments Declaration -> Printer ())
-> [WithComments Declaration] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments Declaration -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments Declaration]
decls) 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' (Type LHsType GhcPs
x) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"t" 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 ()
forall a. Printer a -> Printer a
wrapWithBars (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x)
  pretty' (Variable Bool
True WithComments PrefixName
var) = 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
>> WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
var
  pretty' (Variable Bool
False WithComments PrefixName
var) = 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
>> WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
var
#if MIN_VERSION_ghc_lib_parser(9, 4, 1)
mkBracket :: GHC.HsQuote GHC.GhcPs -> Bracket
#else
mkBracket :: GHC.HsBracket GHC.GhcPs -> Bracket
#endif
mkBracket :: HsQuote GhcPs -> Bracket
mkBracket (GHC.ExpBr XExpBr GhcPs
_ LHsExpr GhcPs
x) = LHsExpr GhcPs -> Bracket
UntypedExpression LHsExpr GhcPs
x
mkBracket (GHC.PatBr XPatBr GhcPs
_ LPat GhcPs
x) = LPat GhcPs -> Bracket
Pattern LPat GhcPs
x
mkBracket (GHC.DecBrL XDecBrL GhcPs
_ [LHsDecl GhcPs]
x) =
  [WithComments Declaration] -> Bracket
Declaration ([WithComments Declaration] -> Bracket)
-> [WithComments Declaration] -> Bracket
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> WithComments Declaration)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [WithComments Declaration]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsDecl GhcPs -> Declaration)
-> WithComments (HsDecl GhcPs) -> WithComments Declaration
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsDecl GhcPs -> Declaration
mkDeclaration (WithComments (HsDecl GhcPs) -> WithComments Declaration)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> WithComments (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> WithComments Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> WithComments (HsDecl GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
x
mkBracket (GHC.TypBr XTypBr GhcPs
_ LHsType GhcPs
x) = LHsType GhcPs -> Bracket
Type LHsType GhcPs
x
mkBracket (GHC.VarBr XVarBr GhcPs
_ Bool
b LIdP GhcPs
x) = Bool -> WithComments PrefixName -> Bracket
Variable Bool
b (WithComments PrefixName -> Bracket)
-> WithComments PrefixName -> Bracket
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (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
x
mkBracket (GHC.DecBrG {}) = String -> Bracket
forall a. HasCallStack => String -> a
error String
"This AST node should never appear."
#if !MIN_VERSION_ghc_lib_parser(9, 4, 1)
mkBracket (GHC.TExpBr _ x) = TypedExpression x
#endif