module Text.BBCode.Internal.Builder where

import Numeric.Natural
import Text.BBCode.Internal.Helper

{-| Newline

> nl == 'text' "\n"
-}
nl :: BBCode
nl :: BBCode
nl = Text -> BBCode
text Text
"\n"
{-# INLINE nl #-}

-- | > text == 'ElText'
text :: Text -> BBCode
text :: Text -> BBCode
text = Text -> BBCode
ElText
{-# INLINE text #-}

-- | Wrap @['BBCode']@ in 'ElDocument'
doc :: [BBCode] -> BBCode
doc :: [BBCode] -> BBCode
doc = [BBCode] -> BBCode
ElDocument
{-# INLINE doc #-}

{-| Horizontal line

> hr == 'ElVoid' 'HR'
-}
hr :: BBCode
hr :: BBCode
hr = El -> BBCode
ElVoid El
HR
{-# INLINE hr #-}

{-|
Line break

> br == 'ElVoid' 'BR'
-}
br :: BBCode
br :: BBCode
br = El -> BBCode
ElVoid El
BR
{-# INLINE br #-}

-- | > clear == 'ElVoid' 'Clear'
clear :: BBCode
clear :: BBCode
clear = El -> BBCode
ElVoid El
Clear
{-# INLINE clear #-}

{-|
Notice it is not a function, but a value.

@listEl@ represents "[*]"

> listEl == 'ElVoid' 'ListElement'
-}
listEl :: BBCode
listEl :: BBCode
listEl = El -> BBCode
ElVoid El
ListElement
{-# INLINE listEl #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
bold :: BBCode -> BBCode
bold :: BBCode -> BBCode
bold = El -> BBCode -> BBCode
ElSimple El
Bold
{-# INLINE bold #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
italic :: BBCode -> BBCode
italic :: BBCode -> BBCode
italic = El -> BBCode -> BBCode
ElSimple El
Italic
{-# INLINE italic #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
underline :: BBCode -> BBCode
underline :: BBCode -> BBCode
underline = El -> BBCode -> BBCode
ElSimple El
Underline
{-# INLINE underline #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
strikethrough :: BBCode -> BBCode
strikethrough :: BBCode -> BBCode
strikethrough = El -> BBCode -> BBCode
ElSimple El
Strikethrough
{-# INLINE strikethrough #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
indent :: BBCode -> BBCode
indent :: BBCode -> BBCode
indent = El -> BBCode -> BBCode
ElSimple El
Indent
{-# INLINE indent #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
nfo :: BBCode -> BBCode
nfo :: BBCode -> BBCode
nfo = El -> BBCode -> BBCode
ElSimple El
NFO
{-# INLINE nfo #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
oneline :: BBCode -> BBCode
oneline :: BBCode -> BBCode
oneline = El -> BBCode -> BBCode
ElSimple El
Oneline
{-# INLINE oneline #-}

-- | 'Code' element contains plain text
code :: Text -> BBCode
code :: Text -> BBCode
code = El -> BBCode -> BBCode
ElSimple El
Code forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BBCode
ElText
{-# INLINE code #-}

-- | 'Preformatted' element contains plain text
pre :: Text -> BBCode
pre :: Text -> BBCode
pre = El -> BBCode -> BBCode
ElSimple El
Preformatted forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BBCode
ElText
{-# INLINE pre #-}

{-|
'bold', 'italic', 'underline', and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
box :: BBCode -> BBCode
box :: BBCode -> BBCode
box = El -> BBCode -> BBCode
ElSimple El
Box
{-# INLINE box #-}

-- | Takes image URL
image :: Text -> BBCode
image :: Text -> BBCode
image = El -> BBCode -> BBCode
ElSimple El
Image forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BBCode
ElText
{-# INLINE image #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
quote :: BBCode -> BBCode
quote :: BBCode -> BBCode
quote = El -> BBCode -> BBCode
ElSimple El
Quote
{-# INLINE quote #-}

{-|
bold, italic, underline, and all the rest functions @'BBCode' -> 'BBCode'@ work
the same way by wrapping argument in another element.
-}
spoiler :: BBCode -> BBCode
spoiler :: BBCode -> BBCode
spoiler = El -> BBCode -> BBCode
ElSimple El
Spoiler
{-# INLINE spoiler #-}

{-| Each element of list is prepended with 'listElement', meaning you can't
create list with contents but without elements

>>> list [bold "10", italic "15"]
ElSimple List (ElDocument [ElVoid ListElement,ElSimple Bold (ElText "10"),ElVoid ListElement,ElSimple Italic (ElText "15")])
-}
list :: [BBCode] -> BBCode
list :: [BBCode] -> BBCode
list =
  El -> BBCode -> BBCode
ElSimple El
List
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BBCode] -> BBCode
ElDocument
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[BBCode]
b BBCode
a -> [BBCode]
b forall a. Semigroup a => a -> a -> a
<> [BBCode
listEl, BBCode
a]) []
{-# INLINEABLE list #-}

-- | Like 'box' but with alignment argument
boxAlign :: BoxPosition -> BBCode -> BBCode
boxAlign :: BoxPosition -> BBCode -> BBCode
boxAlign BoxPosition
arg = El -> Text -> BBCode -> BBCode
ElArg El
Box (forall a. IsArgument a => a -> Text
toArgument BoxPosition
arg)
{-# INLINE boxAlign #-}

-- | Like 'image' but with alignment argument
imageAlign :: ImagePosition -> Text -> BBCode
imageAlign :: ImagePosition -> Text -> BBCode
imageAlign ImagePosition
arg = El -> Text -> BBCode -> BBCode
ElArg El
Image (forall a. IsArgument a => a -> Text
toArgument ImagePosition
arg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BBCode
ElText
{-# INLINE imageAlign #-}

-- | Named quote
quoteNamed :: Text -> BBCode -> BBCode
quoteNamed :: Text -> BBCode -> BBCode
quoteNamed = El -> Text -> BBCode -> BBCode
ElArg El
Quote
{-# INLINE quoteNamed #-}

-- | Named spoiler
spoilerNamed :: Text -> BBCode -> BBCode
spoilerNamed :: Text -> BBCode -> BBCode
spoilerNamed = El -> Text -> BBCode -> BBCode
ElArg El
Spoiler
{-# INLINE spoilerNamed #-}

{-| Ordered list

>>> listFlavor LatinUpper [bold "I am bald", boxAlign BoxRight "get boxxxed"]
ElArg List "A" (ElDocument [ElVoid ListElement,ElSimple Bold (ElText "I am bald"),ElVoid ListElement,ElArg Box "right" (ElText "get boxxxed")])
-}
listFlavor :: Foldable t => ListFlavor -> t BBCode -> BBCode
listFlavor :: forall (t :: * -> *).
Foldable t =>
ListFlavor -> t BBCode -> BBCode
listFlavor ListFlavor
flavor =
  El -> Text -> BBCode -> BBCode
ElArg El
List (forall a. IsArgument a => a -> Text
toArgument ListFlavor
flavor)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BBCode] -> BBCode
ElDocument
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[BBCode]
b BBCode
a -> [BBCode]
b forall a. Semigroup a => a -> a -> a
<> [BBCode
listEl, BBCode
a]) []
{-# INLINEABLE listFlavor #-}

{-| Change color of inner BBCode
First argument is either color name (e.g. blue) or hex color(e.g. #333 or #151515)
-}
color :: Text -> BBCode -> BBCode
color :: Text -> BBCode -> BBCode
color = El -> Text -> BBCode -> BBCode
ElArg El
Color
{-# INLINE color #-}

{-| Create a hyperlink

first argument is expected to be valid URL
-}
url :: Text -> BBCode -> BBCode
url :: Text -> BBCode -> BBCode
url = El -> Text -> BBCode -> BBCode
ElArg El
URL
{-# INLINE url #-}

{-| Change font size of inner bbcode

@arg@ ∈ [10, 29] and @arg@ is natural
-}
size :: Natural -> BBCode -> BBCode
size :: Natural -> BBCode -> BBCode
size Natural
arg = El -> Text -> BBCode -> BBCode
ElArg El
Size (forall a b. (Show a, IsString b) => a -> b
show' Natural
arg)
{-# INLINE size #-}

align :: AlignPosition -> BBCode -> BBCode
align :: AlignPosition -> BBCode -> BBCode
align AlignPosition
arg = El -> Text -> BBCode -> BBCode
ElArg El
Align (forall a. IsArgument a => a -> Text
toArgument AlignPosition
arg)
{-# INLINE align #-}

{-| Change font of inner BBCode

argument should be a valid font name
-}
font :: Text -> BBCode -> BBCode
font :: Text -> BBCode -> BBCode
font = El -> Text -> BBCode -> BBCode
ElArg El
Font
{-# INLINE font #-}