{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Language.Cimple.PrettyComment
    ( ppCommentInfo
    ) where

import           Data.Fix                      (foldFix)
import           Data.List                     (dropWhile)
import qualified Data.List.Split               as List
import           Data.Text                     (Text)
import           Language.Cimple               (AssignOp (..), BinaryOp (..),
                                                Comment, CommentF (..),
                                                CommentStyle (..), Lexeme (..),
                                                LexemeClass (..), Node,
                                                NodeF (..), Nullability (..),
                                                Scope (..), UnaryOp (..),
                                                lexemeLine, lexemeText)
import           Language.Cimple.PrettyColor   (black, blue, cyan, dullcyan,
                                                dullgreen, dullmagenta, dullred,
                                                dullyellow, underline)
import           Language.Cimple.PrettyCommon
import           Prettyprinter
import           Prettyprinter.Render.Terminal (AnsiStyle)

ppCodeBody :: [Doc AnsiStyle] -> Doc AnsiStyle
ppCodeBody :: [Doc AnsiStyle] -> Doc AnsiStyle
ppCodeBody =
    [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat
    ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Doc AnsiStyle) -> [[Char]] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc AnsiStyle)
-> ([Char] -> [Char]) -> [Char] -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
" *" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>))
    ([[Char]] -> [Doc AnsiStyle])
-> ([Doc AnsiStyle] -> [[Char]])
-> [Doc AnsiStyle]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    ([[Char]] -> [[Char]])
-> ([Doc AnsiStyle] -> [[Char]]) -> [Doc AnsiStyle] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn [Char]
"\n"
    ([Char] -> [[Char]])
-> ([Doc AnsiStyle] -> [Char]) -> [Doc AnsiStyle] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Char]
renderS
    (Doc AnsiStyle -> [Char])
-> ([Doc AnsiStyle] -> Doc AnsiStyle) -> [Doc AnsiStyle] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
forall ann xxx. Doc ann -> Doc xxx
plain
    (Doc AnsiStyle -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat

ppCommentInfo :: Pretty a => Comment (Lexeme a) -> Doc AnsiStyle
ppCommentInfo :: Comment (Lexeme a) -> Doc AnsiStyle
ppCommentInfo = (CommentF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle)
-> Comment (Lexeme a) -> Doc AnsiStyle
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix CommentF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
forall a.
Pretty a =>
CommentF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
go
  where
  ppRef :: forall a. Pretty a => Lexeme a -> Doc AnsiStyle
  ppRef :: Lexeme a -> Doc AnsiStyle
ppRef      = Doc AnsiStyle -> Doc AnsiStyle
underline (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme a -> Doc AnsiStyle) -> Lexeme a -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
cyan (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme a -> Doc AnsiStyle) -> Lexeme a -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme
  ppAttr :: forall a. Pretty a => Maybe (Lexeme a) -> Doc AnsiStyle
  ppAttr :: Maybe (Lexeme a) -> Doc AnsiStyle
ppAttr     = Doc AnsiStyle
-> (Lexeme a -> Doc AnsiStyle) -> Maybe (Lexeme a) -> Doc AnsiStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc AnsiStyle
forall a. Monoid a => a
mempty (Doc AnsiStyle -> Doc AnsiStyle
blue (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme a -> Doc AnsiStyle) -> Lexeme a -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme)
  mapTail :: (a -> a) -> [a] -> [a]
mapTail a -> a
_ []     = []
  mapTail a -> a
f (a
x:[a]
xs) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
xs

  go :: Pretty a => CommentF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
  go :: CommentF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
go = \case
    DocComment [Doc AnsiStyle]
docs ->
        Doc AnsiStyle -> Doc AnsiStyle
dullyellow ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"/**") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        (if [Doc AnsiStyle] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc AnsiStyle]
docs then Doc AnsiStyle
forall a. Monoid a => a
mempty else [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat ((Doc AnsiStyle -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
align ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a b. (a -> b) -> a -> b
$ (Doc AnsiStyle -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. (a -> a) -> [a] -> [a]
mapTail ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" *" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>) [Doc AnsiStyle]
docs)) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> Doc AnsiStyle
dullyellow ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" */")

    DocWord Lexeme a
w -> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
w

    DocParam Maybe (Lexeme a)
attr Lexeme a
name ->
        Doc AnsiStyle
kwDocParam Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Maybe (Lexeme a) -> Doc AnsiStyle
forall a. Pretty a => Maybe (Lexeme a) -> Doc AnsiStyle
ppAttr Maybe (Lexeme a)
attr Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name

    DocSecurityRank Lexeme a
kw Maybe (Lexeme a)
mparam Lexeme a
rank ->
        Doc AnsiStyle
kwDocSecurityRank Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'(' Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
kw Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        (case Maybe (Lexeme a)
mparam of
            Maybe (Lexeme a)
Nothing    -> Doc AnsiStyle
forall a. Monoid a => a
mempty
            Just Lexeme a
param -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
", " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
param
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
", " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
rank Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
')'

    CommentF (Lexeme a) (Doc AnsiStyle)
DocAttention      -> Doc AnsiStyle
kwDocAttention
    CommentF (Lexeme a) (Doc AnsiStyle)
DocBrief          -> Doc AnsiStyle
kwDocBrief
    CommentF (Lexeme a) (Doc AnsiStyle)
DocDeprecated     -> Doc AnsiStyle
kwDocDeprecated
    CommentF (Lexeme a) (Doc AnsiStyle)
DocFile           -> Doc AnsiStyle
kwDocFile
    CommentF (Lexeme a) (Doc AnsiStyle)
DocReturn         -> Doc AnsiStyle
kwDocReturn
    CommentF (Lexeme a) (Doc AnsiStyle)
DocRetval         -> Doc AnsiStyle
kwDocRetval
    DocSee Lexeme a
name       -> Doc AnsiStyle
kwDocSee        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppRef Lexeme a
name
    DocRef Lexeme a
name         -> Doc AnsiStyle
kwDocRef        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppRef Lexeme a
name
    DocP Lexeme a
name           -> Doc AnsiStyle
kwDocP          Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppRef Lexeme a
name
    DocExtends Lexeme a
feat     -> Doc AnsiStyle
kwDocExtends    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
feat
    DocImplements Lexeme a
feat  -> Doc AnsiStyle
kwDocImplements Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
feat
    CommentF (Lexeme a) (Doc AnsiStyle)
DocPrivate          -> Doc AnsiStyle
kwDocPrivate
    CommentF (Lexeme a) (Doc AnsiStyle)
DocNote             -> Doc AnsiStyle
kwDocNote
    DocSection Lexeme a
title -> Doc AnsiStyle
kwDocSection Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
title
    DocSubsection Lexeme a
title -> Doc AnsiStyle
kwDocSubsection Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
title

    DocLine [Doc AnsiStyle]
docs -> [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat [Doc AnsiStyle]
docs
    DocCode Lexeme a
_ [Doc AnsiStyle]
code Lexeme a
_ ->
        Doc AnsiStyle
kwDocCode Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
ppCodeBody [Doc AnsiStyle]
code Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
kwDocEndCode