{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

module HIndent.Ast.WithComments
  ( WithComments
  , prettyWith
  , fromGenLocated
  , fromEpAnn
  , mkWithComments
  , getNode
  ) where

import Control.Monad
import Control.Monad.RWS
import qualified GHC.Hs as GHC
import qualified GHC.Types.SrcLoc as GHC
import HIndent.Ast.NodeComments (NodeComments(..))
import qualified HIndent.Ast.NodeComments as NodeComments
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
import HIndent.Printer

data WithComments a = WithComments
  { forall a. WithComments a -> NodeComments
comments :: NodeComments
  , forall a. WithComments a -> a
node :: a
  } deriving ((forall m. Monoid m => WithComments m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithComments a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithComments a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithComments a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithComments a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithComments a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithComments a -> b)
-> (forall a. (a -> a -> a) -> WithComments a -> a)
-> (forall a. (a -> a -> a) -> WithComments a -> a)
-> (forall a. WithComments a -> [a])
-> (forall a. WithComments a -> Bool)
-> (forall a. WithComments a -> Int)
-> (forall a. Eq a => a -> WithComments a -> Bool)
-> (forall a. Ord a => WithComments a -> a)
-> (forall a. Ord a => WithComments a -> a)
-> (forall a. Num a => WithComments a -> a)
-> (forall a. Num a => WithComments a -> a)
-> Foldable WithComments
forall a. Eq a => a -> WithComments a -> Bool
forall a. Num a => WithComments a -> a
forall a. Ord a => WithComments a -> a
forall m. Monoid m => WithComments m -> m
forall a. WithComments a -> Bool
forall a. WithComments a -> Int
forall a. WithComments a -> [a]
forall a. (a -> a -> a) -> WithComments a -> a
forall m a. Monoid m => (a -> m) -> WithComments a -> m
forall b a. (b -> a -> b) -> b -> WithComments a -> b
forall a b. (a -> b -> b) -> b -> WithComments a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithComments m -> m
fold :: forall m. Monoid m => WithComments m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithComments a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithComments a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithComments a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithComments a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithComments a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithComments a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithComments a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithComments a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithComments a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithComments a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithComments a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithComments a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithComments a -> a
foldr1 :: forall a. (a -> a -> a) -> WithComments a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithComments a -> a
foldl1 :: forall a. (a -> a -> a) -> WithComments a -> a
$ctoList :: forall a. WithComments a -> [a]
toList :: forall a. WithComments a -> [a]
$cnull :: forall a. WithComments a -> Bool
null :: forall a. WithComments a -> Bool
$clength :: forall a. WithComments a -> Int
length :: forall a. WithComments a -> Int
$celem :: forall a. Eq a => a -> WithComments a -> Bool
elem :: forall a. Eq a => a -> WithComments a -> Bool
$cmaximum :: forall a. Ord a => WithComments a -> a
maximum :: forall a. Ord a => WithComments a -> a
$cminimum :: forall a. Ord a => WithComments a -> a
minimum :: forall a. Ord a => WithComments a -> a
$csum :: forall a. Num a => WithComments a -> a
sum :: forall a. Num a => WithComments a -> a
$cproduct :: forall a. Num a => WithComments a -> a
product :: forall a. Num a => WithComments a -> a
Foldable, Functor WithComments
Foldable WithComments
(Functor WithComments, Foldable WithComments) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WithComments a -> f (WithComments b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithComments (f a) -> f (WithComments a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WithComments a -> m (WithComments b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithComments (m a) -> m (WithComments a))
-> Traversable WithComments
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithComments (m a) -> m (WithComments a)
forall (f :: * -> *) a.
Applicative f =>
WithComments (f a) -> f (WithComments a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithComments a -> m (WithComments b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithComments a -> f (WithComments b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithComments a -> f (WithComments b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithComments a -> f (WithComments b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithComments (f a) -> f (WithComments a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithComments (f a) -> f (WithComments a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithComments a -> m (WithComments b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithComments a -> m (WithComments b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithComments (m a) -> m (WithComments a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WithComments (m a) -> m (WithComments a)
Traversable, WithComments a -> WithComments a -> Bool
(WithComments a -> WithComments a -> Bool)
-> (WithComments a -> WithComments a -> Bool)
-> Eq (WithComments a)
forall a. Eq a => WithComments a -> WithComments a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithComments a -> WithComments a -> Bool
== :: WithComments a -> WithComments a -> Bool
$c/= :: forall a. Eq a => WithComments a -> WithComments a -> Bool
/= :: WithComments a -> WithComments a -> Bool
Eq)

instance Functor WithComments where
  fmap :: forall a b. (a -> b) -> WithComments a -> WithComments b
fmap a -> b
f WithComments {a
NodeComments
comments :: forall a. WithComments a -> NodeComments
node :: forall a. WithComments a -> a
comments :: NodeComments
node :: a
..} = NodeComments -> b -> WithComments b
forall a. NodeComments -> a -> WithComments a
WithComments NodeComments
comments (a -> b
f a
node)

instance CommentExtraction (WithComments a) where
  nodeComments :: WithComments a -> NodeComments
nodeComments WithComments {a
NodeComments
comments :: forall a. WithComments a -> NodeComments
node :: forall a. WithComments a -> a
comments :: NodeComments
node :: a
..} = NodeComments
comments

instance (Pretty a) => Pretty (WithComments a) where
  pretty' :: WithComments a -> Printer ()
pretty' WithComments {a
NodeComments
comments :: forall a. WithComments a -> NodeComments
node :: forall a. WithComments a -> a
comments :: NodeComments
node :: a
..} = a -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty' a
node

-- | Prints comments included in the location information and then the
-- AST node body.
prettyWith :: WithComments a -> (a -> Printer ()) -> Printer ()
prettyWith :: forall a. WithComments a -> (a -> Printer ()) -> Printer ()
prettyWith WithComments {a
NodeComments
comments :: forall a. WithComments a -> NodeComments
node :: forall a. WithComments a -> a
comments :: NodeComments
node :: a
..} a -> Printer ()
f = do
  NodeComments -> Printer ()
printCommentsBefore NodeComments
comments
  a -> Printer ()
f a
node
  NodeComments -> Printer ()
printCommentOnSameLine NodeComments
comments
  NodeComments -> Printer ()
printCommentsAfter NodeComments
comments

-- | Prints comments that are before the given AST node.
printCommentsBefore :: NodeComments -> Printer ()
printCommentsBefore :: NodeComments -> Printer ()
printCommentsBefore NodeComments
p =
  [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (NodeComments -> [LEpaComment]
commentsBefore NodeComments
p) ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(GHC.L EpaLocation' NoComments
loc EpaComment
c) -> do
    let col :: Int64
col = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
GHC.srcSpanStartCol (EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
GHC.anchor EpaLocation' NoComments
loc) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ EpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty EpaComment
c
    Printer ()
newline

-- | Prints comments that are on the same line as the given AST node.
printCommentOnSameLine :: NodeComments -> Printer ()
printCommentOnSameLine :: NodeComments -> Printer ()
printCommentOnSameLine (NodeComments -> [LEpaComment]
commentsOnSameLine -> (LEpaComment
c:[LEpaComment]
cs)) = do
  Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
  if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
    then Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel
           (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
GHC.srcSpanStartCol (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
GHC.anchor (EpaLocation' NoComments -> RealSrcSpan)
-> EpaLocation' NoComments -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaLocation' NoComments
forall l e. GenLocated l e -> l
GHC.getLoc LEpaComment
c)
           (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
spaced
           ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LEpaComment -> Printer ()) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LEpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty
           ([LEpaComment] -> [Printer ()]) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ LEpaComment
c LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
: [LEpaComment]
cs
    else [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LEpaComment -> Printer ()) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LEpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ([LEpaComment] -> [Printer ()]) -> [LEpaComment] -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ LEpaComment
c LEpaComment -> [LEpaComment] -> [LEpaComment]
forall a. a -> [a] -> [a]
: [LEpaComment]
cs
  Printer ()
eolCommentsArePrinted
printCommentOnSameLine NodeComments
_ = () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Prints comments that are after the given AST node.
printCommentsAfter :: NodeComments -> Printer ()
printCommentsAfter :: NodeComments -> Printer ()
printCommentsAfter NodeComments
p =
  case NodeComments -> [LEpaComment]
commentsAfter NodeComments
p of
    [] -> () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [LEpaComment]
xs -> do
      Bool
isThereCommentsOnSameLine <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
      Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isThereCommentsOnSameLine Printer ()
newline
      [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LEpaComment]
xs ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(GHC.L EpaLocation' NoComments
loc EpaComment
c) -> do
        let col :: Int64
col = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
GHC.srcSpanStartCol (EpaLocation' NoComments -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
GHC.anchor EpaLocation' NoComments
loc) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indentedWithFixedLevel Int64
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ EpaComment -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty EpaComment
c
        Printer ()
eolCommentsArePrinted

fromGenLocated :: (CommentExtraction l) => GHC.GenLocated l a -> WithComments a
fromGenLocated :: forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GHC.L l
l a
a) = NodeComments -> a -> WithComments a
forall a. NodeComments -> a -> WithComments a
WithComments (l -> NodeComments
forall a. CommentExtraction a => a -> NodeComments
nodeComments l
l) a
a

fromEpAnn :: GHC.EpAnn a -> b -> WithComments b
fromEpAnn :: forall a b. EpAnn a -> b -> WithComments b
fromEpAnn EpAnn a
ann = NodeComments -> b -> WithComments b
forall a. NodeComments -> a -> WithComments a
WithComments (EpAnn a -> NodeComments
forall a. EpAnn a -> NodeComments
NodeComments.fromEpAnn EpAnn a
ann)

mkWithComments :: a -> WithComments a
mkWithComments :: forall a. a -> WithComments a
mkWithComments = NodeComments -> a -> WithComments a
forall a. NodeComments -> a -> WithComments a
WithComments NodeComments
forall a. Monoid a => a
mempty

getNode :: WithComments a -> a
getNode :: forall a. WithComments a -> a
getNode = WithComments a -> a
forall a. WithComments a -> a
node