@@ -272,7 +272,7 @@ runInline p = fmap canonalizeInline $ do
272
272
paragraph' :: forall p . (MonadFail p , P. MonadParsec Void Text p ) => StateT InlineState p () -> StateT InlineState p ()
273
273
paragraph' end' = do
274
274
(end >> pure () )
275
- <|> (lookChar >>= \ c -> attachedOpenings c <|> word c)
275
+ <|> (lookChar >>= \ c -> intersectingModifier c <|> attachedOpenings c <|> word c)
276
276
where
277
277
end = do
278
278
end' <|> P. eof
@@ -289,21 +289,38 @@ paragraph' end' = do
289
289
modify $ modifierInline .~ new
290
290
where
291
291
close (NoModifier b) = fail " No closing"
292
- close (OpenModifier cm i b) =
292
+ close (OpenModifier cm i b) =
293
293
case b of
294
294
(OpenModifier cd id bd) -> if c == cm then pure (OpenModifier cd (id <> f i) bd) else close (OpenModifier cd (id <> Text cm <> i) bd)
295
295
(NoModifier id ) -> if c == cm then pure (NoModifier (id <> f i)) else fail " No closing"
296
296
pushStack :: Text -> StateT InlineState p ()
297
297
pushStack c = do
298
298
s <- gets (view modifierInline)
299
- new <- case s of
299
+ new <- case s of
300
300
NoModifier i -> pure $ OpenModifier c mempty (NoModifier i)
301
301
stack@ (OpenModifier cm i b) ->
302
302
if not $ hasModifier c stack
303
303
then pure $ OpenModifier c mempty stack
304
304
else fail " No open modifier"
305
305
modify $ modifierInline .~ new
306
306
307
+ parseTextModifier :: StateT InlineState p () -> Text -> (Text -> Inline ) -> StateT InlineState p ()
308
+ parseTextModifier follow char f = P. string char >> P. try (go " " ) <|> word (T. head char)
309
+ where
310
+ go :: Text -> StateT InlineState p ()
311
+ go previousText = do
312
+ text <- P. takeWhileP (Just " Inline Text modifier" ) (\ c -> c /= T. last char && c /= ' \n ' )
313
+ let fullText = previousText <> text
314
+ ( do
315
+ P. string $ T. reverse char
316
+ followedBy follow
317
+ appendInlineToStack (f fullText)
318
+ modify (delimitedActive .~ False )
319
+ withNextChar $ \ c -> parWhitespace c <|> attachedClosings c <|> attachedOpenings c <|> word c
320
+ )
321
+ <|> (P. newline >> P. hspace >> P. newline >> fail " No Text modifier" )
322
+ <|> (P. newline >> P. hspace >> go fullText)
323
+
307
324
attachedOpenings :: Char -> StateT InlineState p ()
308
325
attachedOpenings = \ case
309
326
' *' -> parseOpening " *"
@@ -313,32 +330,15 @@ paragraph' end' = do
313
330
' ,' -> parseOpening " ,"
314
331
' |' -> parseOpening " |"
315
332
' ^' -> parseOpening " ^"
316
- ' `' -> parseTextModifier " `" Verbatim
317
- ' $' -> parseTextModifier " $" Math
333
+ ' `' -> parseTextModifier follow " `" Verbatim
334
+ ' $' -> parseTextModifier follow " $" Math
318
335
-- '=' -> parseOpening TODO: Behavior unclear
319
336
_ -> fail " No attachedOpenings"
320
337
where
321
- parseTextModifier :: Text -> (Text -> Inline ) -> StateT InlineState p ()
322
- parseTextModifier char f = P. try (go " " ) <|> word (T. head char)
323
- where
324
- go :: Text -> StateT InlineState p ()
325
- go previousText = do
326
- P. string char
327
- text <- P. takeWhileP (Just " Inline Text modifier" ) (\ c -> c /= T. head char && c /= ' \n ' )
328
- let fullText = previousText <> text
329
- ( do
330
- P. string char
331
- followedBy
332
- ( singleSpace <|> newline
333
- <|> withNextChar
334
- (guard . flip S. member (punctuationSymbols <> attachedModifierSymbols))
335
- )
336
- appendInlineToStack (f fullText)
337
- modify (delimitedActive .~ False )
338
- withNextChar $ \ c -> parWhitespace c <|> attachedClosings c <|> attachedOpenings c <|> word c
339
- )
340
- <|> (P. newline >> P. hspace >> P. newline >> fail " No Text modifier" )
341
- <|> (P. newline >> P. hspace >> go fullText)
338
+ follow =
339
+ singleSpace <|> newline
340
+ <|> withNextChar
341
+ (guard . flip S. member (punctuationSymbols <> attachedModifierSymbols))
342
342
parseOpening c = do
343
343
P. try $ do
344
344
anyChar >> withNextChar (\ c -> guard $ isLetter c || S. member c specialSymbols)
@@ -394,22 +394,54 @@ paragraph' end' = do
394
394
withNextChar f = end <|> (lookChar >>= f)
395
395
396
396
intersectingModifier :: Char -> StateT InlineState p ()
397
- intersectingModifier = \ case
398
- _ -> fail " No intersecting modifier"
397
+ intersectingModifier c1 = do
398
+ c2 <- followedBy $ anyChar >> anyChar
399
+ case c1: [c2] of
400
+ " :*" -> intersectingOpen " :*"
401
+ " :/" -> intersectingOpen " :/"
402
+ " :_" -> intersectingOpen " :_"
403
+ " :-" -> intersectingOpen " :-"
404
+ " :^" -> intersectingOpen " :^"
405
+ " :," -> intersectingOpen " :,"
406
+ " :|" -> intersectingOpen " :|"
407
+ " :`" -> parseTextModifier (pure () ) " :`" Verbatim
408
+ " :$" -> parseTextModifier (pure () ) " :$" Math
409
+
410
+ " *:" -> intersectingClosed " :*" Bold
411
+ " /:" -> intersectingClosed " :/" Italic
412
+ " _:" -> intersectingClosed " :_" Underline
413
+ " -:" -> intersectingClosed " :-" Strikethrough
414
+ " ^:" -> intersectingClosed " :^" Superscript
415
+ " ,:" -> intersectingClosed " :," Subscript
416
+ " |:" -> intersectingClosed " :|" Spoiler
417
+ s -> fail " No intersecting modifier"
418
+ where
419
+ intersectingClosed mod f = do
420
+ P. string $ T. reverse mod
421
+ popStack mod f
422
+ next
423
+ intersectingOpen mod = do
424
+ P. string mod
425
+ pushStack mod
426
+ next
427
+ next = do
428
+ modify (delimitedActive .~ True )
429
+ withNextChar $ \ c -> parWhitespace c <|> attachedClosings c <|> attachedOpenings c <|> word c
399
430
400
431
parWhitespace :: Char -> StateT InlineState p ()
401
- parWhitespace = \ case
402
- ' ' -> do
403
- appendInlineToStack Space
404
- next
405
- ' ~' -> do
406
- P. try (anyChar >> P. hspace >> P. newline)
407
- next
408
- ' \n ' -> do
409
- newline
410
- modify (delimitedActive .~ True )
411
- next
412
- _ -> fail " No newline or space"
432
+ parWhitespace c =
433
+ intersectingModifier c <|> case c of
434
+ ' ' -> do
435
+ appendInlineToStack Space
436
+ next
437
+ ' ~' -> do
438
+ P. try (anyChar >> P. hspace >> P. newline)
439
+ next
440
+ ' \n ' -> do
441
+ newline
442
+ modify (delimitedActive .~ True )
443
+ next
444
+ _ -> fail " No newline or space"
413
445
where
414
446
next = do
415
447
P. hspace
@@ -421,7 +453,8 @@ paragraph' end' = do
421
453
anyChar >> withNextChar (\ c -> parWhitespace c <|> attachedClosings c <|> attachedOpenings c <|> word c)
422
454
else fail " "
423
455
424
- many1 p = p >>= \ a -> (a : ) <$> many p
456
+ many1 :: (Alternative f ) => f a -> f [a ]
457
+ many1 p = (:) <$> p <*> many p
425
458
426
459
manyV :: Alternative f => f a -> f (V. Vector a )
427
460
manyV = fmap V. fromList . many
0 commit comments