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

        | "DC1" | "DC2" | "DC3" | "DC4" | "NAK" | "SYN" | "ETB" | "CAN"

        | "EM" | "SUB" | "ESC" | "FS" | "GS" | "RS" | "US" | "SP" | "DEL"

 @escape     = \\ ( $charesc      | @ascii | @decimal | o @octal | x @hexadecimal )

 :-

 -- Note [Lexing interpolated strings]

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

 -- Lexing interpolated strings will do the following steps:

 --

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

   (\" | \"\") / ([\n .] # \")   { StringInterContentRaw }

   \$ \{                         { StringInterContentExpOpen }

   \" \" \"                      { StringInterContentEnd }

 }

 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

   Char '^' : Char c : cs -> pure (chr $ ord c - ord '@', cs)

   -- long form escapes (e.g. '\NUL')

   cs | Just (esc, cs') <- parseLongEscape cs -> pure (esc, cs')

   -- shouldn't happen

   Char c : _ -> panic $ "found unexpected escape character: " ++ show c

   [] -> panic "escape character unexpectedly ended"

     * 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

 test('StringInterpolationInType', normal, compile_fail, [''])

 test('StringInterpolationLineComment', normal, compile_fail, [''])

 test('StringInterpolationSmartQuotes', normal, compile_fail, [''])

 # ---------- END OF FILE ---------- #

 # Don't just place tests at the end here; put in correct section

       , 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, [''])