{-# 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 GHC.Utils.Monad.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.Types.CostCentre
import GHC.Types.CostCentre.State
import GHC.Types.Name hiding (varName)
import GHC.Types.Tickish
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

import Language.Haskell.Syntax.Module.Name

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
        , countEntries :: Bool
countEntries = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ProfCountEntries 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) -> State CostCentreState (Id, Expr Id)
doPair [(Id, Expr Id)]
bs
  where
    doPair :: (Id, Expr Id) -> State CostCentreState (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 = NamePprCtx -> Depth -> SDoc -> SDoc
withUserStyle NamePprCtx
alwaysQualify Depth
DefaultDepth forall a b. (a -> b) -> a -> b
$
          forall doc. IsLine doc => [doc] -> doc
hcat (forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
dot (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr (Env -> [Id]
parents Env
env))) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => String -> doc
text String
"calling:" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr Id
v)

        ccName :: CcName
        ccName :: CcName
ccName = String -> CcName
mkFastString forall a b. (a -> b) -> a -> b
$ SDocContext -> SDoc -> String
renderWithContext SDocContext
defaultSDocContext SDoc
nameDoc
    CostCentreIndex
ccIdx <- CcName -> M CostCentreIndex
getCCIndex' CcName
ccName
    let count :: Bool
count = Env -> Bool
countEntries Env
env
        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
mkExprCCFlavour 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
count 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 -> State CostCentreState (Alt Id)
doAlt [Alt Id]
alts
  where
    doAlt :: Alt Id -> State CostCentreState (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 s a. (s -> (a, s)) -> State s a
state (CcName -> CostCentreState -> (CostCentreIndex, CostCentreState)
getCCIndex CcName
name)

data Env = Env
  { Env -> Module
thisModule  :: Module
  , Env -> Bool
countEntries :: !Bool
  , 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) = forall doc. IsLine doc => Char -> doc
char Char
c forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr NamePattern
rest
  ppr (PWildcard NamePattern
rest) = forall doc. IsLine doc => Char -> doc
char Char
'*' forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr NamePattern
rest
  ppr NamePattern
PEnd = forall doc. IsOutput doc => doc
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. HasCallStack => 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 (forall doc. IsLine doc => Char -> doc
char Char
'*') forall a. Outputable a => a -> SDoc
ppr (CallerCcFilter -> Maybe ModuleName
ccfModuleName CallerCcFilter
ccf)
    forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'.'
    forall doc. IsLine doc => doc -> doc -> doc
<> 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)