{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

module Language.Haskell.GHC.ExactPrint.Utils
    -- (
    --   showAst
    -- , ss2pos, ss2posEnd
    -- , ss2delta, ss2deltaEnd
    -- , ss2range
    -- , rs
    -- , debug, debugM
    -- , adjustDeltaForOffset
    -- , sortEpaComments
    -- , epaCommentsBalanced
    -- , notDocDecl
    -- , notIEDoc
    -- , hsDeclsLocalBinds
    -- , hsDeclsClassDecl
    -- , hsDeclsValBinds
    -- , captureOrderBinds
    -- , wrapSig, wrapDecl
    -- , decl2Sig
    -- , mkLEpaComment
    -- , mkEpaComments
    -- , mkKWComment
    -- , tokComment
    -- , comment2LEpaComment
    -- , commentOrigDelta
    -- , replaceDeclsClassDecl
    -- , decl2Bind
    -- , badRealSrcSpan
    -- , rs2range
    -- , origDelta
    -- , dedentDocChunk
    -- , orderedDecls
    -- , needsWhere
    -- , undelta
    -- , spanLength
    -- , isGoodDelta
    -- , dpFromString
    -- , insertCppComments
    -- )
    where

import Control.Monad (when)
-- import Control.Monad.State.Lazy
import GHC.Utils.Monad.State.Strict
import Data.Data hiding ( Fixity )
import Data.Function
import Data.Generics.Aliases
import Data.Generics.Schemes
import Data.List
import qualified Data.Map.Strict as Map

import qualified GHC
import GHC hiding (EpaComment)
import GHC.Base (NonEmpty(..))
import GHC.Data.FastString
import GHC.Driver.Ppr
import GHC.Hs.Dump
import GHC.Parser.Lexer (allocateComments)
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc

import Language.Haskell.GHC.ExactPrint.Types

import Debug.Trace

-- ---------------------------------------------------------------------

-- |Global switch to enable debug tracing in ghc-exactprint Delta / Print
debugEnabledFlag :: Bool
-- debugEnabledFlag = True
debugEnabledFlag :: Bool
debugEnabledFlag = Bool
False

-- |Provide a version of trace that comes at the end of the line, so it can
-- easily be commented out when debugging different things.
debug :: c -> String -> c
debug :: forall c. c -> String -> c
debug c
c String
s = if Bool
debugEnabledFlag
              then String -> c -> c
forall a. String -> a -> a
trace String
s c
c
              else c
c
debugM :: Monad m => String -> m ()
debugM :: forall (m :: * -> *). Monad m => String -> m ()
debugM String
s = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugEnabledFlag (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
s

warn :: c -> String -> c
-- warn = flip trace
warn :: forall c. c -> String -> c
warn c
c String
_ = c
c

-- ---------------------------------------------------------------------

captureOrderBinds :: [LHsDecl GhcPs] -> AnnSortKey BindTag
captureOrderBinds :: [LHsDecl GhcPs] -> AnnSortKey BindTag
captureOrderBinds [LHsDecl GhcPs]
ls = [BindTag] -> AnnSortKey BindTag
forall tag. [tag] -> AnnSortKey tag
AnnSortKey ([BindTag] -> AnnSortKey BindTag)
-> [BindTag] -> AnnSortKey BindTag
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> BindTag)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [BindTag]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsDecl GhcPs) -> BindTag
forall {l} {p}.
Outputable (GenLocated l (HsDecl p)) =>
GenLocated l (HsDecl p) -> BindTag
go [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
ls
  where
    go :: GenLocated l (HsDecl p) -> BindTag
go (L l
_ (ValD XValD p
_ HsBind p
_))       = BindTag
BindTag
    go (L l
_ (SigD XSigD p
_ Sig p
_))       = BindTag
SigDTag
    go GenLocated l (HsDecl p)
d      = String -> BindTag
forall a. HasCallStack => String -> a
error (String -> BindTag) -> String -> BindTag
forall a b. (a -> b) -> a -> b
$ String
"captureOrderBinds:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLocated l (HsDecl p) -> String
forall a. Outputable a => a -> String
showGhc GenLocated l (HsDecl p)
d

-- ---------------------------------------------------------------------

notDocDecl :: LHsDecl GhcPs -> Bool
notDocDecl :: LHsDecl GhcPs -> Bool
notDocDecl (L SrcSpanAnnA
_ DocD{}) = Bool
False
notDocDecl LHsDecl GhcPs
_ = Bool
True

notIEDoc :: LIE GhcPs -> Bool
notIEDoc :: LIE GhcPs -> Bool
notIEDoc (L SrcSpanAnnA
_ IEGroup {})    = Bool
False
notIEDoc (L SrcSpanAnnA
_ IEDoc {})      = Bool
False
notIEDoc (L SrcSpanAnnA
_ IEDocNamed {}) = Bool
False
notIEDoc LIE GhcPs
_ = Bool
True

-- ---------------------------------------------------------------------
-- | A good delta has no negative values.
isGoodDelta :: DeltaPos -> Bool
isGoodDelta :: DeltaPos -> Bool
isGoodDelta (SameLine Int
co) = Int
co Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
isGoodDelta (DifferentLine Int
ro Int
_co) = Int
ro Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  -- Note: DifferentLine invariant is ro is nonzero and positive


-- | Create a delta from the current position to the start of the given
-- @RealSrcSpan@.
ss2delta :: Pos -> RealSrcSpan -> DeltaPos
ss2delta :: Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
ref RealSrcSpan
ss = Pos -> Pos -> DeltaPos
pos2delta Pos
ref (RealSrcSpan -> Pos
ss2pos RealSrcSpan
ss)

-- | create a delta from the end of a current span.  The +1 is because
-- the stored position ends up one past the span, this is prior to
-- that adjustment
ss2deltaEnd :: RealSrcSpan -> RealSrcSpan -> DeltaPos
ss2deltaEnd :: RealSrcSpan -> RealSrcSpan -> DeltaPos
ss2deltaEnd RealSrcSpan
rrs RealSrcSpan
ss = Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
ref RealSrcSpan
ss
  where
    (Int
r,Int
c) = RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
rrs
    ref :: Pos
ref = if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
             then (Int
r,Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
             else (Int
r,Int
c)

-- | create a delta from the start of a current span.  The +1 is
-- because the stored position ends up one past the span, this is
-- prior to that adjustment
ss2deltaStart :: RealSrcSpan -> RealSrcSpan -> DeltaPos
ss2deltaStart :: RealSrcSpan -> RealSrcSpan -> DeltaPos
ss2deltaStart RealSrcSpan
rrs RealSrcSpan
ss = Pos -> RealSrcSpan -> DeltaPos
ss2delta Pos
ref RealSrcSpan
ss
  where
    (Int
r,Int
c) = RealSrcSpan -> Pos
ss2pos RealSrcSpan
rrs
    ref :: Pos
ref = if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
             then (Int
r,Int
c)
             else (Int
r,Int
c)

-- | Convert the start of the second @Pos@ to be an offset from the
-- first. The assumption is the reference starts before the second @Pos@
pos2delta :: Pos -> Pos -> DeltaPos
pos2delta :: Pos -> Pos -> DeltaPos
pos2delta (Int
refl,Int
refc) (Int
l,Int
c) = Int -> Int -> DeltaPos
deltaPos Int
lo Int
co
  where
    lo :: Int
lo = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
refl
    co :: Int
co = if Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
refc
                    else Int
c

-- | Apply the delta to the current position, taking into account the
-- current column offset if advancing to a new line
undelta :: Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta :: Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta (Int
l,Int
c) (SameLine Int
dc)         (LayoutStartCol Int
_co) = (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dc)
undelta (Int
l,Int
_) (DifferentLine Int
dl Int
dc) (LayoutStartCol Int
co) = (Int
fl,Int
fc)
  where
    -- Note: invariant: dl > 0
    fl :: Int
fl = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dl
    fc :: Int
fc = Int
co Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dc

-- ---------------------------------------------------------------------

adjustDeltaForOffset :: LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset :: LayoutStartCol -> DeltaPos -> DeltaPos
adjustDeltaForOffset LayoutStartCol
_colOffset                      dp :: DeltaPos
dp@(SameLine Int
_) = DeltaPos
dp
adjustDeltaForOffset (LayoutStartCol Int
colOffset) (DifferentLine Int
l Int
c)
  = Int -> Int -> DeltaPos
DifferentLine Int
l (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
colOffset)

-- ---------------------------------------------------------------------

ss2pos :: RealSrcSpan -> Pos
ss2pos :: RealSrcSpan -> Pos
ss2pos RealSrcSpan
ss = (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss,RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss)

ss2posEnd :: RealSrcSpan -> Pos
ss2posEnd :: RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
ss = (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss,RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
ss)

ss2range :: SrcSpan -> (Pos,Pos)
ss2range :: SrcSpan -> (Pos, Pos)
ss2range SrcSpan
ss = (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
rs SrcSpan
ss, RealSrcSpan -> Pos
ss2posEnd (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RealSrcSpan
rs SrcSpan
ss)

rs2range :: RealSrcSpan -> (Pos,Pos)
rs2range :: RealSrcSpan -> (Pos, Pos)
rs2range RealSrcSpan
ss = (RealSrcSpan -> Pos
ss2pos RealSrcSpan
ss, RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
ss)

rs :: SrcSpan -> RealSrcSpan
rs :: SrcSpan -> RealSrcSpan
rs (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) = RealSrcSpan
s
rs SrcSpan
_ = RealSrcSpan
badRealSrcSpan

range2rs :: (Pos,Pos) -> RealSrcSpan
range2rs :: (Pos, Pos) -> RealSrcSpan
range2rs (Pos
s,Pos
e) = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan (Pos -> RealSrcLoc
mkLoc Pos
s) (Pos -> RealSrcLoc
mkLoc Pos
e)
  where
    mkLoc :: Pos -> RealSrcLoc
mkLoc (Int
l,Int
c) = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
fsLit String
"ghc-exactprint") Int
l Int
c

badRealSrcSpan :: RealSrcSpan
badRealSrcSpan :: RealSrcSpan
badRealSrcSpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
bad RealSrcLoc
bad
  where
    bad :: RealSrcLoc
bad = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
fsLit String
"ghc-exactprint-nospan") Int
0 Int
0

spanLength :: RealSrcSpan -> Int
spanLength :: RealSrcSpan -> Int
spanLength = (-) (Int -> Int -> Int)
-> (RealSrcSpan -> Int) -> RealSrcSpan -> Int -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RealSrcSpan -> Int
srcSpanEndCol (RealSrcSpan -> Int -> Int)
-> (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall a b.
(RealSrcSpan -> a -> b) -> (RealSrcSpan -> a) -> RealSrcSpan -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RealSrcSpan -> Int
srcSpanStartCol


-- | Useful for debug dumps
eloc2str :: EpaLocation -> String
eloc2str :: EpaLocation -> String
eloc2str (EpaSpan SrcSpan
r) = String
"EpaSpan " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (SrcSpan -> (Pos, Pos)
ss2range SrcSpan
r)
eloc2str EpaLocation
epaLoc = EpaLocation -> String
forall a. Show a => a -> String
show EpaLocation
epaLoc

-- ---------------------------------------------------------------------
-- | Checks whether a SrcSpan has zero length.
isPointSrcSpan :: RealSrcSpan -> Bool
isPointSrcSpan :: RealSrcSpan -> Bool
isPointSrcSpan RealSrcSpan
ss = RealSrcSpan -> Int
spanLength RealSrcSpan
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                  Bool -> Bool -> Bool
&& RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss

-- ---------------------------------------------------------------------

-- | A GHC comment includes the span of the preceding token.  Take an
-- original comment, and convert the 'Anchor to have a have a
-- `MovedAnchor` operation based on the original location, only if it
-- does not already have one.
commentOrigDelta :: LEpaComment -> LEpaComment
commentOrigDelta :: LEpaComment -> LEpaComment
commentOrigDelta (L (EpaSpan ss :: SrcSpan
ss@(RealSrcSpan RealSrcSpan
la Maybe BufSpan
_)) (GHC.EpaComment EpaCommentTok
t RealSrcSpan
pp))
  = (EpaLocation' NoComments -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss DeltaPos
dp NoComments
NoComments) (EpaCommentTok -> RealSrcSpan -> EpaComment
GHC.EpaComment EpaCommentTok
t RealSrcSpan
pp))
                  LEpaComment -> String -> LEpaComment
forall c. c -> String -> c
`debug` (String
"commentOrigDelta: (la, pp, r,c, dp)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (RealSrcSpan, RealSrcSpan, Int, Int, DeltaPos) -> String
forall a. Data a => a -> String
showAst (RealSrcSpan
la, RealSrcSpan
pp, Int
r,Int
c, DeltaPos
dp))
  where
        (Int
r,Int
c) = RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
pp

        dp :: DeltaPos
dp = if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
               then (Pos -> RealSrcSpan -> DeltaPos
ss2delta (Int
r,Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RealSrcSpan
la)
               else (Pos -> RealSrcSpan -> DeltaPos
ss2delta (Int
r,Int
c)   RealSrcSpan
la)
commentOrigDelta LEpaComment
c = LEpaComment
c

origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos
origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos
origDelta RealSrcSpan
pos RealSrcSpan
pp = Pos -> RealSrcSpan -> DeltaPos
ss2delta (RealSrcSpan -> Pos
ss2posEnd RealSrcSpan
pp) RealSrcSpan
pos

-- ---------------------------------------------------------------------

needsWhere :: DataDefnCons (LConDecl (GhcPass p)) -> Bool
needsWhere :: forall (p :: Pass). DataDefnCons (LConDecl (GhcPass p)) -> Bool
needsWhere (NewTypeCon LConDecl (GhcPass p)
_) = Bool
True
needsWhere (DataTypeCons Bool
_ []) = Bool
True
needsWhere (DataTypeCons Bool
_ ((L SrcSpanAnnA
_ (ConDeclGADT{})):[LConDecl (GhcPass p)]
_)) = Bool
True
needsWhere DataDefnCons (LConDecl (GhcPass p))
_ = Bool
False

-- ---------------------------------------------------------------------

-- | Insert the comments at the appropriate places in the AST
insertCppComments ::  ParsedSource -> [LEpaComment] -> ParsedSource
-- insertCppComments p [] = p
insertCppComments :: ParsedSource -> [LEpaComment] -> ParsedSource
insertCppComments (L SrcSpan
l HsModule GhcPs
p) [LEpaComment]
cs0 = ParsedSource -> [LEpaComment] -> ParsedSource
insertRemainingCppComments (SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsModule GhcPs
p2) [LEpaComment]
remaining
  where
    (EpAnn EpaLocation
anct AnnsModule
ant EpAnnComments
cst) = XModulePs -> EpAnn AnnsModule
hsmodAnn (XModulePs -> EpAnn AnnsModule) -> XModulePs -> EpAnn AnnsModule
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
hsmodExt HsModule GhcPs
p
    cs :: [LEpaComment]
cs = [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cst [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cst [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs0
    p0 :: HsModule GhcPs
p0 = HsModule GhcPs
p { hsmodExt = (hsmodExt p) { hsmodAnn = EpAnn anct ant emptyComments }}
    -- Comments embedded within spans
    -- everywhereM is a bottom-up traversal
    (HsModule GhcPs
p1, [LEpaComment]
toplevel) = State [LEpaComment] (HsModule GhcPs)
-> [LEpaComment] -> (HsModule GhcPs, [LEpaComment])
forall s a. State s a -> s -> (a, s)
runState (GenericM (State [LEpaComment]) -> GenericM (State [LEpaComment])
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((SrcSpanAnnA -> State [LEpaComment] SrcSpanAnnA)
-> a -> State [LEpaComment] a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM   SrcSpanAnnA -> State [LEpaComment] SrcSpanAnnA
addCommentsListItem
                                           (a -> State [LEpaComment] a)
-> (EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn))
-> a
-> State [LEpaComment] a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn)
addCommentsGrhs
                                           (a -> State [LEpaComment] a)
-> (EpAnn (AnnList ()) -> State [LEpaComment] (EpAnn (AnnList ())))
-> a
-> State [LEpaComment] a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` EpAnn (AnnList ()) -> State [LEpaComment] (EpAnn (AnnList ()))
addCommentsList) HsModule GhcPs
p0) [LEpaComment]
cs
    (HsModule GhcPs
p2, [LEpaComment]
remaining) = HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment])
insertTopLevelCppComments HsModule GhcPs
p1 [LEpaComment]
toplevel

    addCommentsListItem :: EpAnn AnnListItem -> State [LEpaComment] (EpAnn AnnListItem)
    addCommentsListItem :: SrcSpanAnnA -> State [LEpaComment] SrcSpanAnnA
addCommentsListItem = SrcSpanAnnA -> State [LEpaComment] SrcSpanAnnA
forall ann. EpAnn ann -> State [LEpaComment] (EpAnn ann)
addComments

    addCommentsList :: EpAnn (AnnList ()) -> State [LEpaComment] (EpAnn (AnnList ()))
    addCommentsList :: EpAnn (AnnList ()) -> State [LEpaComment] (EpAnn (AnnList ()))
addCommentsList = EpAnn (AnnList ()) -> State [LEpaComment] (EpAnn (AnnList ()))
forall ann. EpAnn ann -> State [LEpaComment] (EpAnn ann)
addComments

    addCommentsGrhs :: EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn)
    addCommentsGrhs :: EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn)
addCommentsGrhs = EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn)
forall ann. EpAnn ann -> State [LEpaComment] (EpAnn ann)
addComments

    addComments :: forall ann. EpAnn ann -> State [LEpaComment] (EpAnn ann)
    addComments :: forall ann. EpAnn ann -> State [LEpaComment] (EpAnn ann)
addComments (EpAnn EpaLocation
anc ann
an EpAnnComments
ocs) = do
      case EpaLocation
anc of
        EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) -> do
          unAllocated <- State [LEpaComment] [LEpaComment]
forall s. State s s
get
          let
            (rest, these) = GHC.Parser.Lexer.allocateComments s unAllocated
            cs' = EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments EpAnnComments
ocs [LEpaComment]
these
          put rest
          return $ EpAnn anc an cs'

        EpaLocation
_ -> EpAnn ann -> State [LEpaComment] (EpAnn ann)
forall a. a -> State [LEpaComment] a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn ann -> State [LEpaComment] (EpAnn ann))
-> EpAnn ann -> State [LEpaComment] (EpAnn ann)
forall a b. (a -> b) -> a -> b
$ EpaLocation -> ann -> EpAnnComments -> EpAnn ann
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc ann
an EpAnnComments
ocs

workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments EpAnnComments
ocs [] = EpAnnComments
ocs
workInComments EpAnnComments
ocs [LEpaComment]
new = EpAnnComments
cs'
  where
    pc :: [LEpaComment]
pc = EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
ocs
    fc :: [LEpaComment]
fc = EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
ocs
    cs' :: EpAnnComments
cs' = case [LEpaComment]
fc of
      [] -> [LEpaComment] -> EpAnnComments
EpaComments ([LEpaComment] -> EpAnnComments) -> [LEpaComment] -> EpAnnComments
forall a b. (a -> b) -> a -> b
$ [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
pc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
fc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
new
      (L EpaLocation' NoComments
ac EpaComment
_:[LEpaComment]
_) -> [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced ([LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
pc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs_before)
                                        ([LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
fc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs_after)
             where
               ([LEpaComment]
cs_before,[LEpaComment]
cs_after)
                   = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ac) )
                           [LEpaComment]
new

insertTopLevelCppComments ::  HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment])
insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment])
insertTopLevelCppComments (HsModule (XModulePs EpAnn AnnsModule
an EpLayout
lo Maybe (LWarningTxt GhcPs)
mdeprec Maybe (LHsDoc GhcPs)
mbDoc) Maybe (XRec GhcPs ModuleName)
mmn Maybe (XRec GhcPs [LIE GhcPs])
mexports [LImportDecl GhcPs]
imports [LHsDecl GhcPs]
decls) [LEpaComment]
cs
  = (XCModule GhcPs
-> Maybe (XRec GhcPs ModuleName)
-> Maybe (XRec GhcPs [LIE GhcPs])
-> [LImportDecl GhcPs]
-> [LHsDecl GhcPs]
-> HsModule GhcPs
forall p.
XCModule p
-> Maybe (XRec p ModuleName)
-> Maybe (XRec p [LIE p])
-> [LImportDecl p]
-> [LHsDecl p]
-> HsModule p
HsModule (EpAnn AnnsModule
-> EpLayout
-> Maybe (LWarningTxt GhcPs)
-> Maybe (LHsDoc GhcPs)
-> XModulePs
XModulePs EpAnn AnnsModule
an4 EpLayout
lo Maybe (LWarningTxt GhcPs)
mdeprec Maybe (LHsDoc GhcPs)
mbDoc) Maybe (XRec GhcPs ModuleName)
mmn Maybe (XRec GhcPs [LIE GhcPs])
Maybe
  (GenLocated
     (EpAnn (AnnList (EpToken "hiding", [EpToken ","])))
     [GenLocated SrcSpanAnnA (IE GhcPs)])
mexports' [LImportDecl GhcPs]
[LocatedA (ImportDecl GhcPs)]
imports' [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls', [LEpaComment]
cs3)
    -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs))
    -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs))
  where
    -- Comments at the top level.
    (EpAnn AnnsModule
an0, [LEpaComment]
cs0) =
      case Maybe (XRec GhcPs ModuleName)
mmn of
        Maybe (XRec GhcPs ModuleName)
Nothing -> (EpAnn AnnsModule
an, [LEpaComment]
cs)
        Just XRec GhcPs ModuleName
_ ->
            -- We have a module name. Capture all comments up to the `where`
            let
              ([LEpaComment]
these, [LEpaComment]
remaining) = SplitWhere
-> EpToken "where"
-> [LEpaComment]
-> ([LEpaComment], [LEpaComment])
splitOnWhere SplitWhere
Before (AnnsModule -> EpToken "where"
am_where (AnnsModule -> EpToken "where") -> AnnsModule -> EpToken "where"
forall a b. (a -> b) -> a -> b
$ EpAnn AnnsModule -> AnnsModule
forall ann. EpAnn ann -> ann
anns EpAnn AnnsModule
an) [LEpaComment]
cs
              (EpAnn EpaLocation
a AnnsModule
anno EpAnnComments
ocs) = EpAnn AnnsModule
an :: EpAnn AnnsModule
              anm :: EpAnn AnnsModule
anm = EpaLocation -> AnnsModule -> EpAnnComments -> EpAnn AnnsModule
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
a AnnsModule
anno (EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments EpAnnComments
ocs [LEpaComment]
these)
            in
              (EpAnn AnnsModule
anm, [LEpaComment]
remaining)
    (EpAnn AnnsModule
an1,[LEpaComment]
cs0a) = case EpLayout
lo of
        EpExplicitBraces (EpTok (EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_))) EpToken "}"
_close ->
            let
                ([LEpaComment]
stay,[LEpaComment]
cs0a') = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ RealSrcSpan
s)) [LEpaComment]
cs0
                cs' :: EpAnnComments
cs' = EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments (EpAnn AnnsModule -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments EpAnn AnnsModule
an0) [LEpaComment]
stay
            in (EpAnn AnnsModule
an0 { comments = cs' }, [LEpaComment]
cs0a')
        EpLayout
_ -> (EpAnn AnnsModule
an0,[LEpaComment]
cs0)
    -- Deal with possible leading semis
    (EpAnn AnnsModule
an2, [LEpaComment]
cs0b) = case AnnsModule -> [TrailingAnn]
am_decls (AnnsModule -> [TrailingAnn]) -> AnnsModule -> [TrailingAnn]
forall a b. (a -> b) -> a -> b
$ EpAnn AnnsModule -> AnnsModule
forall ann. EpAnn ann -> ann
anns EpAnn AnnsModule
an1 of
        (AddSemiAnn (EpTok (EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_))):[TrailingAnn]
_) -> (EpAnn AnnsModule
an1 {comments = cs'}, [LEpaComment]
cs0b')
          where
            ([LEpaComment]
stay,[LEpaComment]
cs0b') = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ RealSrcSpan
s)) [LEpaComment]
cs0a
            cs' :: EpAnnComments
cs' = EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments (EpAnn AnnsModule -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments EpAnn AnnsModule
an1) [LEpaComment]
stay
        [TrailingAnn]
_ -> (EpAnn AnnsModule
an1,[LEpaComment]
cs0a)

    (Maybe
  (GenLocated
     (EpAnn (AnnList (EpToken "hiding", [EpToken ","])))
     [GenLocated SrcSpanAnnA (IE GhcPs)])
mexports', EpAnn AnnsModule
an3, [LEpaComment]
cs1) =
      case Maybe (XRec GhcPs [LIE GhcPs])
mexports of
        Maybe (XRec GhcPs [LIE GhcPs])
Nothing -> (Maybe
  (GenLocated
     (EpAnn (AnnList (EpToken "hiding", [EpToken ","])))
     [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. Maybe a
Nothing, EpAnn AnnsModule
an2, [LEpaComment]
cs0b)
        Just (L EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
l [GenLocated SrcSpanAnnA (IE GhcPs)]
exports) -> (GenLocated
  (EpAnn (AnnList (EpToken "hiding", [EpToken ","])))
  [GenLocated SrcSpanAnnA (IE GhcPs)]
-> Maybe
     (GenLocated
        (EpAnn (AnnList (EpToken "hiding", [EpToken ","])))
        [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. a -> Maybe a
Just (EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> GenLocated
     (EpAnn (AnnList (EpToken "hiding", [EpToken ","])))
     [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. l -> e -> GenLocated l e
L EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
l [GenLocated SrcSpanAnnA (IE GhcPs)]
exports'), EpAnn AnnsModule
an3', [LEpaComment]
cse)
                         where
                           hc1' :: EpAnnComments
hc1' = EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments (EpAnn AnnsModule -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments EpAnn AnnsModule
an2) [LEpaComment]
csh'
                           an3' :: EpAnn AnnsModule
an3' = EpAnn AnnsModule
an2 { comments = hc1' }
                           ([LEpaComment]
csh', [LEpaComment]
cs0b') = case AnnListBrackets -> (EpaLocation, EpaLocation)
annListBracketsLocs (AnnListBrackets -> (EpaLocation, EpaLocation))
-> AnnListBrackets -> (EpaLocation, EpaLocation)
forall a b. (a -> b) -> a -> b
$ AnnList (EpToken "hiding", [EpToken ","]) -> AnnListBrackets
forall a. AnnList a -> AnnListBrackets
al_brackets (AnnList (EpToken "hiding", [EpToken ","]) -> AnnListBrackets)
-> AnnList (EpToken "hiding", [EpToken ","]) -> AnnListBrackets
forall a b. (a -> b) -> a -> b
$ EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
-> AnnList (EpToken "hiding", [EpToken ","])
forall ann. EpAnn ann -> ann
anns EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
l of
                               (EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_),EpaLocation
_) ->([LEpaComment]
h, [LEpaComment]
n)
                                 where
                                   ([LEpaComment]
h,[LEpaComment]
n) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> (RealSrcSpan -> Pos
ss2pos RealSrcSpan
s) )
                                       [LEpaComment]
cs0b

                               (EpaLocation, EpaLocation)
_ -> ([], [LEpaComment]
cs0b)
                           ([GenLocated SrcSpanAnnA (IE GhcPs)]
exports', [LEpaComment]
cse) = [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [LEpaComment]
-> ([GenLocated SrcSpanAnnA (IE GhcPs)], [LEpaComment])
forall a.
[LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])
allocPreceding [GenLocated SrcSpanAnnA (IE GhcPs)]
exports [LEpaComment]
cs0b'
    ([LocatedA (ImportDecl GhcPs)]
imports0, [LEpaComment]
cs2) = [LocatedA (ImportDecl GhcPs)]
-> [LEpaComment] -> ([LocatedA (ImportDecl GhcPs)], [LEpaComment])
forall a.
[LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])
allocPreceding [LImportDecl GhcPs]
[LocatedA (ImportDecl GhcPs)]
imports [LEpaComment]
cs1
    ([LocatedA (ImportDecl GhcPs)]
imports', [LEpaComment]
hc0i) = [LocatedA (ImportDecl GhcPs)]
-> ([LocatedA (ImportDecl GhcPs)], [LEpaComment])
forall a. [LocatedA a] -> ([LocatedA a], [LEpaComment])
balanceFirstLocatedAComments [LocatedA (ImportDecl GhcPs)]
imports0

    ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls0, [LEpaComment]
cs3) = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [LEpaComment]
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], [LEpaComment])
forall a.
[LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])
allocPreceding [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls [LEpaComment]
cs2
    ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls', [LEpaComment]
hc0d) = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)], [LEpaComment])
forall a. [LocatedA a] -> ([LocatedA a], [LEpaComment])
balanceFirstLocatedAComments [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls0

    -- Either hc0i or hc0d should have comments. Combine them
    hc0 :: [LEpaComment]
hc0 = [LEpaComment]
hc0i [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
hc0d

    ([LEpaComment]
hc1,[LEpaComment]
hc_cs) = if EpToken "where"
forall (tok :: Symbol). EpToken tok
NoEpTok EpToken "where" -> EpToken "where" -> Bool
forall a. Eq a => a -> a -> Bool
== (AnnsModule -> EpToken "where"
am_where (AnnsModule -> EpToken "where") -> AnnsModule -> EpToken "where"
forall a b. (a -> b) -> a -> b
$ EpAnn AnnsModule -> AnnsModule
forall ann. EpAnn ann -> ann
anns EpAnn AnnsModule
an3)
        then ([LEpaComment]
hc0,[])
        else SplitWhere
-> EpToken "where"
-> [LEpaComment]
-> ([LEpaComment], [LEpaComment])
splitOnWhere SplitWhere
After (AnnsModule -> EpToken "where"
am_where (AnnsModule -> EpToken "where") -> AnnsModule -> EpToken "where"
forall a b. (a -> b) -> a -> b
$ EpAnn AnnsModule -> AnnsModule
forall ann. EpAnn ann -> ann
anns EpAnn AnnsModule
an3)  [LEpaComment]
hc0
    hc2 :: EpAnnComments
hc2 = EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments (EpAnn AnnsModule -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments EpAnn AnnsModule
an3) [LEpaComment]
hc1
    an4 :: EpAnn AnnsModule
an4 = EpAnn AnnsModule
an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 }

    allocPreceding :: [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])
    allocPreceding :: forall a.
[LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])
allocPreceding [] [LEpaComment]
cs' = ([], [LEpaComment]
cs')
    allocPreceding (L (EpAnn EpaLocation
anc4 AnnListItem
an5 EpAnnComments
cs4) a
a:[LocatedA a]
xs) [LEpaComment]
cs' = ((SrcSpanAnnA -> a -> LocatedA a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc4 AnnListItem
an5 EpAnnComments
cs4') a
aLocatedA a -> [LocatedA a] -> [LocatedA a]
forall a. a -> [a] -> [a]
:[LocatedA a]
xs'), [LEpaComment]
rest')
      where
        ([LEpaComment]
rest, [LEpaComment]
these) =
          case EpaLocation
anc4 of
            EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) ->
                Pos -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
allocatePriorComments (RealSrcSpan -> Pos
ss2pos RealSrcSpan
s) [LEpaComment]
cs'
            EpaLocation
_ -> ([LEpaComment]
cs', [])
        cs4' :: EpAnnComments
cs4' = EpAnnComments -> [LEpaComment] -> EpAnnComments
workInComments EpAnnComments
cs4 [LEpaComment]
these
        ([LocatedA a]
xs',[LEpaComment]
rest') = [LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])
forall a.
[LocatedA a] -> [LEpaComment] -> ([LocatedA a], [LEpaComment])
allocPreceding [LocatedA a]
xs [LEpaComment]
rest

annListBracketsLocs :: AnnListBrackets -> (EpaLocation,EpaLocation)
annListBracketsLocs :: AnnListBrackets -> (EpaLocation, EpaLocation)
annListBracketsLocs (ListParens EpToken "("
o EpToken ")"
c) = (EpToken "(" -> EpaLocation
forall (tok :: Symbol). EpToken tok -> EpaLocation
getEpTokenLoc EpToken "("
o,    EpToken ")" -> EpaLocation
forall (tok :: Symbol). EpToken tok -> EpaLocation
getEpTokenLoc EpToken ")"
c)
annListBracketsLocs (ListBraces EpToken "{"
o EpToken "}"
c) = (EpToken "{" -> EpaLocation
forall (tok :: Symbol). EpToken tok -> EpaLocation
getEpTokenLoc EpToken "{"
o,    EpToken "}" -> EpaLocation
forall (tok :: Symbol). EpToken tok -> EpaLocation
getEpTokenLoc EpToken "}"
c)
annListBracketsLocs (ListSquare EpToken "["
o EpToken "]"
c) = (EpToken "[" -> EpaLocation
forall (tok :: Symbol). EpToken tok -> EpaLocation
getEpTokenLoc EpToken "["
o,    EpToken "]" -> EpaLocation
forall (tok :: Symbol). EpToken tok -> EpaLocation
getEpTokenLoc EpToken "]"
c)
annListBracketsLocs (ListBanana EpUniToken "(|" "\10631"
o EpUniToken "|)" "\10632"
c) = (EpUniToken "(|" "\10631" -> EpaLocation
forall (tok :: Symbol) (toku :: Symbol).
EpUniToken tok toku -> EpaLocation
getEpUniTokenLoc EpUniToken "(|" "\10631"
o, EpUniToken "|)" "\10632" -> EpaLocation
forall (tok :: Symbol) (toku :: Symbol).
EpUniToken tok toku -> EpaLocation
getEpUniTokenLoc EpUniToken "|)" "\10632"
c)
annListBracketsLocs AnnListBrackets
ListNone         = (EpaLocation
forall a. NoAnn a => a
noAnn,              EpaLocation
forall a. NoAnn a => a
noAnn)


data SplitWhere = Before | After

splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
splitOnWhere :: SplitWhere
-> EpToken "where"
-> [LEpaComment]
-> ([LEpaComment], [LEpaComment])
splitOnWhere SplitWhere
w (EpTok (EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_))) [LEpaComment]
csIn = ([LEpaComment]
hc, [LEpaComment]
fc)
  where
    splitFunc :: SplitWhere -> a -> a -> Bool
splitFunc SplitWhere
Before a
anc_pos a
c_pos = a
c_pos a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
anc_pos
    splitFunc SplitWhere
After  a
anc_pos a
c_pos = a
anc_pos a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
c_pos
    ([LEpaComment]
hc,[LEpaComment]
fc) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) ->  SplitWhere -> Pos -> Pos -> Bool
forall {a}. Ord a => SplitWhere -> a -> a -> Bool
splitFunc SplitWhere
w (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) (RealSrcSpan -> Pos
ss2pos RealSrcSpan
s)) [LEpaComment]
csIn
splitOnWhere SplitWhere
_ EpToken "where"
_ [LEpaComment]
csIn = ([LEpaComment]
csIn,[])

balanceFirstLocatedAComments :: [LocatedA a] -> ([LocatedA a], [LEpaComment])
balanceFirstLocatedAComments :: forall a. [LocatedA a] -> ([LocatedA a], [LEpaComment])
balanceFirstLocatedAComments [] = ([],[])
balanceFirstLocatedAComments ((L (EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
csd) a
a):[LocatedA a]
ds) = (SrcSpanAnnA -> a -> LocatedA a
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> AnnListItem -> EpAnnComments -> SrcSpanAnnA
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
anc AnnListItem
an EpAnnComments
csd0) a
aLocatedA a -> [LocatedA a] -> [LocatedA a]
forall a. a -> [a] -> [a]
:[LocatedA a]
ds, [LEpaComment]
hc')
  where
    (EpAnnComments
csd0, [LEpaComment]
hc') = case EpaLocation
anc of
        EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) -> (EpAnnComments
csd', [LEpaComment]
hc)
               (EpAnnComments, [LEpaComment])
-> String -> (EpAnnComments, [LEpaComment])
forall c. c -> String -> c
`debug` (String
"balanceFirstLocatedAComments: (csd,csd',attached,header)=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (EpAnnComments, EpAnnComments, [(Int, LEpaComment)],
 [(Int, LEpaComment)])
-> String
forall a. Data a => a -> String
showAst (EpAnnComments
csd,EpAnnComments
csd',[(Int, LEpaComment)]
attached,[(Int, LEpaComment)]
header))
          where
            ([LEpaComment]
priors, [LEpaComment]
inners) =  (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> (RealSrcSpan -> Pos
ss2pos RealSrcSpan
s) )
                                       (EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
csd)
            pcds :: [(Int, LEpaComment)]
pcds = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas' RealSrcSpan
s [LEpaComment]
priors
            ([(Int, LEpaComment)]
attached, [(Int, LEpaComment)]
header) = ((Int, LEpaComment) -> Bool)
-> [(Int, LEpaComment)]
-> ([(Int, LEpaComment)], [(Int, LEpaComment)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(Int
d,LEpaComment
_c) -> Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) [(Int, LEpaComment)]
pcds
            csd' :: EpAnnComments
csd' = EpAnnComments -> [LEpaComment] -> EpAnnComments
setPriorComments EpAnnComments
csd ([LEpaComment] -> [LEpaComment]
forall a. [a] -> [a]
reverse (((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
attached) [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
inners)
            hc :: [LEpaComment]
hc = [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a]
reverse (((Int, LEpaComment) -> LEpaComment)
-> [(Int, LEpaComment)] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LEpaComment) -> LEpaComment
forall a b. (a, b) -> b
snd [(Int, LEpaComment)]
header)
        EpaLocation
_ -> (EpAnnComments
csd, [])



priorCommentsDeltas' :: RealSrcSpan -> [LEpaComment]
                    -> [(Int, LEpaComment)]
priorCommentsDeltas' :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
priorCommentsDeltas' RealSrcSpan
r [LEpaComment]
cs = RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go RealSrcSpan
r ([LEpaComment] -> [LEpaComment]
forall a. [a] -> [a]
reverse [LEpaComment]
cs)
  where
    go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
    go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go RealSrcSpan
_   [] = []
    go RealSrcSpan
_   (la :: LEpaComment
la@(L l :: EpaLocation' NoComments
l@(EpaDelta SrcSpan
_ DeltaPos
dp NoComments
_) EpaComment
_):[LEpaComment]
las) = (DeltaPos -> Int
getDeltaLine DeltaPos
dp, LEpaComment
la) (Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go (EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
l) [LEpaComment]
las
    go RealSrcSpan
rs' (la :: LEpaComment
la@(L EpaLocation' NoComments
l EpaComment
_):[LEpaComment]
las) = RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment RealSrcSpan
rs' LEpaComment
la (Int, LEpaComment) -> [(Int, LEpaComment)] -> [(Int, LEpaComment)]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go (EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
l) [LEpaComment]
las

    deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
    deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment RealSrcSpan
rs' (L EpaLocation' NoComments
loc EpaComment
c) = (Int -> Int
forall a. Num a => a -> a
abs(Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al), EpaLocation' NoComments -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L EpaLocation' NoComments
loc EpaComment
c)
      where
        (Int
al,Int
_) = RealSrcSpan -> Pos
ss2pos RealSrcSpan
rs'
        (Int
ll,Int
_) = RealSrcSpan -> Pos
ss2pos (EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
loc)

allocatePriorComments
  :: Pos
  -> [LEpaComment]
  -> ([LEpaComment], [LEpaComment])
allocatePriorComments :: Pos -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
allocatePriorComments Pos
ss_loc [LEpaComment]
comment_q =
  let
    cmp :: GenLocated (EpaLocation' a) e -> Bool
cmp (L EpaLocation' a
l e
_) = RealSrcSpan -> Pos
ss2pos (EpaLocation' a -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' a
l) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
ss_loc
    ([LEpaComment]
newAnns,[LEpaComment]
after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
cmp [LEpaComment]
comment_q
  in
    ([LEpaComment]
after, [LEpaComment]
newAnns)

insertRemainingCppComments ::  ParsedSource -> [LEpaComment] -> ParsedSource
insertRemainingCppComments :: ParsedSource -> [LEpaComment] -> ParsedSource
insertRemainingCppComments (L SrcSpan
l HsModule GhcPs
p) [LEpaComment]
cs = SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsModule GhcPs
p'
    -- `debug` ("insertRemainingCppComments: (cs,an')=" ++ showAst (cs,an'))
  where
    (EpAnn EpaLocation
a AnnsModule
an EpAnnComments
ocs) = XModulePs -> EpAnn AnnsModule
GHC.hsmodAnn (XModulePs -> EpAnn AnnsModule) -> XModulePs -> EpAnn AnnsModule
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
GHC.hsmodExt HsModule GhcPs
p
    an' :: EpAnn AnnsModule
an' = EpaLocation -> AnnsModule -> EpAnnComments -> EpAnn AnnsModule
forall ann. EpaLocation -> ann -> EpAnnComments -> EpAnn ann
EpAnn EpaLocation
a AnnsModule
an (Pos -> EpAnnComments -> [LEpaComment] -> EpAnnComments
addTrailingComments Pos
end_loc EpAnnComments
ocs [LEpaComment]
cs)
    p' :: HsModule GhcPs
p' = HsModule GhcPs
p { GHC.hsmodExt = (GHC.hsmodExt p) { GHC.hsmodAnn = an' } }
    end_loc :: Pos
end_loc = case XModulePs -> EpLayout
GHC.hsmodLayout (XModulePs -> EpLayout) -> XModulePs -> EpLayout
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> XCModule GhcPs
forall p. HsModule p -> XCModule p
GHC.hsmodExt HsModule GhcPs
p of
        EpExplicitBraces EpToken "{"
_open EpToken "}"
close -> case EpToken "}"
close of
            EpTok (EpaSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_)) -> RealSrcSpan -> Pos
ss2pos RealSrcSpan
s
            EpToken "}"
_ -> (Int
1,Int
1)
        EpLayout
_ -> (Int
1,Int
1)
    ([LEpaComment]
new_before, [LEpaComment]
new_after) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
end_loc ) [LEpaComment]
cs

    addTrailingComments :: Pos -> EpAnnComments -> [LEpaComment] -> EpAnnComments
addTrailingComments Pos
end_loc' EpAnnComments
cur [LEpaComment]
new = [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
pc' [LEpaComment]
fc'
      where
        pc :: [LEpaComment]
pc = EpAnnComments -> [LEpaComment]
priorComments EpAnnComments
cur
        fc :: [LEpaComment]
fc = EpAnnComments -> [LEpaComment]
getFollowingComments EpAnnComments
cur
        ([LEpaComment]
pc', [LEpaComment]
fc') = case [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a]
reverse [LEpaComment]
pc of
            [] -> ([LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
pc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
new_before, [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
fc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
new_after)
            (L EpaLocation' NoComments
ac EpaComment
_:[LEpaComment]
_) -> ([LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
pc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs_before, [LEpaComment] -> [LEpaComment]
sortEpaComments ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
fc [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs_after)
              where
               ([LEpaComment]
cs_before,[LEpaComment]
cs_after)
                   = if (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ac) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
end_loc'
                       then (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(L EpaLocation' NoComments
ll EpaComment
_) -> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ll) Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
ac) ) [LEpaComment]
new
                       else ([LEpaComment]
new_before, [LEpaComment]
new_after)

-- ---------------------------------------------------------------------

ghcCommentText :: LEpaComment -> String
ghcCommentText :: LEpaComment -> String
ghcCommentText (L EpaLocation' NoComments
_ (GHC.EpaComment (EpaDocComment HsDocString
s) RealSrcSpan
_))      = HsDocString -> String
exactPrintHsDocString HsDocString
s
ghcCommentText (L EpaLocation' NoComments
_ (GHC.EpaComment (EpaDocOptions String
s) RealSrcSpan
_))      = String
s
ghcCommentText (L EpaLocation' NoComments
_ (GHC.EpaComment (EpaLineComment String
s) RealSrcSpan
_))     = String
s
ghcCommentText (L EpaLocation' NoComments
_ (GHC.EpaComment (EpaBlockComment String
s) RealSrcSpan
_))    = String
s

tokComment :: LEpaComment -> [Comment]
tokComment :: LEpaComment -> [Comment]
tokComment t :: LEpaComment
t@(L EpaLocation' NoComments
lt EpaComment
c) =
  case EpaComment
c of
    (GHC.EpaComment (EpaDocComment HsDocString
dc) RealSrcSpan
pt) -> EpaLocation -> RealSrcSpan -> HsDocString -> [Comment]
hsDocStringComments (EpaLocation' NoComments -> EpaLocation
noCommentsToEpaLocation EpaLocation' NoComments
lt) RealSrcSpan
pt HsDocString
dc
    EpaComment
_ -> [String -> EpaLocation' NoComments -> RealSrcSpan -> Comment
mkComment (String -> String
normaliseCommentText (LEpaComment -> String
ghcCommentText LEpaComment
t)) EpaLocation' NoComments
lt (EpaComment -> RealSrcSpan
ac_prior_tok EpaComment
c)]

hsDocStringComments :: EpaLocation -> RealSrcSpan -> GHC.HsDocString -> [Comment]
hsDocStringComments :: EpaLocation -> RealSrcSpan -> HsDocString -> [Comment]
hsDocStringComments EpaLocation
_ RealSrcSpan
pt (MultiLineDocString HsDocStringDecorator
dec (LHsDocStringChunk
x :| [LHsDocStringChunk]
xs)) =
  let
    decStr :: String
decStr = HsDocStringDecorator -> String
printDecorator HsDocStringDecorator
dec
    L SrcSpan
lx HsDocStringChunk
x' = Int -> LHsDocStringChunk -> LHsDocStringChunk
dedentDocChunkBy (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
decStr) LHsDocStringChunk
x
    str :: String
str = String
"-- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
decStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
x'
    docChunk :: RealSrcSpan -> [LHsDocStringChunk] -> [Comment]
docChunk RealSrcSpan
_ [] = []
    docChunk RealSrcSpan
pt' (L SrcSpan
l HsDocStringChunk
chunk:[LHsDocStringChunk]
cs)
      = String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
chunk) (SrcSpan -> EpaLocation' NoComments
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
l) RealSrcSpan
pt' Maybe String
forall a. Maybe a
Nothing Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LHsDocStringChunk] -> [Comment]
docChunk (SrcSpan -> RealSrcSpan
rs SrcSpan
l) [LHsDocStringChunk]
cs
  in
    (String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment String
str (SrcSpan -> EpaLocation' NoComments
forall a. SrcSpan -> EpaLocation' a
spanAsAnchor SrcSpan
lx) RealSrcSpan
pt Maybe String
forall a. Maybe a
Nothing Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: RealSrcSpan -> [LHsDocStringChunk] -> [Comment]
docChunk (SrcSpan -> RealSrcSpan
rs SrcSpan
lx) ((LHsDocStringChunk -> LHsDocStringChunk)
-> [LHsDocStringChunk] -> [LHsDocStringChunk]
forall a b. (a -> b) -> [a] -> [b]
map LHsDocStringChunk -> LHsDocStringChunk
dedentDocChunk [LHsDocStringChunk]
xs))
hsDocStringComments EpaLocation
anc RealSrcSpan
pt (NestedDocString dec :: HsDocStringDecorator
dec@(HsDocStringNamed String
_) (L SrcSpan
_ HsDocStringChunk
chunk))
  = [String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment (String
"{- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HsDocStringDecorator -> String
printDecorator HsDocStringDecorator
dec String -> String -> String
forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
chunk String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-}") (EpaLocation -> EpaLocation' NoComments
epaToNoCommentsLocation EpaLocation
anc) RealSrcSpan
pt Maybe String
forall a. Maybe a
Nothing ]
hsDocStringComments EpaLocation
anc RealSrcSpan
pt (NestedDocString HsDocStringDecorator
dec (L SrcSpan
_ HsDocStringChunk
chunk))
  = [String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment (String
"{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ HsDocStringDecorator -> String
printDecorator HsDocStringDecorator
dec String -> String -> String
forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
chunk String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-}") (EpaLocation -> EpaLocation' NoComments
epaToNoCommentsLocation EpaLocation
anc) RealSrcSpan
pt Maybe String
forall a. Maybe a
Nothing ]

hsDocStringComments EpaLocation
_ RealSrcSpan
_ (GeneratedDocString HsDocStringChunk
_) = [] -- Should not appear in user-written code

-- At the moment the locations of the 'HsDocStringChunk's are from the start of
-- the string part, leaving aside the "--". So we need to subtract 2 columns from it
dedentDocChunk :: LHsDocStringChunk -> LHsDocStringChunk
dedentDocChunk :: LHsDocStringChunk -> LHsDocStringChunk
dedentDocChunk LHsDocStringChunk
chunk = Int -> LHsDocStringChunk -> LHsDocStringChunk
dedentDocChunkBy Int
2 LHsDocStringChunk
chunk

dedentDocChunkBy :: Int -> LHsDocStringChunk -> LHsDocStringChunk
dedentDocChunkBy :: Int -> LHsDocStringChunk -> LHsDocStringChunk
dedentDocChunkBy  Int
dedent (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
mb) HsDocStringChunk
c) = SrcSpan -> HsDocStringChunk -> LHsDocStringChunk
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
l' Maybe BufSpan
mb) HsDocStringChunk
c
  where
    f :: FastString
f = RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
l
    sl :: Int
sl = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
l
    sc :: Int
sc = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
l
    el :: Int
el = RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
l
    ec :: Int
ec = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
l
    l' :: RealSrcSpan
l' = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
f Int
sl (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dedent))
                       (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
f Int
el (Int
ec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dedent))

dedentDocChunkBy Int
_ LHsDocStringChunk
x = LHsDocStringChunk
x


epaCommentsBalanced :: [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced :: [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced [LEpaComment]
priorCs     [] = [LEpaComment] -> EpAnnComments
EpaComments [LEpaComment]
priorCs
epaCommentsBalanced [LEpaComment]
priorCs [LEpaComment]
postCs = [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [LEpaComment]
priorCs [LEpaComment]
postCs

mkEpaComments :: [Comment] -> [Comment] -> EpAnnComments
mkEpaComments :: [Comment] -> [Comment] -> EpAnnComments
mkEpaComments [Comment]
priorCs []
  = [LEpaComment] -> EpAnnComments
EpaComments ((Comment -> LEpaComment) -> [Comment] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> LEpaComment
comment2LEpaComment [Comment]
priorCs)
mkEpaComments [Comment]
priorCs [Comment]
postCs
  = [LEpaComment] -> [LEpaComment] -> EpAnnComments
epaCommentsBalanced ((Comment -> LEpaComment) -> [Comment] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> LEpaComment
comment2LEpaComment [Comment]
priorCs) ((Comment -> LEpaComment) -> [Comment] -> [LEpaComment]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> LEpaComment
comment2LEpaComment [Comment]
postCs)

comment2LEpaComment :: Comment -> LEpaComment
comment2LEpaComment :: Comment -> LEpaComment
comment2LEpaComment (Comment String
s EpaLocation' NoComments
anc RealSrcSpan
r Maybe String
_mk) = String -> EpaLocation' NoComments -> RealSrcSpan -> LEpaComment
mkLEpaComment String
s EpaLocation' NoComments
anc RealSrcSpan
r

mkLEpaComment :: String -> NoCommentsLocation -> RealSrcSpan -> LEpaComment
mkLEpaComment :: String -> EpaLocation' NoComments -> RealSrcSpan -> LEpaComment
mkLEpaComment String
s EpaLocation' NoComments
loc RealSrcSpan
r = (EpaLocation' NoComments -> EpaComment -> LEpaComment
forall l e. l -> e -> GenLocated l e
L EpaLocation' NoComments
loc (EpaCommentTok -> RealSrcSpan -> EpaComment
GHC.EpaComment (String -> EpaCommentTok
EpaLineComment String
s) RealSrcSpan
r))

mkComment :: String -> NoCommentsLocation -> RealSrcSpan -> Comment
mkComment :: String -> EpaLocation' NoComments -> RealSrcSpan -> Comment
mkComment String
c EpaLocation' NoComments
loc RealSrcSpan
r = String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment String
c EpaLocation' NoComments
loc RealSrcSpan
r Maybe String
forall a. Maybe a
Nothing

-- Windows comments include \r in them from the lexer.
normaliseCommentText :: String -> String
normaliseCommentText :: String -> String
normaliseCommentText [] = []
normaliseCommentText (Char
'\r':String
xs) = String -> String
normaliseCommentText String
xs
normaliseCommentText (Char
x:String
xs) = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
normaliseCommentText String
xs

-- |Must compare without span filenames, for CPP injected comments with fake filename
cmpComments :: Comment -> Comment -> Ordering
cmpComments :: Comment -> Comment -> Ordering
cmpComments (Comment String
_ EpaLocation' NoComments
l1 RealSrcSpan
_ Maybe String
_) (Comment String
_ EpaLocation' NoComments
l2 RealSrcSpan
_ Maybe String
_) = Pos -> Pos -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
l1) (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' NoComments
l2)

-- |Sort, comparing without span filenames, for CPP injected comments with fake filename
sortComments :: [Comment] -> [Comment]
sortComments :: [Comment] -> [Comment]
sortComments [Comment]
cs = (Comment -> Comment -> Ordering) -> [Comment] -> [Comment]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Comment -> Comment -> Ordering
cmpComments [Comment]
cs

-- |Sort, comparing without span filenames, for CPP injected comments with fake filename
sortEpaComments :: [LEpaComment] -> [LEpaComment]
sortEpaComments :: [LEpaComment] -> [LEpaComment]
sortEpaComments [LEpaComment]
cs = (LEpaComment -> LEpaComment -> Ordering)
-> [LEpaComment] -> [LEpaComment]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LEpaComment -> LEpaComment -> Ordering
forall {a} {e} {a} {e}.
GenLocated (EpaLocation' a) e
-> GenLocated (EpaLocation' a) e -> Ordering
cmp [LEpaComment]
cs
  where
    cmp :: GenLocated (EpaLocation' a) e
-> GenLocated (EpaLocation' a) e -> Ordering
cmp (L EpaLocation' a
l1 e
_) (L EpaLocation' a
l2 e
_) = Pos -> Pos -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' a -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' a
l1) (RealSrcSpan -> Pos
ss2pos (RealSrcSpan -> Pos) -> RealSrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ EpaLocation' a -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation' a
l2)

-- | Makes a comment which originates from a specific keyword.
mkKWComment :: String -> NoCommentsLocation -> Comment
mkKWComment :: String -> EpaLocation' NoComments -> Comment
mkKWComment String
kw (EpaSpan (RealSrcSpan RealSrcSpan
ss Maybe BufSpan
mb)) = String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment String
kw (SrcSpan -> EpaLocation' NoComments
forall a. SrcSpan -> EpaLocation' a
EpaSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
ss Maybe BufSpan
mb)) RealSrcSpan
ss (String -> Maybe String
forall a. a -> Maybe a
Just String
kw)
mkKWComment String
kw (EpaSpan (UnhelpfulSpan UnhelpfulSpanReason
_))   = String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment String
kw (SrcSpan -> DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
noSrcSpan (Int -> DeltaPos
SameLine Int
0) NoComments
NoComments) RealSrcSpan
placeholderRealSpan (String -> Maybe String
forall a. a -> Maybe a
Just String
kw)
mkKWComment String
kw (EpaDelta SrcSpan
ss DeltaPos
dp NoComments
cs)           = String
-> EpaLocation' NoComments
-> RealSrcSpan
-> Maybe String
-> Comment
Comment String
kw (SrcSpan -> DeltaPos -> NoComments -> EpaLocation' NoComments
forall a. SrcSpan -> DeltaPos -> a -> EpaLocation' a
EpaDelta SrcSpan
ss DeltaPos
dp NoComments
cs) RealSrcSpan
placeholderRealSpan (String -> Maybe String
forall a. a -> Maybe a
Just String
kw)

sortAnchorLocated :: [GenLocated EpaLocation a] -> [GenLocated EpaLocation a]
sortAnchorLocated :: forall a. [GenLocated EpaLocation a] -> [GenLocated EpaLocation a]
sortAnchorLocated = (GenLocated EpaLocation a -> GenLocated EpaLocation a -> Ordering)
-> [GenLocated EpaLocation a] -> [GenLocated EpaLocation a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> (GenLocated EpaLocation a -> RealSrcSpan)
-> GenLocated EpaLocation a
-> GenLocated EpaLocation a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (EpaLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan (EpaLocation -> RealSrcSpan)
-> (GenLocated EpaLocation a -> EpaLocation)
-> GenLocated EpaLocation a
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpaLocation a -> EpaLocation
forall l e. GenLocated l e -> l
getLoc))

-- | Calculates the distance from the start of a string to the end of
-- a string.
dpFromString ::  String -> DeltaPos
dpFromString :: String -> DeltaPos
dpFromString String
xs = String -> Int -> Int -> DeltaPos
dpFromString' String
xs Int
0 Int
0
  where
    dpFromString' :: String -> Int -> Int -> DeltaPos
dpFromString' String
"" Int
line Int
col =
      if Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Int -> DeltaPos
SameLine Int
col
        else Int -> Int -> DeltaPos
DifferentLine Int
line Int
col
    dpFromString' (Char
'\n': String
cs) Int
line Int
_   = String -> Int -> Int -> DeltaPos
dpFromString' String
cs (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0
    dpFromString' (Char
_:String
cs)     Int
line Int
col = String -> Int -> Int -> DeltaPos
dpFromString' String
cs Int
line       (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- ---------------------------------------------------------------------

isSymbolRdrName :: RdrName -> Bool
isSymbolRdrName :: RdrName -> Bool
isSymbolRdrName RdrName
n = OccName -> Bool
isSymOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
n

rdrName2String :: RdrName -> String
rdrName2String :: RdrName -> String
rdrName2String RdrName
r =
  case RdrName -> Maybe Name
isExact_maybe RdrName
r of
    Just Name
n  -> Name -> String
name2String Name
n
    Maybe Name
Nothing ->
      case RdrName
r of
        Unqual OccName
occ       -> OccName -> String
occNameString OccName
occ
        Qual ModuleName
modname OccName
occ -> ModuleName -> String
moduleNameString ModuleName
modname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occNameString OccName
occ
        Orig Module
_ OccName
occ       -> OccName -> String
occNameString OccName
occ
        Exact Name
n          -> Name -> String
forall a. NamedThing a => a -> String
getOccString Name
n

name2String :: Name -> String
name2String :: Name -> String
name2String = Name -> String
forall a. Outputable a => a -> String
showPprUnsafe

-- ---------------------------------------------------------------------

type DeclsByTag a = Map.Map DeclTag [(RealSrcSpan, a)]

orderedDecls
  :: AnnSortKey DeclTag
  -> DeclsByTag a
  -> [(RealSrcSpan, a)]
orderedDecls :: forall a. AnnSortKey DeclTag -> DeclsByTag a -> [(RealSrcSpan, a)]
orderedDecls AnnSortKey DeclTag
sortKey DeclsByTag a
declGroup  =
  case AnnSortKey DeclTag
sortKey of
    AnnSortKey DeclTag
NoAnnSortKey ->
      ((RealSrcSpan, a) -> (RealSrcSpan, a) -> Ordering)
-> [(RealSrcSpan, a)] -> [(RealSrcSpan, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(RealSrcSpan, a)
a (RealSrcSpan, a)
b -> RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((RealSrcSpan, a) -> RealSrcSpan
forall a b. (a, b) -> a
fst (RealSrcSpan, a)
a) ((RealSrcSpan, a) -> RealSrcSpan
forall a b. (a, b) -> a
fst (RealSrcSpan, a)
b)) ([[(RealSrcSpan, a)]] -> [(RealSrcSpan, a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(RealSrcSpan, a)]] -> [(RealSrcSpan, a)])
-> [[(RealSrcSpan, a)]] -> [(RealSrcSpan, a)]
forall a b. (a -> b) -> a -> b
$ DeclsByTag a -> [[(RealSrcSpan, a)]]
forall k a. Map k a -> [a]
Map.elems DeclsByTag a
declGroup)
    AnnSortKey [DeclTag]
keys ->
      let
        go :: [DeclTag] -> DeclsByTag a -> [(RealSrcSpan, a)]
        go :: forall a. [DeclTag] -> DeclsByTag a -> [(RealSrcSpan, a)]
go [] DeclsByTag a
_                      = []
        go (DeclTag
tag:[DeclTag]
ks) DeclsByTag a
dbt = (RealSrcSpan, a)
d (RealSrcSpan, a) -> [(RealSrcSpan, a)] -> [(RealSrcSpan, a)]
forall a. a -> [a] -> [a]
: [DeclTag] -> DeclsByTag a -> [(RealSrcSpan, a)]
forall a. [DeclTag] -> DeclsByTag a -> [(RealSrcSpan, a)]
go [DeclTag]
ks DeclsByTag a
dbt'
          where
            dbt' :: DeclsByTag a
dbt' = ([(RealSrcSpan, a)] -> [(RealSrcSpan, a)])
-> DeclTag -> DeclsByTag a -> DeclsByTag a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\[(RealSrcSpan, a)]
ds -> Int -> [(RealSrcSpan, a)] -> [(RealSrcSpan, a)]
forall a. Int -> [a] -> [a]
drop Int
1 [(RealSrcSpan, a)]
ds) DeclTag
tag DeclsByTag a
dbt
            d :: (RealSrcSpan, a)
d = case DeclTag -> DeclsByTag a -> Maybe [(RealSrcSpan, a)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DeclTag
tag DeclsByTag a
dbt of
              Just ((RealSrcSpan, a)
d':[(RealSrcSpan, a)]
_) -> (RealSrcSpan, a)
d'
              Maybe [(RealSrcSpan, a)]
_           -> String -> (RealSrcSpan, a)
forall a. HasCallStack => String -> a
error (String -> (RealSrcSpan, a)) -> String -> (RealSrcSpan, a)
forall a b. (a -> b) -> a -> b
$ String
"orderedDecls: could not look up "
                                       String -> String -> String
forall a. [a] -> [a] -> [a]
++ DeclTag -> String
forall a. Show a => a -> String
show DeclTag
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [DeclTag] -> String
forall a. Show a => a -> String
show (DeclsByTag a -> [DeclTag]
forall k a. Map k a -> [k]
Map.keys DeclsByTag a
dbt)
      in
        [DeclTag] -> DeclsByTag a -> [(RealSrcSpan, a)]
forall a. [DeclTag] -> DeclsByTag a -> [(RealSrcSpan, a)]
go [DeclTag]
keys DeclsByTag a
declGroup

hsDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsClassDecl TyClDecl GhcPs
dec = case TyClDecl GhcPs
dec of
  ClassDecl { tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt = (AnnClassDecl
_an2, EpLayout
_layout, AnnSortKey DeclTag
sortKey),
              tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig GhcPs]
sigs,tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths = LHsBinds GhcPs
methods,
              tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl GhcPs]
ats, tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamDefltDecl GhcPs]
at_defs
            } -> ((RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a, b) -> b
snd [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
decls
    where
      srs :: EpAnn a -> RealSrcSpan
      srs :: forall a. EpAnn a -> RealSrcSpan
srs EpAnn a
a = SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ EpAnn a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpAnn a
a
      decls :: [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
decls
          = AnnSortKey DeclTag
-> DeclsByTag (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. AnnSortKey DeclTag -> DeclsByTag a -> [(RealSrcSpan, a)]
orderedDecls AnnSortKey DeclTag
sortKey (DeclsByTag (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))])
-> DeclsByTag (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a b. (a -> b) -> a -> b
$ [(DeclTag, [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))])]
-> DeclsByTag (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [(DeclTag
ClsSigTag,    (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> (RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (\(L SrcSpanAnnA
l Sig GhcPs
s) -> (SrcSpanAnnA -> RealSrcSpan
forall a. EpAnn a -> RealSrcSpan
srs SrcSpanAnnA
l, SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (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)]
sigs),
               (DeclTag
ClsMethodTag, (GenLocated SrcSpanAnnA (HsBind GhcPs)
 -> (RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (\(L SrcSpanAnnA
l HsBind GhcPs
s) -> (SrcSpanAnnA -> RealSrcSpan
forall a. EpAnn a -> RealSrcSpan
srs SrcSpanAnnA
l, SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
NoExtField
noExtField HsBind GhcPs
s))) LHsBinds GhcPs
[GenLocated SrcSpanAnnA (HsBind GhcPs)]
methods),
               (DeclTag
ClsAtTag,     (GenLocated SrcSpanAnnA (FamilyDecl GhcPs)
 -> (RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (\(L SrcSpanAnnA
l FamilyDecl GhcPs
s) -> (SrcSpanAnnA -> RealSrcSpan
forall a. EpAnn a -> RealSrcSpan
srs SrcSpanAnnA
l, SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
NoExtField
noExtField (TyClDecl GhcPs -> HsDecl GhcPs) -> TyClDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XFamDecl GhcPs -> FamilyDecl GhcPs -> TyClDecl GhcPs
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl GhcPs
NoExtField
noExtField FamilyDecl GhcPs
s))) [LFamilyDecl GhcPs]
[GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
ats),
               (DeclTag
ClsAtdTag,    (GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)
 -> (RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
-> [(RealSrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (\(L SrcSpanAnnA
l TyFamInstDecl GhcPs
s) -> (SrcSpanAnnA -> RealSrcSpan
forall a. EpAnn a -> RealSrcSpan
srs SrcSpanAnnA
l, SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
NoExtField
noExtField (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XTyFamInstD GhcPs -> TyFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XTyFamInstD pass -> TyFamInstDecl pass -> InstDecl pass
TyFamInstD XTyFamInstD GhcPs
NoExtField
noExtField TyFamInstDecl GhcPs
s))) [LTyFamDefltDecl GhcPs]
[GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
at_defs)
              ]
  TyClDecl GhcPs
_ -> String -> [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> [LHsDecl GhcPs]) -> String -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"hsDeclsClassDecl:dec=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TyClDecl GhcPs -> String
forall a. Data a => a -> String
showAst TyClDecl GhcPs
dec

replaceDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs] -> TyClDecl GhcPs
replaceDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs] -> TyClDecl GhcPs
replaceDeclsClassDecl TyClDecl GhcPs
decl [LHsDecl GhcPs]
decls = case TyClDecl GhcPs
decl of
  ClassDecl { tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt = (AnnClassDecl
an2, EpLayout
layout, AnnSortKey DeclTag
_) } -> TyClDecl GhcPs
decl'
    where
      ([DeclTag]
tags, LHsBinds GhcPs
methods', [LSig GhcPs]
sigs', [LFamilyDecl GhcPs]
ats', [LTyFamDefltDecl GhcPs]
at_defs', [LDataFamInstDecl GhcPs]
_, [LDocDecl GhcPs]
_docs) = [LHsDecl GhcPs]
-> ([DeclTag], LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
    [LTyFamDefltDecl GhcPs], [LDataFamInstDecl GhcPs],
    [LDocDecl GhcPs])
partitionWithSortKey [LHsDecl GhcPs]
decls
      decl' :: TyClDecl GhcPs
decl' = TyClDecl GhcPs
decl { tcdCExt = (an2, layout, AnnSortKey tags),
                     tcdSigs = sigs',tcdMeths = methods',
                     tcdATs = ats', tcdATDefs = at_defs'
                   }

  TyClDecl GhcPs
_ -> String -> TyClDecl GhcPs
forall a. HasCallStack => String -> a
error (String -> TyClDecl GhcPs) -> String -> TyClDecl GhcPs
forall a b. (a -> b) -> a -> b
$ String
"replaceDeclsClassDecl:decl=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TyClDecl GhcPs -> String
forall a. Data a => a -> String
showAst TyClDecl GhcPs
decl

partitionWithSortKey
  :: [LHsDecl GhcPs]
  -> ([DeclTag], LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
      [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
partitionWithSortKey :: [LHsDecl GhcPs]
-> ([DeclTag], LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
    [LTyFamDefltDecl GhcPs], [LDataFamInstDecl GhcPs],
    [LDocDecl GhcPs])
partitionWithSortKey = [LHsDecl GhcPs]
-> ([DeclTag], LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
    [LTyFamDefltDecl GhcPs], [LDataFamInstDecl GhcPs],
    [LDocDecl GhcPs])
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> ([DeclTag], [GenLocated SrcSpanAnnA (HsBind GhcPs)],
    [GenLocated SrcSpanAnnA (Sig GhcPs)],
    [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)],
    [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)],
    [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)],
    [GenLocated SrcSpanAnnA (DocDecl GhcPs)])
forall {p} {l}.
(Data (HsDecl p), Typeable p) =>
[GenLocated l (HsDecl p)]
-> ([DeclTag], [GenLocated l (HsBind p)], [GenLocated l (Sig p)],
    [GenLocated l (FamilyDecl p)], [GenLocated l (TyFamInstDecl p)],
    [GenLocated l (DataFamInstDecl p)], [GenLocated l (DocDecl p)])
go
  where
    go :: [GenLocated l (HsDecl p)]
-> ([DeclTag], [GenLocated l (HsBind p)], [GenLocated l (Sig p)],
    [GenLocated l (FamilyDecl p)], [GenLocated l (TyFamInstDecl p)],
    [GenLocated l (DataFamInstDecl p)], [GenLocated l (DocDecl p)])
go [] = ([], [], [], [], [], [], [])
    go ((L l
l HsDecl p
decl) : [GenLocated l (HsDecl p)]
ds) =
      let ([DeclTag]
tags, [GenLocated l (HsBind p)]
bs, [GenLocated l (Sig p)]
ss, [GenLocated l (FamilyDecl p)]
ts, [GenLocated l (TyFamInstDecl p)]
tfis, [GenLocated l (DataFamInstDecl p)]
dfis, [GenLocated l (DocDecl p)]
docs) = [GenLocated l (HsDecl p)]
-> ([DeclTag], [GenLocated l (HsBind p)], [GenLocated l (Sig p)],
    [GenLocated l (FamilyDecl p)], [GenLocated l (TyFamInstDecl p)],
    [GenLocated l (DataFamInstDecl p)], [GenLocated l (DocDecl p)])
go [GenLocated l (HsDecl p)]
ds in
      case HsDecl p
decl of
        ValD XValD p
_ HsBind p
b
          -> (DeclTag
ClsMethodTagDeclTag -> [DeclTag] -> [DeclTag]
forall a. a -> [a] -> [a]
:[DeclTag]
tags, l -> HsBind p -> GenLocated l (HsBind p)
forall l e. l -> e -> GenLocated l e
L l
l HsBind p
b GenLocated l (HsBind p)
-> [GenLocated l (HsBind p)] -> [GenLocated l (HsBind p)]
forall a. a -> [a] -> [a]
: [GenLocated l (HsBind p)]
bs, [GenLocated l (Sig p)]
ss, [GenLocated l (FamilyDecl p)]
ts, [GenLocated l (TyFamInstDecl p)]
tfis, [GenLocated l (DataFamInstDecl p)]
dfis, [GenLocated l (DocDecl p)]
docs)
        SigD XSigD p
_ Sig p
s
          -> (DeclTag
ClsSigTagDeclTag -> [DeclTag] -> [DeclTag]
forall a. a -> [a] -> [a]
:[DeclTag]
tags, [GenLocated l (HsBind p)]
bs, l -> Sig p -> GenLocated l (Sig p)
forall l e. l -> e -> GenLocated l e
L l
l Sig p
s GenLocated l (Sig p)
-> [GenLocated l (Sig p)] -> [GenLocated l (Sig p)]
forall a. a -> [a] -> [a]
: [GenLocated l (Sig p)]
ss, [GenLocated l (FamilyDecl p)]
ts, [GenLocated l (TyFamInstDecl p)]
tfis, [GenLocated l (DataFamInstDecl p)]
dfis, [GenLocated l (DocDecl p)]
docs)
        TyClD XTyClD p
_ (FamDecl XFamDecl p
_ FamilyDecl p
t)
          -> (DeclTag
ClsAtTagDeclTag -> [DeclTag] -> [DeclTag]
forall a. a -> [a] -> [a]
:[DeclTag]
tags, [GenLocated l (HsBind p)]
bs, [GenLocated l (Sig p)]
ss, l -> FamilyDecl p -> GenLocated l (FamilyDecl p)
forall l e. l -> e -> GenLocated l e
L l
l FamilyDecl p
t GenLocated l (FamilyDecl p)
-> [GenLocated l (FamilyDecl p)] -> [GenLocated l (FamilyDecl p)]
forall a. a -> [a] -> [a]
: [GenLocated l (FamilyDecl p)]
ts, [GenLocated l (TyFamInstDecl p)]
tfis, [GenLocated l (DataFamInstDecl p)]
dfis, [GenLocated l (DocDecl p)]
docs)
        InstD XInstD p
_ (TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst = TyFamInstDecl p
tfi })
          -> (DeclTag
ClsAtdTagDeclTag -> [DeclTag] -> [DeclTag]
forall a. a -> [a] -> [a]
:[DeclTag]
tags, [GenLocated l (HsBind p)]
bs, [GenLocated l (Sig p)]
ss, [GenLocated l (FamilyDecl p)]
ts, l -> TyFamInstDecl p -> GenLocated l (TyFamInstDecl p)
forall l e. l -> e -> GenLocated l e
L l
l TyFamInstDecl p
tfi GenLocated l (TyFamInstDecl p)
-> [GenLocated l (TyFamInstDecl p)]
-> [GenLocated l (TyFamInstDecl p)]
forall a. a -> [a] -> [a]
: [GenLocated l (TyFamInstDecl p)]
tfis, [GenLocated l (DataFamInstDecl p)]
dfis, [GenLocated l (DocDecl p)]
docs)
        InstD XInstD p
_ (DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl p
dfi })
          -> ([DeclTag]
tags, [GenLocated l (HsBind p)]
bs, [GenLocated l (Sig p)]
ss, [GenLocated l (FamilyDecl p)]
ts, [GenLocated l (TyFamInstDecl p)]
tfis, l -> DataFamInstDecl p -> GenLocated l (DataFamInstDecl p)
forall l e. l -> e -> GenLocated l e
L l
l DataFamInstDecl p
dfi GenLocated l (DataFamInstDecl p)
-> [GenLocated l (DataFamInstDecl p)]
-> [GenLocated l (DataFamInstDecl p)]
forall a. a -> [a] -> [a]
: [GenLocated l (DataFamInstDecl p)]
dfis, [GenLocated l (DocDecl p)]
docs)
        DocD XDocD p
_ DocDecl p
d
          -> ([DeclTag]
tags, [GenLocated l (HsBind p)]
bs, [GenLocated l (Sig p)]
ss, [GenLocated l (FamilyDecl p)]
ts, [GenLocated l (TyFamInstDecl p)]
tfis, [GenLocated l (DataFamInstDecl p)]
dfis, l -> DocDecl p -> GenLocated l (DocDecl p)
forall l e. l -> e -> GenLocated l e
L l
l DocDecl p
d GenLocated l (DocDecl p)
-> [GenLocated l (DocDecl p)] -> [GenLocated l (DocDecl p)]
forall a. a -> [a] -> [a]
: [GenLocated l (DocDecl p)]
docs)
        HsDecl p
_ -> String
-> ([DeclTag], [GenLocated l (HsBind p)], [GenLocated l (Sig p)],
    [GenLocated l (FamilyDecl p)], [GenLocated l (TyFamInstDecl p)],
    [GenLocated l (DataFamInstDecl p)], [GenLocated l (DocDecl p)])
forall a. HasCallStack => String -> a
error (String
 -> ([DeclTag], [GenLocated l (HsBind p)], [GenLocated l (Sig p)],
     [GenLocated l (FamilyDecl p)], [GenLocated l (TyFamInstDecl p)],
     [GenLocated l (DataFamInstDecl p)], [GenLocated l (DocDecl p)]))
-> String
-> ([DeclTag], [GenLocated l (HsBind p)], [GenLocated l (Sig p)],
    [GenLocated l (FamilyDecl p)], [GenLocated l (TyFamInstDecl p)],
    [GenLocated l (DataFamInstDecl p)], [GenLocated l (DocDecl p)])
forall a b. (a -> b) -> a -> b
$ String
"partitionBindsAndSigs" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HsDecl p -> String
forall a. Data a => a -> String
showAst HsDecl p
decl)


-- ---------------------------------------------------------------------

orderedDeclsBinds
  :: AnnSortKey BindTag
  -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
  -> [LHsDecl GhcPs]
orderedDeclsBinds :: AnnSortKey BindTag
-> [LHsDecl GhcPs] -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
orderedDeclsBinds AnnSortKey BindTag
sortKey [LHsDecl GhcPs]
binds [LHsDecl GhcPs]
sigs =
  case AnnSortKey BindTag
sortKey of
    AnnSortKey BindTag
NoAnnSortKey ->
      (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\GenLocated SrcSpanAnnA (HsDecl GhcPs)
a GenLocated SrcSpanAnnA (HsDecl GhcPs)
b -> RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
a)
                              (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
b)) ([LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
binds [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sigs)
    AnnSortKey [BindTag]
keys ->
      let
        go :: [BindTag] -> [a] -> [a] -> [a]
go [] [a]
_ [a]
_                      = []
        go (BindTag
BindTag:[BindTag]
ks) (a
b:[a]
bs) [a]
ss = a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [BindTag] -> [a] -> [a] -> [a]
go [BindTag]
ks [a]
bs [a]
ss
        go (BindTag
SigDTag:[BindTag]
ks) [a]
bs (a
s:[a]
ss) = a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [BindTag] -> [a] -> [a] -> [a]
go [BindTag]
ks [a]
bs [a]
ss
        go (BindTag
_:[BindTag]
ks) [a]
bs [a]
ss           =     [BindTag] -> [a] -> [a] -> [a]
go [BindTag]
ks [a]
bs [a]
ss
      in
        [BindTag]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall {a}. [BindTag] -> [a] -> [a] -> [a]
go [BindTag]
keys [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
binds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sigs

hsDeclsLocalBinds :: HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds :: HsLocalBinds GhcPs -> [LHsDecl GhcPs]
hsDeclsLocalBinds HsLocalBinds GhcPs
lb = case HsLocalBinds GhcPs
lb of
    HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
sortKey LHsBinds GhcPs
bs [LSig GhcPs]
sigs) ->
      let
        bds :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bds = (GenLocated SrcSpanAnnA (HsBind GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LHsBind GhcPs -> LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsBind GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
wrapDecl LHsBinds GhcPs
[GenLocated SrcSpanAnnA (HsBind GhcPs)]
bs
        sds :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sds = (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LSig GhcPs -> LHsDecl GhcPs
GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
wrapSig [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs
      in
        AnnSortKey BindTag
-> [LHsDecl GhcPs] -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
orderedDeclsBinds XValBinds GhcPs GhcPs
AnnSortKey BindTag
sortKey [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sds
    HsValBinds XHsValBinds GhcPs GhcPs
_ (XValBindsLR XXValBindsLR GhcPs GhcPs
_) -> String -> [LHsDecl GhcPs]
forall a. HasCallStack => String -> a
error (String -> [LHsDecl GhcPs]) -> String -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ String
"hsDecls.XValBindsLR not valid"
    HsIPBinds {}       -> []
    EmptyLocalBinds {} -> []

hsDeclsValBinds :: (HsValBindsLR GhcPs GhcPs) -> [LHsDecl GhcPs]
hsDeclsValBinds :: HsValBindsLR GhcPs GhcPs -> [LHsDecl GhcPs]
hsDeclsValBinds (ValBinds XValBinds GhcPs GhcPs
sortKey LHsBinds GhcPs
bs [LSig GhcPs]
sigs) =
      let
        bds :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bds = (GenLocated SrcSpanAnnA (HsBind GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LHsBind GhcPs -> LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsBind GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
wrapDecl LHsBinds GhcPs
[GenLocated SrcSpanAnnA (HsBind GhcPs)]
bs
        sds :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sds = (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LSig GhcPs -> LHsDecl GhcPs
GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
wrapSig [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs
      in
        AnnSortKey BindTag
-> [LHsDecl GhcPs] -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
orderedDeclsBinds XValBinds GhcPs GhcPs
AnnSortKey BindTag
sortKey [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
bds [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
sds
hsDeclsValBinds XValBindsLR{} = String -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. HasCallStack => String -> a
error String
"hsDeclsValBinds"

-- ---------------------------------------------------------------------

-- |Pure function to convert a 'LHsDecl' to a 'LHsBind'. This does
-- nothing to any annotations that may be attached to either of the elements.
-- It is used as a utility function in 'replaceDecls'
decl2Bind :: LHsDecl GhcPs -> [LHsBind GhcPs]
decl2Bind :: LHsDecl GhcPs -> LHsBinds GhcPs
decl2Bind (L SrcSpanAnnA
l (ValD XValD GhcPs
_ HsBind GhcPs
s)) = [SrcSpanAnnA
-> HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBind GhcPs
s]
decl2Bind LHsDecl GhcPs
_                      = []

-- |Pure function to convert a 'LSig' to a 'LHsBind'. This does
-- nothing to any annotations that may be attached to either of the elements.
-- It is used as a utility function in 'replaceDecls'
decl2Sig :: LHsDecl GhcPs -> [LSig GhcPs]
decl2Sig :: LHsDecl GhcPs -> [LSig GhcPs]
decl2Sig (L SrcSpanAnnA
l (SigD XSigD GhcPs
_ Sig GhcPs
s)) = [SrcSpanAnnA -> Sig GhcPs -> GenLocated SrcSpanAnnA (Sig GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Sig GhcPs
s]
decl2Sig LHsDecl GhcPs
_                = []

-- ---------------------------------------------------------------------

-- |Convert a 'LSig' into a 'LHsDecl'
wrapSig :: LSig GhcPs -> LHsDecl GhcPs
wrapSig :: LSig GhcPs -> LHsDecl GhcPs
wrapSig (L SrcSpanAnnA
l Sig GhcPs
s) = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
NoExtField
NoExtField Sig GhcPs
s)

-- ---------------------------------------------------------------------

-- |Convert a 'LHsBind' into a 'LHsDecl'
wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs
wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs
wrapDecl (L SrcSpanAnnA
l HsBind GhcPs
s) = SrcSpanAnnA
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
NoExtField
NoExtField HsBind GhcPs
s)

-- ---------------------------------------------------------------------

showAst :: (Data a) => a -> String
showAst :: forall a. Data a => a -> String
showAst a
ast
  = SDoc -> String
showSDocUnsafe
    (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
forall a. Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
showAstData BlankSrcSpan
BlankSrcSpanFile BlankEpAnnotations
NoBlankEpAnnotations a
ast