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