{-# LANGUAGE CPP, NoOverloadedLists, NoOverloadedStrings #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Exon.Haskell.Translate (toExp) where

import qualified Data.ByteString as B
import qualified Data.List.NonEmpty as NonEmpty
import GHC.Data.FastString
import GHC.Driver.Ppr (showSDoc)
import GHC.Driver.Session (DynFlags)
import GHC.Hs.Expr as Expr
import GHC.Hs.Extension as Ext
import GHC.Hs.Lit
import GHC.Hs.Pat as Pat
import GHC.Hs.Type (HsSigType (HsSig), HsType (..), HsWildCardBndrs (..), sig_body)
import GHC.Types.Basic (Boxity (..))
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.SourceText (il_value, rationalFromFractionalLit)
import GHC.Types.SrcLoc
import qualified GHC.Unit.Module as Module
import GHC.Utils.Outputable (ppr)
import qualified Language.Haskell.TH.Syntax as TH
#if MIN_VERSION_ghc(9,6,0)
import Language.Haskell.Syntax.Basic (FieldLabelString (..))
#endif

import qualified Exon.Haskell.Settings as Settings

-- TODO: why this disapears in GHC >= 9.2?
fl_value :: FractionalLit -> Rational
fl_value = FractionalLit -> Rational
rationalFromFractionalLit



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

toLit :: HsLit GhcPs -> TH.Lit
toLit :: HsLit GhcPs -> Lit
toLit (HsChar XHsChar GhcPs
_ Char
c) = Char -> Lit
TH.CharL Char
c
toLit (HsCharPrim XHsCharPrim GhcPs
_ Char
c) = Char -> Lit
TH.CharPrimL Char
c
toLit (HsString XHsString GhcPs
_ FastString
s) = String -> Lit
TH.StringL (FastString -> String
unpackFS FastString
s)
toLit (HsStringPrim XHsStringPrim GhcPs
_ ByteString
s) = [Word8] -> Lit
TH.StringPrimL (ByteString -> [Word8]
B.unpack ByteString
s)
toLit (HsInt XHsInt GhcPs
_ IntegralLit
i) = Integer -> Lit
TH.IntegerL (IntegralLit -> Integer
il_value IntegralLit
i)
toLit (HsIntPrim XHsIntPrim GhcPs
_ Integer
i) = Integer -> Lit
TH.IntPrimL Integer
i
toLit (HsWordPrim XHsWordPrim GhcPs
_ Integer
i) = Integer -> Lit
TH.WordPrimL Integer
i
toLit (HsInt64Prim XHsInt64Prim GhcPs
_ Integer
i) = Integer -> Lit
TH.IntegerL Integer
i
toLit (HsWord64Prim XHsWord64Prim GhcPs
_ Integer
i) = Integer -> Lit
TH.WordPrimL Integer
i
toLit (HsInteger XHsInteger GhcPs
_ Integer
i Type
_) = Integer -> Lit
TH.IntegerL Integer
i
toLit (HsRat XHsRat GhcPs
_ FractionalLit
f Type
_) = Rational -> Lit
TH.FloatPrimL (FractionalLit -> Rational
fl_value FractionalLit
f)
toLit (HsFloatPrim XHsFloatPrim GhcPs
_ FractionalLit
f) = Rational -> Lit
TH.FloatPrimL (FractionalLit -> Rational
fl_value FractionalLit
f)
toLit (HsDoublePrim XHsDoublePrim GhcPs
_ FractionalLit
f) = Rational -> Lit
TH.DoublePrimL (FractionalLit -> Rational
fl_value FractionalLit
f)

toLit' :: OverLitVal -> TH.Lit
toLit' :: OverLitVal -> Lit
toLit' (HsIntegral IntegralLit
i) = Integer -> Lit
TH.IntegerL (IntegralLit -> Integer
il_value IntegralLit
i)
toLit' (HsFractional FractionalLit
f) = Rational -> Lit
TH.RationalL (FractionalLit -> Rational
fl_value FractionalLit
f)
toLit' (HsIsString SourceText
_ FastString
fs) = String -> Lit
TH.StringL (FastString -> String
unpackFS FastString
fs)

toType :: HsType GhcPs -> TH.Type
toType :: HsType GhcPs -> Type
toType (HsWildCardTy XWildCardTy GhcPs
_) = Type
TH.WildCardT
toType (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ LIdP GhcPs
n) =
  let n' :: RdrName
n' = GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
   in if RdrName -> Bool
isRdrTyVar RdrName
n'
        then Name -> Type
TH.VarT (RdrName -> Name
toName RdrName
n')
        else Name -> Type
TH.ConT (RdrName -> Name
toName RdrName
n')
toType HsType GhcPs
t = String -> String -> Type
forall e a. (HasCallStack, Show e) => String -> e -> a
todo String
"toType" (DynFlags -> SDoc -> String
showSDoc([Extension] -> DynFlags
Settings.baseDynFlags []) (SDoc -> String)
-> (HsType GhcPs -> SDoc) -> HsType GhcPs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HsType GhcPs -> String) -> HsType GhcPs -> String
forall a b. (a -> b) -> a -> b
$ HsType GhcPs
t)

toName :: RdrName -> TH.Name
toName :: RdrName -> Name
toName RdrName
n = case RdrName
n of
  (Unqual OccName
o) -> String -> Name
TH.mkName (OccName -> String
occNameString OccName
o)
  (Qual ModuleName
m OccName
o) -> String -> Name
TH.mkName (ModuleName -> String
Module.moduleNameString ModuleName
m String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OccName -> String
occNameString OccName
o)
  (Orig Module
_ OccName
_) -> String -> Name
forall a. HasCallStack => String -> a
error String
"orig"
  (Exact Name
_) -> String -> Name
forall a. HasCallStack => String -> a
error String
"exact"

toFieldExp :: a
toFieldExp :: forall a. a
toFieldExp = a
forall a. HasCallStack => a
undefined

toPat :: DynFlags -> Pat.Pat GhcPs -> TH.Pat
toPat :: DynFlags -> Pat GhcPs -> Pat
toPat DynFlags
_dynFlags (Pat.VarPat XVarPat GhcPs
_ (LIdP GhcPs -> RdrName
GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc -> RdrName
name)) = Name -> Pat
TH.VarP (RdrName -> Name
toName RdrName
name)
toPat DynFlags
dynFlags Pat GhcPs
p = String -> String -> Pat
forall e a. (HasCallStack, Show e) => String -> e -> a
todo String
"toPat" (DynFlags -> SDoc -> String
showSDoc DynFlags
dynFlags (SDoc -> String) -> (Pat GhcPs -> SDoc) -> Pat GhcPs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Pat GhcPs -> String) -> Pat GhcPs -> String
forall a b. (a -> b) -> a -> b
$ Pat GhcPs
p)

toExp :: DynFlags -> Expr.HsExpr GhcPs -> TH.Exp
toExp :: DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
_ (Expr.HsVar XVar GhcPs
_ LIdP GhcPs
n) =
  let n' :: RdrName
n' = GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
   in if RdrName -> Bool
isRdrDataCon RdrName
n'
        then Name -> Exp
TH.ConE (RdrName -> Name
toName RdrName
n')
        else Name -> Exp
TH.VarE (RdrName -> Name
toName RdrName
n')

toExp DynFlags
_ (Expr.HsUnboundVar XUnboundVar GhcPs
_ OccName
n)              = Name -> Exp
TH.UnboundVarE (String -> Name
TH.mkName (String -> Name) -> (OccName -> String) -> OccName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString (OccName -> String) -> (OccName -> OccName) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> OccName
forall name. HasOccName name => name -> OccName
occName (OccName -> Name) -> OccName -> Name
forall a b. (a -> b) -> a -> b
$ OccName
n)

toExp DynFlags
_ Expr.HsIPVar {}
  = String -> String -> Exp
forall e a. (HasCallStack, Show e) => String -> e -> a
noTH String
"toExp" String
"HsIPVar"

toExp DynFlags
_ (Expr.HsLit XLitE GhcPs
_ HsLit GhcPs
l)
  = Lit -> Exp
TH.LitE (HsLit GhcPs -> Lit
toLit HsLit GhcPs
l)

toExp DynFlags
_ (Expr.HsOverLit XOverLitE GhcPs
_ OverLit {OverLitVal
ol_val :: OverLitVal
ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val})
  = Lit -> Exp
TH.LitE (OverLitVal -> Lit
toLit' OverLitVal
ol_val)

toExp DynFlags
d (Expr.HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
e2)
  = Exp -> Exp -> Exp
TH.AppE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e1) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e2)

#if MIN_VERSION_ghc(9,6,0)
toExp d (Expr.HsAppType _ e _ HsWC {hswc_body}) = TH.AppTypeE (toExp d . unLoc $ e) (toType . unLoc $ hswc_body)
#else
toExp DynFlags
d (Expr.HsAppType XAppTypeE GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e HsWC {LHsType (NoGhcTc GhcPs)
hswc_body :: LHsType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body}) = Exp -> Type -> Exp
TH.AppTypeE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e) (HsType GhcPs -> Type
toType (HsType GhcPs -> Type)
-> (LHsType (NoGhcTc GhcPs) -> HsType GhcPs)
-> LHsType (NoGhcTc GhcPs)
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType (NoGhcTc GhcPs) -> HsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (LHsType (NoGhcTc GhcPs) -> Type)
-> LHsType (NoGhcTc GhcPs) -> Type
forall a b. (a -> b) -> a -> b
$ LHsType (NoGhcTc GhcPs)
hswc_body)
#endif

toExp DynFlags
d (Expr.ExprWithTySig XExprWithTySig GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e HsWC{hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body=LHsSigType (NoGhcTc GhcPs) -> HsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsSig{LHsType GhcPs
sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body :: LHsType GhcPs
sig_body}}) = Exp -> Type -> Exp
TH.SigE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e) (HsType GhcPs -> Type
toType (HsType GhcPs -> Type)
-> (LHsType GhcPs -> HsType GhcPs) -> LHsType GhcPs -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> HsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (LHsType GhcPs -> Type) -> LHsType GhcPs -> Type
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs
sig_body)

toExp DynFlags
d (Expr.OpApp XOpApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e1 XRec GhcPs (HsExpr GhcPs)
o XRec GhcPs (HsExpr GhcPs)
e2)
  = Exp -> Exp -> Exp -> Exp
TH.UInfixE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e1) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
o) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e2)

toExp DynFlags
d (Expr.NegApp XNegApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e SyntaxExpr GhcPs
_)
  = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'negate) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e)

-- NOTE: for lambda, there is only one match
#if MIN_VERSION_ghc(9,6,0)
toExp d (Expr.HsLam _ (Expr.MG _ (unLoc -> (map unLoc -> [Expr.Match _ _ (map unLoc -> ps) (Expr.GRHSs _ [unLoc -> Expr.GRHS _ _ (unLoc -> e)] _)]))))
#else
toExp DynFlags
d (Expr.HsLam XLam GhcPs
_ (Expr.MG XMG GhcPs (XRec GhcPs (HsExpr GhcPs))
_ (XRec GhcPs [LMatch GhcPs (XRec GhcPs (HsExpr GhcPs))]
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc -> ((GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc -> [Expr.Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsMatchContext GhcPs
_ ((GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [Pat GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc -> [Pat GhcPs]
ps) (Expr.GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated
  (SrcAnn NoEpAnns)
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc -> Expr.GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [GuardLStmt GhcPs]
_ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsExpr GhcPs
e)] HsLocalBinds GhcPs
_)])) Origin
_))
#endif
  = [Pat] -> Exp -> Exp
TH.LamE ((Pat GhcPs -> Pat) -> [Pat GhcPs] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags -> Pat GhcPs -> Pat
toPat DynFlags
d) [Pat GhcPs]
ps) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d HsExpr GhcPs
e)

-- toExp (Expr.Let _ bs e)                       = TH.LetE (toDecs bs) (toExp e)
--
toExp DynFlags
d (Expr.HsIf XIf GhcPs
_ XRec GhcPs (HsExpr GhcPs)
a XRec GhcPs (HsExpr GhcPs)
b XRec GhcPs (HsExpr GhcPs)
c)                   = Exp -> Exp -> Exp -> Exp
TH.CondE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a)) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b)) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
c))

-- toExp (Expr.MultiIf _ ifs)                    = TH.MultiIfE (map toGuard ifs)
-- toExp (Expr.Case _ e alts)                    = TH.CaseE (toExp e) (map toMatch alts)
-- toExp (Expr.Do _ ss)                          = TH.DoE (map toStmt ss)
-- toExp e@Expr.MDo{}                            = noTH "toExp" e
--
toExp DynFlags
d (Expr.ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
args Boxity
boxity) = [Maybe Exp] -> Exp
ctor [Maybe Exp]
tupArgs
  where
    toTupArg :: HsTupArg id -> Maybe (HsExpr id)
toTupArg (Expr.Present XPresent id
_ XRec id (HsExpr id)
e) = HsExpr id -> Maybe (HsExpr id)
forall a. a -> Maybe a
Just (HsExpr id -> Maybe (HsExpr id)) -> HsExpr id -> Maybe (HsExpr id)
forall a b. (a -> b) -> a -> b
$ GenLocated l (HsExpr id) -> HsExpr id
forall l e. GenLocated l e -> e
unLoc XRec id (HsExpr id)
GenLocated l (HsExpr id)
e
    toTupArg (Expr.Missing XMissing id
_) = Maybe (HsExpr id)
forall a. Maybe a
Nothing
    toTupArg HsTupArg id
_ = String -> Maybe (HsExpr id)
forall a. HasCallStack => String -> a
error String
"impossible case"

    ctor :: [Maybe Exp] -> Exp
ctor = case Boxity
boxity of
      Boxity
Boxed -> [Maybe Exp] -> Exp
TH.TupE
      Boxity
Unboxed -> [Maybe Exp] -> Exp
TH.UnboxedTupE

    tupArgs :: [Maybe Exp]
tupArgs = (HsTupArg GhcPs -> Maybe Exp) -> [HsTupArg GhcPs] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((HsExpr GhcPs -> Exp) -> Maybe (HsExpr GhcPs) -> Maybe Exp
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d)) (Maybe (HsExpr GhcPs) -> Maybe Exp)
-> (HsTupArg GhcPs -> Maybe (HsExpr GhcPs))
-> HsTupArg GhcPs
-> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTupArg GhcPs -> Maybe (HsExpr GhcPs)
forall {id} {l}.
(XRec id (HsExpr id) ~ GenLocated l (HsExpr id)) =>
HsTupArg id -> Maybe (HsExpr id)
toTupArg) [HsTupArg GhcPs]
args

-- toExp (Expr.List _ xs)                        = TH.ListE (fmap toExp xs)
#if MIN_VERSION_ghc(9, 4, 0)
toExp DynFlags
d (Expr.HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e LHsToken ")" GhcPs
_)
#else
toExp d (Expr.HsPar _ e)
#endif
  = Exp -> Exp
TH.ParensE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (HsExpr GhcPs)
-> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (HsExpr GhcPs) -> Exp)
-> XRec GhcPs (HsExpr GhcPs) -> Exp
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsExpr GhcPs)
e)

toExp DynFlags
d (Expr.SectionL XSectionL GhcPs
_ (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsExpr GhcPs
a) (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsExpr GhcPs
b))
  = Maybe Exp -> Exp -> Maybe Exp -> Exp
TH.InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Maybe Exp) -> HsExpr GhcPs -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d HsExpr GhcPs
b) Maybe Exp
forall a. Maybe a
Nothing

toExp DynFlags
d (Expr.SectionR XSectionR GhcPs
_ (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsExpr GhcPs
a) (XRec GhcPs (HsExpr GhcPs) -> HsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsExpr GhcPs
b))
  = Maybe Exp -> Exp -> Maybe Exp -> Exp
TH.InfixE Maybe Exp
forall a. Maybe a
Nothing (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d HsExpr GhcPs
a) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Maybe Exp) -> HsExpr GhcPs -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs
b)

toExp DynFlags
_ (Expr.RecordCon XRecordCon GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
name HsRecFields {[LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
rec_flds :: [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds})
  = Name -> [FieldExp] -> Exp
TH.RecConE (RdrName -> Name
toName (RdrName -> Name)
-> (XRec GhcPs (ConLikeP GhcPs) -> RdrName)
-> XRec GhcPs (ConLikeP GhcPs)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcPs (ConLikeP GhcPs) -> RdrName
GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (ConLikeP GhcPs) -> Name)
-> XRec GhcPs (ConLikeP GhcPs) -> Name
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (ConLikeP GhcPs)
name) ((GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> FieldExp)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [FieldExp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> FieldExp
forall a. a
toFieldExp [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rec_flds)

-- toExp (Expr.RecUpdate _ e xs)                 = TH.RecUpdE (toExp e) (fmap toFieldExp xs)
-- toExp (Expr.ListComp _ e ss)                  = TH.CompE $ map convert ss ++ [TH.NoBindS (toExp e)]
--  where
--   convert (Expr.QualStmt _ st)                = toStmt st
--   convert s                                   = noTH "toExp ListComp" s
-- toExp (Expr.ExpTypeSig _ e t)                 = TH.SigE (toExp e) (toType t)
--
toExp DynFlags
d (Expr.ExplicitList XExplicitList GhcPs
_ ((GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [HsExpr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> [HsExpr GhcPs]
args)) = [Exp] -> Exp
TH.ListE ((HsExpr GhcPs -> Exp) -> [HsExpr GhcPs] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d) [HsExpr GhcPs]
args)

toExp DynFlags
d (Expr.ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
e)
  = Range -> Exp
TH.ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ case ArithSeqInfo GhcPs
e of
    (From XRec GhcPs (HsExpr GhcPs)
a) -> Exp -> Range
TH.FromR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a)
    (FromThen XRec GhcPs (HsExpr GhcPs)
a XRec GhcPs (HsExpr GhcPs)
b) -> Exp -> Exp -> Range
TH.FromThenR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b)
    (FromTo XRec GhcPs (HsExpr GhcPs)
a XRec GhcPs (HsExpr GhcPs)
b) -> Exp -> Exp -> Range
TH.FromToR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b)
    (FromThenTo XRec GhcPs (HsExpr GhcPs)
a XRec GhcPs (HsExpr GhcPs)
b XRec GhcPs (HsExpr GhcPs)
c) -> Exp -> Exp -> Exp -> Range
TH.FromThenToR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
c)

#if MIN_VERSION_ghc(9, 6, 0)
toExp _ (Expr.HsProjection _ locatedFields) =
  let
    extractFieldLabel (DotFieldOcc _ locatedStr) = field_label <$> locatedStr
    extractFieldLabel _ = error "Don't know how to handle XHsFieldLabel constructor..."
  in
    TH.ProjectionE (NonEmpty.map (unpackFS . unLoc . extractFieldLabel . unLoc) locatedFields)

toExp d (Expr.HsGetField _ expr locatedField) =
  let
    extractFieldLabel (DotFieldOcc _ locatedStr) = field_label <$> locatedStr
    extractFieldLabel _ = error "Don't know how to handle XHsFieldLabel constructor..."
  in
    TH.GetFieldE (toExp d (unLoc expr)) (unpackFS . unLoc . extractFieldLabel . unLoc $ locatedField)
#elif MIN_VERSION_ghc(9, 4, 0)
toExp DynFlags
_ (Expr.HsProjection XProjection GhcPs
_ NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
locatedFields) =
  let
    extractFieldLabel :: DotFieldOcc p -> XRec p FastString
extractFieldLabel (DotFieldOcc XCDotFieldOcc p
_ XRec p FastString
locatedStr) = XRec p FastString
locatedStr
    extractFieldLabel DotFieldOcc p
_ = String -> XRec p FastString
forall a. HasCallStack => String -> a
error String
"Don't know how to handle XHsFieldLabel constructor..."
  in
    NonEmpty String -> Exp
TH.ProjectionE ((GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> String)
-> NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
-> NonEmpty String
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (FastString -> String
unpackFS (FastString -> String)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> FastString)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN FastString -> FastString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FastString -> FastString)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
    -> GenLocated SrcSpanAnnN FastString)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcPs -> XRec GhcPs FastString
DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FastString
forall {p}. DotFieldOcc p -> XRec p FastString
extractFieldLabel (DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FastString)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
    -> DotFieldOcc GhcPs)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> GenLocated SrcSpanAnnN FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> DotFieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc) NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
locatedFields)

toExp DynFlags
d (Expr.HsGetField XGetField GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr XRec GhcPs (DotFieldOcc GhcPs)
locatedField) =
  let
    extractFieldLabel :: DotFieldOcc p -> XRec p FastString
extractFieldLabel (DotFieldOcc XCDotFieldOcc p
_ XRec p FastString
locatedStr) = XRec p FastString
locatedStr
    extractFieldLabel DotFieldOcc p
_ = String -> XRec p FastString
forall a. HasCallStack => String -> a
error String
"Don't know how to handle XHsFieldLabel constructor..."
  in
    Exp -> String -> Exp
TH.GetFieldE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr)) (FastString -> String
unpackFS (FastString -> String)
-> (XRec GhcPs (DotFieldOcc GhcPs) -> FastString)
-> XRec GhcPs (DotFieldOcc GhcPs)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN FastString -> FastString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FastString -> FastString)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
    -> GenLocated SrcSpanAnnN FastString)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcPs -> XRec GhcPs FastString
DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FastString
forall {p}. DotFieldOcc p -> XRec p FastString
extractFieldLabel (DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FastString)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
    -> DotFieldOcc GhcPs)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> GenLocated SrcSpanAnnN FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> DotFieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc (XRec GhcPs (DotFieldOcc GhcPs) -> String)
-> XRec GhcPs (DotFieldOcc GhcPs) -> String
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (DotFieldOcc GhcPs)
locatedField)
#else
toExp _ (Expr.HsProjection _ locatedFields) =
  let
    extractFieldLabel (HsFieldLabel _ locatedStr) = locatedStr
    extractFieldLabel _ = error "Don't know how to handle XHsFieldLabel constructor..."
  in
    TH.ProjectionE (NonEmpty.map (unpackFS . unLoc . extractFieldLabel . unLoc) locatedFields)

toExp d (Expr.HsGetField _ expr locatedField) =
  let
    extractFieldLabel (HsFieldLabel _ locatedStr) = locatedStr
    extractFieldLabel _ = error "Don't know how to handle XHsFieldLabel constructor..."
  in
    TH.GetFieldE (toExp d (unLoc expr)) (unpackFS . unLoc . extractFieldLabel . unLoc $ locatedField)
#endif

#if MIN_VERSION_ghc(9, 6, 0)
toExp _ (Expr.HsOverLabel _ _ fastString) = TH.LabelE (unpackFS fastString)
#else
toExp DynFlags
_ (Expr.HsOverLabel XOverLabel GhcPs
_ FastString
fastString) = String -> Exp
TH.LabelE (FastString -> String
unpackFS FastString
fastString)
#endif

toExp DynFlags
dynFlags HsExpr GhcPs
e = String -> String -> Exp
forall e a. (HasCallStack, Show e) => String -> e -> a
todo String
"toExp" (DynFlags -> SDoc -> String
showSDoc DynFlags
dynFlags (SDoc -> String)
-> (HsExpr GhcPs -> SDoc) -> HsExpr GhcPs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HsExpr GhcPs -> String) -> HsExpr GhcPs -> String
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs
e)

todo :: (HasCallStack, Show e) => String -> e -> a
todo :: forall e a. (HasCallStack, Show e) => String -> e -> a
todo String
fun e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun, String
": not implemented: ", e -> String
forall b a. (Show a, IsString b) => a -> b
show e
thing]

noTH :: (HasCallStack, Show e) => String -> e -> a
noTH :: forall e a. (HasCallStack, Show e) => String -> e -> a
noTH String
fun e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun, String
": no TemplateHaskell for: ", e -> String
forall b a. (Show a, IsString b) => a -> b
show e
thing]

moduleName :: String
moduleName :: String
moduleName = String
"Language.Haskell.Meta.Translate"