module Text.BBCode.Internal.Parser
( Parser
, runParserEnv
, runParserMaybeEnv
, parseTestEnv
, parsers
, bbcode
, bbcode1
, hr
, br
, clear
, bold
, italic
, underline
, strikethrough
, indent
, nfo
, oneline
, everythingInElement
, code
, preformatted
, box
, boxAlign
, image
, imageAlign
, quote
, quoteNamed
, spoiler
, spoilerNamed
, listElement
, list
, listFlavor
, colorName
, colorHex
, url
, size
, align
, font
, plaintext
)
where
import Control.Applicative (Applicative (liftA2))
import Control.Monad.Reader
import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.Functor (($>))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (isNothing)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Void (Void)
import Text.BBCode.Internal.Helper hiding (closing, opening, openingArg, surround, wrap, wrapArg)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer (charLiteral)
type Parser a = ParsecT Void Text (Reader [El]) a
runParserEnv :: ParsecT e s (Reader r) a -> r -> s -> Either (ParseErrorBundle s e) a
runParserEnv :: forall e s r a.
ParsecT e s (Reader r) a
-> r -> s -> Either (ParseErrorBundle s e) a
runParserEnv ParsecT e s (ReaderT r Identity) a
p r
env s
input = forall r a. Reader r a -> r -> a
runReader (forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT ParsecT e s (ReaderT r Identity) a
p String
"" s
input) r
env
{-# INLINEABLE runParserEnv #-}
runParserMaybeEnv :: ParsecT e s (Reader r) a -> r -> s -> Maybe a
runParserMaybeEnv :: forall e s r a. ParsecT e s (Reader r) a -> r -> s -> Maybe a
runParserMaybeEnv ParsecT e s (Reader r) a
p r
env s
input =
forall e s r a.
ParsecT e s (Reader r) a
-> r -> s -> Either (ParseErrorBundle s e) a
runParserEnv ParsecT e s (Reader r) a
p r
env s
input forall a b. a -> (a -> b) -> b
& \case
(Right a
x) -> forall a. a -> Maybe a
Just a
x
Either (ParseErrorBundle s e) a
_ -> forall a. Maybe a
Nothing
{-# INLINEABLE runParserMaybeEnv #-}
parseTestEnv :: Show a => Parser a -> Text -> IO ()
parseTestEnv :: forall a. Show a => Parser a -> Text -> IO ()
parseTestEnv Parser a
p Text
input =
Text -> IO ()
T.putStrLn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall a. Show a => a -> String
show
forall a b. (a -> b) -> a -> b
$ forall e s r a.
ParsecT e s (Reader r) a
-> r -> s -> Either (ParseErrorBundle s e) a
runParserEnv Parser a
p [] Text
input
{-# INLINEABLE parseTestEnv #-}
mp :: Show a => Parser a -> Text -> IO String
mp :: forall a. Show a => Parser a -> Text -> IO String
mp Parser a
parser Text
text = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall e s r a.
ParsecT e s (Reader r) a
-> r -> s -> Either (ParseErrorBundle s e) a
runParserEnv Parser a
parser [] Text
text
opening :: El -> Parser ()
opening :: El -> Parser ()
opening El
el = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Tokens Text
"[", forall a. IsString a => El -> a
elName El
el, Tokens Text
"]"]
{-# INLINEABLE opening #-}
openingArg :: El -> Parser a -> Parser a
openingArg :: forall a. El -> Parser a -> Parser a
openingArg El
el Parser a
p = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Tokens Text
"[", forall a. IsString a => El -> a
elName El
el, Tokens Text
"="]
a
res <- Parser a
p
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char forall a b. (a -> b) -> a -> b
$ Char
']'
pure a
res
{-# INLINEABLE openingArg #-}
closing :: El -> Parser ()
closing :: El -> Parser ()
closing El
el = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Tokens Text
"[/", forall a. IsString a => El -> a
elName El
el, Tokens Text
"]"]
{-# INLINEABLE closing #-}
localAddEl :: MonadReader [r] m => r -> m a -> m a
localAddEl :: forall r (m :: * -> *) a. MonadReader [r] m => r -> m a -> m a
localAddEl r
el = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall a. Semigroup a => a -> a -> a
<> [r
el])
{-# INLINEABLE localAddEl #-}
elVoid :: El -> Parser BBCode
elVoid :: El -> ParsecT Void Text (Reader [El]) BBCode
elVoid El
el = El -> Parser ()
opening El
el forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> El -> BBCode
ElVoid El
el
{-# INLINEABLE elVoid #-}
elSimple :: El -> Parser BBCode -> Parser BBCode
elSimple :: El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
el ParsecT Void Text (Reader [El]) BBCode
body = do
El -> Parser ()
opening El
el
BBCode
res <- forall r (m :: * -> *) a. MonadReader [r] m => r -> m a -> m a
localAddEl El
el ParsecT Void Text (Reader [El]) BBCode
body
El -> Parser ()
closing El
el
pure $ El -> BBCode -> BBCode
ElSimple El
el BBCode
res
{-# INLINEABLE elSimple #-}
elArg :: El -> Parser Text -> Parser BBCode -> Parser BBCode
elArg :: El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg El
el Parser Text
arg ParsecT Void Text (Reader [El]) BBCode
body = do
Text
a <- forall a. El -> Parser a -> Parser a
openingArg El
el Parser Text
arg
BBCode
b <- forall r (m :: * -> *) a. MonadReader [r] m => r -> m a -> m a
localAddEl El
el ParsecT Void Text (Reader [El]) BBCode
body
El -> Parser ()
closing El
el
pure $ El -> Text -> BBCode -> BBCode
ElArg El
el Text
a BBCode
b
{-# INLINEABLE elArg #-}
parsers :: Map El [Parser BBCode]
parsers :: Map El [ParsecT Void Text (Reader [El]) BBCode]
parsers =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (El
HR, [ParsecT Void Text (Reader [El]) BBCode
hr])
, (El
BR, [ParsecT Void Text (Reader [El]) BBCode
br])
, (El
Clear, [ParsecT Void Text (Reader [El]) BBCode
clear])
, (El
ListElement, [ParsecT Void Text (Reader [El]) BBCode
listElement])
, (El
Bold, [ParsecT Void Text (Reader [El]) BBCode
bold])
, (El
Italic, [ParsecT Void Text (Reader [El]) BBCode
italic])
, (El
Underline, [ParsecT Void Text (Reader [El]) BBCode
underline])
, (El
Strikethrough, [ParsecT Void Text (Reader [El]) BBCode
strikethrough])
, (El
Indent, [ParsecT Void Text (Reader [El]) BBCode
indent])
, (El
NFO, [ParsecT Void Text (Reader [El]) BBCode
nfo])
, (El
Oneline, [ParsecT Void Text (Reader [El]) BBCode
oneline])
, (El
Code, [ParsecT Void Text (Reader [El]) BBCode
code])
, (El
Preformatted, [ParsecT Void Text (Reader [El]) BBCode
preformatted])
, (El
Box, [ParsecT Void Text (Reader [El]) BBCode
box, ParsecT Void Text (Reader [El]) BBCode
boxAlign])
, (El
Image, [ParsecT Void Text (Reader [El]) BBCode
image, ParsecT Void Text (Reader [El]) BBCode
imageAlign])
, (El
Quote, [ParsecT Void Text (Reader [El]) BBCode
quote, ParsecT Void Text (Reader [El]) BBCode
quoteNamed])
, (El
Spoiler, [ParsecT Void Text (Reader [El]) BBCode
spoiler, ParsecT Void Text (Reader [El]) BBCode
spoilerNamed])
, (El
List, [ParsecT Void Text (Reader [El]) BBCode
list, ParsecT Void Text (Reader [El]) BBCode
listFlavor])
, (El
Color, [ParsecT Void Text (Reader [El]) BBCode
colorName, ParsecT Void Text (Reader [El]) BBCode
colorHex])
, (El
Size, [ParsecT Void Text (Reader [El]) BBCode
size])
, (El
URL, [ParsecT Void Text (Reader [El]) BBCode
url])
, (El
Align, [ParsecT Void Text (Reader [El]) BBCode
align])
, (El
Font, [ParsecT Void Text (Reader [El]) BBCode
font])
]
{-# NOINLINE parsers #-}
bbcode :: Parser BBCode
bbcode :: ParsecT Void Text (Reader [El]) BBCode
bbcode = do
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Map El [ParsecT Void Text (Reader [El]) BBCode]
parsers forall a. Semigroup a => a -> a -> a
<> [ParsecT Void Text (Reader [El]) BBCode
plaintext])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
[] -> forall a. Monoid a => a
mempty
[BBCode
x] -> BBCode
x
[BBCode]
xs -> [BBCode] -> BBCode
ElDocument [BBCode]
xs
{-# NOINLINE bbcode #-}
bbcode1 :: Parser BBCode
bbcode1 :: ParsecT Void Text (Reader [El]) BBCode
bbcode1 =
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Map El [ParsecT Void Text (Reader [El]) BBCode]
parsers)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
[BBCode
x] -> BBCode
x
[BBCode]
xs -> [BBCode] -> BBCode
ElDocument [BBCode]
xs
{-# NOINLINE bbcode1 #-}
hr :: Parser BBCode
hr :: ParsecT Void Text (Reader [El]) BBCode
hr = El -> ParsecT Void Text (Reader [El]) BBCode
elVoid El
HR
{-# INLINEABLE hr #-}
br :: Parser BBCode
br :: ParsecT Void Text (Reader [El]) BBCode
br = El -> ParsecT Void Text (Reader [El]) BBCode
elVoid El
BR
{-# INLINEABLE br #-}
clear :: Parser BBCode
clear :: ParsecT Void Text (Reader [El]) BBCode
clear = El -> ParsecT Void Text (Reader [El]) BBCode
elVoid El
Clear
{-# INLINEABLE clear #-}
bold :: Parser BBCode
bold :: ParsecT Void Text (Reader [El]) BBCode
bold = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Bold ParsecT Void Text (Reader [El]) BBCode
bbcode
italic :: Parser BBCode
italic :: ParsecT Void Text (Reader [El]) BBCode
italic = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Italic ParsecT Void Text (Reader [El]) BBCode
bbcode
underline :: Parser BBCode
underline :: ParsecT Void Text (Reader [El]) BBCode
underline = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Underline ParsecT Void Text (Reader [El]) BBCode
bbcode
strikethrough :: Parser BBCode
strikethrough :: ParsecT Void Text (Reader [El]) BBCode
strikethrough = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Strikethrough ParsecT Void Text (Reader [El]) BBCode
bbcode
indent :: Parser BBCode
indent :: ParsecT Void Text (Reader [El]) BBCode
indent = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Indent ParsecT Void Text (Reader [El]) BBCode
bbcode
nfo :: Parser BBCode
nfo :: ParsecT Void Text (Reader [El]) BBCode
nfo = do
Maybe El
insideNFO <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (forall a. Eq a => a -> a -> Bool
== El
NFO))
if forall a. Maybe a -> Bool
isNothing Maybe El
insideNFO
then El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
NFO ParsecT Void Text (Reader [El]) BBCode
bbcode
else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't parse [nfo] inside [nfo]"
oneline :: Parser BBCode
oneline :: ParsecT Void Text (Reader [El]) BBCode
oneline = do
Maybe El
insideOneline <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (forall a. Eq a => a -> a -> Bool
== El
Oneline))
if forall a. Maybe a -> Bool
isNothing Maybe El
insideOneline
then El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Oneline ParsecT Void Text (Reader [El]) BBCode
bbcode
else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't parse [oneline] inside [oneline]"
everythingInElement :: El -> Parser BBCode
everythingInElement :: El -> ParsecT Void Text (Reader [El]) BBCode
everythingInElement El
el = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
el forall a b. (a -> b) -> a -> b
$ do
let bc :: ParsecT Void Text (Reader [El]) (Tokens Text)
bc = do
Tokens Text
r <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'[')
Maybe ()
end <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ El -> Parser ()
closing El
el
if forall a. Maybe a -> Bool
isNothing Maybe ()
end
then (Tokens Text
r <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
takeP forall a. Maybe a
Nothing Int
1) ParsecT Void Text (Reader [El]) (Tokens Text)
bc
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Tokens Text
r
Text -> BBCode
ElText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
bc
{-# INLINEABLE everythingInElement #-}
code :: Parser BBCode
code :: ParsecT Void Text (Reader [El]) BBCode
code = El -> ParsecT Void Text (Reader [El]) BBCode
everythingInElement El
Code
{-# INLINEABLE code #-}
preformatted :: Parser BBCode
preformatted :: ParsecT Void Text (Reader [El]) BBCode
preformatted = El -> ParsecT Void Text (Reader [El]) BBCode
everythingInElement El
Preformatted
{-# INLINEABLE preformatted #-}
box :: Parser BBCode
box :: ParsecT Void Text (Reader [El]) BBCode
box = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Box ParsecT Void Text (Reader [El]) BBCode
bbcode
image :: Parser BBCode
image :: ParsecT Void Text (Reader [El]) BBCode
image = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Image forall a b. (a -> b) -> a -> b
$ Text -> BBCode
ElText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"URL") (forall a. Eq a => a -> a -> Bool
/= Char
'[')
{-# INLINEABLE image #-}
quote :: Parser BBCode
quote :: ParsecT Void Text (Reader [El]) BBCode
quote = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Quote ParsecT Void Text (Reader [El]) BBCode
bbcode
spoiler :: Parser BBCode
spoiler :: ParsecT Void Text (Reader [El]) BBCode
spoiler = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
Spoiler ParsecT Void Text (Reader [El]) BBCode
bbcode
listElement :: Parser BBCode
listElement :: ParsecT Void Text (Reader [El]) BBCode
listElement = do
Bool
isInsideList <- forall s a. Getting Any s a -> s -> Bool
has (forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' El ()
_List) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall s a. Snoc s s a a => Traversal' s a
_last
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isInsideList forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not inside list"
BBCode
res <- El -> ParsecT Void Text (Reader [El]) BBCode
elVoid El
ListElement
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
isSpace
pure BBCode
res
list :: Parser BBCode
list :: ParsecT Void Text (Reader [El]) BBCode
list = El
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elSimple El
List ParsecT Void Text (Reader [El]) BBCode
bbcode
boxAlign :: Parser BBCode
boxAlign :: ParsecT Void Text (Reader [El]) BBCode
boxAlign = El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg El
Box (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"left" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"center" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"right") ParsecT Void Text (Reader [El]) BBCode
bbcode
imageAlign :: Parser BBCode
imageAlign :: ParsecT Void Text (Reader [El]) BBCode
imageAlign =
El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg El
Image (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"left" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"right") forall a b. (a -> b) -> a -> b
$
Text -> BBCode
ElText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"URL") (forall a. Eq a => a -> a -> Bool
/= Char
'[')
{-# INLINEABLE imageAlign #-}
quoteNamed :: Parser BBCode
quoteNamed :: ParsecT Void Text (Reader [El]) BBCode
quoteNamed = El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg El
Quote Parser Text
arg ParsecT Void Text (Reader [El]) BBCode
bbcode
where
arg :: Parser Text
arg =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"quote author in quotes(e.g. [quote=\"Dan\"])" forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
charLiteral (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"')
spoilerNamed :: Parser BBCode
spoilerNamed :: ParsecT Void Text (Reader [El]) BBCode
spoilerNamed = El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg El
Spoiler Parser Text
arg ParsecT Void Text (Reader [El]) BBCode
bbcode
where
arg :: Parser Text
arg =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"spoiler name in quotes (e.g. [spoiler=\"The ending is\"])" forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
charLiteral (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"')
listFlavor :: Parser BBCode
listFlavor :: ParsecT Void Text (Reader [El]) BBCode
listFlavor =
El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg
El
List
(forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tokens Text
"a", Tokens Text
"A", Tokens Text
"i", Tokens Text
"I", Tokens Text
"1"])
ParsecT Void Text (Reader [El]) BBCode
bbcode
colorName :: Parser BBCode
colorName :: ParsecT Void Text (Reader [El]) BBCode
colorName =
El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg
El
Color
( forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
(forall a. a -> Maybe a
Just String
"Color name")
(\Token Text
c -> Char -> Bool
isAsciiLower Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Token Text
c)
)
ParsecT Void Text (Reader [El]) BBCode
bbcode
colorHex :: Parser BBCode
colorHex :: ParsecT Void Text (Reader [El]) BBCode
colorHex =
El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg
El
Color
( forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"hex color(e.g. #333 or #123456)" forall a b. (a -> b) -> a -> b
$ do
Char
hash :: Char <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'#'
String
name :: String <-
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
6 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Char
hash forall a. a -> [a] -> [a]
: String
name
)
ParsecT Void Text (Reader [El]) BBCode
bbcode
url :: Parser BBCode
url :: ParsecT Void Text (Reader [El]) BBCode
url = El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg El
URL (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"URL") (forall a. Eq a => a -> a -> Bool
/= Char
']')) ParsecT Void Text (Reader [El]) BBCode
bbcode
size :: Parser BBCode
size :: ParsecT Void Text (Reader [El]) BBCode
size =
El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg
El
Size
(forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int
10 .. Int
29] :: [Int]))
ParsecT Void Text (Reader [El]) BBCode
bbcode
align :: Parser BBCode
align :: ParsecT Void Text (Reader [El]) BBCode
align =
El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg
El
Align
(forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tokens Text
"left", Tokens Text
"right", Tokens Text
"center", Tokens Text
"justify"])
ParsecT Void Text (Reader [El]) BBCode
bbcode
font :: Parser BBCode
font :: ParsecT Void Text (Reader [El]) BBCode
font =
El
-> Parser Text
-> ParsecT Void Text (Reader [El]) BBCode
-> ParsecT Void Text (Reader [El]) BBCode
elArg
El
Font
( forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
(forall a. a -> Maybe a
Just String
"font name(digits and latin letters)")
(Char -> Bool
isAsciiLower forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| Char -> Bool
isAsciiUpper forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| Char -> Bool
isDigit)
)
ParsecT Void Text (Reader [El]) BBCode
bbcode
plaintext :: Parser BBCode
plaintext :: ParsecT Void Text (Reader [El]) BBCode
plaintext = do
Maybe El
currentElement <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall s a. Snoc s s a a => Traversal' s a
_last
let bc :: ParsecT Void Text (Reader [El]) (Tokens Text)
bc = do
Tokens Text
res <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'[')
Maybe (Tokens Text)
end <-
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
[
[El]
elementOpenings
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. IsString a => El -> a
elName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\Tokens Text
el -> forall a. Monoid a => [a] -> a
mconcat [Tokens Text
"[", Tokens Text
el, Tokens Text
"]"])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string'
,
[El]
elementArgOpenings
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. IsString a => El -> a
elName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Tokens Text
"[" <>)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string'
,
Maybe El
currentElement
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to El -> Parser ()
closing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Tokens Text
"")
, [forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Tokens Text
""]
]
if forall a. Maybe a -> Bool
isNothing Maybe (Tokens Text)
end
then
(Tokens Text
res <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
takeP forall a. Maybe a
Nothing Int
1) ParsecT Void Text (Reader [El]) (Tokens Text)
bc
else
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tokens Text
res
Text -> BBCode
ElText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
bc
{-# INLINEABLE plaintext #-}