{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Test.Tasty.AutoCollect.GHC (
  module Test.Tasty.AutoCollect.GHC.Shim,

  -- * Output helpers
  showPpr,

  -- * Parsers
  parseDecl,
  parseLitStrPat,
  parseSigWcType,

  -- * Builders
  genFuncSig,
  genFuncDecl,
  lhsvar,
  mkHsVar,
  mkHsAppTypes,
  mkHsTyVar,
  mkExprTypeSig,

  -- * Annotation utilities
  getExportComments,

  -- * Located utilities
  firstLocatedWhere,
  getSpanLine,

  -- * Name utilities
  mkRdrName,
  mkLRdrName,
  mkRdrNameType,
  mkLRdrNameType,
  fromRdrName,
) where

#if __GLASGOW_HASKELL__ < 910
import Data.Foldable (foldl')
#endif
import Data.List (sortOn)
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.Text qualified as Text
import GHC.Types.Name.Occurrence qualified as NameSpace (tcName, varName)

import Test.Tasty.AutoCollect.GHC.Shim hiding (
  mkHsAppTypes,
  msg,
  showPpr,
 )

{----- Output helpers -----}

showPpr :: (Outputable a) => a -> String
showPpr :: forall a. Outputable a => a -> [Char]
showPpr = SDoc -> [Char]
showSDocUnsafe (SDoc -> [Char]) -> (a -> SDoc) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
forall a. Outputable a => a -> SDoc
ppr

{----- Parsers ----}

parseDecl :: LHsDecl GhcPs -> Maybe ParsedDecl
parseDecl :: LHsDecl GhcPs -> Maybe ParsedDecl
parseDecl (L SrcSpanAnnA
_ HsDecl GhcPs
decl) =
  case HsDecl GhcPs
decl of
    SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
names LHsSigWcType GhcPs
ty) -> ParsedDecl -> Maybe ParsedDecl
forall a. a -> Maybe a
Just (ParsedDecl -> Maybe ParsedDecl) -> ParsedDecl -> Maybe ParsedDecl
forall a b. (a -> b) -> a -> b
$ [LocatedN RdrName] -> LHsSigWcType GhcPs -> ParsedDecl
FuncSig [LIdP GhcPs]
[LocatedN RdrName]
names LHsSigWcType GhcPs
ty
    ValD XValD GhcPs
_ (FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
name MG{mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches}) ->
      ParsedDecl -> Maybe ParsedDecl
forall a. a -> Maybe a
Just (ParsedDecl -> Maybe ParsedDecl) -> ParsedDecl -> Maybe ParsedDecl
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> [LocatedA FuncSingleDef] -> ParsedDecl
FuncDef LIdP GhcPs
LocatedN RdrName
name ([LocatedA FuncSingleDef] -> ParsedDecl)
-> [LocatedA FuncSingleDef] -> ParsedDecl
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> LocatedA FuncSingleDef)
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA FuncSingleDef]
forall a b. (a -> b) -> [a] -> [b]
map ((Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> FuncSingleDef)
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> LocatedA FuncSingleDef
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> FuncSingleDef
parseFuncSingleDef) [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
matches
    HsDecl GhcPs
_ -> Maybe ParsedDecl
forall a. Maybe a
Nothing
  where
    parseFuncSingleDef :: Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> FuncSingleDef
parseFuncSingleDef Match{[LPat GhcPs]
m_pats :: [LPat GhcPs]
m_pats :: forall p body. Match p body -> [LPat p]
m_pats, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
bodys HsLocalBinds GhcPs
whereClause} =
      FuncSingleDef
        { funcDefArgs :: [LPat GhcPs]
funcDefArgs = [LPat GhcPs]
m_pats
        , funcDefGuards :: [FuncGuardedBody]
funcDefGuards = (GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> FuncGuardedBody)
-> [GenLocated
      (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [FuncGuardedBody]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> FuncGuardedBody
forall {l}.
GenLocated l (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> FuncGuardedBody
parseFuncGuardedBody [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
[GenLocated
   (Anno (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
bodys
        , funcDefWhereClause :: HsLocalBinds GhcPs
funcDefWhereClause = HsLocalBinds GhcPs
whereClause
        }
    parseFuncGuardedBody :: GenLocated l (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> FuncGuardedBody
parseFuncGuardedBody (L l
_ (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [GuardLStmt GhcPs]
guards GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)) =
      [GuardLStmt GhcPs] -> LHsExpr GhcPs -> FuncGuardedBody
FuncGuardedBody [GuardLStmt GhcPs]
guards LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body

parseLitStrPat :: LPat GhcPs -> Maybe String
parseLitStrPat :: LPat GhcPs -> Maybe [Char]
parseLitStrPat = \case
  L SrcSpanAnnA
_ (LitPat XLitPat GhcPs
_ (HsString XHsString GhcPs
_ FastString
s)) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (FastString -> [Char]
unpackFS FastString
s)
  LPat GhcPs
_ -> Maybe [Char]
forall a. Maybe a
Nothing

parseSigWcType :: LHsSigWcType GhcPs -> Maybe ParsedType
parseSigWcType :: LHsSigWcType GhcPs -> Maybe ParsedType
parseSigWcType (HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (L SrcSpanAnnA
_ (HsSig XHsSig GhcPs
_ HsOuterSigTyVarBndrs GhcPs
_ LHsType GhcPs
ltype))) = LHsType GhcPs -> Maybe ParsedType
parseType LHsType GhcPs
ltype

parseType :: LHsType GhcPs -> Maybe ParsedType
parseType :: LHsType GhcPs -> Maybe ParsedType
parseType (L SrcSpanAnnA
_ HsType GhcPs
ty) =
  case HsType GhcPs
ty of
    HsTyVar XTyVar GhcPs
_ PromotionFlag
flag LIdP GhcPs
name -> ParsedType -> Maybe ParsedType
forall a. a -> Maybe a
Just (ParsedType -> Maybe ParsedType) -> ParsedType -> Maybe ParsedType
forall a b. (a -> b) -> a -> b
$ PromotionFlag -> LocatedN RdrName -> ParsedType
TypeVar PromotionFlag
flag LIdP GhcPs
LocatedN RdrName
name
    HsListTy XListTy GhcPs
_ LHsType GhcPs
t -> ParsedType -> ParsedType
TypeList (ParsedType -> ParsedType) -> Maybe ParsedType -> Maybe ParsedType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsType GhcPs -> Maybe ParsedType
parseType LHsType GhcPs
t
    HsType GhcPs
_ -> Maybe ParsedType
forall a. Maybe a
Nothing

{----- Builders -----}

genFuncSig :: LocatedN RdrName -> LHsType GhcPs -> HsDecl GhcPs
genFuncSig :: LocatedN RdrName -> LHsType GhcPs -> HsDecl GhcPs
genFuncSig LocatedN RdrName
funcName LHsType GhcPs
funcType =
  XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
NoExtField
noExtField
    (Sig GhcPs -> HsDecl GhcPs)
-> (LHsType GhcPs -> Sig GhcPs) -> LHsType GhcPs -> HsDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XTypeSig GhcPs -> [LIdP GhcPs] -> LHsSigWcType GhcPs -> Sig GhcPs
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
EpAnn AnnSig
forall a. EpAnn a
noAnn [LIdP GhcPs
LocatedN RdrName
funcName]
    (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
 -> Sig GhcPs)
-> (GenLocated SrcSpanAnnA (HsType GhcPs)
    -> HsWildCardBndrs
         GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs)))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> Sig GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> LHsSigWcType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
hsTypeToHsSigWcType
    (LHsType GhcPs -> HsDecl GhcPs) -> LHsType GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs
funcType

-- | Make simple function declaration of the form `<funcName> <funcArgs> = <funcBody> where <funcWhere>`
genFuncDecl :: LocatedN RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> Maybe (HsLocalBinds GhcPs) -> HsDecl GhcPs
genFuncDecl :: LocatedN RdrName
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> Maybe (HsLocalBinds GhcPs)
-> HsDecl GhcPs
genFuncDecl LocatedN RdrName
funcName [LPat GhcPs]
funcArgs LHsExpr GhcPs
funcBody Maybe (HsLocalBinds GhcPs)
mFuncWhere =
  XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
NoExtField
NoExtField (HsBindLR GhcPs GhcPs -> HsDecl GhcPs)
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> HsBindLR GhcPs GhcPs)
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedN RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBindLR GhcPs GhcPs
mkFunBind Origin
generatedOrigin LocatedN RdrName
funcName ([GenLocated
    SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> HsDecl GhcPs)
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$
    [ HsMatchContext GhcPs
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> HsLocalBinds GhcPs
-> LMatch GhcPs (LHsExpr GhcPs)
forall (p :: Pass).
IsPass p =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch (LIdP (NoGhcTc GhcPs) -> HsMatchContext GhcPs
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc GhcPs)
LocatedN RdrName
funcName) [LPat GhcPs]
funcArgs LHsExpr GhcPs
funcBody HsLocalBinds GhcPs
funcWhere
    ]
  where
    funcWhere :: HsLocalBinds GhcPs
funcWhere = HsLocalBinds GhcPs
-> Maybe (HsLocalBinds GhcPs) -> HsLocalBinds GhcPs
forall a. a -> Maybe a -> a
fromMaybe HsLocalBinds GhcPs
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds Maybe (HsLocalBinds GhcPs)
mFuncWhere

lhsvar :: LocatedN RdrName -> LHsExpr GhcPs
lhsvar :: LocatedN RdrName -> LHsExpr GhcPs
lhsvar = HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (LocatedN RdrName -> HsExpr GhcPs)
-> LocatedN RdrName
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
NoExtField

mkHsVar :: Name -> LHsExpr GhcPs
mkHsVar :: Name -> LHsExpr GhcPs
mkHsVar = LocatedN RdrName -> LHsExpr GhcPs
LocatedN RdrName -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhsvar (LocatedN RdrName -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (Name -> LocatedN RdrName)
-> Name
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> LocatedN RdrName
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (RdrName -> LocatedN RdrName)
-> (Name -> RdrName) -> Name -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName

mkHsAppTypes :: LHsExpr GhcPs -> [LHsType GhcPs] -> LHsExpr GhcPs
mkHsAppTypes :: LHsExpr GhcPs -> [LHsType GhcPs] -> LHsExpr GhcPs
mkHsAppTypes = (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
e -> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs
mkHsAppType LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e)

mkHsTyVar :: Name -> LHsType GhcPs
mkHsTyVar :: Name -> LHsType GhcPs
mkHsTyVar = HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> (Name -> HsType GhcPs)
-> Name
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted (LocatedN RdrName -> HsType GhcPs)
-> (Name -> LocatedN RdrName) -> Name -> HsType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> LocatedN RdrName
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (RdrName -> LocatedN RdrName)
-> (Name -> RdrName) -> Name -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName

-- | mkExprTypeSig e t = [| $e :: $t |]
mkExprTypeSig :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkExprTypeSig :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs
mkExprTypeSig LHsExpr GhcPs
e LHsType GhcPs
t =
  HsExpr GhcPs -> LHsExpr GhcPs
HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr GhcPs -> LHsExpr GhcPs)
-> (HsWildCardBndrs
      GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
    -> HsExpr GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
e (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
 -> LHsExpr GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$
    XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC XHsWC GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
NoExtField
NoExtField (LHsType GhcPs -> LHsSigType GhcPs
hsTypeToHsSigType LHsType GhcPs
t)

{----- Annotation utilities -----}

-- | Get the contents of all comments in the given hsmodExports list.
getExportComments :: LocatedL [LIE GhcPs] -> [RealLocated String]
getExportComments :: LocatedL [LIE GhcPs] -> [RealLocated [Char]]
getExportComments = (GenLocated Anchor EpaComment -> RealLocated [Char])
-> [GenLocated Anchor EpaComment] -> [RealLocated [Char]]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated Anchor EpaComment -> RealLocated [Char]
fromLEpaComment ([GenLocated Anchor EpaComment] -> [RealLocated [Char]])
-> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [GenLocated Anchor EpaComment])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [RealLocated [Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAnnComments -> [GenLocated Anchor EpaComment]
priorComments (EpAnnComments -> [GenLocated Anchor EpaComment])
-> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> EpAnnComments)
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated Anchor EpaComment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAnn AnnList -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments (EpAnn AnnList -> EpAnnComments)
-> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> EpAnn AnnList)
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> EpAnnComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> EpAnn AnnList
forall ann e. GenLocated (SrcAnn ann) e -> EpAnn ann
getEpAnn
  where
    fromLEpaComment :: GenLocated Anchor EpaComment -> RealLocated [Char]
fromLEpaComment (L Anchor
ann EpaComment{EpaCommentTok
ac_tok :: EpaCommentTok
ac_tok :: EpaComment -> EpaCommentTok
ac_tok}) =
      RealSrcSpan -> [Char] -> RealLocated [Char]
forall l e. l -> e -> GenLocated l e
L (Anchor -> RealSrcSpan
anchor Anchor
ann) ([Char] -> RealLocated [Char]) -> [Char] -> RealLocated [Char]
forall a b. (a -> b) -> a -> b
$ (Text -> [Char]
Text.unpack (Text -> [Char])
-> (EpaCommentTok -> Text) -> EpaCommentTok -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip (Text -> Text) -> (EpaCommentTok -> Text) -> EpaCommentTok -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaCommentTok -> Text
epaCommentTokText) EpaCommentTok
ac_tok

{----- Located utilities -----}

firstLocatedWhere :: (Ord l) => (GenLocated l e -> Maybe a) -> [GenLocated l e] -> Maybe a
firstLocatedWhere :: forall l e a.
Ord l =>
(GenLocated l e -> Maybe a) -> [GenLocated l e] -> Maybe a
firstLocatedWhere GenLocated l e -> Maybe a
f = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a)
-> ([GenLocated l e] -> [a]) -> [GenLocated l e] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated l e -> Maybe a) -> [GenLocated l e] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GenLocated l e -> Maybe a
f ([GenLocated l e] -> [a])
-> ([GenLocated l e] -> [GenLocated l e])
-> [GenLocated l e]
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated l e -> l) -> [GenLocated l e] -> [GenLocated l e]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn GenLocated l e -> l
forall l e. GenLocated l e -> l
getLoc

getSpanLine :: SrcSpan -> String
getSpanLine :: SrcSpan -> [Char]
getSpanLine SrcSpan
loc =
  case SrcSpan -> SrcLoc
srcSpanStart SrcSpan
loc of
    RealSrcLoc RealSrcLoc
srcLoc Maybe BufPos
_ -> [Char]
"line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (RealSrcLoc -> Int
srcLocLine RealSrcLoc
srcLoc)
    UnhelpfulLoc FastString
s -> FastString -> [Char]
unpackFS FastString
s

{----- Name utilities -----}

mkRdrName :: String -> RdrName
mkRdrName :: [Char] -> RdrName
mkRdrName = OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> ([Char] -> OccName) -> [Char] -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpace -> [Char] -> OccName
mkOccName NameSpace
NameSpace.varName

mkLRdrName :: String -> LocatedN RdrName
mkLRdrName :: [Char] -> LocatedN RdrName
mkLRdrName = RdrName -> LocatedN RdrName
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (RdrName -> LocatedN RdrName)
-> ([Char] -> RdrName) -> [Char] -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> RdrName
mkRdrName

mkRdrNameType :: String -> RdrName
mkRdrNameType :: [Char] -> RdrName
mkRdrNameType = OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> ([Char] -> OccName) -> [Char] -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpace -> [Char] -> OccName
mkOccName NameSpace
NameSpace.tcName

mkLRdrNameType :: String -> LocatedN RdrName
mkLRdrNameType :: [Char] -> LocatedN RdrName
mkLRdrNameType = RdrName -> LocatedN RdrName
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (RdrName -> LocatedN RdrName)
-> ([Char] -> RdrName) -> [Char] -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> RdrName
mkRdrNameType

fromRdrName :: LocatedN RdrName -> String
fromRdrName :: LocatedN RdrName -> [Char]
fromRdrName = OccName -> [Char]
occNameString (OccName -> [Char])
-> (LocatedN RdrName -> OccName) -> LocatedN RdrName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (LocatedN RdrName -> RdrName) -> LocatedN RdrName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc