module Text.BBCode.Internal.Builder where

import Numeric.Natural
import Text.BBCode.Internal.Helper
import Data.List (intersperse)

{-| Newline

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

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

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

-- | 'intersperse' list with 'nl' and wrap it in 'ElDocument'
docNL :: [BBCode] -> BBCode
docNL = doc . intersperse nl

{-| Horizontal line

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

{-|
Line break

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

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

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

@listEl@ represents "[*]"

> listEl == 'ElVoid' 'ListElement'
-}
listEl :: BBCode
listEl = ElVoid 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 = ElSimple 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 = ElSimple 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 = ElSimple 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 = ElSimple 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 = ElSimple 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 = ElSimple 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 = ElSimple Oneline
{-# INLINE oneline #-}

-- | 'Code' element contains plain text
code :: Text -> BBCode
code = ElSimple Code . ElText
{-# INLINE code #-}

-- | 'Preformatted' element contains plain text
pre :: Text -> BBCode
pre = ElSimple Preformatted . 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 = ElSimple Box
{-# INLINE box #-}

-- | Takes image URL
image :: Text -> BBCode
image = ElSimple Image . 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 = ElSimple 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 = ElSimple 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 =
  ElSimple List
    . ElDocument
    . foldl (\b a -> b <> [listEl, a]) []
{-# INLINEABLE list #-}

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

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

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

-- | Named spoiler
spoilerNamed :: Text -> BBCode -> BBCode
spoilerNamed = ElArg 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 flavor =
  ElArg List (toArgument flavor)
    . ElDocument
    . foldl (\b a -> b <> [listEl, 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 = ElArg Color
{-# INLINE color #-}

{-| Create a hyperlink

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

{-| Change font size of inner bbcode

@arg@ ∈ [10, 29] and @arg@ is natural
-}
size :: Natural -> BBCode -> BBCode
size arg = ElArg Size (show' arg)
{-# INLINE size #-}

align :: AlignPosition -> BBCode -> BBCode
align arg = ElArg Align (toArgument arg)
{-# INLINE align #-}

{-| Change font of inner BBCode

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