diff --git a/src/Juvix/Data/Comment.hs b/src/Juvix/Data/Comment.hs index 57a7f2e349..061b0673ae 100644 --- a/src/Juvix/Data/Comment.hs +++ b/src/Juvix/Data/Comment.hs @@ -1,10 +1,12 @@ module Juvix.Data.Comment where import Data.HashMap.Strict qualified as HashMap +import Data.Text qualified as Text +import Juvix.Data.CodeAnn (CodeAnn (..), PrettyCodeAnn, ppCodeAnn) import Juvix.Data.Loc import Juvix.Extra.Strings qualified as Str import Juvix.Prelude.Base -import Prettyprinter +import Prettyprinter hiding (concatWith) newtype Comments = Comments { _commentsByFile :: HashMap (Path Abs File) FileComments @@ -99,14 +101,48 @@ instance HasLoc SpaceSection where instance HasLoc Comment where getLoc = (^. commentInterval) +instance PrettyCodeAnn Comment where + ppCodeAnn = annotate AnnComment . pretty + instance Pretty Comment where pretty :: Comment -> Doc ann - pretty c = delim (pretty (c ^. commentText)) + pretty c = delim (c ^. commentText) where - delim :: Doc ann -> Doc ann + delim :: Text -> Doc ann delim = case c ^. commentType of - CommentOneLine -> (Str.commentLineStart <>) - CommentBlock -> enclose Str.commentBlockStart Str.commentBlockEnd + CommentOneLine -> (Str.commentLineStart <>) . pretty + CommentBlock -> + enclose Str.commentBlockStart Str.commentBlockEnd + . pretty + . trimPrefixSpace + + trimPrefixSpace :: Text -> Text + trimPrefixSpace txt = case Text.unsnoc txt of + Nothing -> "" + Just (_, l) -> + appendNl + . striplines + $ txt + where + striplines :: Text -> Text + striplines = + concatWith (\a b -> a <> "\n" <> b) + . run + . execOutputList + . go True + . Text.lines + go :: (Members '[Output Text] r) => Bool -> [Text] -> Sem r () + go isFirst = \case + [] -> return () + a : as + | isFirst && isLast -> output a + | isFirst -> output (Text.stripEnd a) >> go False as + | isLast -> output (Text.stripStart a) + | otherwise -> output (Text.strip a) >> go False as + where + isLast = null as + lastnl = '\n' == l + appendNl = if lastnl then (<> "\n") else id allComments :: Comments -> [Comment] allComments c = diff --git a/src/Juvix/Data/Effect/ExactPrint/Base.hs b/src/Juvix/Data/Effect/ExactPrint/Base.hs index 1fd17ce248..e918077f85 100644 --- a/src/Juvix/Data/Effect/ExactPrint/Base.hs +++ b/src/Juvix/Data/Effect/ExactPrint/Base.hs @@ -154,7 +154,7 @@ printSpaceSpan = mapM_ printSpaceSection . (^. spaceSpan) printComment :: (Members '[State Builder] r) => Comment -> Sem r () printComment c = do - append' (annotate AnnComment (P.pretty c)) + append' (ppCodeAnn c) hardline' popQueue :: (Members '[State Builder] r) => Sem r () diff --git a/tests/positive/Format.juvix b/tests/positive/Format.juvix index 85d245f4a1..3ade7476bc 100644 --- a/tests/positive/Format.juvix +++ b/tests/positive/Format.juvix @@ -534,6 +534,22 @@ module MultiIf; | else := 2; end; +{-hi + +-} +module CommentAfterFun; + myfun (a : Nat) : Nat := + {- + My comment. + -} + {-nospaces-} + {- somespaces -} + {- first line + + last line -} + 1; +end; + module PublicImports; module Inner;