diff --git a/core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs b/core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs index ecbcde2..eab1feb 100644 --- a/core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs +++ b/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 diff --git a/core/src/Text/Interpolation/Nyan/Core/Internal/Parser.hs b/core/src/Text/Interpolation/Nyan/Core/Internal/Parser.hs index ebd2b9c..f41b444 100644 --- a/core/src/Text/Interpolation/Nyan/Core/Internal/Parser.hs +++ b/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 diff --git a/core/src/Text/Interpolation/Nyan/Core/Internal/Processor.hs b/core/src/Text/Interpolation/Nyan/Core/Internal/Processor.hs index 45d1b8b..6ad6c16 100644 --- a/core/src/Text/Interpolation/Nyan/Core/Internal/Processor.hs +++ b/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 diff --git a/core/tests/Test/Customization.hs b/core/tests/Test/Customization.hs index a9c3970..9ad99b0 100644 --- a/core/tests/Test/Customization.hs +++ b/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 diff --git a/core/tests/Test/Interpolator.hs b/core/tests/Test/Interpolator.hs index eaae800..b3aa01c 100644 --- a/core/tests/Test/Interpolator.hs +++ b/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" + ] + ] ] diff --git a/core/tests/Test/Parser.hs b/core/tests/Test/Parser.hs index 98aae69..e6bbcd1 100644 --- a/core/tests/Test/Parser.hs +++ b/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"