    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE TupleSections #-}

    -- | Adds cost-centers to call sites selected with the @-fprof-caller=...@
    -- flag.
    module GHC.Core.Opt.CallerCC
        ( addCallerCostCentres
        , CallerCcFilter(..)
        , NamePattern(..)
        , parseCallerCcFilter
        ) where

    import Data.Word (Word8)
    import Data.Maybe

    import Control.Applicative
    import Control.Monad.Trans.State.Strict
    import Data.Either
    import Control.Monad
    import qualified Text.ParserCombinators.ReadP as P

    import GHC.Prelude
    import GHC.Utils.Outputable as Outputable
    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Types.CostCentre
    import GHC.Types.CostCentre.State
    import GHC.Types.Name hiding (varName)
    import GHC.Types.Tickish
    import GHC.Unit.Module.Name
    import GHC.Unit.Module.ModGuts
    import GHC.Types.SrcLoc
    import GHC.Types.Var
    import GHC.Unit.Types
    import GHC.Data.FastString
    import GHC.Core
    import GHC.Core.Opt.Monad
    import GHC.Utils.Panic
    import qualified GHC.Utils.Binary as B
    import Data.Char

    addCallerCostCentres :: ModGuts -> CoreM ModGuts
    addCallerCostCentres :: ModGuts -> CoreM ModGuts
    addCallerCostCentres ModGuts
    guts = do
      DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      let filters :: [CallerCcFilter]
    filters = DynFlags -> [CallerCcFilter]
    callerCcFilters DynFlags
    dflags
      let env :: Env
          env :: Env
    env = Env
            { thisModule :: Module
    thisModule = ModGuts -> Module
    mg_module ModGuts
    guts
            , ccState :: CostCentreState
    ccState = CostCentreState
    newCostCentreState
            , dflags :: DynFlags
    dflags = DynFlags
    dflags
            , revParents :: [Id]
    revParents = []
            , filters :: [CallerCcFilter]
    filters = [CallerCcFilter]
    filters
            }
      let guts' :: ModGuts
    guts' = ModGuts
    guts { mg_binds :: CoreProgram
    mg_binds = Env -> CoreProgram -> CoreProgram
    doCoreProgram Env
    env (ModGuts -> CoreProgram
    mg_binds ModGuts
    guts)
                       }
      forall (m :: * -> *) a. Monad m => a -> m a
    return ModGuts
    guts'

    doCoreProgram :: Env -> CoreProgram -> CoreProgram
    doCoreProgram :: Env -> CoreProgram -> CoreProgram
    doCoreProgram Env
    env CoreProgram
    binds = forall a b c. (a -> b -> c) -> b -> a -> c
    flip forall s a. State s a -> s -> a
    evalState CostCentreState
    newCostCentreState forall a b. (a -> b) -> a -> b
    $ do
        forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Env -> CoreBind -> M CoreBind
    doBind Env
    env) CoreProgram
    binds

    doBind :: Env -> CoreBind -> M CoreBind
    doBind :: Env -> CoreBind -> M CoreBind
    doBind Env
    env (NonRec Id
    b Expr Id
    rhs) = forall b. b -> Expr b -> Bind b
    NonRec Id
    b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr (Id -> Env -> Env
    addParent Id
    b Env
    env) Expr Id
    rhs
    doBind Env
    env (Rec [(Id, Expr Id)]
    bs) = forall b. [(b, Expr b)] -> Bind b
    Rec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Id, Expr Id) -> StateT CostCentreState Identity (Id, Expr Id)
    doPair [(Id, Expr Id)]
    bs
      where
        doPair :: (Id, Expr Id) -> StateT CostCentreState Identity (Id, Expr Id)
    doPair (Id
    b,Expr Id
    rhs) = (Id
    b,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr (Id -> Env -> Env
    addParent Id
    b Env
    env) Expr Id
    rhs

    doExpr :: Env -> CoreExpr -> M CoreExpr
    doExpr :: Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env e :: Expr Id
    e@(Var Id
    v)
      | Env -> Id -> Bool
    needsCallSiteCostCentre Env
    env Id
    v = do
        let nameDoc :: SDoc
            nameDoc :: SDoc
    nameDoc = PrintUnqualified -> Depth -> SDoc -> SDoc
    withUserStyle PrintUnqualified
    alwaysQualify Depth
    DefaultDepth forall a b. (a -> b) -> a -> b
    $
              [SDoc] -> SDoc
    hcat (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    dot (forall a b. (a -> b) -> [a] -> [b]
    map forall a. Outputable a => a -> SDoc
    ppr (Env -> [Id]
    parents Env
    env))) SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens (String -> SDoc
    text String
    "calling:" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Id
    v)

            ccName :: CcName
            ccName :: CcName
    ccName = String -> CcName
    mkFastString forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    showSDoc (Env -> DynFlags
    dflags Env
    env) SDoc
    nameDoc
        CostCentreIndex
    ccIdx <- CcName -> M CostCentreIndex
    getCCIndex' CcName
    ccName
        let span :: SrcSpan
    span = case Env -> [Id]
    revParents Env
    env of
              Id
    top:[Id]
    _ -> Name -> SrcSpan
    nameSrcSpan forall a b. (a -> b) -> a -> b
    $ Id -> Name
    varName Id
    top
              [Id]
    _     -> SrcSpan
    noSrcSpan
            cc :: CostCentre
    cc = CCFlavour -> CcName -> Module -> SrcSpan -> CostCentre
    NormalCC (CostCentreIndex -> CCFlavour
    ExprCC CostCentreIndex
    ccIdx) CcName
    ccName (Env -> Module
    thisModule Env
    env) SrcSpan
    span
            tick :: CoreTickish
            tick :: CoreTickish
    tick = forall (pass :: TickishPass).
    CostCentre -> Bool -> Bool -> GenTickish pass
    ProfNote CostCentre
    cc Bool
    True Bool
    True
        forall (f :: * -> *) a. Applicative f => a -> f a
    pure forall a b. (a -> b) -> a -> b
    $ forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    tick Expr Id
    e
      | Bool
    otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
    pure Expr Id
    e
    doExpr Env
    _env e :: Expr Id
    e@(Lit Literal
    _)       = forall (f :: * -> *) a. Applicative f => a -> f a
    pure Expr Id
    e
    doExpr Env
    env (Expr Id
    f `App` Expr Id
    x)      = forall b. Expr b -> Expr b -> Expr b
    App forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    x
    doExpr Env
    env (Lam Id
    b Expr Id
    x)        = forall b. b -> Expr b -> Expr b
    Lam Id
    b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    x
    doExpr Env
    env (Let CoreBind
    b Expr Id
    rhs)      = forall b. Bind b -> Expr b -> Expr b
    Let forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> CoreBind -> M CoreBind
    doBind Env
    env CoreBind
    b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    rhs
    doExpr Env
    env (Case Expr Id
    scrut Id
    b Type
    ty [Alt Id]
    alts) =
        forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    scrut forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall (f :: * -> *) a. Applicative f => a -> f a
    pure Id
    b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    ty forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Alt Id -> StateT CostCentreState Identity (Alt Id)
    doAlt [Alt Id]
    alts
      where
        doAlt :: Alt Id -> StateT CostCentreState Identity (Alt Id)
    doAlt (Alt AltCon
    con [Id]
    bs Expr Id
    rhs)  = forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [Id]
    bs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    rhs
    doExpr Env
    env (Cast Expr Id
    expr CoercionR
    co)   = forall b. Expr b -> CoercionR -> Expr b
    Cast forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    expr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall (f :: * -> *) a. Applicative f => a -> f a
    pure CoercionR
    co
    doExpr Env
    env (Tick CoreTickish
    t Expr Id
    e)       = forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env -> Expr Id -> M (Expr Id)
    doExpr Env
    env Expr Id
    e
    doExpr Env
    _env e :: Expr Id
    e@(Type Type
    _)      = forall (f :: * -> *) a. Applicative f => a -> f a
    pure Expr Id
    e
    doExpr Env
    _env e :: Expr Id
    e@(Coercion CoercionR
    _)  = forall (f :: * -> *) a. Applicative f => a -> f a
    pure Expr Id
    e

    type M = State CostCentreState

    getCCIndex' :: FastString -> M CostCentreIndex
    getCCIndex' :: CcName -> M CostCentreIndex
    getCCIndex' CcName
    name = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state (CcName -> CostCentreState -> (CostCentreIndex, CostCentreState)
    getCCIndex CcName
    name)

    data Env = Env
      { Env -> Module
    thisModule  :: Module
      , Env -> DynFlags
    dflags      :: DynFlags
      , Env -> CostCentreState
    ccState     :: CostCentreState
      , Env -> [Id]
    revParents  :: [Id]
      , Env -> [CallerCcFilter]
    filters     :: [CallerCcFilter]
      }

    addParent :: Id -> Env -> Env
    addParent :: Id -> Env -> Env
    addParent Id
    i Env
    env = Env
    env { revParents :: [Id]
    revParents = Id
    i forall a. a -> [a] -> [a]
    : Env -> [Id]
    revParents Env
    env }

    parents :: Env -> [Id]
    parents :: Env -> [Id]
    parents Env
    env = forall a. [a] -> [a]
    reverse (Env -> [Id]
    revParents Env
    env)

    needsCallSiteCostCentre :: Env -> Id -> Bool
    needsCallSiteCostCentre :: Env -> Id -> Bool
    needsCallSiteCostCentre Env
    env Id
    i =
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any CallerCcFilter -> Bool
    matches (Env -> [CallerCcFilter]
    filters Env
    env)
      where
        matches :: CallerCcFilter -> Bool
        matches :: CallerCcFilter -> Bool
    matches CallerCcFilter
    ccf =
            Bool
    checkModule Bool -> Bool -> Bool
    && Bool
    checkFunc
          where
            checkModule :: Bool
    checkModule =
              case CallerCcFilter -> Maybe ModuleName
    ccfModuleName CallerCcFilter
    ccf of
                Just ModuleName
    modFilt
                  | Just Module
    iMod <- Name -> Maybe Module
    nameModule_maybe (Id -> Name
    varName Id
    i)
                  -> forall unit. GenModule unit -> ModuleName
    moduleName Module
    iMod forall a. Eq a => a -> a -> Bool
    == ModuleName
    modFilt
                  | Bool
    otherwise -> Bool
    False
                Maybe ModuleName
    Nothing -> Bool
    True
            checkFunc :: Bool
    checkFunc =
                NamePattern -> OccName -> Bool
    occNameMatches (CallerCcFilter -> NamePattern
    ccfFuncName CallerCcFilter
    ccf) (forall a. NamedThing a => a -> OccName
    getOccName Id
    i)

    data NamePattern
        = PChar Char NamePattern
        | PWildcard NamePattern
        | PEnd

    instance Outputable NamePattern where
      ppr :: NamePattern -> SDoc
    ppr (PChar Char
    c NamePattern
    rest) = Char -> SDoc
    char Char
    c SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr NamePattern
    rest
      ppr (PWildcard NamePattern
    rest) = Char -> SDoc
    char Char
    '*' SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr NamePattern
    rest
      ppr NamePattern
    PEnd = SDoc
    Outputable.empty

    instance B.Binary NamePattern where
      get :: BinHandle -> IO NamePattern
    get BinHandle
    bh = do
        Word8
    tag <- forall a. Binary a => BinHandle -> IO a
    B.get BinHandle
    bh
        case Word8
    tag :: Word8 of
          Word8
    0 -> Char -> NamePattern -> NamePattern
    PChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall a. Binary a => BinHandle -> IO a
    B.get BinHandle
    bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall a. Binary a => BinHandle -> IO a
    B.get BinHandle
    bh
          Word8
    1 -> NamePattern -> NamePattern
    PWildcard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall a. Binary a => BinHandle -> IO a
    B.get BinHandle
    bh
          Word8
    2 -> forall (f :: * -> *) a. Applicative f => a -> f a
    pure NamePattern
    PEnd
          Word8
    _ -> forall a. String -> a
    panic String
    "Binary(NamePattern): Invalid tag"
      put_ :: BinHandle -> NamePattern -> IO ()
    put_ BinHandle
    bh (PChar Char
    x NamePattern
    y) = forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh (Word8
    0 :: Word8) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh Char
    x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh NamePattern
    y
      put_ BinHandle
    bh (PWildcard NamePattern
    x) = forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh (Word8
    1 :: Word8) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh NamePattern
    x
      put_ BinHandle
    bh NamePattern
    PEnd = forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh (Word8
    2 :: Word8)

    occNameMatches :: NamePattern -> OccName -> Bool
    occNameMatches :: NamePattern -> OccName -> Bool
    occNameMatches NamePattern
    pat = NamePattern -> String -> Bool
    go NamePattern
    pat forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OccName -> String
    occNameString
      where
        go :: NamePattern -> String -> Bool
        go :: NamePattern -> String -> Bool
    go NamePattern
    PEnd String
    "" = Bool
    True
        go (PChar Char
    c NamePattern
    rest) (Char
    d:String
    s)
          = Char
    d forall a. Eq a => a -> a -> Bool
    == Char
    c Bool -> Bool -> Bool
    && NamePattern -> String -> Bool
    go NamePattern
    rest String
    s
        go (PWildcard NamePattern
    rest) String
    s
          = NamePattern -> String -> Bool
    go NamePattern
    rest String
    s Bool -> Bool -> Bool
    || NamePattern -> String -> Bool
    go (NamePattern -> NamePattern
    PWildcard NamePattern
    rest) (forall a. [a] -> [a]
    tail String
    s)
        go NamePattern
    _ String
    _  = Bool
    False

    type Parser = P.ReadP

    parseNamePattern :: Parser NamePattern
    parseNamePattern :: Parser NamePattern
    parseNamePattern = Parser NamePattern
    pattern
      where
        pattern :: Parser NamePattern
    pattern = Parser NamePattern
    star forall a. ReadP a -> ReadP a -> ReadP a
    P.<++ Parser NamePattern
    wildcard forall a. ReadP a -> ReadP a -> ReadP a
    P.<++ Parser NamePattern
    char forall a. ReadP a -> ReadP a -> ReadP a
    P.<++ Parser NamePattern
    end
        star :: Parser NamePattern
    star = Char -> NamePattern -> NamePattern
    PChar Char
    '*' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ String -> ReadP String
    P.string String
    "\\*" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser NamePattern
    pattern
        wildcard :: Parser NamePattern
    wildcard = do
          forall (f :: * -> *) a. Functor f => f a -> f ()
    void forall a b. (a -> b) -> a -> b
    $ Char -> ReadP Char
    P.char Char
    '*'
          NamePattern -> NamePattern
    PWildcard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser NamePattern
    pattern
        char :: Parser NamePattern
    char = Char -> NamePattern -> NamePattern
    PChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReadP Char
    P.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser NamePattern
    pattern
        end :: Parser NamePattern
    end = NamePattern
    PEnd forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ReadP ()
    P.eof

    data CallerCcFilter
        = CallerCcFilter { CallerCcFilter -> Maybe ModuleName
    ccfModuleName  :: Maybe ModuleName
                         , CallerCcFilter -> NamePattern
    ccfFuncName    :: NamePattern
                         }

    instance Outputable CallerCcFilter where
      ppr :: CallerCcFilter -> SDoc
    ppr CallerCcFilter
    ccf =
        forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Char -> SDoc
    char Char
    '*') forall a. Outputable a => a -> SDoc
    ppr (CallerCcFilter -> Maybe ModuleName
    ccfModuleName CallerCcFilter
    ccf)
        SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '.'
        SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr (CallerCcFilter -> NamePattern
    ccfFuncName CallerCcFilter
    ccf)

    instance B.Binary CallerCcFilter where
      get :: BinHandle -> IO CallerCcFilter
    get BinHandle
    bh = Maybe ModuleName -> NamePattern -> CallerCcFilter
    CallerCcFilter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall a. Binary a => BinHandle -> IO a
    B.get BinHandle
    bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall a. Binary a => BinHandle -> IO a
    B.get BinHandle
    bh
      put_ :: BinHandle -> CallerCcFilter -> IO ()
    put_ BinHandle
    bh (CallerCcFilter Maybe ModuleName
    x NamePattern
    y) = forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh Maybe ModuleName
    x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall a. Binary a => BinHandle -> a -> IO ()
    B.put_ BinHandle
    bh NamePattern
    y

    parseCallerCcFilter :: String -> Either String CallerCcFilter
    parseCallerCcFilter :: String -> Either String CallerCcFilter
    parseCallerCcFilter String
    inp =
        case forall a. ReadP a -> ReadS a
    P.readP_to_S Parser CallerCcFilter
    parseCallerCcFilter' String
    inp of
          ((CallerCcFilter
    result, String
    ""):[(CallerCcFilter, String)]
    _) -> forall a b. b -> Either a b
    Right CallerCcFilter
    result
          [(CallerCcFilter, String)]
    _ -> forall a b. a -> Either a b
    Left forall a b. (a -> b) -> a -> b
    $ String
    "parse error on " forall a. [a] -> [a] -> [a]
    ++ String
    inp

    parseCallerCcFilter' :: Parser CallerCcFilter
    parseCallerCcFilter' :: Parser CallerCcFilter
    parseCallerCcFilter' =
      Maybe ModuleName -> NamePattern -> CallerCcFilter
    CallerCcFilter
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser (Maybe ModuleName)
    moduleFilter
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*  Char -> ReadP Char
    P.char Char
    '.'
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser NamePattern
    parseNamePattern
      where
        moduleFilter :: Parser (Maybe ModuleName)
        moduleFilter :: Parser (Maybe ModuleName)
    moduleFilter =
          (forall a. a -> Maybe a
    Just forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ModuleName
    mkModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReadP String
    moduleName)
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
          (forall a. Maybe a
    Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> ReadP Char
    P.char Char
    '*')

        moduleName :: Parser String
        moduleName :: ReadP String
    moduleName = do
          Char
    c <- (Char -> Bool) -> ReadP Char
    P.satisfy Char -> Bool
    isUpper
          String
    cs <- (Char -> Bool) -> ReadP String
    P.munch1 (\Char
    c -> Char -> Bool
    isUpper Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isLower Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isDigit Char
    c Bool -> Bool -> Bool
    || Char
    c forall a. Eq a => a -> a -> Bool
    == Char
    '_')
          Maybe String
    rest <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional forall a b. (a -> b) -> a -> b
    $ Char -> ReadP Char
    P.char Char
    '.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Char
    '.'forall a. a -> [a] -> [a]
    :) ReadP String
    moduleName
          forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Char
    c forall a. a -> [a] -> [a]
    : (String
    cs forall a. [a] -> [a] -> [a]
    ++ forall a. a -> Maybe a -> a
    fromMaybe String
    "" Maybe String
    rest)