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)

{-| Parser with reader transformer inside.

Reader environment contains current context for element.

It is used for 'oneline' because @"[oneline][oneline][\/oneline][\/oneline]"@ should
produce error. Same with 'nfo'

Also used by 'plaintext' to end parsing on closing element of current environment.

>>> parseTestEnv bbcode "[i]Bread[/b][/i]"
ElSimple Italic (ElText "Bread[/b]")

Notice it parsed @"[\/b]"@. 'plaintext' finishes parsing only on closing element that matches last parsed opening
-}
type Parser a = ParsecT Void Text (Reader [El]) a

-- | 'runParser' specialized for 'Parser'
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 #-}

-- | 'parseMaybe' specialized for 'Parser'
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 #-}

-- | 'parseTest' specialized for 'Parser'. Passes empty list to inner reader monad
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 #-}

-- | Same as 'parseTestEnv' but works with HLS's codelenses
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 #-}

{-|All parsers used by 'bbcode' and 'bbcode1'

Keys are element names and values are associated element parsers.

Values are lists because some elements have optional element.
That means they are two separate parsers, e.g.
'Box' element parsers are 'box' (simple element) and 'boxAlign' (element with
parameter)
-}
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 #-}

{-| Parse zero or more BBCode elements
Doesn't necessarily return value wrapped in 'ElDocument', it returns
@('mempty' :: BBCode)@ if it parses no elements, or just element if parses
just one element. Otherwise it is 'ElDocument'
-}
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 #-}

-- | Similar to 'bbcode' but parses one or more elements
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]"

-- BUG: in a string "[code][code][/code][/code]" parser only does
--
-- >>> mp (everythingInElement Code) "[code][code][/code][/code]"
-- ElSimple Code (ElText "[code]")
-- >>> mp (everythingInElement Code <* eof) "[code][code][/code][/code]"
-- 1:20:
--   |
-- 1 | [code][code][/code][/code]
--   |                    ^
-- unexpected '['
-- expecting end of input
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 #-}

-- >>> mp (code <* eof) "[code][code][/code][/code]"
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

-- >>> mp colorName "[color=gray][/color]"
-- ElArg Color "GreEn" (ElText "")
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

-- >>> mp colorHex "[color=#333][/color]"
-- ElArg Color "#333" (ElText "")
-- >>> mp colorHex "[color=#333Faa][/color]"
-- ElArg Color "#333Faa" (ElText "")
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 <- -- Attempts to find element that will end parsing
          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
$
            [ -- Opening element ends parsing text(only simple elements)
              [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'
            , -- Opening element ends parsing text.
              -- Note that it produces opening element without closing bracket,
              -- because we can't predict what an argument will be
              [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'
            , -- Current closing element (last element in reader environment)
              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 -- continue parsing text
            (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 -- end parsing
            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 #-}