{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module GHC.Parser.PostProcess.Haddock (addHaddockToModule) where
import GHC.Prelude hiding (mod)
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Driver.Flags ( WarningFlag(..) )
import GHC.Utils.Panic
import GHC.Data.Bag
import Data.Semigroup
import Data.Foldable
import Data.Traversable
import Data.Maybe
import Control.Monad
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Writer
import Data.Functor.Identity
import Data.Coerce
import qualified Data.Monoid
import GHC.Parser.Lexer
import GHC.Parser.Errors
import GHC.Utils.Misc (mergeListsBy, filterOut, mapLastM, (<&&>))
addHaddockToModule :: Located HsModule -> P (Located HsModule)
addHaddockToModule :: Located HsModule -> P (Located HsModule)
addHaddockToModule Located HsModule
lmod = do
PState
pState <- P PState
getPState
let all_comments :: [PsLocated HdkComment]
all_comments = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PState -> OrdList (PsLocated HdkComment)
hdk_comments PState
pState)
initial_hdk_st :: HdkSt
initial_hdk_st = [PsLocated HdkComment] -> [HdkWarn] -> HdkSt
HdkSt [PsLocated HdkComment]
all_comments []
(Located HsModule
lmod', HdkSt
final_hdk_st) = forall a. HdkA a -> HdkSt -> (a, HdkSt)
runHdkA (forall a. HasHaddock a => a -> HdkA a
addHaddock Located HsModule
lmod) HdkSt
initial_hdk_st
hdk_warnings :: [HdkWarn]
hdk_warnings = HdkSt -> [HdkWarn]
collectHdkWarnings HdkSt
final_hdk_st
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HdkWarn -> P ()
reportHdkWarning [HdkWarn]
hdk_warnings
return Located HsModule
lmod'
reportHdkWarning :: HdkWarn -> P ()
reportHdkWarning :: HdkWarn -> P ()
reportHdkWarning (HdkWarnInvalidComment (L PsSpan
l HdkComment
_)) =
forall (m :: * -> *). MonadP m => WarningFlag -> PsWarning -> m ()
addWarning WarningFlag
Opt_WarnInvalidHaddock forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsWarning
PsWarnHaddockInvalidPos (PsSpan -> SrcSpan
mkSrcSpanPs PsSpan
l)
reportHdkWarning (HdkWarnExtraComment (L SrcSpan
l HsDocString
_)) =
forall (m :: * -> *). MonadP m => WarningFlag -> PsWarning -> m ()
addWarning WarningFlag
Opt_WarnInvalidHaddock forall a b. (a -> b) -> a -> b
$ SrcSpan -> PsWarning
PsWarnHaddockIgnoreMulti SrcSpan
l
collectHdkWarnings :: HdkSt -> [HdkWarn]
collectHdkWarnings :: HdkSt -> [HdkWarn]
collectHdkWarnings HdkSt{ [PsLocated HdkComment]
hdk_st_pending :: HdkSt -> [PsLocated HdkComment]
hdk_st_pending :: [PsLocated HdkComment]
hdk_st_pending, [HdkWarn]
hdk_st_warnings :: HdkSt -> [HdkWarn]
hdk_st_warnings :: [HdkWarn]
hdk_st_warnings } =
forall a b. (a -> b) -> [a] -> [b]
map PsLocated HdkComment -> HdkWarn
HdkWarnInvalidComment [PsLocated HdkComment]
hdk_st_pending
forall a. [a] -> [a] -> [a]
++ [HdkWarn]
hdk_st_warnings
class HasHaddock a where
addHaddock :: a -> HdkA a
instance HasHaddock a => HasHaddock [a] where
addHaddock :: [a] -> HdkA [a]
addHaddock = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. HasHaddock a => a -> HdkA a
addHaddock
instance HasHaddock (Located HsModule) where
addHaddock :: Located HsModule -> HdkA (Located HsModule)
addHaddock (L SrcSpan
l_mod HsModule
mod) = do
Maybe (Maybe (GenLocated SrcSpan HsDocString))
headerDocs <-
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for @Maybe (HsModule -> Maybe (LocatedA ModuleName)
hsmodName HsModule
mod) forall a b. (a -> b) -> a -> b
$ \(L SrcSpanAnnA
l_name ModuleName
_) ->
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_name) forall a b. (a -> b) -> a -> b
$ forall a. HdkM a -> HdkA a
liftHdkA forall a b. (a -> b) -> a -> b
$ do
[GenLocated SrcSpan HsDocString]
docs <-
forall a. LocRange -> HdkM a -> HdkM a
inLocRange (Maybe BufPos -> LocRange
locRangeTo (SrcLoc -> Maybe BufPos
getBufPos (SrcSpan -> SrcLoc
srcSpanStart (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_name)))) forall a b. (a -> b) -> a -> b
$
forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
takeHdkComments PsLocated HdkComment -> Maybe (GenLocated SrcSpan HsDocString)
mkDocNext
[GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
selectDocString [GenLocated SrcSpan HsDocString]
docs
Maybe (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
hsmodExports' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse @Maybe forall a. HasHaddock a => a -> HdkA a
addHaddock (HsModule -> Maybe (LocatedL [LIE GhcPs])
hsmodExports HsModule
mod)
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA (HsModule -> [LImportDecl GhcPs]
hsmodImports HsModule
mod)
let layout_info :: LayoutInfo
layout_info = HsModule -> LayoutInfo
hsmodLayout HsModule
mod
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls' <- forall a.
HasHaddock a =>
LayoutInfo -> (PsLocated HdkComment -> Maybe a) -> [a] -> HdkA [a]
addHaddockInterleaveItems LayoutInfo
layout_info (LayoutInfo -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
mkDocHsDecl LayoutInfo
layout_info) (HsModule -> [LHsDecl GhcPs]
hsmodDecls HsModule
mod)
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpan
l_mod forall a b. (a -> b) -> a -> b
$
HsModule
mod { hsmodExports :: Maybe (LocatedL [LIE GhcPs])
hsmodExports = Maybe (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
hsmodExports'
, hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls'
, hsmodHaddockModHeader :: Maybe (GenLocated SrcSpan HsDocString)
hsmodHaddockModHeader = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join @Maybe Maybe (Maybe (GenLocated SrcSpan HsDocString))
headerDocs }
instance HasHaddock (LocatedL [LocatedA (IE GhcPs)]) where
addHaddock :: LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> HdkA (LocatedL [GenLocated SrcSpanAnnA (IE GhcPs)])
addHaddock (L SrcSpanAnnL
l_exports [GenLocated SrcSpanAnnA (IE GhcPs)]
exports) =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnL
l_exports) forall a b. (a -> b) -> a -> b
$ do
[GenLocated SrcSpanAnnA (IE GhcPs)]
exports' <- forall a.
HasHaddock a =>
LayoutInfo -> (PsLocated HdkComment -> Maybe a) -> [a] -> HdkA [a]
addHaddockInterleaveItems LayoutInfo
NoLayoutInfo PsLocated HdkComment -> Maybe (LIE GhcPs)
mkDocIE [GenLocated SrcSpanAnnA (IE GhcPs)]
exports
SrcSpan -> HdkA ()
registerLocHdkA (SrcLoc -> SrcSpan
srcLocSpan (SrcSpan -> SrcLoc
srcSpanEnd (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnL
l_exports)))
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l_exports [GenLocated SrcSpanAnnA (IE GhcPs)]
exports'
instance HasHaddock (LocatedA (IE GhcPs)) where
addHaddock :: GenLocated SrcSpanAnnA (IE GhcPs)
-> HdkA (GenLocated SrcSpanAnnA (IE GhcPs))
addHaddock GenLocated SrcSpanAnnA (IE GhcPs)
a = GenLocated SrcSpanAnnA (IE GhcPs)
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA GenLocated SrcSpanAnnA (IE GhcPs)
a
addHaddockInterleaveItems
:: forall a.
HasHaddock a
=> LayoutInfo
-> (PsLocated HdkComment -> Maybe a)
-> [a]
-> HdkA [a]
addHaddockInterleaveItems :: forall a.
HasHaddock a =>
LayoutInfo -> (PsLocated HdkComment -> Maybe a) -> [a] -> HdkA [a]
addHaddockInterleaveItems LayoutInfo
layout_info PsLocated HdkComment -> Maybe a
get_doc_item = [a] -> HdkA [a]
go
where
go :: [a] -> HdkA [a]
go :: [a] -> HdkA [a]
go [] = forall a. HdkM a -> HdkA a
liftHdkA (forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
takeHdkComments PsLocated HdkComment -> Maybe a
get_doc_item)
go (a
item : [a]
items) = do
[a]
docItems <- forall a. HdkM a -> HdkA a
liftHdkA (forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
takeHdkComments PsLocated HdkComment -> Maybe a
get_doc_item)
a
item' <- HdkA a -> HdkA a
with_layout_info (forall a. HasHaddock a => a -> HdkA a
addHaddock a
item)
[a]
other_items <- [a] -> HdkA [a]
go [a]
items
pure $ [a]
docItems forall a. [a] -> [a] -> [a]
++ a
item'forall a. a -> [a] -> [a]
:[a]
other_items
with_layout_info :: HdkA a -> HdkA a
with_layout_info :: HdkA a -> HdkA a
with_layout_info = case LayoutInfo
layout_info of
LayoutInfo
NoLayoutInfo -> forall a. a -> a
id
LayoutInfo
ExplicitBraces -> forall a. a -> a
id
VirtualBraces Int
n ->
let loc_range :: LocRange
loc_range = forall a. Monoid a => a
mempty { loc_range_col :: ColumnBound
loc_range_col = Int -> ColumnBound
ColumnFrom (Int
nforall a. Num a => a -> a -> a
+Int
1) }
in forall a b. (HdkM a -> HdkM b) -> HdkA a -> HdkA b
hoistHdkA (forall a. LocRange -> HdkM a -> HdkM a
inLocRange LocRange
loc_range)
instance HasHaddock (LocatedA (HsDecl GhcPs)) where
addHaddock :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> HdkA (GenLocated SrcSpanAnnA (HsDecl GhcPs))
addHaddock GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse @LocatedA forall a. HasHaddock a => a -> HdkA a
addHaddock GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl
instance HasHaddock (HsDecl GhcPs) where
addHaddock :: HsDecl GhcPs -> HdkA (HsDecl GhcPs)
addHaddock (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
x [LIdP GhcPs]
names LHsSigWcType GhcPs
t)) = do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA [LIdP GhcPs]
names
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
t' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsSigWcType GhcPs
t
pure (forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
noExtField (forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
x [LIdP GhcPs]
names HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
t'))
addHaddock (SigD XSigD GhcPs
_ (PatSynSig XPatSynSig GhcPs
x [LIdP GhcPs]
names LHsSigType GhcPs
t)) = do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA [LIdP GhcPs]
names
GenLocated SrcSpanAnnA (HsSigType GhcPs)
t' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsSigType GhcPs
t
pure (forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
noExtField (forall pass.
XPatSynSig pass -> [LIdP pass] -> LHsSigType pass -> Sig pass
PatSynSig XPatSynSig GhcPs
x [LIdP GhcPs]
names GenLocated SrcSpanAnnA (HsSigType GhcPs)
t'))
addHaddock (SigD XSigD GhcPs
_ (ClassOpSig XClassOpSig GhcPs
x Bool
is_dflt [LIdP GhcPs]
names LHsSigType GhcPs
t)) = do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA [LIdP GhcPs]
names
GenLocated SrcSpanAnnA (HsSigType GhcPs)
t' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsSigType GhcPs
t
pure (forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
noExtField (forall pass.
XClassOpSig pass
-> Bool -> [LIdP pass] -> LHsSigType pass -> Sig pass
ClassOpSig XClassOpSig GhcPs
x Bool
is_dflt [LIdP GhcPs]
names GenLocated SrcSpanAnnA (HsSigType GhcPs)
t'))
addHaddock (TyClD XTyClD GhcPs
x TyClDecl GhcPs
decl)
| DataDecl { XDataDecl GhcPs
tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
tcdDExt :: XDataDecl GhcPs
tcdDExt, LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName, LHsQTyVars GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars, LexicalFixity
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcPs
defn } <- TyClDecl GhcPs
decl
= do
forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA LIdP GhcPs
tcdLName
HsDataDefn GhcPs
defn' <- forall a. HasHaddock a => a -> HdkA a
addHaddock HsDataDefn GhcPs
defn
pure $
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
x (DataDecl {
XDataDecl GhcPs
tcdDExt :: XDataDecl GhcPs
tcdDExt :: XDataDecl GhcPs
tcdDExt,
LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName, LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars, LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity,
tcdDataDefn :: HsDataDefn GhcPs
tcdDataDefn = HsDataDefn GhcPs
defn' })
addHaddock (TyClD XTyClD GhcPs
_ TyClDecl GhcPs
decl)
| ClassDecl { tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt = (EpAnn [AddEpAnn]
x, AnnSortKey
NoAnnSortKey, LayoutInfo
tcdLayout),
Maybe (LHsContext GhcPs)
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt, LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName, LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars, LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity, [LHsFunDep GhcPs]
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs :: [LHsFunDep GhcPs]
tcdFDs,
[LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs :: [LSig GhcPs]
tcdSigs, LHsBinds GhcPs
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths :: LHsBinds GhcPs
tcdMeths, [LFamilyDecl GhcPs]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs :: [LFamilyDecl GhcPs]
tcdATs, [LTyFamDefltDecl GhcPs]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdATDefs } <- TyClDecl GhcPs
decl
= do
forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA LIdP GhcPs
tcdLName
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
where_cls' <-
forall a.
HasHaddock a =>
LayoutInfo -> (PsLocated HdkComment -> Maybe a) -> [a] -> HdkA [a]
addHaddockInterleaveItems LayoutInfo
tcdLayout (LayoutInfo -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
mkDocHsDecl LayoutInfo
tcdLayout) forall a b. (a -> b) -> a -> b
$
(LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamDefltDecl GhcPs], [LDataFamInstDecl GhcPs],
[LDocDecl GhcPs])
-> [LHsDecl GhcPs]
flattenBindsAndSigs (LHsBinds GhcPs
tcdMeths, [LSig GhcPs]
tcdSigs, [LFamilyDecl GhcPs]
tcdATs, [LTyFamDefltDecl GhcPs]
tcdATDefs, [], [])
pure $
let (LHsBinds GhcPs
tcdMeths', [LSig GhcPs]
tcdSigs', [LFamilyDecl GhcPs]
tcdATs', [LTyFamDefltDecl GhcPs]
tcdATDefs', [LDataFamInstDecl GhcPs]
_, [LDocDecl GhcPs]
tcdDocs) = [LHsDecl GhcPs]
-> (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamDefltDecl GhcPs], [LDataFamInstDecl GhcPs],
[LDocDecl GhcPs])
partitionBindsAndSigs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
where_cls'
decl' :: TyClDecl GhcPs
decl' = ClassDecl { tcdCExt :: XClassDecl GhcPs
tcdCExt = (EpAnn [AddEpAnn]
x, AnnSortKey
NoAnnSortKey, LayoutInfo
tcdLayout)
, Maybe (LHsContext GhcPs)
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt, LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName, LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars, LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity, [LHsFunDep GhcPs]
tcdFDs :: [LHsFunDep GhcPs]
tcdFDs :: [LHsFunDep GhcPs]
tcdFDs
, tcdSigs :: [LSig GhcPs]
tcdSigs = [LSig GhcPs]
tcdSigs'
, tcdMeths :: LHsBinds GhcPs
tcdMeths = LHsBinds GhcPs
tcdMeths'
, tcdATs :: [LFamilyDecl GhcPs]
tcdATs = [LFamilyDecl GhcPs]
tcdATs'
, tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdATDefs = [LTyFamDefltDecl GhcPs]
tcdATDefs'
, [LDocDecl GhcPs]
tcdDocs :: [LDocDecl GhcPs]
tcdDocs :: [LDocDecl GhcPs]
tcdDocs }
in forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
noExtField TyClDecl GhcPs
decl'
addHaddock (InstD XInstD GhcPs
_ InstDecl GhcPs
decl)
| DataFamInstD { XDataFamInstD GhcPs
dfid_ext :: forall pass. InstDecl pass -> XDataFamInstD pass
dfid_ext :: XDataFamInstD GhcPs
dfid_ext, DataFamInstDecl GhcPs
dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst :: DataFamInstDecl GhcPs
dfid_inst } <- InstDecl GhcPs
decl
, DataFamInstDecl { FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn :: FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn } <- DataFamInstDecl GhcPs
dfid_inst
= do
FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn' <- case FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn of
FamEqn { XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext, LIdP GhcPs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon :: LIdP GhcPs
feqn_tycon, HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs, HsTyPats GhcPs
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats :: HsTyPats GhcPs
feqn_pats, LexicalFixity
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity :: LexicalFixity
feqn_fixity, HsDataDefn GhcPs
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs :: HsDataDefn GhcPs
feqn_rhs }
-> do
forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA LIdP GhcPs
feqn_tycon
HsDataDefn GhcPs
feqn_rhs' <- forall a. HasHaddock a => a -> HdkA a
addHaddock HsDataDefn GhcPs
feqn_rhs
pure $ FamEqn {
XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_ext,
LIdP GhcPs
feqn_tycon :: LIdP GhcPs
feqn_tycon :: LIdP GhcPs
feqn_tycon, HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_bndrs, HsTyPats GhcPs
feqn_pats :: HsTyPats GhcPs
feqn_pats :: HsTyPats GhcPs
feqn_pats, LexicalFixity
feqn_fixity :: LexicalFixity
feqn_fixity :: LexicalFixity
feqn_fixity,
feqn_rhs :: HsDataDefn GhcPs
feqn_rhs = HsDataDefn GhcPs
feqn_rhs' }
pure $ forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
noExtField (DataFamInstD {
XDataFamInstD GhcPs
dfid_ext :: XDataFamInstD GhcPs
dfid_ext :: XDataFamInstD GhcPs
dfid_ext,
dfid_inst :: DataFamInstDecl GhcPs
dfid_inst = DataFamInstDecl { dfid_eqn :: FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn = FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn' } })
addHaddock (TyClD XTyClD GhcPs
_ TyClDecl GhcPs
decl)
| SynDecl { XSynDecl GhcPs
tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
tcdSExt :: XSynDecl GhcPs
tcdSExt, LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName, LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars, LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity, LHsType GhcPs
tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs :: LHsType GhcPs
tcdRhs } <- TyClDecl GhcPs
decl
= do
forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA LIdP GhcPs
tcdLName
GenLocated SrcSpanAnnA (HsType GhcPs)
tcdRhs' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsType GhcPs
tcdRhs
pure $
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
noExtField (SynDecl {
XSynDecl GhcPs
tcdSExt :: XSynDecl GhcPs
tcdSExt :: XSynDecl GhcPs
tcdSExt,
LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName, LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars, LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity :: LexicalFixity
tcdFixity,
tcdRhs :: LHsType GhcPs
tcdRhs = GenLocated SrcSpanAnnA (HsType GhcPs)
tcdRhs' })
addHaddock (ForD XForD GhcPs
_ ForeignDecl GhcPs
decl) = do
forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA (forall pass. ForeignDecl pass -> LIdP pass
fd_name ForeignDecl GhcPs
decl)
GenLocated SrcSpanAnnA (HsSigType GhcPs)
fd_sig_ty' <- forall a. HasHaddock a => a -> HdkA a
addHaddock (forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty ForeignDecl GhcPs
decl)
pure $ forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD NoExtField
noExtField (ForeignDecl GhcPs
decl{ fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty = GenLocated SrcSpanAnnA (HsSigType GhcPs)
fd_sig_ty' })
addHaddock HsDecl GhcPs
d = forall (f :: * -> *) a. Applicative f => a -> f a
pure HsDecl GhcPs
d
instance HasHaddock (HsDataDefn GhcPs) where
addHaddock :: HsDataDefn GhcPs -> HdkA (HsDataDefn GhcPs)
addHaddock defn :: HsDataDefn GhcPs
defn@HsDataDefn{} = do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ @Maybe forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA (forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig HsDataDefn GhcPs
defn)
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons' <- forall a. HasHaddock a => a -> HdkA a
addHaddock (forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcPs
defn)
[GenLocated SrcSpan (HsDerivingClause GhcPs)]
dd_derivs' <- forall a. HasHaddock a => a -> HdkA a
addHaddock (forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDataDefn GhcPs
defn)
pure $ HsDataDefn GhcPs
defn { dd_cons :: [LConDecl GhcPs]
dd_cons = [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
dd_cons',
dd_derivs :: HsDeriving GhcPs
dd_derivs = [GenLocated SrcSpan (HsDerivingClause GhcPs)]
dd_derivs' }
instance HasHaddock (Located [Located (HsDerivingClause GhcPs)]) where
addHaddock :: Located [GenLocated SrcSpan (HsDerivingClause GhcPs)]
-> HdkA (Located [GenLocated SrcSpan (HsDerivingClause GhcPs)])
addHaddock Located [GenLocated SrcSpan (HsDerivingClause GhcPs)]
lderivs =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall l e. GenLocated l e -> l
getLoc Located [GenLocated SrcSpan (HsDerivingClause GhcPs)]
lderivs) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse @Located forall a. HasHaddock a => a -> HdkA a
addHaddock Located [GenLocated SrcSpan (HsDerivingClause GhcPs)]
lderivs
instance HasHaddock (Located (HsDerivingClause GhcPs)) where
addHaddock :: GenLocated SrcSpan (HsDerivingClause GhcPs)
-> HdkA (GenLocated SrcSpan (HsDerivingClause GhcPs))
addHaddock GenLocated SrcSpan (HsDerivingClause GhcPs)
lderiv =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpan (HsDerivingClause GhcPs)
lderiv) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for @Located GenLocated SrcSpan (HsDerivingClause GhcPs)
lderiv forall a b. (a -> b) -> a -> b
$ \HsDerivingClause GhcPs
deriv ->
case HsDerivingClause GhcPs
deriv of
HsDerivingClause { XCHsDerivingClause GhcPs
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_ext, Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy, LDerivClauseTys GhcPs
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys :: LDerivClauseTys GhcPs
deriv_clause_tys } -> do
let
(HdkA ()
register_strategy_before, HdkA ()
register_strategy_after) =
case Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy of
Maybe (LDerivStrategy GhcPs)
Nothing -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure (), forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Just (L SrcSpan
l (ViaStrategy XViaStrategy GhcPs
_)) -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure (), SrcSpan -> HdkA ()
registerLocHdkA SrcSpan
l)
Just (L SrcSpan
l DerivStrategy GhcPs
_) -> (SrcSpan -> HdkA ()
registerLocHdkA SrcSpan
l, forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
HdkA ()
register_strategy_before
GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
deriv_clause_tys' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LDerivClauseTys GhcPs
deriv_clause_tys
HdkA ()
register_strategy_after
pure HsDerivingClause
{ XCHsDerivingClause GhcPs
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_ext,
Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_strategy,
deriv_clause_tys :: LDerivClauseTys GhcPs
deriv_clause_tys = GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
deriv_clause_tys' }
instance HasHaddock (LocatedC (DerivClauseTys GhcPs)) where
addHaddock :: GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
-> HdkA (GenLocated SrcSpanAnnC (DerivClauseTys GhcPs))
addHaddock (L SrcSpanAnnC
l_dct DerivClauseTys GhcPs
dct) =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnC
l_dct) forall a b. (a -> b) -> a -> b
$
case DerivClauseTys GhcPs
dct of
DctSingle XDctSingle GhcPs
x LHsSigType GhcPs
ty -> do
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsSigType GhcPs
ty
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
l_dct forall a b. (a -> b) -> a -> b
$ forall pass.
XDctSingle pass -> LHsSigType pass -> DerivClauseTys pass
DctSingle XDctSingle GhcPs
x GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty'
DctMulti XDctMulti GhcPs
x [LHsSigType GhcPs]
tys -> do
[GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys' <- forall a. HasHaddock a => a -> HdkA a
addHaddock [LHsSigType GhcPs]
tys
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
l_dct forall a b. (a -> b) -> a -> b
$ forall pass.
XDctMulti pass -> [LHsSigType pass] -> DerivClauseTys pass
DctMulti XDctMulti GhcPs
x [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys'
instance HasHaddock (LocatedA (ConDecl GhcPs)) where
addHaddock :: GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> HdkA (GenLocated SrcSpanAnnA (ConDecl GhcPs))
addHaddock (L SrcSpanAnnA
l_con_decl ConDecl GhcPs
con_decl) =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_con_decl) forall a b. (a -> b) -> a -> b
$
case ConDecl GhcPs
con_decl of
ConDeclGADT { XConDeclGADT GhcPs
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_g_ext :: XConDeclGADT GhcPs
con_g_ext, [LIdP GhcPs]
con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_names :: [LIdP GhcPs]
con_names, XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs, Maybe (LHsContext GhcPs)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt, HsConDeclGADTDetails GhcPs
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args :: HsConDeclGADTDetails GhcPs
con_g_args, LHsType GhcPs
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty :: LHsType GhcPs
con_res_ty } -> do
Maybe (GenLocated SrcSpan HsDocString)
con_doc' <- forall a. ConHdkA a -> HdkA a
discardHasInnerDocs forall a b. (a -> b) -> a -> b
$ SrcSpan -> ConHdkA (Maybe (GenLocated SrcSpan HsDocString))
getConDoc (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (forall a. [a] -> a
head [LIdP GhcPs]
con_names))
HsConDeclGADTDetails GhcPs
con_g_args' <-
case HsConDeclGADTDetails GhcPs
con_g_args of
PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
ts -> forall pass.
[HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
PrefixConGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasHaddock a => a -> HdkA a
addHaddock [HsScaled GhcPs (LHsType GhcPs)]
ts
RecConGADT (L SrcSpanAnnL
l_rec [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds) -> do
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. ConHdkA a -> HdkA a
discardHasInnerDocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDeclField GhcPs -> ConHdkA (LConDeclField GhcPs)
addHaddockConDeclField) [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds
pure $ forall pass.
XRec pass [LConDeclField pass] -> HsConDeclGADTDetails pass
RecConGADT (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l_rec [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds')
GenLocated SrcSpanAnnA (HsType GhcPs)
con_res_ty' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsType GhcPs
con_res_ty
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l_con_decl forall a b. (a -> b) -> a -> b
$
ConDeclGADT { XConDeclGADT GhcPs
con_g_ext :: XConDeclGADT GhcPs
con_g_ext :: XConDeclGADT GhcPs
con_g_ext, [LIdP GhcPs]
con_names :: [LIdP GhcPs]
con_names :: [LIdP GhcPs]
con_names, XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_bndrs, Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt,
con_doc :: Maybe (GenLocated SrcSpan HsDocString)
con_doc = Maybe (GenLocated SrcSpan HsDocString)
con_doc',
con_g_args :: HsConDeclGADTDetails GhcPs
con_g_args = HsConDeclGADTDetails GhcPs
con_g_args',
con_res_ty :: LHsType GhcPs
con_res_ty = GenLocated SrcSpanAnnA (HsType GhcPs)
con_res_ty' }
ConDeclH98 { XConDeclH98 GhcPs
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_ext :: XConDeclH98 GhcPs
con_ext, LIdP GhcPs
con_name :: forall pass. ConDecl pass -> LIdP pass
con_name :: LIdP GhcPs
con_name, Bool
con_forall :: forall pass. ConDecl pass -> Bool
con_forall :: Bool
con_forall, [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs, Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt, HsConDeclH98Details GhcPs
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args :: HsConDeclH98Details GhcPs
con_args } ->
SrcLoc -> ConHdkA (LConDecl GhcPs) -> HdkA (LConDecl GhcPs)
addConTrailingDoc (SrcSpan -> SrcLoc
srcSpanEnd forall a b. (a -> b) -> a -> b
$ forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_con_decl) forall a b. (a -> b) -> a -> b
$
case HsConDeclH98Details GhcPs
con_args of
PrefixCon [Void]
_ [HsScaled GhcPs (LHsType GhcPs)]
ts -> do
Maybe (GenLocated SrcSpan HsDocString)
con_doc' <- SrcSpan -> ConHdkA (Maybe (GenLocated SrcSpan HsDocString))
getConDoc (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
con_name)
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
ts' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse HsScaled GhcPs (LHsType GhcPs)
-> ConHdkA (HsScaled GhcPs (LHsType GhcPs))
addHaddockConDeclFieldTy [HsScaled GhcPs (LHsType GhcPs)]
ts
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l_con_decl forall a b. (a -> b) -> a -> b
$
ConDeclH98 { XConDeclH98 GhcPs
con_ext :: XConDeclH98 GhcPs
con_ext :: XConDeclH98 GhcPs
con_ext, LIdP GhcPs
con_name :: LIdP GhcPs
con_name :: LIdP GhcPs
con_name, Bool
con_forall :: Bool
con_forall :: Bool
con_forall, [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs, Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt,
con_doc :: Maybe (GenLocated SrcSpan HsDocString)
con_doc = Maybe (GenLocated SrcSpan HsDocString)
con_doc',
con_args :: HsConDeclH98Details GhcPs
con_args = forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
ts' }
InfixCon HsScaled GhcPs (LHsType GhcPs)
t1 HsScaled GhcPs (LHsType GhcPs)
t2 -> do
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t1' <- HsScaled GhcPs (LHsType GhcPs)
-> ConHdkA (HsScaled GhcPs (LHsType GhcPs))
addHaddockConDeclFieldTy HsScaled GhcPs (LHsType GhcPs)
t1
Maybe (GenLocated SrcSpan HsDocString)
con_doc' <- SrcSpan -> ConHdkA (Maybe (GenLocated SrcSpan HsDocString))
getConDoc (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
con_name)
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t2' <- HsScaled GhcPs (LHsType GhcPs)
-> ConHdkA (HsScaled GhcPs (LHsType GhcPs))
addHaddockConDeclFieldTy HsScaled GhcPs (LHsType GhcPs)
t2
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l_con_decl forall a b. (a -> b) -> a -> b
$
ConDeclH98 { XConDeclH98 GhcPs
con_ext :: XConDeclH98 GhcPs
con_ext :: XConDeclH98 GhcPs
con_ext, LIdP GhcPs
con_name :: LIdP GhcPs
con_name :: LIdP GhcPs
con_name, Bool
con_forall :: Bool
con_forall :: Bool
con_forall, [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs, Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt,
con_doc :: Maybe (GenLocated SrcSpan HsDocString)
con_doc = Maybe (GenLocated SrcSpan HsDocString)
con_doc',
con_args :: HsConDeclH98Details GhcPs
con_args = forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t1' HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
t2' }
RecCon (L SrcSpanAnnL
l_rec [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds) -> do
Maybe (GenLocated SrcSpan HsDocString)
con_doc' <- SrcSpan -> ConHdkA (Maybe (GenLocated SrcSpan HsDocString))
getConDoc (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
con_name)
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse LConDeclField GhcPs -> ConHdkA (LConDeclField GhcPs)
addHaddockConDeclField [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l_con_decl forall a b. (a -> b) -> a -> b
$
ConDeclH98 { XConDeclH98 GhcPs
con_ext :: XConDeclH98 GhcPs
con_ext :: XConDeclH98 GhcPs
con_ext, LIdP GhcPs
con_name :: LIdP GhcPs
con_name :: LIdP GhcPs
con_name, Bool
con_forall :: Bool
con_forall :: Bool
con_forall, [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs, Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_mb_cxt,
con_doc :: Maybe (GenLocated SrcSpan HsDocString)
con_doc = Maybe (GenLocated SrcSpan HsDocString)
con_doc',
con_args :: HsConDeclH98Details GhcPs
con_args = forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l_rec [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds') }
type ConHdkA = WriterT HasInnerDocs HdkA
newtype HasInnerDocs = HasInnerDocs Bool
deriving (NonEmpty HasInnerDocs -> HasInnerDocs
HasInnerDocs -> HasInnerDocs -> HasInnerDocs
forall b. Integral b => b -> HasInnerDocs -> HasInnerDocs
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> HasInnerDocs -> HasInnerDocs
$cstimes :: forall b. Integral b => b -> HasInnerDocs -> HasInnerDocs
sconcat :: NonEmpty HasInnerDocs -> HasInnerDocs
$csconcat :: NonEmpty HasInnerDocs -> HasInnerDocs
<> :: HasInnerDocs -> HasInnerDocs -> HasInnerDocs
$c<> :: HasInnerDocs -> HasInnerDocs -> HasInnerDocs
Semigroup, Semigroup HasInnerDocs
HasInnerDocs
[HasInnerDocs] -> HasInnerDocs
HasInnerDocs -> HasInnerDocs -> HasInnerDocs
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [HasInnerDocs] -> HasInnerDocs
$cmconcat :: [HasInnerDocs] -> HasInnerDocs
mappend :: HasInnerDocs -> HasInnerDocs -> HasInnerDocs
$cmappend :: HasInnerDocs -> HasInnerDocs -> HasInnerDocs
mempty :: HasInnerDocs
$cmempty :: HasInnerDocs
Monoid) via Data.Monoid.Any
discardHasInnerDocs :: ConHdkA a -> HdkA a
discardHasInnerDocs :: forall a. ConHdkA a -> HdkA a
discardHasInnerDocs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
getConDoc
:: SrcSpan
-> ConHdkA (Maybe LHsDocString)
getConDoc :: SrcSpan -> ConHdkA (Maybe (GenLocated SrcSpan HsDocString))
getConDoc SrcSpan
l =
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA SrcSpan
l forall a b. (a -> b) -> a -> b
$ forall a. HdkM a -> HdkA a
liftHdkA forall a b. (a -> b) -> a -> b
$ do
Maybe (GenLocated SrcSpan HsDocString)
mDoc <- SrcSpan -> HdkM (Maybe (GenLocated SrcSpan HsDocString))
getPrevNextDoc SrcSpan
l
return (Maybe (GenLocated SrcSpan HsDocString)
mDoc, Bool -> HasInnerDocs
HasInnerDocs (forall a. Maybe a -> Bool
isJust Maybe (GenLocated SrcSpan HsDocString)
mDoc))
addHaddockConDeclFieldTy
:: HsScaled GhcPs (LHsType GhcPs)
-> ConHdkA (HsScaled GhcPs (LHsType GhcPs))
addHaddockConDeclFieldTy :: HsScaled GhcPs (LHsType GhcPs)
-> ConHdkA (HsScaled GhcPs (LHsType GhcPs))
addHaddockConDeclFieldTy (HsScaled HsArrow GhcPs
mult (L SrcSpanAnnA
l HsType GhcPs
t)) =
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$ forall a. HdkM a -> HdkA a
liftHdkA forall a b. (a -> b) -> a -> b
$ do
Maybe (GenLocated SrcSpan HsDocString)
mDoc <- SrcSpan -> HdkM (Maybe (GenLocated SrcSpan HsDocString))
getPrevNextDoc (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
return (forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow GhcPs
mult (LHsType GhcPs
-> Maybe (GenLocated SrcSpan HsDocString) -> LHsType GhcPs
mkLHsDocTy (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsType GhcPs
t) Maybe (GenLocated SrcSpan HsDocString)
mDoc),
Bool -> HasInnerDocs
HasInnerDocs (forall a. Maybe a -> Bool
isJust Maybe (GenLocated SrcSpan HsDocString)
mDoc))
addHaddockConDeclField
:: LConDeclField GhcPs
-> ConHdkA (LConDeclField GhcPs)
addHaddockConDeclField :: LConDeclField GhcPs -> ConHdkA (LConDeclField GhcPs)
addHaddockConDeclField (L SrcSpanAnnA
l_fld ConDeclField GhcPs
fld) =
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall a b. (a -> b) -> a -> b
$ forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_fld) forall a b. (a -> b) -> a -> b
$ forall a. HdkM a -> HdkA a
liftHdkA forall a b. (a -> b) -> a -> b
$ do
Maybe (GenLocated SrcSpan HsDocString)
cd_fld_doc <- SrcSpan -> HdkM (Maybe (GenLocated SrcSpan HsDocString))
getPrevNextDoc (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l_fld)
return (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l_fld (ConDeclField GhcPs
fld { Maybe (GenLocated SrcSpan HsDocString)
cd_fld_doc :: Maybe (GenLocated SrcSpan HsDocString)
cd_fld_doc :: Maybe (GenLocated SrcSpan HsDocString)
cd_fld_doc }),
Bool -> HasInnerDocs
HasInnerDocs (forall a. Maybe a -> Bool
isJust Maybe (GenLocated SrcSpan HsDocString)
cd_fld_doc))
addConTrailingDoc
:: SrcLoc
-> ConHdkA (LConDecl GhcPs)
-> HdkA (LConDecl GhcPs)
addConTrailingDoc :: SrcLoc -> ConHdkA (LConDecl GhcPs) -> HdkA (LConDecl GhcPs)
addConTrailingDoc SrcLoc
l_sep =
forall a b. (HdkM a -> HdkM b) -> HdkA a -> HdkA b
hoistHdkA HdkM (LConDecl GhcPs, HasInnerDocs) -> HdkM (LConDecl GhcPs)
add_trailing_doc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
where
add_trailing_doc
:: HdkM (LConDecl GhcPs, HasInnerDocs)
-> HdkM (LConDecl GhcPs)
add_trailing_doc :: HdkM (LConDecl GhcPs, HasInnerDocs) -> HdkM (LConDecl GhcPs)
add_trailing_doc HdkM (LConDecl GhcPs, HasInnerDocs)
m = do
(L SrcSpanAnnA
l ConDecl GhcPs
con_decl, HasInnerDocs Bool
has_inner_docs) <-
forall a. LocRange -> HdkM a -> HdkM a
inLocRange (Maybe BufPos -> LocRange
locRangeTo (SrcLoc -> Maybe BufPos
getBufPos SrcLoc
l_sep)) HdkM (LConDecl GhcPs, HasInnerDocs)
m
case ConDecl GhcPs
con_decl of
ConDeclH98{} -> do
[GenLocated SrcSpan HsDocString]
trailingDocs <-
forall a. LocRange -> HdkM a -> HdkM a
inLocRange (Maybe BufPos -> LocRange
locRangeFrom (SrcLoc -> Maybe BufPos
getBufPos SrcLoc
l_sep)) forall a b. (a -> b) -> a -> b
$
forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
takeHdkComments PsLocated HdkComment -> Maybe (GenLocated SrcSpan HsDocString)
mkDocPrev
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpan HsDocString]
trailingDocs
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ConDecl GhcPs
con_decl)
else do
if Bool
has_inner_docs then do
let mk_doc_ty :: HsScaled GhcPs (LHsType GhcPs)
-> HdkM (HsScaled GhcPs (LHsType GhcPs))
mk_doc_ty :: HsScaled GhcPs (LHsType GhcPs)
-> HdkM (HsScaled GhcPs (LHsType GhcPs))
mk_doc_ty x :: HsScaled GhcPs (LHsType GhcPs)
x@(HsScaled HsArrow GhcPs
_ (L SrcSpanAnnA
_ HsDocTy{})) =
HsScaled GhcPs (LHsType GhcPs)
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [GenLocated SrcSpan HsDocString] -> HdkM ()
reportExtraDocs [GenLocated SrcSpan HsDocString]
trailingDocs
mk_doc_ty (HsScaled HsArrow GhcPs
mult (L SrcSpanAnnA
l' HsType GhcPs
t)) = do
Maybe (GenLocated SrcSpan HsDocString)
doc <- [GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
selectDocString [GenLocated SrcSpan HsDocString]
trailingDocs
return $ forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow GhcPs
mult (LHsType GhcPs
-> Maybe (GenLocated SrcSpan HsDocString) -> LHsType GhcPs
mkLHsDocTy (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' HsType GhcPs
t) Maybe (GenLocated SrcSpan HsDocString)
doc)
let mk_doc_fld :: LConDeclField GhcPs
-> HdkM (LConDeclField GhcPs)
mk_doc_fld :: LConDeclField GhcPs -> HdkM (LConDeclField GhcPs)
mk_doc_fld x :: LConDeclField GhcPs
x@(L SrcSpanAnnA
_ (ConDeclField { cd_fld_doc :: forall pass.
ConDeclField pass -> Maybe (GenLocated SrcSpan HsDocString)
cd_fld_doc = Just GenLocated SrcSpan HsDocString
_ })) =
LConDeclField GhcPs
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [GenLocated SrcSpan HsDocString] -> HdkM ()
reportExtraDocs [GenLocated SrcSpan HsDocString]
trailingDocs
mk_doc_fld (L SrcSpanAnnA
l' ConDeclField GhcPs
con_fld) = do
Maybe (GenLocated SrcSpan HsDocString)
doc <- [GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
selectDocString [GenLocated SrcSpan HsDocString]
trailingDocs
return $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' (ConDeclField GhcPs
con_fld { cd_fld_doc :: Maybe (GenLocated SrcSpan HsDocString)
cd_fld_doc = Maybe (GenLocated SrcSpan HsDocString)
doc })
HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
con_args' <- case forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args ConDecl GhcPs
con_decl of
x :: HsConDeclH98Details GhcPs
x@(PrefixCon [Void]
_ []) -> HsConDeclH98Details GhcPs
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [GenLocated SrcSpan HsDocString] -> HdkM ()
reportExtraDocs [GenLocated SrcSpan HsDocString]
trailingDocs
x :: HsConDeclH98Details GhcPs
x@(RecCon (L SrcSpanAnnL
_ [])) -> HsConDeclH98Details GhcPs
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [GenLocated SrcSpan HsDocString] -> HdkM ()
reportExtraDocs [GenLocated SrcSpan HsDocString]
trailingDocs
PrefixCon [Void]
_ [HsScaled GhcPs (LHsType GhcPs)]
ts -> forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Functor f => (a -> f a) -> [a] -> f [a]
mapLastM HsScaled GhcPs (LHsType GhcPs)
-> HdkM (HsScaled GhcPs (LHsType GhcPs))
mk_doc_ty [HsScaled GhcPs (LHsType GhcPs)]
ts
InfixCon HsScaled GhcPs (LHsType GhcPs)
t1 HsScaled GhcPs (LHsType GhcPs)
t2 -> forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon HsScaled GhcPs (LHsType GhcPs)
t1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsScaled GhcPs (LHsType GhcPs)
-> HdkM (HsScaled GhcPs (LHsType GhcPs))
mk_doc_ty HsScaled GhcPs (LHsType GhcPs)
t2
RecCon (L SrcSpanAnnL
l_rec [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds) -> do
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds' <- forall (f :: * -> *) a. Functor f => (a -> f a) -> [a] -> f [a]
mapLastM LConDeclField GhcPs -> HdkM (LConDeclField GhcPs)
mk_doc_fld [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds
return (forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l_rec [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds'))
return $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ConDecl GhcPs
con_decl{ con_args :: HsConDeclH98Details GhcPs
con_args = HsConDetails
Void
(HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
(GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
con_args' })
else do
Maybe (GenLocated SrcSpan HsDocString)
con_doc' <- [GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
selectDocString (forall pass. ConDecl pass -> Maybe (GenLocated SrcSpan HsDocString)
con_doc ConDecl GhcPs
con_decl forall a. Maybe a -> [a] -> [a]
`mcons` [GenLocated SrcSpan HsDocString]
trailingDocs)
return $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (ConDecl GhcPs
con_decl{ con_doc :: Maybe (GenLocated SrcSpan HsDocString)
con_doc = Maybe (GenLocated SrcSpan HsDocString)
con_doc' })
ConDecl GhcPs
_ -> forall a. String -> a
panic String
"addConTrailingDoc: non-H98 ConDecl"
instance HasHaddock a => HasHaddock (HsScaled GhcPs a) where
addHaddock :: HsScaled GhcPs a -> HdkA (HsScaled GhcPs a)
addHaddock (HsScaled HsArrow GhcPs
mult a
a) = forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow GhcPs
mult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasHaddock a => a -> HdkA a
addHaddock a
a
instance HasHaddock a => HasHaddock (HsWildCardBndrs GhcPs a) where
addHaddock :: HsWildCardBndrs GhcPs a -> HdkA (HsWildCardBndrs GhcPs a)
addHaddock (HsWC XHsWC GhcPs a
_ a
t) = forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC NoExtField
noExtField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasHaddock a => a -> HdkA a
addHaddock a
t
instance HasHaddock (LocatedA (HsSigType GhcPs)) where
addHaddock :: GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HdkA (GenLocated SrcSpanAnnA (HsSigType GhcPs))
addHaddock (L SrcSpanAnnA
l (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcPs
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
body})) =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$ do
case HsOuterSigTyVarBndrs GhcPs
outer_bndrs of
HsOuterImplicit{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
bndrs} ->
SrcSpan -> HdkA ()
registerLocHdkA (forall flag. [LHsTyVarBndr flag GhcPs] -> SrcSpan
getLHsTyVarBndrsLoc [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
bndrs)
GenLocated SrcSpanAnnA (HsType GhcPs)
body' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsType GhcPs
body
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall a b. (a -> b) -> a -> b
$ forall pass.
XHsSig pass
-> HsOuterSigTyVarBndrs pass -> LHsType pass -> HsSigType pass
HsSig NoExtField
noExtField HsOuterSigTyVarBndrs GhcPs
outer_bndrs GenLocated SrcSpanAnnA (HsType GhcPs)
body'
instance HasHaddock (LocatedA (HsType GhcPs)) where
addHaddock :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> HdkA (GenLocated SrcSpanAnnA (HsType GhcPs))
addHaddock (L SrcSpanAnnA
l HsType GhcPs
t) =
forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$
case HsType GhcPs
t of
HsForAllTy XForAllTy GhcPs
x HsForAllTelescope GhcPs
tele LHsType GhcPs
body -> do
SrcSpan -> HdkA ()
registerLocHdkA (HsForAllTelescope GhcPs -> SrcSpan
getForAllTeleLoc HsForAllTelescope GhcPs
tele)
GenLocated SrcSpanAnnA (HsType GhcPs)
body' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsType GhcPs
body
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall pass.
XForAllTy pass
-> HsForAllTelescope pass -> LHsType pass -> HsType pass
HsForAllTy XForAllTy GhcPs
x HsForAllTelescope GhcPs
tele GenLocated SrcSpanAnnA (HsType GhcPs)
body')
HsQualTy XQualTy GhcPs
x Maybe (LHsContext GhcPs)
mlhs LHsType GhcPs
rhs -> do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA Maybe (LHsContext GhcPs)
mlhs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsType GhcPs
rhs
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall pass.
XQualTy pass
-> Maybe (LHsContext pass) -> LHsType pass -> HsType pass
HsQualTy XQualTy GhcPs
x Maybe (LHsContext GhcPs)
mlhs GenLocated SrcSpanAnnA (HsType GhcPs)
rhs')
HsFunTy XFunTy GhcPs
u HsArrow GhcPs
mult LHsType GhcPs
lhs LHsType GhcPs
rhs -> do
GenLocated SrcSpanAnnA (HsType GhcPs)
lhs' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsType GhcPs
lhs
GenLocated SrcSpanAnnA (HsType GhcPs)
rhs' <- forall a. HasHaddock a => a -> HdkA a
addHaddock LHsType GhcPs
rhs
pure $ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
u HsArrow GhcPs
mult GenLocated SrcSpanAnnA (HsType GhcPs)
lhs' GenLocated SrcSpanAnnA (HsType GhcPs)
rhs')
HsType GhcPs
_ -> forall a. HdkM a -> HdkA a
liftHdkA forall a b. (a -> b) -> a -> b
$ do
Maybe (GenLocated SrcSpan HsDocString)
mDoc <- SrcSpan -> HdkM (Maybe (GenLocated SrcSpan HsDocString))
getPrevNextDoc (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l)
return (LHsType GhcPs
-> Maybe (GenLocated SrcSpan HsDocString) -> LHsType GhcPs
mkLHsDocTy (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsType GhcPs
t) Maybe (GenLocated SrcSpan HsDocString)
mDoc)
data HdkA a =
HdkA
!(Maybe BufSpan)
!(HdkM a)
deriving (forall a b. a -> HdkA b -> HdkA a
forall a b. (a -> b) -> HdkA a -> HdkA b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HdkA b -> HdkA a
$c<$ :: forall a b. a -> HdkA b -> HdkA a
fmap :: forall a b. (a -> b) -> HdkA a -> HdkA b
$cfmap :: forall a b. (a -> b) -> HdkA a -> HdkA b
Functor)
instance Applicative HdkA where
HdkA Maybe BufSpan
l1 HdkM (a -> b)
m1 <*> :: forall a b. HdkA (a -> b) -> HdkA a -> HdkA b
<*> HdkA Maybe BufSpan
l2 HdkM a
m2 =
forall a. Maybe BufSpan -> HdkM a -> HdkA a
HdkA
(Maybe BufSpan
l1 forall a. Semigroup a => a -> a -> a
<> Maybe BufSpan
l2)
(HdkM (a -> b) -> HdkM (a -> b)
delim1 HdkM (a -> b)
m1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HdkM a -> HdkM a
delim2 HdkM a
m2)
where
delim1 :: HdkM (a -> b) -> HdkM (a -> b)
delim1 = forall a. LocRange -> HdkM a -> HdkM a
inLocRange (Maybe BufPos -> LocRange
locRangeTo (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @Maybe BufSpan -> BufPos
bufSpanStart Maybe BufSpan
l2))
delim2 :: HdkM a -> HdkM a
delim2 = forall a. LocRange -> HdkM a -> HdkM a
inLocRange (Maybe BufPos -> LocRange
locRangeFrom (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @Maybe BufSpan -> BufPos
bufSpanEnd Maybe BufSpan
l1))
pure :: forall a. a -> HdkA a
pure a
a =
forall a. HdkM a -> HdkA a
liftHdkA (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
runHdkA :: HdkA a -> HdkSt -> (a, HdkSt)
runHdkA :: forall a. HdkA a -> HdkSt -> (a, HdkSt)
runHdkA (HdkA Maybe BufSpan
_ HdkM a
m) = forall a. HdkM a -> InlineHdkM a
unHdkM HdkM a
m forall a. Monoid a => a
mempty
registerLocHdkA :: SrcSpan -> HdkA ()
registerLocHdkA :: SrcSpan -> HdkA ()
registerLocHdkA SrcSpan
l = forall a. Maybe BufSpan -> HdkM a -> HdkA a
HdkA (SrcSpan -> Maybe BufSpan
getBufSpan SrcSpan
l) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
registerHdkA :: GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA :: forall a e. GenLocated (SrcSpanAnn' a) e -> HdkA ()
registerHdkA GenLocated (SrcSpanAnn' a) e
a = SrcSpan -> HdkA ()
registerLocHdkA (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated (SrcSpanAnn' a) e
a)
hoistHdkA :: (HdkM a -> HdkM b) -> HdkA a -> HdkA b
hoistHdkA :: forall a b. (HdkM a -> HdkM b) -> HdkA a -> HdkA b
hoistHdkA HdkM a -> HdkM b
f (HdkA Maybe BufSpan
l HdkM a
m) = forall a. Maybe BufSpan -> HdkM a -> HdkA a
HdkA Maybe BufSpan
l (HdkM a -> HdkM b
f HdkM a
m)
liftHdkA :: HdkM a -> HdkA a
liftHdkA :: forall a. HdkM a -> HdkA a
liftHdkA = forall a. Maybe BufSpan -> HdkM a -> HdkA a
HdkA forall a. Monoid a => a
mempty
extendHdkA :: SrcSpan -> HdkA a -> HdkA a
extendHdkA :: forall a. SrcSpan -> HdkA a -> HdkA a
extendHdkA SrcSpan
l' (HdkA Maybe BufSpan
l HdkM a
m) = forall a. Maybe BufSpan -> HdkM a -> HdkA a
HdkA (SrcSpan -> Maybe BufSpan
getBufSpan SrcSpan
l' forall a. Semigroup a => a -> a -> a
<> Maybe BufSpan
l) HdkM a
m
newtype HdkM a = HdkM (ReaderT LocRange (State HdkSt) a)
deriving (forall a b. a -> HdkM b -> HdkM a
forall a b. (a -> b) -> HdkM a -> HdkM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HdkM b -> HdkM a
$c<$ :: forall a b. a -> HdkM b -> HdkM a
fmap :: forall a b. (a -> b) -> HdkM a -> HdkM b
$cfmap :: forall a b. (a -> b) -> HdkM a -> HdkM b
Functor, Functor HdkM
forall a. a -> HdkM a
forall a b. HdkM a -> HdkM b -> HdkM a
forall a b. HdkM a -> HdkM b -> HdkM b
forall a b. HdkM (a -> b) -> HdkM a -> HdkM b
forall a b c. (a -> b -> c) -> HdkM a -> HdkM b -> HdkM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. HdkM a -> HdkM b -> HdkM a
$c<* :: forall a b. HdkM a -> HdkM b -> HdkM a
*> :: forall a b. HdkM a -> HdkM b -> HdkM b
$c*> :: forall a b. HdkM a -> HdkM b -> HdkM b
liftA2 :: forall a b c. (a -> b -> c) -> HdkM a -> HdkM b -> HdkM c
$cliftA2 :: forall a b c. (a -> b -> c) -> HdkM a -> HdkM b -> HdkM c
<*> :: forall a b. HdkM (a -> b) -> HdkM a -> HdkM b
$c<*> :: forall a b. HdkM (a -> b) -> HdkM a -> HdkM b
pure :: forall a. a -> HdkM a
$cpure :: forall a. a -> HdkM a
Applicative, Applicative HdkM
forall a. a -> HdkM a
forall a b. HdkM a -> HdkM b -> HdkM b
forall a b. HdkM a -> (a -> HdkM b) -> HdkM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> HdkM a
$creturn :: forall a. a -> HdkM a
>> :: forall a b. HdkM a -> HdkM b -> HdkM b
$c>> :: forall a b. HdkM a -> HdkM b -> HdkM b
>>= :: forall a b. HdkM a -> (a -> HdkM b) -> HdkM b
$c>>= :: forall a b. HdkM a -> (a -> HdkM b) -> HdkM b
Monad)
data HdkSt =
HdkSt
{ HdkSt -> [PsLocated HdkComment]
hdk_st_pending :: [PsLocated HdkComment]
, HdkSt -> [HdkWarn]
hdk_st_warnings :: [HdkWarn]
}
data HdkWarn
= (PsLocated HdkComment)
| LHsDocString
type InlineHdkM a = LocRange -> HdkSt -> (a, HdkSt)
mkHdkM :: InlineHdkM a -> HdkM a
unHdkM :: HdkM a -> InlineHdkM a
mkHdkM :: forall a. InlineHdkM a -> HdkM a
mkHdkM = coerce :: forall a b. Coercible a b => a -> b
coerce
unHdkM :: forall a. HdkM a -> InlineHdkM a
unHdkM = coerce :: forall a b. Coercible a b => a -> b
coerce
inLocRange :: LocRange -> HdkM a -> HdkM a
inLocRange :: forall a. LocRange -> HdkM a -> HdkM a
inLocRange LocRange
r (HdkM ReaderT LocRange (State HdkSt) a
m) = forall a. ReaderT LocRange (State HdkSt) a -> HdkM a
HdkM (forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (forall a. Monoid a => a -> a -> a
mappend LocRange
r) ReaderT LocRange (State HdkSt) a
m)
takeHdkComments :: forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
PsLocated HdkComment -> Maybe a
f =
forall a. InlineHdkM a -> HdkM a
mkHdkM forall a b. (a -> b) -> a -> b
$
\(LocRange LowerLocBound
hdk_from UpperLocBound
hdk_to ColumnBound
hdk_col) ->
\HdkSt
hdk_st ->
let
comments :: [PsLocated HdkComment]
comments = HdkSt -> [PsLocated HdkComment]
hdk_st_pending HdkSt
hdk_st
([PsLocated HdkComment]
comments_before_range, [PsLocated HdkComment]
comments') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall {e}. LowerLocBound -> GenLocated PsSpan e -> Bool
is_after LowerLocBound
hdk_from) [PsLocated HdkComment]
comments
([PsLocated HdkComment]
comments_in_range, [PsLocated HdkComment]
comments_after_range) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall {e}. UpperLocBound -> GenLocated PsSpan e -> Bool
is_before UpperLocBound
hdk_to forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<&&> forall {e}. ColumnBound -> GenLocated PsSpan e -> Bool
is_indented ColumnBound
hdk_col) [PsLocated HdkComment]
comments'
([a]
items, [PsLocated HdkComment]
other_comments) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PsLocated HdkComment
-> ([a], [PsLocated HdkComment]) -> ([a], [PsLocated HdkComment])
add_comment ([], []) [PsLocated HdkComment]
comments_in_range
remaining_comments :: [PsLocated HdkComment]
remaining_comments = [PsLocated HdkComment]
comments_before_range forall a. [a] -> [a] -> [a]
++ [PsLocated HdkComment]
other_comments forall a. [a] -> [a] -> [a]
++ [PsLocated HdkComment]
comments_after_range
hdk_st' :: HdkSt
hdk_st' = HdkSt
hdk_st{ hdk_st_pending :: [PsLocated HdkComment]
hdk_st_pending = [PsLocated HdkComment]
remaining_comments }
in
([a]
items, HdkSt
hdk_st')
where
is_after :: LowerLocBound -> GenLocated PsSpan e -> Bool
is_after LowerLocBound
StartOfFile GenLocated PsSpan e
_ = Bool
True
is_after (StartLoc BufPos
l) (L PsSpan
l_comment e
_) = BufSpan -> BufPos
bufSpanStart (PsSpan -> BufSpan
psBufSpan PsSpan
l_comment) forall a. Ord a => a -> a -> Bool
>= BufPos
l
is_before :: UpperLocBound -> GenLocated PsSpan e -> Bool
is_before UpperLocBound
EndOfFile GenLocated PsSpan e
_ = Bool
True
is_before (EndLoc BufPos
l) (L PsSpan
l_comment e
_) = BufSpan -> BufPos
bufSpanStart (PsSpan -> BufSpan
psBufSpan PsSpan
l_comment) forall a. Ord a => a -> a -> Bool
<= BufPos
l
is_indented :: ColumnBound -> GenLocated PsSpan e -> Bool
is_indented (ColumnFrom Int
n) (L PsSpan
l_comment e
_) = RealSrcSpan -> Int
srcSpanStartCol (PsSpan -> RealSrcSpan
psRealSpan PsSpan
l_comment) forall a. Ord a => a -> a -> Bool
>= Int
n
add_comment
:: PsLocated HdkComment
-> ([a], [PsLocated HdkComment])
-> ([a], [PsLocated HdkComment])
add_comment :: PsLocated HdkComment
-> ([a], [PsLocated HdkComment]) -> ([a], [PsLocated HdkComment])
add_comment PsLocated HdkComment
hdk_comment ([a]
items, [PsLocated HdkComment]
other_hdk_comments) =
case PsLocated HdkComment -> Maybe a
f PsLocated HdkComment
hdk_comment of
Just a
item -> (a
item forall a. a -> [a] -> [a]
: [a]
items, [PsLocated HdkComment]
other_hdk_comments)
Maybe a
Nothing -> ([a]
items, PsLocated HdkComment
hdk_comment forall a. a -> [a] -> [a]
: [PsLocated HdkComment]
other_hdk_comments)
getPrevNextDoc :: SrcSpan -> HdkM (Maybe LHsDocString)
getPrevNextDoc :: SrcSpan -> HdkM (Maybe (GenLocated SrcSpan HsDocString))
getPrevNextDoc SrcSpan
l = do
let (SrcLoc
l_start, SrcLoc
l_end) = (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l, SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
l)
before_t :: LocRange
before_t = Maybe BufPos -> LocRange
locRangeTo (SrcLoc -> Maybe BufPos
getBufPos SrcLoc
l_start)
after_t :: LocRange
after_t = Maybe BufPos -> LocRange
locRangeFrom (SrcLoc -> Maybe BufPos
getBufPos SrcLoc
l_end)
[GenLocated SrcSpan HsDocString]
nextDocs <- forall a. LocRange -> HdkM a -> HdkM a
inLocRange LocRange
before_t forall a b. (a -> b) -> a -> b
$ forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
takeHdkComments PsLocated HdkComment -> Maybe (GenLocated SrcSpan HsDocString)
mkDocNext
[GenLocated SrcSpan HsDocString]
prevDocs <- forall a. LocRange -> HdkM a -> HdkM a
inLocRange LocRange
after_t forall a b. (a -> b) -> a -> b
$ forall a. (PsLocated HdkComment -> Maybe a) -> HdkM [a]
takeHdkComments PsLocated HdkComment -> Maybe (GenLocated SrcSpan HsDocString)
mkDocPrev
[GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
selectDocString ([GenLocated SrcSpan HsDocString]
nextDocs forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpan HsDocString]
prevDocs)
appendHdkWarning :: HdkWarn -> HdkM ()
appendHdkWarning :: HdkWarn -> HdkM ()
appendHdkWarning HdkWarn
e = forall a. ReaderT LocRange (State HdkSt) a -> HdkM a
HdkM (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\LocRange
_ -> forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify HdkSt -> HdkSt
append_warn))
where
append_warn :: HdkSt -> HdkSt
append_warn HdkSt
hdk_st = HdkSt
hdk_st { hdk_st_warnings :: [HdkWarn]
hdk_st_warnings = HdkWarn
e forall a. a -> [a] -> [a]
: HdkSt -> [HdkWarn]
hdk_st_warnings HdkSt
hdk_st }
selectDocString :: [LHsDocString] -> HdkM (Maybe LHsDocString)
selectDocString :: [GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
selectDocString = [GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filterOut (HsDocString -> Bool
isEmptyDocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
where
select :: [GenLocated SrcSpan HsDocString]
-> HdkM (Maybe (GenLocated SrcSpan HsDocString))
select [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
select [GenLocated SrcSpan HsDocString
doc] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just GenLocated SrcSpan HsDocString
doc)
select (GenLocated SrcSpan HsDocString
doc : [GenLocated SrcSpan HsDocString]
extra_docs) = do
[GenLocated SrcSpan HsDocString] -> HdkM ()
reportExtraDocs [GenLocated SrcSpan HsDocString]
extra_docs
return (forall a. a -> Maybe a
Just GenLocated SrcSpan HsDocString
doc)
reportExtraDocs :: [LHsDocString] -> HdkM ()
=
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\GenLocated SrcSpan HsDocString
extra_doc -> HdkWarn -> HdkM ()
appendHdkWarning (GenLocated SrcSpan HsDocString -> HdkWarn
HdkWarnExtraComment GenLocated SrcSpan HsDocString
extra_doc))
mkDocHsDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
mkDocHsDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
mkDocHsDecl LayoutInfo
layout_info PsLocated HdkComment
a = forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc (forall p. XDocD p -> DocDecl -> HsDecl p
DocD NoExtField
noExtField) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LayoutInfo -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs)
mkDocDecl LayoutInfo
layout_info PsLocated HdkComment
a
mkDocDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs)
mkDocDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs)
mkDocDecl LayoutInfo
layout_info (L PsSpan
l_comment HdkComment
hdk_comment)
| Bool
indent_mismatch = forall a. Maybe a
Nothing
| Bool
otherwise =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L (forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan forall a b. (a -> b) -> a -> b
$ PsSpan -> SrcSpan
mkSrcSpanPs PsSpan
l_comment) forall a b. (a -> b) -> a -> b
$
case HdkComment
hdk_comment of
HdkCommentNext HsDocString
doc -> HsDocString -> DocDecl
DocCommentNext HsDocString
doc
HdkCommentPrev HsDocString
doc -> HsDocString -> DocDecl
DocCommentPrev HsDocString
doc
HdkCommentNamed String
s HsDocString
doc -> String -> HsDocString -> DocDecl
DocCommentNamed String
s HsDocString
doc
HdkCommentSection Int
n HsDocString
doc -> Int -> HsDocString -> DocDecl
DocGroup Int
n HsDocString
doc
where
indent_mismatch :: Bool
indent_mismatch = case LayoutInfo
layout_info of
LayoutInfo
NoLayoutInfo -> Bool
False
LayoutInfo
ExplicitBraces -> Bool
False
VirtualBraces Int
n -> Int
n forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> Int
srcSpanStartCol (PsSpan -> RealSrcSpan
psRealSpan PsSpan
l_comment)
mkDocIE :: PsLocated HdkComment -> Maybe (LIE GhcPs)
mkDocIE :: PsLocated HdkComment -> Maybe (LIE GhcPs)
mkDocIE (L PsSpan
l_comment HdkComment
hdk_comment) =
case HdkComment
hdk_comment of
HdkCommentSection Int
n HsDocString
doc -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall pass. XIEGroup pass -> Int -> HsDocString -> IE pass
IEGroup NoExtField
noExtField Int
n HsDocString
doc)
HdkCommentNamed String
s HsDocString
_doc -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall pass. XIEDocNamed pass -> String -> IE pass
IEDocNamed NoExtField
noExtField String
s)
HdkCommentNext HsDocString
doc -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall pass. XIEDoc pass -> HsDocString -> IE pass
IEDoc NoExtField
noExtField HsDocString
doc)
HdkComment
_ -> forall a. Maybe a
Nothing
where l :: SrcSpanAnnA
l = forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan forall a b. (a -> b) -> a -> b
$ PsSpan -> SrcSpan
mkSrcSpanPs PsSpan
l_comment
mkDocNext :: PsLocated HdkComment -> Maybe LHsDocString
mkDocNext :: PsLocated HdkComment -> Maybe (GenLocated SrcSpan HsDocString)
mkDocNext (L PsSpan
l (HdkCommentNext HsDocString
doc)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L (PsSpan -> SrcSpan
mkSrcSpanPs PsSpan
l) HsDocString
doc
mkDocNext PsLocated HdkComment
_ = forall a. Maybe a
Nothing
mkDocPrev :: PsLocated HdkComment -> Maybe LHsDocString
mkDocPrev :: PsLocated HdkComment -> Maybe (GenLocated SrcSpan HsDocString)
mkDocPrev (L PsSpan
l (HdkCommentPrev HsDocString
doc)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L (PsSpan -> SrcSpan
mkSrcSpanPs PsSpan
l) HsDocString
doc
mkDocPrev PsLocated HdkComment
_ = forall a. Maybe a
Nothing
data LocRange =
LocRange
{ LocRange -> LowerLocBound
loc_range_from :: !LowerLocBound,
LocRange -> UpperLocBound
loc_range_to :: !UpperLocBound,
LocRange -> ColumnBound
loc_range_col :: !ColumnBound }
instance Semigroup LocRange where
LocRange LowerLocBound
from1 UpperLocBound
to1 ColumnBound
col1 <> :: LocRange -> LocRange -> LocRange
<> LocRange LowerLocBound
from2 UpperLocBound
to2 ColumnBound
col2 =
LowerLocBound -> UpperLocBound -> ColumnBound -> LocRange
LocRange (LowerLocBound
from1 forall a. Semigroup a => a -> a -> a
<> LowerLocBound
from2) (UpperLocBound
to1 forall a. Semigroup a => a -> a -> a
<> UpperLocBound
to2) (ColumnBound
col1 forall a. Semigroup a => a -> a -> a
<> ColumnBound
col2)
instance Monoid LocRange where
mempty :: LocRange
mempty = LowerLocBound -> UpperLocBound -> ColumnBound -> LocRange
LocRange forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
locRangeFrom :: Maybe BufPos -> LocRange
locRangeFrom :: Maybe BufPos -> LocRange
locRangeFrom (Just BufPos
l) = forall a. Monoid a => a
mempty { loc_range_from :: LowerLocBound
loc_range_from = BufPos -> LowerLocBound
StartLoc BufPos
l }
locRangeFrom Maybe BufPos
Nothing = forall a. Monoid a => a
mempty
locRangeTo :: Maybe BufPos -> LocRange
locRangeTo :: Maybe BufPos -> LocRange
locRangeTo (Just BufPos
l) = forall a. Monoid a => a
mempty { loc_range_to :: UpperLocBound
loc_range_to = BufPos -> UpperLocBound
EndLoc BufPos
l }
locRangeTo Maybe BufPos
Nothing = forall a. Monoid a => a
mempty
data LowerLocBound = StartOfFile | StartLoc !BufPos
instance Semigroup LowerLocBound where
LowerLocBound
StartOfFile <> :: LowerLocBound -> LowerLocBound -> LowerLocBound
<> LowerLocBound
l = LowerLocBound
l
LowerLocBound
l <> LowerLocBound
StartOfFile = LowerLocBound
l
StartLoc BufPos
l1 <> StartLoc BufPos
l2 = BufPos -> LowerLocBound
StartLoc (forall a. Ord a => a -> a -> a
max BufPos
l1 BufPos
l2)
instance Monoid LowerLocBound where
mempty :: LowerLocBound
mempty = LowerLocBound
StartOfFile
data UpperLocBound = EndOfFile | EndLoc !BufPos
instance Semigroup UpperLocBound where
UpperLocBound
EndOfFile <> :: UpperLocBound -> UpperLocBound -> UpperLocBound
<> UpperLocBound
l = UpperLocBound
l
UpperLocBound
l <> UpperLocBound
EndOfFile = UpperLocBound
l
EndLoc BufPos
l1 <> EndLoc BufPos
l2 = BufPos -> UpperLocBound
EndLoc (forall a. Ord a => a -> a -> a
min BufPos
l1 BufPos
l2)
instance Monoid UpperLocBound where
mempty :: UpperLocBound
mempty = UpperLocBound
EndOfFile
newtype ColumnBound = ColumnFrom Int
instance Semigroup ColumnBound where
ColumnFrom Int
n <> :: ColumnBound -> ColumnBound -> ColumnBound
<> ColumnFrom Int
m = Int -> ColumnBound
ColumnFrom (forall a. Ord a => a -> a -> a
max Int
n Int
m)
instance Monoid ColumnBound where
mempty :: ColumnBound
mempty = Int -> ColumnBound
ColumnFrom Int
leftmostColumn
mkLHsDocTy :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs
mkLHsDocTy :: LHsType GhcPs
-> Maybe (GenLocated SrcSpan HsDocString) -> LHsType GhcPs
mkLHsDocTy LHsType GhcPs
t Maybe (GenLocated SrcSpan HsDocString)
Nothing = LHsType GhcPs
t
mkLHsDocTy LHsType GhcPs
t (Just GenLocated SrcSpan HsDocString
doc) = forall l e. l -> e -> GenLocated l e
L (forall l e. GenLocated l e -> l
getLoc LHsType GhcPs
t) (forall pass.
XDocTy pass
-> LHsType pass -> GenLocated SrcSpan HsDocString -> HsType pass
HsDocTy forall a. EpAnn a
noAnn LHsType GhcPs
t GenLocated SrcSpan HsDocString
doc)
getForAllTeleLoc :: HsForAllTelescope GhcPs -> SrcSpan
getForAllTeleLoc :: HsForAllTelescope GhcPs -> SrcSpan
getForAllTeleLoc HsForAllTelescope GhcPs
tele =
case HsForAllTelescope GhcPs
tele of
HsForAllVis{ [LHsTyVarBndr () GhcPs]
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_vis_bndrs } -> forall flag. [LHsTyVarBndr flag GhcPs] -> SrcSpan
getLHsTyVarBndrsLoc [LHsTyVarBndr () GhcPs]
hsf_vis_bndrs
HsForAllInvis { [LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs } -> forall flag. [LHsTyVarBndr flag GhcPs] -> SrcSpan
getLHsTyVarBndrsLoc [LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs
getLHsTyVarBndrsLoc :: [LHsTyVarBndr flag GhcPs] -> SrcSpan
getLHsTyVarBndrsLoc :: forall flag. [LHsTyVarBndr flag GhcPs] -> SrcSpan
getLHsTyVarBndrsLoc [LHsTyVarBndr flag GhcPs]
bndrs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
noSrcSpan forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LHsTyVarBndr flag GhcPs]
bndrs
flattenBindsAndSigs
:: (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
-> [LHsDecl GhcPs]
flattenBindsAndSigs :: (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
[LTyFamDefltDecl GhcPs], [LDataFamInstDecl GhcPs],
[LDocDecl GhcPs])
-> [LHsDecl GhcPs]
flattenBindsAndSigs (LHsBinds GhcPs
all_bs, [LSig GhcPs]
all_ss, [LFamilyDecl GhcPs]
all_ts, [LTyFamDefltDecl GhcPs]
all_tfis, [LDataFamInstDecl GhcPs]
all_dfis, [LDocDecl GhcPs]
all_docs) =
forall a. (a -> a -> Ordering) -> [[a]] -> [a]
mergeListsBy forall a1 a2 a3.
GenLocated (SrcSpanAnn' a1) a2
-> GenLocated (SrcSpanAnn' a3) a2 -> Ordering
cmpBufSpanA [
forall a b l. (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL (\HsBind GhcPs
b -> forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
noExtField HsBind GhcPs
b) (forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
all_bs),
forall a b l. (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL (\Sig GhcPs
s -> forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
noExtField Sig GhcPs
s) [LSig GhcPs]
all_ss,
forall a b l. (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL (\FamilyDecl GhcPs
t -> forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD NoExtField
noExtField (forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl NoExtField
noExtField FamilyDecl GhcPs
t)) [LFamilyDecl GhcPs]
all_ts,
forall a b l. (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL (\TyFamInstDecl GhcPs
tfi -> forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
noExtField (forall pass.
XTyFamInstD pass -> TyFamInstDecl pass -> InstDecl pass
TyFamInstD NoExtField
noExtField TyFamInstDecl GhcPs
tfi)) [LTyFamDefltDecl GhcPs]
all_tfis,
forall a b l. (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL (\DataFamInstDecl GhcPs
dfi -> forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
noExtField (forall pass.
XDataFamInstD pass -> DataFamInstDecl pass -> InstDecl pass
DataFamInstD forall a. EpAnn a
noAnn DataFamInstDecl GhcPs
dfi)) [LDataFamInstDecl GhcPs]
all_dfis,
forall a b l. (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL (\DocDecl
d -> forall p. XDocD p -> DocDecl -> HsDecl p
DocD NoExtField
noExtField DocDecl
d) [LDocDecl GhcPs]
all_docs
]
cmpBufSpanA :: GenLocated (SrcSpanAnn' a1) a2 -> GenLocated (SrcSpanAnn' a3) a2 -> Ordering
cmpBufSpanA :: forall a1 a2 a3.
GenLocated (SrcSpanAnn' a1) a2
-> GenLocated (SrcSpanAnn' a3) a2 -> Ordering
cmpBufSpanA (L SrcSpanAnn' a1
la a2
a) (L SrcSpanAnn' a3
lb a2
b) = forall a. HasDebugCallStack => Located a -> Located a -> Ordering
cmpBufSpan (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a1
la) a2
a) (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a3
lb) a2
b)
mcons :: Maybe a -> [a] -> [a]
mcons :: forall a. Maybe a -> [a] -> [a]
mcons = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:)
mapLL :: (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL :: forall a b l. (a -> b) -> [GenLocated l a] -> [GenLocated l b]
mapLL a -> b
f = forall a b. (a -> b) -> [a] -> [b]
map (forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc a -> b
f)