[#6] Add a switch for allowing comments

Problem: We want the interpolator to support commentaries in
arbitrary lines.

Solution: Implement a switch to allow writing comments and
add some tests against the implementation.

core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs

@@ -32,6 +32,8 @@ data IntData = IntData
 data ParsedIntPiece
   = PipString Text
     -- ^ Mere text.
+  | PipComments Text
+    -- ^ Comments.
   | PipNewline Text
     -- ^ Some line feed.
     -- This must be preferred over 'PipString'.
@@ -84,6 +86,7 @@ data PreviewLevel
 -- | All switches options.
 data SwitchesOptions = SwitchesOptions
   { spacesTrimming          :: Bool
+  , commenting              :: Bool
   , indentationStripping    :: Bool
   , leadingNewlineStripping :: Bool
   , trailingSpacesStripping :: Bool
@@ -100,6 +103,7 @@ data SwitchesOptions = SwitchesOptions
 -- mandatory for specifying in the interpolator.
 data DefaultSwitchesOptions = DefaultSwitchesOptions
   { defSpacesTrimming          :: Maybe Bool
+  , defCommenting              :: Maybe Bool
   , defIndentationStripping    :: Maybe Bool
   , defLeadingNewlineStripping :: Maybe Bool
   , defTrailingSpacesStripping :: Maybe Bool
@@ -117,6 +121,7 @@ data DefaultSwitchesOptions = DefaultSwitchesOptions
 basicDefaultSwitchesOptions :: DefaultSwitchesOptions
 basicDefaultSwitchesOptions = DefaultSwitchesOptions
   { defSpacesTrimming = Just False
+  , defCommenting = Just False
   , defIndentationStripping = Just False
   , defLeadingNewlineStripping = Just False
   , defTrailingSpacesStripping = Just False
@@ -130,6 +135,7 @@ basicDefaultSwitchesOptions = DefaultSwitchesOptions
 recommendedDefaultSwitchesOptions :: DefaultSwitchesOptions
 recommendedDefaultSwitchesOptions = DefaultSwitchesOptions
   { defSpacesTrimming = Just False
+  , defCommenting = Just False
   , defIndentationStripping = Just True
   , defLeadingNewlineStripping = Just True
   , defTrailingSpacesStripping = Just True

core/src/Text/Interpolation/Nyan/Core/Internal/Parser.hs

@@ -17,6 +17,7 @@ import Fmt (Builder, build, fmt)
 import Text.Interpolation.Nyan.Core.Internal.Base
 import Text.Megaparsec (Parsec, customFailure, eof, errorBundlePretty, label, lookAhead, parse,
                         single, takeWhile1P, takeWhileP)
+import Text.Megaparsec.Char (string)
 import Text.Megaparsec.Error (ShowErrorComponent (..))
 
 newtype OptionChanged = OptionChanged Bool
@@ -25,6 +26,7 @@ newtype OptionChanged = OptionChanged Bool
 -- | An accumulator for switch options during parsing.
 data SwitchesOptionsBuilder = SwitchesOptionsBuilder
   { spacesTrimmingB          :: (OptionChanged, Maybe Bool)
+  , commentingB              :: (OptionChanged, Maybe Bool)
   , indentationStrippingB    :: (OptionChanged, Maybe Bool)
   , leadingNewlineStrippingB :: (OptionChanged, Maybe Bool)
   , trailingSpacesStrippingB :: (OptionChanged, Maybe Bool)
@@ -38,6 +40,7 @@ toSwitchesOptionsBuilder :: DefaultSwitchesOptions -> SwitchesOptionsBuilder
 toSwitchesOptionsBuilder DefaultSwitchesOptions{..} =
   SwitchesOptionsBuilder
   { spacesTrimmingB = (OptionChanged False, defSpacesTrimming)
+  , commentingB = (OptionChanged False, defCommenting)
   , indentationStrippingB = (OptionChanged False, defIndentationStripping)
   , leadingNewlineStrippingB = (OptionChanged False, defLeadingNewlineStripping)
   , trailingSpacesStrippingB = (OptionChanged False, defTrailingSpacesStripping)
@@ -50,6 +53,7 @@ toSwitchesOptionsBuilder DefaultSwitchesOptions{..} =
 finalizeSwitchesOptions :: MonadFail m => SwitchesOptionsBuilder -> m SwitchesOptions
 finalizeSwitchesOptions SwitchesOptionsBuilder{..} = do
   spacesTrimming <- fromOptional "spaces trimming" spacesTrimmingB
+  commenting <- fromOptional "allow commenting" commentingB
   indentationStripping <- fromOptional "indentation stripping" indentationStrippingB
   leadingNewlineStripping <- fromOptional "leading newline stripping" leadingNewlineStrippingB
   trailingSpacesStripping <- fromOptional "trailing spaces stripping" trailingSpacesStrippingB
@@ -73,6 +77,12 @@ setIfNew desc new (OptionChanged ch, old)
   | old == Just new = fail $ "Switch option `" <> desc <> "` is set redundantly"
   | otherwise = return (OptionChanged True, Just new)
 
+setCommenting :: SwitchesOptionsSetter m => Bool -> m ()
+setCommenting enable = do
+  opts <- get
+  res <- setIfNew "allow comments" enable (commentingB opts)
+  put opts{ commentingB = res }
+
 setSpacesTrimming :: SwitchesOptionsSetter m => Bool -> m ()
 setSpacesTrimming enable = do
   opts <- get
@@ -150,6 +160,11 @@ switchesSectionP defSOpts =
       , single 'S' $> False
       ] >>= setSpacesTrimming
 
+    , asum
+      [ single 'c' $> True
+      , single 'C' $> False
+      ] >>= setCommenting
+
     , asum
       [ single 'd' $> True
       , single 'D' $> False
@@ -201,6 +216,7 @@ switchesHelpMessage sopts =
         (error "")
         (error "")
         (error "")
+        (error "")
         -- ↑ Note: If you edit this, you may also need to update
         -- the help messages below.
   in mconcat
@@ -257,8 +273,14 @@ switchesHelpMessage sopts =
 intPieceP :: Ord e => Parsec e Text [ParsedIntPiece]
 intPieceP = asum
   [
+
+    -- consume comments
+    string "--" >>= \prefix -> do
+      content <- takeWhile1P Nothing (/= '\n')
+      pure $ one $ PipComments (prefix <> content)
+
     -- consume normal text
-    one . PipString <$> takeWhile1P Nothing (notAnyOf [(== '\\'), (== '#'), isSpace])
+  , one . PipString <$> takeWhile1P Nothing (notAnyOf [(== '\\'), (== '#'), isSpace])
 
     -- potentially interpolator case
   , single '#' *> do

core/src/Text/Interpolation/Nyan/Core/Internal/Processor.hs

@@ -15,6 +15,7 @@ import Text.Interpolation.Nyan.Core.Internal.Base
 processIntString :: SwitchesOptions -> ParsedInterpolatedString -> InterpolatedString
 processIntString sopts istr = istr
   & V.fromList
+  & do if commenting sopts then skipComments else id
   & do if leadingNewlineStripping sopts then stripLeadingNewline else id
   & do if trailingSpacesStripping sopts then stripTrailingLeadingWs else id
   & do if indentationStripping sopts then stripCommonIndentation else id
@@ -30,6 +31,8 @@ processIntString sopts istr = istr
   where
     (&) = flip ($)
 
+    skipComments = V.filter \case PipComments{} -> False; _ -> True
+
     stripLeadingNewline ps = case V.uncons ps of
       Just (PipNewline _, ps') -> ps'
       _                        -> ps
@@ -45,6 +48,9 @@ processIntString sopts istr = istr
       PipString s ->
         let s' = trimText s
         in if T.null s' then Nothing else Just (PipString s')
+      PipComments s ->
+        let s' = trimText s
+        in if T.null s' then Nothing else Just (PipString s')
       p@PipInt{} -> Just p
 
     trimLeftSpaces ps = case V.uncons ps of
@@ -104,6 +110,7 @@ processIntString sopts istr = istr
           -- invisible spaces to break the newlines sequence.
           p@PipLeadingWs{} : l -> p : skipNext l
           p@PipString{} : l    -> p : reduceNext l
+          p@PipComments{} : l  -> p : reduceNext l
           p@PipInt{} : l       -> p : reduceNext l
           []                   -> []
 
@@ -113,6 +120,7 @@ processIntString sopts istr = istr
       PipNewline nl  -> IpString nl
       PipLeadingWs n -> IpString . mconcat $ replicate (fromIntegral n) " "
       PipEmptyLine   -> IpString mempty
+      PipComments s  -> IpString s
       PipInt i       -> IpInt i
 
     glueStrings :: InterpolatedString -> InterpolatedString

core/tests/Test/Customization.hs

@@ -28,6 +28,7 @@ _AllFieldsAreExported =
             (error "")
             (error "")
             (error "")
+            (error "")
             -- ↑ if you change this, also add a field to the record below
       in basicDefaultSwitchesOptions
         { defIndentationStripping = Nothing

core/tests/Test/Interpolator.hs

@@ -297,6 +297,20 @@ test_DefaultInterpolator = testGroup "Default interpolator"
 
       ]
 
+      ----------------------------------
+    , testGroup "Commenting"
+
+      [ testCase "Basic comments" do
+          [int|tc|Abc -- this is a comment|]
+              @?= "Abc "
+
+      , testCase "Comments in arbitrary lines" do
+          [int|tc| -- comments at the beginning
+              My text -- comments in the middle
+              -- comments at the end
+          |] @?= " \nMy text \n\n"
+      ]
+
     ]
 
   ]

core/tests/Test/Parser.hs

@@ -121,7 +121,7 @@ test_TextParser = testGroup "Main text parser"
 
 basicSwitchesOptions :: SwitchesOptions
 basicSwitchesOptions =
-  SwitchesOptions False False False False AnyFromBuilder False False PreviewNone
+  SwitchesOptions False False False False False AnyFromBuilder False False PreviewNone
 
 test_SwitchesParser :: TestTree
 test_SwitchesParser = testGroup "Switches parser"