import GHC.Hs.Lit

 import Language.Haskell.Syntax.Extension

 import Language.Haskell.Syntax.Basic (FieldLabelString(..))

 import Language.Haskell.Syntax.Text

 import Language.Haskell.Syntax.Module.Name

 import GHC.Hs.Extension

 type instance XLam           (GhcPass _) = EpAnnLam

 type instance XApp           (GhcPass _) = NoExtField

 type instance XInterString GhcTc = DataConCantHappen

 type instance XAppTypeE      GhcPs = EpToken "@"

 type instance XAppTypeE      GhcRn = NoExtField

 instance NoAnn AnnFunRhs where

   noAnn = AnnFunRhs noAnn noAnn noAnn

 -- ---------------------------------------------------------------------

 type instance XSCC           (GhcPass _) = (AnnPragSCC, SourceText)

 ppr_expr (HsOverLit _ lit)   = ppr lit

 ppr_expr (HsQualLit _ lit)   = ppr lit

   char 's' <> delim <> hcat (map pprInterPart parts) <> delim

   where

     delim

       | otherwise = char '"'

     pprInterPart = \case

       HsInterStringExpr _ expr -> text "${" <> ppr_lexpr expr <> text "}"

       HsInterStringRaw st s ->

         case st of

           SourceText src

             | otherwise -> ftext src

           NoSourceText

             | otherwise -> pprHsString' (unpackHText s)

 ppr_expr (HsHole x) = case (ghcPass @p, x) of

 addTickHsExpr e@(HsQualLit {})          = return e

 addTickHsExpr (HsInterString x ty parts) = do

   parts' <- forM parts $ \case

     HsInterStringExpr x e -> HsInterStringExpr x <$> addTickLHsExpr e

   return $ HsInterString x ty parts'

 addTickHsExpr e@(HsEmbTy {})            = return e

 addTickHsExpr e@(HsStar {})             = return e

 processStringInter tokBegin parts tokEnd = do

   parts' <- mapM mkInterStringPartPV $ processRawLexedStrings parts

   ams1 (L (comb2 tokBegin tokEnd) ()) $

   where

     L _ (ITstringInterBegin meta) = tokBegin

     processRawLexedStrings ::

       [Either (SourceText, RawLexedString) ECP] ->

 tok_string_inter_qual_begin :: StringMeta -> Action

 tok_string_inter_qual_begin meta span buf len buf2 = do

   let meta' = meta{strMetaQualified = Just modName}

   tok_string_inter_begin meta' span buf len buf2

   where

 -- Note [Lexing interpolated strings]

 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 -- Lexing interpolated strings will do the following steps:

 --

 -- 1. Lex `s"` => push `string_inter_content` lex state

 import Data.Functor.Identity (Identity (..))

 import qualified Data.List.NonEmpty as NonEmpty

 import Data.Maybe (listToMaybe, mapMaybe)

 import GHC.Data.OrdList (fromOL, nilOL, snocOL)

 import GHC.Data.StringBuffer (StringBuffer)

 import qualified GHC.Data.StringBuffer as StringBuffer

   deriving (Show, Eq)

 lexString :: Int -> StringBuffer -> Either StringLexError String

 -- -----------------------------------------------------------------------------

 -- Lexing interface

       c : cs -> go (acc `snocOL` c) cs

 resolveEscapesMaybe :: HasChar c => [c] -> Maybe [c]

 -- -----------------------------------------------------------------------------

 -- Escape characters

     * Lines with only whitespace characters

 3. Calculate the longest prefix of whitespace shared by all lines in the remaining list

 -}

                  return (HsApp noExtField (noLocA neg) (noLocA (HsOverLit x lit'))

                         , fvs ) }

   (parts', fvs1) <- unzip <$> mapM rnInterStringPart parts

   pure (expr, plusFNs fvs1 `plusFN` fvs2)

   where

     rnInterStringPart = \case

 import GHC.Tc.Utils.Monad

 import GHC.Types.Name.Set (FreeNames, emptyFNs, plusFNs)

 import GHC.Types.SrcLoc (unLoc)

 {- Note [Desugaring interpolated strings]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 Cross-references:

 Interpolated strings are represented with the following HsExpr tree:

 -- have already been renamed, but handles renaming of overloaded strings, if

 -- necessary.

 rewriteInterString ::

   [HsInterStringPart GhcRn] ->

   RnM (HsExpr GhcRn, FreeNames)

   (mkOverloaded, fns1) <- get_mkOverloaded

   (rawName, fns2) <- lookupName KnownOccs.interpolateRawIdOcc

   (convertName, fns3) <- lookupName KnownOccs.interpolateValueIdOcc

   pure (expr, plusFNs [fns1, fns2, fns3, fns4, fns5, fns6])

   where

     lookupName =

         Just mod -> lookupNameWithQualifier mod

         Nothing -> lookupSyntaxName

     -- Handle -XOverloadedStrings

     get_mkOverloaded = do

       overloaded <- xoptM LangExt.OverloadedStrings

         then do

           (fromStringExpr, fns) <- lookupSyntaxExpr KnownOccs.fromStringClassOpOcc

           pure (nlHsApp (noLocA fromStringExpr), fns)

 import Language.Haskell.Syntax.Module.Name

 import Language.Haskell.Syntax.Type

 import Language.Haskell.Syntax.Binds

 -- libraries:

 import Data.Data hiding (Fixity(..))

   | -- | See Note [Parsing interpolated strings]

     HsInterString

       (XInterString p)

       [HsInterStringPart p]

   -- | Lambda, Lambda-case, and Lambda-cases

 data HsInterStringPart p

   = HsInterStringRaw (XInterStringRaw p) HText

   | HsInterStringExpr (XInterStringExpr p) (LHsExpr p)

 {-

 Note [Parens in HsSyn]

 type family XInterString    x

 type family XInterStringRaw x

 type family XInterStringExpr x

 type family XLam            x

 type family XLamCase        x

 type family XApp            x

       , expression =

           let s = "world" in s ++ s" hello ${s}"

       }

   , TestCase -- curly brace Char

       { label =

           """

       , expression =

           s"a ${'}'} b"

       }

   , TestCase -- interpolated expression with comment

       { label =

           """

       , expression =

           let x = "test" in s"a “${x}” b"

       }

   ]

 {----- Types for tests -----}

 	$(CHECK_PPR)   $(LIBDIR) PprQualifiedStrings.hs

 	$(CHECK_EXACT) $(LIBDIR) PprQualifiedStrings.hs

 .PHONY: Haddock1

 Haddock1:

 	# $(CHECK_PPR)   $(LIBDIR) Haddock1.hs

 test('Haddock1', [ignore_stderr,req_ppr_deps], makefile_test, ['Haddock1'])

 test('T27423c', [ignore_stderr,req_ppr_deps], makefile_test, ['T27423c'])

 test('PprStringNoSourceText', normal, compile, [''])