{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.NodeComments
  ( NodeComments(..)
  , fromEpAnn
  ) where

import qualified GHC.Hs as GHC
import qualified GHC.Types.SrcLoc as GHC
import HIndent.Pragma

-- | Comments belonging to an AST node.
data NodeComments = NodeComments
  { NodeComments -> [LEpaComment]
commentsBefore :: [GHC.LEpaComment]
  , NodeComments -> [LEpaComment]
commentsOnSameLine :: [GHC.LEpaComment]
  , NodeComments -> [LEpaComment]
commentsAfter :: [GHC.LEpaComment]
  } deriving (NodeComments -> NodeComments -> Bool
(NodeComments -> NodeComments -> Bool)
-> (NodeComments -> NodeComments -> Bool) -> Eq NodeComments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeComments -> NodeComments -> Bool
== :: NodeComments -> NodeComments -> Bool
$c/= :: NodeComments -> NodeComments -> Bool
/= :: NodeComments -> NodeComments -> Bool
Eq)

instance Semigroup NodeComments where
  NodeComments
x <> :: NodeComments -> NodeComments -> NodeComments
<> NodeComments
y =
    NodeComments
      { commentsBefore :: [LEpaComment]
commentsBefore = NodeComments -> [LEpaComment]
commentsBefore NodeComments
x [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. Semigroup a => a -> a -> a
<> NodeComments -> [LEpaComment]
commentsBefore NodeComments
y
      , commentsOnSameLine :: [LEpaComment]
commentsOnSameLine = NodeComments -> [LEpaComment]
commentsOnSameLine NodeComments
x [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. Semigroup a => a -> a -> a
<> NodeComments -> [LEpaComment]
commentsOnSameLine NodeComments
y
      , commentsAfter :: [LEpaComment]
commentsAfter = NodeComments -> [LEpaComment]
commentsAfter NodeComments
x [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. Semigroup a => a -> a -> a
<> NodeComments -> [LEpaComment]
commentsAfter NodeComments
y
      }

instance Monoid NodeComments where
  mempty :: NodeComments
mempty =
    NodeComments
      {commentsBefore :: [LEpaComment]
commentsBefore = [], commentsOnSameLine :: [LEpaComment]
commentsOnSameLine = [], commentsAfter :: [LEpaComment]
commentsAfter = []}

fromEpAnn :: GHC.EpAnn a -> NodeComments
fromEpAnn :: forall a. EpAnn a -> NodeComments
fromEpAnn = EpAnn a -> NodeComments
forall a. EpAnn a -> NodeComments
fromEpAnn' (EpAnn a -> NodeComments)
-> (EpAnn a -> EpAnn a) -> EpAnn a -> NodeComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAnn a -> EpAnn a
forall ann. EpAnn ann -> EpAnn ann
filterOutEofAndPragmasFromAnn

fromEpAnn' :: GHC.EpAnn a -> NodeComments
fromEpAnn' :: forall a. EpAnn a -> NodeComments
fromEpAnn' GHC.EpAnn {a
Anchor
EpAnnComments
entry :: Anchor
anns :: a
comments :: EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
anns :: forall ann. EpAnn ann -> ann
entry :: forall ann. EpAnn ann -> Anchor
..} = NodeComments {[LEpaComment]
commentsBefore :: [LEpaComment]
commentsOnSameLine :: [LEpaComment]
commentsAfter :: [LEpaComment]
commentsBefore :: [LEpaComment]
commentsOnSameLine :: [LEpaComment]
commentsAfter :: [LEpaComment]
..}
  where
    commentsBefore :: [LEpaComment]
commentsBefore = EpAnnComments -> [LEpaComment]
GHC.priorComments EpAnnComments
comments
    commentsOnSameLine :: [LEpaComment]
commentsOnSameLine =
      (LEpaComment -> Bool) -> [LEpaComment] -> [LEpaComment]
forall a. (a -> Bool) -> [a] -> [a]
filter LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
isCommentOnSameLine ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
GHC.getFollowingComments EpAnnComments
comments
    commentsAfter :: [LEpaComment]
commentsAfter =
      (LEpaComment -> Bool) -> [LEpaComment] -> [LEpaComment]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (LEpaComment -> Bool) -> LEpaComment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEpaComment -> Bool
forall {a} {e}. GenLocated (EpaLocation' a) e -> Bool
isCommentOnSameLine) ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
GHC.getFollowingComments EpAnnComments
comments
    isCommentOnSameLine :: GenLocated (EpaLocation' a) e -> Bool
isCommentOnSameLine (GHC.L EpaLocation' a
comAnn e
_) =
      RealSrcSpan -> Int
GHC.srcSpanEndLine (Anchor -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
GHC.anchor Anchor
entry)
        Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
GHC.srcSpanStartLine (EpaLocation' a -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
GHC.anchor EpaLocation' a
comAnn)
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
fromEpAnn' GHC.EpAnnNotUsed = NodeComments [] [] []
#endif
filterOutEofAndPragmasFromAnn :: GHC.EpAnn ann -> GHC.EpAnn ann
filterOutEofAndPragmasFromAnn :: forall ann. EpAnn ann -> EpAnn ann
filterOutEofAndPragmasFromAnn GHC.EpAnn {ann
Anchor
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
anns :: forall ann. EpAnn ann -> ann
entry :: forall ann. EpAnn ann -> Anchor
entry :: Anchor
anns :: ann
comments :: EpAnnComments
..} =
  GHC.EpAnn {comments :: EpAnnComments
comments = EpAnnComments -> EpAnnComments
filterOutEofAndPragmasFromComments EpAnnComments
comments, ann
Anchor
anns :: ann
entry :: Anchor
entry :: Anchor
anns :: ann
..}
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
filterOutEofAndPragmasFromAnn GHC.EpAnnNotUsed = GHC.EpAnnNotUsed
#endif
filterOutEofAndPragmasFromComments :: GHC.EpAnnComments -> GHC.EpAnnComments
filterOutEofAndPragmasFromComments :: EpAnnComments -> EpAnnComments
filterOutEofAndPragmasFromComments EpAnnComments
comments =
  GHC.EpaCommentsBalanced
    { priorComments :: [LEpaComment]
priorComments = [LEpaComment] -> [LEpaComment]
forall l. [GenLocated l EpaComment] -> [GenLocated l EpaComment]
filterOutEofAndPragmas ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
GHC.priorComments EpAnnComments
comments
    , followingComments :: [LEpaComment]
followingComments =
        [LEpaComment] -> [LEpaComment]
forall l. [GenLocated l EpaComment] -> [GenLocated l EpaComment]
filterOutEofAndPragmas ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
GHC.getFollowingComments EpAnnComments
comments
    }

filterOutEofAndPragmas ::
     [GHC.GenLocated l GHC.EpaComment] -> [GHC.GenLocated l GHC.EpaComment]
filterOutEofAndPragmas :: forall l. [GenLocated l EpaComment] -> [GenLocated l EpaComment]
filterOutEofAndPragmas = (GenLocated l EpaComment -> Bool)
-> [GenLocated l EpaComment] -> [GenLocated l EpaComment]
forall a. (a -> Bool) -> [a] -> [a]
filter GenLocated l EpaComment -> Bool
forall l. GenLocated l EpaComment -> Bool
isNeitherEofNorPragmaComment

isNeitherEofNorPragmaComment :: GHC.GenLocated l GHC.EpaComment -> Bool
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
isNeitherEofNorPragmaComment (GHC.L _ (GHC.EpaComment GHC.EpaEofComment _)) =
  False
#endif
isNeitherEofNorPragmaComment :: forall l. GenLocated l EpaComment -> Bool
isNeitherEofNorPragmaComment (GHC.L l
_ (GHC.EpaComment EpaCommentTok
tok RealSrcSpan
_)) =
  Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ EpaCommentTok -> Bool
isPragma EpaCommentTok
tok