{-# LANGUAGE CPP #-}

module HIndent.Ast.Expression.Splice
  ( Splice
  , mkSplice
  ) where

import qualified GHC.Data.FastString as GHC
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
import qualified GHC.Types.SrcLoc as GHC
#endif
data Splice
  = Typed (GHC.LHsExpr GHC.GhcPs)
  | UntypedDollar (GHC.LHsExpr GHC.GhcPs)
  | UntypedBare (GHC.LHsExpr GHC.GhcPs)
  | QuasiQuote PrefixName GHC.FastString

instance CommentExtraction Splice where
  nodeComments :: Splice -> NodeComments
nodeComments Typed {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments UntypedDollar {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments UntypedBare {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments QuasiQuote {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty Splice where
  pretty' :: Splice -> Printer ()
pretty' (Typed LHsExpr GhcPs
x) = 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
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
  pretty' (UntypedDollar LHsExpr GhcPs
x) = 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
>> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
  pretty' (UntypedBare LHsExpr GhcPs
x) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
  pretty' (QuasiQuote PrefixName
l FastString
r) =
    Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty PrefixName
l
      Printer () -> Printer ()
forall a. Printer a -> Printer a
wrapWithBars
        (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
0
        (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> String -> String -> [Printer ()]
printers [] String
""
        (String -> [Printer ()]) -> String -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
r
    where
      printers :: [Printer ()] -> String -> String -> [Printer ()]
printers [Printer ()]
ps String
s [] = [Printer ()] -> [Printer ()]
forall a. [a] -> [a]
reverse (HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> String
forall a. [a] -> [a]
reverse String
s) Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: [Printer ()]
ps)
      printers [Printer ()]
ps String
s (Char
'\n':String
xs) =
        [Printer ()] -> String -> String -> [Printer ()]
printers (Printer ()
newline Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: HasCallStack => String -> Printer ()
String -> Printer ()
string (String -> String
forall a. [a] -> [a]
reverse String
s) Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: [Printer ()]
ps) String
"" String
xs
      printers [Printer ()]
ps String
s (Char
x:String
xs) = [Printer ()] -> String -> String -> [Printer ()]
printers [Printer ()]
ps (Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
s) String
xs
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
mkSplice :: GHC.HsUntypedSplice GHC.GhcPs -> Splice
mkSplice :: HsUntypedSplice GhcPs -> Splice
mkSplice (GHC.HsUntypedSpliceExpr XUntypedSpliceExpr GhcPs
_ LHsExpr GhcPs
x) = LHsExpr GhcPs -> Splice
UntypedDollar LHsExpr GhcPs
x
mkSplice (GHC.HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
l (GHC.L EpAnnCO
_ FastString
r)) = PrefixName -> FastString -> Splice
QuasiQuote (RdrName -> PrefixName
mkPrefixName IdP GhcPs
RdrName
l) FastString
r
#else
mkSplice :: GHC.HsSplice GHC.GhcPs -> Splice
mkSplice (GHC.HsTypedSplice _ _ _ body) = Typed body
mkSplice (GHC.HsUntypedSplice _ GHC.DollarSplice _ body) = UntypedDollar body
mkSplice (GHC.HsUntypedSplice _ GHC.BareSplice _ body) = UntypedBare body
mkSplice (GHC.HsQuasiQuote _ _ l _ r) = QuasiQuote (mkPrefixName l) r
mkSplice GHC.HsSpliced {} = error "This AST node should never appear."
#endif