{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Comment handling.
module Floskell.Comments ( filterCommentLike, annotateWithComments ) where

import           Control.Arrow                ( first, second )
import           Control.Monad.State.Strict

import           Data.Foldable                ( traverse_ )
import           Data.List                    ( foldl', isPrefixOf )
import qualified Data.Map.Strict              as M
import           Data.Text.Lazy               ( Text )
import qualified Data.Text.Lazy               as TL

import           Floskell.Types

import           Language.Haskell.Exts.SrcLoc ( SrcSpanInfo(..) )

data FilterMode = Normal | CppContinuation | Unformatted
    deriving ( FilterMode -> FilterMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterMode -> FilterMode -> Bool
$c/= :: FilterMode -> FilterMode -> Bool
== :: FilterMode -> FilterMode -> Bool
$c== :: FilterMode -> FilterMode -> Bool
Eq, Eq FilterMode
FilterMode -> FilterMode -> Bool
FilterMode -> FilterMode -> Ordering
FilterMode -> FilterMode -> FilterMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FilterMode -> FilterMode -> FilterMode
$cmin :: FilterMode -> FilterMode -> FilterMode
max :: FilterMode -> FilterMode -> FilterMode
$cmax :: FilterMode -> FilterMode -> FilterMode
>= :: FilterMode -> FilterMode -> Bool
$c>= :: FilterMode -> FilterMode -> Bool
> :: FilterMode -> FilterMode -> Bool
$c> :: FilterMode -> FilterMode -> Bool
<= :: FilterMode -> FilterMode -> Bool
$c<= :: FilterMode -> FilterMode -> Bool
< :: FilterMode -> FilterMode -> Bool
$c< :: FilterMode -> FilterMode -> Bool
compare :: FilterMode -> FilterMode -> Ordering
$ccompare :: FilterMode -> FilterMode -> Ordering
Ord, Int -> FilterMode
FilterMode -> Int
FilterMode -> [FilterMode]
FilterMode -> FilterMode
FilterMode -> FilterMode -> [FilterMode]
FilterMode -> FilterMode -> FilterMode -> [FilterMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FilterMode -> FilterMode -> FilterMode -> [FilterMode]
$cenumFromThenTo :: FilterMode -> FilterMode -> FilterMode -> [FilterMode]
enumFromTo :: FilterMode -> FilterMode -> [FilterMode]
$cenumFromTo :: FilterMode -> FilterMode -> [FilterMode]
enumFromThen :: FilterMode -> FilterMode -> [FilterMode]
$cenumFromThen :: FilterMode -> FilterMode -> [FilterMode]
enumFrom :: FilterMode -> [FilterMode]
$cenumFrom :: FilterMode -> [FilterMode]
fromEnum :: FilterMode -> Int
$cfromEnum :: FilterMode -> Int
toEnum :: Int -> FilterMode
$ctoEnum :: Int -> FilterMode
pred :: FilterMode -> FilterMode
$cpred :: FilterMode -> FilterMode
succ :: FilterMode -> FilterMode
$csucc :: FilterMode -> FilterMode
Enum, Int -> FilterMode -> ShowS
[FilterMode] -> ShowS
FilterMode -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FilterMode] -> ShowS
$cshowList :: [FilterMode] -> ShowS
show :: FilterMode -> [Char]
$cshow :: FilterMode -> [Char]
showsPrec :: Int -> FilterMode -> ShowS
$cshowsPrec :: Int -> FilterMode -> ShowS
Show )

data FilterState = FilterState { FilterState -> FilterMode
stMode     :: !FilterMode
                               , FilterState -> [Text]
stLines    :: [Text]
                               , FilterState -> [Comment]
stComments :: [Comment]
                               }
    deriving ( Int -> FilterState -> ShowS
[FilterState] -> ShowS
FilterState -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FilterState] -> ShowS
$cshowList :: [FilterState] -> ShowS
show :: FilterState -> [Char]
$cshow :: FilterState -> [Char]
showsPrec :: Int -> FilterState -> ShowS
$cshowsPrec :: Int -> FilterState -> ShowS
Show )

-- Order by start of span, larger spans before smaller spans.
newtype OrderByStart = OrderByStart SrcSpan
    deriving ( OrderByStart -> OrderByStart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderByStart -> OrderByStart -> Bool
$c/= :: OrderByStart -> OrderByStart -> Bool
== :: OrderByStart -> OrderByStart -> Bool
$c== :: OrderByStart -> OrderByStart -> Bool
Eq )

instance Ord OrderByStart where
    compare :: OrderByStart -> OrderByStart -> Ordering
compare (OrderByStart SrcSpan
l) (OrderByStart SrcSpan
r) =
        forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanStartLine SrcSpan
l) (SrcSpan -> Int
srcSpanStartLine SrcSpan
r)
        forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanStartColumn SrcSpan
l) (SrcSpan -> Int
srcSpanStartColumn SrcSpan
r)
        forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanEndLine SrcSpan
r) (SrcSpan -> Int
srcSpanEndLine SrcSpan
l)
        forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanEndColumn SrcSpan
r) (SrcSpan -> Int
srcSpanEndColumn SrcSpan
l)

-- Order by end of span, smaller spans before larger spans.
newtype OrderByEnd = OrderByEnd SrcSpan
    deriving ( OrderByEnd -> OrderByEnd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderByEnd -> OrderByEnd -> Bool
$c/= :: OrderByEnd -> OrderByEnd -> Bool
== :: OrderByEnd -> OrderByEnd -> Bool
$c== :: OrderByEnd -> OrderByEnd -> Bool
Eq )

instance Ord OrderByEnd where
    compare :: OrderByEnd -> OrderByEnd -> Ordering
compare (OrderByEnd SrcSpan
l) (OrderByEnd SrcSpan
r) =
        forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanEndLine SrcSpan
l) (SrcSpan -> Int
srcSpanEndLine SrcSpan
r)
        forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanEndColumn SrcSpan
l) (SrcSpan -> Int
srcSpanEndColumn SrcSpan
r)
        forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanStartLine SrcSpan
r) (SrcSpan -> Int
srcSpanStartLine SrcSpan
l)
        forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare (SrcSpan -> Int
srcSpanStartColumn SrcSpan
r) (SrcSpan -> Int
srcSpanStartColumn SrcSpan
l)

-- | Remove comment-like blocks from input source, replacing them with
-- blank likes to keep SrcSpan information intact.
filterCommentLike :: [Text] -> ([Text], [Comment])
filterCommentLike :: [Text] -> ([Text], [Comment])
filterCommentLike = FilterState -> ([Text], [Comment])
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FilterState -> (Int, Text) -> FilterState
go FilterState
start forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [ Int
1 .. ]
  where
    start :: FilterState
start = FilterMode -> [Text] -> [Comment] -> FilterState
FilterState FilterMode
Normal [] []

    go :: FilterState -> (Int, Text) -> FilterState
go s :: FilterState
s@FilterState{[Text]
[Comment]
FilterMode
stComments :: [Comment]
stLines :: [Text]
stMode :: FilterMode
stComments :: FilterState -> [Comment]
stLines :: FilterState -> [Text]
stMode :: FilterState -> FilterMode
..} (Int
n, Text
l) = case FilterMode
stMode of
        FilterMode
Normal -> if
            | Text -> Bool
isShebangLine Text
l -> FilterState
-> FilterMode -> CommentType -> Int -> Text -> FilterState
addComment FilterState
s FilterMode
Normal CommentType
IgnoredLine Int
n Text
l
            | Text -> Bool
isCppLine Text
l ->
                let newMode :: FilterMode
newMode =
                        if Text -> Bool
isCppContinuation Text
l then FilterMode
CppContinuation else FilterMode
Normal
                in
                    FilterState
-> FilterMode -> CommentType -> Int -> Text -> FilterState
addComment FilterState
s FilterMode
newMode CommentType
PreprocessorDirective Int
n Text
l
            | Text -> Bool
isBeginIgnore Text
l -> FilterState
-> FilterMode -> CommentType -> Int -> Text -> FilterState
addComment FilterState
s FilterMode
Unformatted CommentType
IgnoredLine Int
n Text
l
            | Bool
otherwise -> FilterState -> Text -> FilterState
addLine FilterState
s Text
l

        FilterMode
CppContinuation ->
            let newMode :: FilterMode
newMode =
                    if Text -> Bool
isCppContinuation Text
l then FilterMode
CppContinuation else FilterMode
Normal
            in
                FilterState
-> FilterMode -> CommentType -> Int -> Text -> FilterState
addComment FilterState
s FilterMode
newMode CommentType
PreprocessorDirective Int
n Text
l

        FilterMode
Unformatted ->
            let newMode :: FilterMode
newMode = if Text -> Bool
isEndIgnore Text
l then FilterMode
Normal else FilterMode
Unformatted
            in
                FilterState
-> FilterMode -> CommentType -> Int -> Text -> FilterState
addComment FilterState
s FilterMode
newMode CommentType
IgnoredLine Int
n Text
l

    finish :: FilterState -> ([Text], [Comment])
finish FilterState
s = (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ FilterState -> [Text]
stLines FilterState
s, forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ FilterState -> [Comment]
stComments FilterState
s)

    addLine :: FilterState -> Text -> FilterState
addLine s :: FilterState
s@FilterState{[Text]
[Comment]
FilterMode
stComments :: [Comment]
stLines :: [Text]
stMode :: FilterMode
stComments :: FilterState -> [Comment]
stLines :: FilterState -> [Text]
stMode :: FilterState -> FilterMode
..} Text
l = FilterState
s { stLines :: [Text]
stLines = Text
l forall a. a -> [a] -> [a]
: [Text]
stLines }

    addComment :: FilterState
-> FilterMode -> CommentType -> Int -> Text -> FilterState
addComment s :: FilterState
s@FilterState{[Text]
[Comment]
FilterMode
stComments :: [Comment]
stLines :: [Text]
stMode :: FilterMode
stComments :: FilterState -> [Comment]
stLines :: FilterState -> [Text]
stMode :: FilterState -> FilterMode
..} FilterMode
mode CommentType
t Int
n Text
l =
        FilterState
s { stMode :: FilterMode
stMode     = FilterMode
mode
          , stLines :: [Text]
stLines    = Text
"" forall a. a -> [a] -> [a]
: [Text]
stLines
          , stComments :: [Comment]
stComments = CommentType -> Int -> Text -> Comment
makeComment CommentType
t Int
n Text
l forall a. a -> [a] -> [a]
: [Comment]
stComments
          }

    makeComment :: CommentType -> Int -> Text -> Comment
makeComment CommentType
t Int
n Text
l =
        CommentType -> SrcSpan -> [Char] -> Comment
Comment CommentType
t
                ([Char] -> Int -> Int -> Int -> Int -> SrcSpan
SrcSpan [Char]
"" Int
n Int
1 Int
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Int64
TL.length Text
l forall a. Num a => a -> a -> a
+ Int64
1))
                (Text -> [Char]
TL.unpack Text
l)

    isShebangLine :: Text -> Bool
isShebangLine = Text -> Text -> Bool
TL.isPrefixOf Text
"#!"

    isCppLine :: Text -> Bool
isCppLine Text
src =
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`TL.isPrefixOf` Text
src)
            [ Text
"#define"
            , Text
"#elif"
            , Text
"#else"
            , Text
"#end"
            , Text
"#enum"
            , Text
"#error"
            , Text
"#if"
            , Text
"#include"
            , Text
"#undef"
            , Text
"#warning"
            ]

    isCppContinuation :: Text -> Bool
isCppContinuation = Text -> Text -> Bool
TL.isSuffixOf Text
"\\"

    isBeginIgnore :: Text -> Bool
isBeginIgnore Text
src = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`TL.isPrefixOf` Text
src)
                            [ Text
"-- floskell-begin-disable-region"
                            , Text
"-- floskell-disable"
                            , Text
"{- floskell-disable"
                            ]

    isEndIgnore :: Text -> Bool
isEndIgnore Text
src = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`TL.isPrefixOf` Text
src)
                          [ Text
"-- floskell-end-disable-region"
                          , Text
"-- floskell-enable"
                          , Text
"{- floskell-enable"
                          ]

onSameLine :: SrcSpan -> SrcSpan -> Bool
onSameLine :: SrcSpan -> SrcSpan -> Bool
onSameLine SrcSpan
ss SrcSpan
ss' = SrcSpan -> Int
srcSpanEndLine SrcSpan
ss forall a. Eq a => a -> a -> Bool
== SrcSpan -> Int
srcSpanStartLine SrcSpan
ss'

isAfterComment :: Comment -> Bool
isAfterComment :: Comment -> Bool
isAfterComment (Comment CommentType
PreprocessorDirective SrcSpan
_ [Char]
str) = [Char]
"#endif" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
str
isAfterComment (Comment CommentType
_ SrcSpan
_ [Char]
str) =
    forall a. Int -> [a] -> [a]
take Int
1 (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'-') [Char]
str) forall a. Eq a => a -> a -> Bool
== [Char]
"^"

isAlignedWith :: Comment -> Comment -> Bool
isAlignedWith :: Comment -> Comment -> Bool
isAlignedWith (Comment CommentType
_ SrcSpan
before [Char]
_) (Comment CommentType
_ SrcSpan
after [Char]
_) =
    SrcSpan -> Int
srcSpanEndLine SrcSpan
before forall a. Eq a => a -> a -> Bool
== SrcSpan -> Int
srcSpanStartLine SrcSpan
after forall a. Num a => a -> a -> a
- Int
1
    Bool -> Bool -> Bool
&& SrcSpan -> Int
srcSpanStartColumn SrcSpan
before forall a. Eq a => a -> a -> Bool
== SrcSpan -> Int
srcSpanStartColumn SrcSpan
after

-- | Annotate the AST with comments.
annotateWithComments
    :: Traversable ast => ast SrcSpanInfo -> [Comment] -> ast NodeInfo
annotateWithComments :: forall (ast :: * -> *).
Traversable ast =>
ast SrcSpanInfo -> [Comment] -> ast NodeInfo
annotateWithComments ast SrcSpanInfo
src [Comment]
comments =
    forall s a. State s a -> s -> a
evalState (do
                   forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Comment -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
assignComment [Comment]
comments
                   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SrcSpanInfo
-> State (Map SrcSpanInfo ([Comment], [Comment])) NodeInfo
transferComments ast SrcSpanInfo
src)
              Map SrcSpanInfo ([Comment], [Comment])
nodeinfos
  where
    nodeinfos :: M.Map SrcSpanInfo ([Comment], [Comment])
    nodeinfos :: Map SrcSpanInfo ([Comment], [Comment])
nodeinfos = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SrcSpanInfo
ssi -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SrcSpanInfo
ssi ([], [])) forall k a. Map k a
M.empty ast SrcSpanInfo
src

    -- Assign a single comment to the right AST node
    assignComment
        :: Comment -> State (M.Map SrcSpanInfo ([Comment], [Comment])) ()
    assignComment :: Comment -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
assignComment comment :: Comment
comment@(Comment CommentType
_ SrcSpan
cspan [Char]
_) = case Comment -> (Maybe SrcSpanInfo, Maybe SrcSpanInfo)
surrounding Comment
comment of
        (Maybe SrcSpanInfo
Nothing, Maybe SrcSpanInfo
Nothing) -> forall a. HasCallStack => [Char] -> a
error [Char]
"No target nodes for comment"
        (Just SrcSpanInfo
before, Maybe SrcSpanInfo
Nothing) -> Location
-> SrcSpanInfo -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
insertComment Location
After SrcSpanInfo
before
        (Maybe SrcSpanInfo
Nothing, Just SrcSpanInfo
after) -> Location
-> SrcSpanInfo -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
insertComment Location
Before SrcSpanInfo
after
        (Just SrcSpanInfo
before, Just SrcSpanInfo
after) ->
            if SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
before SrcSpan -> SrcSpan -> Bool
`onSameLine` SrcSpan
cspan Bool -> Bool -> Bool
|| Comment -> Bool
isAfterComment Comment
comment
            then Location
-> SrcSpanInfo -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
insertComment Location
After SrcSpanInfo
before
            else do
                ([Comment], [Comment])
cmts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => Map k a -> k -> a
M.! SrcSpanInfo
before)
                case ([Comment], [Comment])
cmts of
                    -- We've already collected comments for this
                    -- node and this comment is a continuation.
                    ([Comment]
_, Comment
c' : [Comment]
_)
                        | Comment
c' Comment -> Comment -> Bool
`isAlignedWith` Comment
comment ->
                            Location
-> SrcSpanInfo -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
insertComment Location
After SrcSpanInfo
before

                    -- The comment does not belong to this node.
                    -- If there is a node following this comment,
                    -- assign it to that node, else keep it here,
                    -- anyway.
                    ([Comment], [Comment])
_ -> Location
-> SrcSpanInfo -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
insertComment Location
Before SrcSpanInfo
after
      where
        insertComment :: Location
                      -> SrcSpanInfo
                      -> State (M.Map SrcSpanInfo ([Comment], [Comment])) ()
        insertComment :: Location
-> SrcSpanInfo -> State (Map SrcSpanInfo ([Comment], [Comment])) ()
insertComment Location
Before SrcSpanInfo
ssi = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Comment
comment forall a. a -> [a] -> [a]
:)) SrcSpanInfo
ssi
        insertComment Location
After SrcSpanInfo
ssi = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Comment
comment forall a. a -> [a] -> [a]
:)) SrcSpanInfo
ssi

    -- Transfer collected comments into the AST.
    transferComments
        :: SrcSpanInfo
        -> State (M.Map SrcSpanInfo ([Comment], [Comment])) NodeInfo
    transferComments :: SrcSpanInfo
-> State (Map SrcSpanInfo ([Comment], [Comment])) NodeInfo
transferComments SrcSpanInfo
ssi = do
        ([Comment]
c, [Comment]
c') <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => Map k a -> k -> a
M.! SrcSpanInfo
ssi)
        -- Sometimes, there are multiple AST nodes with the same
        -- SrcSpan.  Make sure we assign comments to only one of
        -- them.
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SrcSpanInfo
ssi ([], [])
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SrcSpan -> [Comment] -> [Comment] -> NodeInfo
NodeInfo (SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
ssi) (forall a. [a] -> [a]
reverse [Comment]
c) (forall a. [a] -> [a]
reverse [Comment]
c')

    surrounding :: Comment -> (Maybe SrcSpanInfo, Maybe SrcSpanInfo)
surrounding (Comment CommentType
_ SrcSpan
ss [Char]
_) = (SrcSpan -> Maybe SrcSpanInfo
nodeBefore SrcSpan
ss, SrcSpan -> Maybe SrcSpanInfo
nodeAfter SrcSpan
ss)

    nodeBefore :: SrcSpan -> Maybe SrcSpanInfo
nodeBefore SrcSpan
ss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ SrcSpan -> OrderByEnd
OrderByEnd SrcSpan
ss forall k v. Ord k => k -> Map k v -> Maybe (k, v)
`M.lookupLT` Map OrderByEnd SrcSpanInfo
spansByEnd

    nodeAfter :: SrcSpan -> Maybe SrcSpanInfo
nodeAfter SrcSpan
ss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ SrcSpan -> OrderByStart
OrderByStart SrcSpan
ss forall k v. Ord k => k -> Map k v -> Maybe (k, v)
`M.lookupGT` Map OrderByStart SrcSpanInfo
spansByStart

    spansByStart :: Map OrderByStart SrcSpanInfo
spansByStart = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SrcSpanInfo
ssi -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (SrcSpan -> OrderByStart
OrderByStart forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
ssi) SrcSpanInfo
ssi)
                         forall k a. Map k a
M.empty
                         ast SrcSpanInfo
src

    spansByEnd :: Map OrderByEnd SrcSpanInfo
spansByEnd =
        forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SrcSpanInfo
ssi -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (SrcSpan -> OrderByEnd
OrderByEnd forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
ssi) SrcSpanInfo
ssi) forall k a. Map k a
M.empty ast SrcSpanInfo
src