{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

module Text.BBCode.Internal.Types where

import Control.Lens hiding (List)
import Data.String (IsString (..))
import Data.Text (Text)

-- |BBCode AST
data BBCode where
  -- |Element that has neither closing part nor arguments
  --
  -- @'ElVoid' 'HR'@ represents "[hr]"
  ElVoid :: El -> BBCode
  -- |Element that has closing part but no arguments
  --
  -- @'ElSimple' 'Bold' ('ElText' "abc")@ represents @"[b]abc[/b]"@
  ElSimple :: El -> BBCode -> BBCode
  -- |Element that has closing part and exactly one argument
  --
  -- @'ElArg' 'Color' "red" ('ElText' "I am red")@ represents @"[color=red]I am red[/color]"@
  ElArg :: El -> Text -> BBCode -> BBCode
  -- |Plain text
  --
  -- @'ElText' "I am text" represents @"I am text"@
  ElText :: Text -> BBCode
  -- |Just a list of BBCode elements, just as type signature says.
  --
  -- @'ElDocument' ['ElSimple' 'Bold' ('ElText' "Bold not bald"), 'ElText' "legit text"]@
  -- represents @"[b]Bold not bald[/b]legit text"@
  ElDocument :: [BBCode] -> BBCode
  deriving
    ( BBCode -> BBCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BBCode -> BBCode -> Bool
$c/= :: BBCode -> BBCode -> Bool
== :: BBCode -> BBCode -> Bool
$c== :: BBCode -> BBCode -> Bool
Eq
    , -- |Don't use it to render BBCode!
      Int -> BBCode -> ShowS
[BBCode] -> ShowS
BBCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BBCode] -> ShowS
$cshowList :: [BBCode] -> ShowS
show :: BBCode -> String
$cshow :: BBCode -> String
showsPrec :: Int -> BBCode -> ShowS
$cshowsPrec :: Int -> BBCode -> ShowS
Show
    )

instance Semigroup BBCode where
  (<>) :: BBCode -> BBCode -> BBCode
  <> :: BBCode -> BBCode -> BBCode
(<>) (ElText Text
x) (ElText Text
y) = Text -> BBCode
ElText forall a b. (a -> b) -> a -> b
$ Text
x forall a. Semigroup a => a -> a -> a
<> Text
y
  (<>) (ElText Text
"") BBCode
y = BBCode
y
  (<>) BBCode
x (ElText Text
"") = BBCode
x
  (<>) (ElDocument [BBCode]
xs) (ElDocument [BBCode]
ys) = [BBCode] -> BBCode
ElDocument forall a b. (a -> b) -> a -> b
$ [BBCode]
xs forall a. Semigroup a => a -> a -> a
<> [BBCode]
ys
  (<>) (ElDocument [BBCode]
xs) BBCode
y = [BBCode] -> BBCode
ElDocument forall a b. (a -> b) -> a -> b
$ [BBCode]
xs forall a. Semigroup a => a -> a -> a
<> [BBCode
y]
  (<>) BBCode
x (ElDocument [BBCode]
ys) = [BBCode] -> BBCode
ElDocument forall a b. (a -> b) -> a -> b
$ [BBCode
x] forall a. Semigroup a => a -> a -> a
<> [BBCode]
ys
  (<>) BBCode
x BBCode
y = [BBCode] -> BBCode
ElDocument [BBCode
x, BBCode
y]
  {-# INLINEABLE (<>) #-}

{- |
Identity is defined as zero-width Text

>>> mempty :: BBCode
ElText ""
-}
instance Monoid BBCode where
  mempty :: BBCode
  mempty :: BBCode
mempty = Text -> BBCode
ElText Text
""
  {-# INLINE mempty #-}

{- |
Allows easier BBCode construction

>>> ElSimple Bold "I am bold"
ElSimple Bold (ElText "I am bold")

Recall that 'ElSimple' takes 'El' and 'BBCode', but not 'Text'
-}
instance IsString BBCode where
  fromString :: String -> BBCode
  fromString :: String -> BBCode
fromString = Text -> BBCode
ElText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
  {-# INLINE fromString #-}

{- ORMOLU_DISABLE -}
{- |
Type of an element. 'BBCode' declares three constructors for elements: 'ElVoid', 'ElSimple', 'ElArg'. But 'El' can be split into four cateogories:
1) void elements,
2) simple elements,
3) elements with optional argument,
4) element with one argument

There is no enforcement of combining 'BBCode' constuctors and 'El' values, that means you can create @ElSimple HR (ElText "smth")@ but that would make no sense. 'Text.BBCode.pretty' would emit a runtime error if you try to pass such value.
-}
data El
  = HR            -- ^ void element
  | BR            -- ^ void element
  | Clear         -- ^ void element
  | ListElement   -- ^ void element

  | Bold          -- ^ simple element
  | Italic        -- ^ simple element
  | Underline     -- ^ simple element
  | Strikethrough -- ^ simple element
  | Indent        -- ^ simple element
  | NFO           -- ^ simple element
  | Oneline       -- ^ simple element
  | Code          -- ^ simple element
  | Preformatted  -- ^ simple element

  | Box           -- ^ element with optional argument
  | Image         -- ^ element with optional argument
  | Quote         -- ^ element with optional argument
  | Spoiler       -- ^ element with optional argument
  | List          -- ^ element with optional argument

  | Color         -- ^ element with one argument
  | URL           -- ^ element with one argument
  | Size          -- ^ element with one argument
  | Align         -- ^ element with one argument
  | Font          -- ^ element with one argument
  deriving
    ( El -> El -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: El -> El -> Bool
$c/= :: El -> El -> Bool
== :: El -> El -> Bool
$c== :: El -> El -> Bool
Eq
    , Eq El
El -> El -> Bool
El -> El -> Ordering
El -> El -> El
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: El -> El -> El
$cmin :: El -> El -> El
max :: El -> El -> El
$cmax :: El -> El -> El
>= :: El -> El -> Bool
$c>= :: El -> El -> Bool
> :: El -> El -> Bool
$c> :: El -> El -> Bool
<= :: El -> El -> Bool
$c<= :: El -> El -> Bool
< :: El -> El -> Bool
$c< :: El -> El -> Bool
compare :: El -> El -> Ordering
$ccompare :: El -> El -> Ordering
Ord -- ^ Allows having 'Data.Map.Map' with key type 'El' (used in Parser)
    , Int -> El -> ShowS
[El] -> ShowS
El -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [El] -> ShowS
$cshowList :: [El] -> ShowS
show :: El -> String
$cshow :: El -> String
showsPrec :: Int -> El -> ShowS
$cshowsPrec :: Int -> El -> ShowS
Show
    , Int -> El
El -> Int
El -> [El]
El -> El
El -> El -> [El]
El -> El -> El -> [El]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: El -> El -> El -> [El]
$cenumFromThenTo :: El -> El -> El -> [El]
enumFromTo :: El -> El -> [El]
$cenumFromTo :: El -> El -> [El]
enumFromThen :: El -> El -> [El]
$cenumFromThen :: El -> El -> [El]
enumFrom :: El -> [El]
$cenumFrom :: El -> [El]
fromEnum :: El -> Int
$cfromEnum :: El -> Int
toEnum :: Int -> El
$ctoEnum :: Int -> El
pred :: El -> El
$cpred :: El -> El
succ :: El -> El
$csucc :: El -> El
Enum -- ^ Allows internal module to quickly list elements of different categories (Void, Simple, Optional, One)
    , El
forall a. a -> a -> Bounded a
maxBound :: El
$cmaxBound :: El
minBound :: El
$cminBound :: El
Bounded -- ^ Addition to Enum instance
    )
{- ORMOLU_ENABLE -}

{- |
Used for building BBCode safely. Instead of passing 'Text' to builder functions,
you pass values of types that implement 'IsArgument'. Then 'toArgument' is used
to convert that value to Text.
-}
class IsArgument a where
  toArgument :: a -> Text

-- | Argument to 'Text.BBCode.align'
data AlignPosition where
  AlignLeft :: AlignPosition
  AlignRight :: AlignPosition
  AlignCenter :: AlignPosition
  AlignJustify :: AlignPosition
  deriving (AlignPosition -> AlignPosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignPosition -> AlignPosition -> Bool
$c/= :: AlignPosition -> AlignPosition -> Bool
== :: AlignPosition -> AlignPosition -> Bool
$c== :: AlignPosition -> AlignPosition -> Bool
Eq, Int -> AlignPosition -> ShowS
[AlignPosition] -> ShowS
AlignPosition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlignPosition] -> ShowS
$cshowList :: [AlignPosition] -> ShowS
show :: AlignPosition -> String
$cshow :: AlignPosition -> String
showsPrec :: Int -> AlignPosition -> ShowS
$cshowsPrec :: Int -> AlignPosition -> ShowS
Show)

instance IsArgument AlignPosition where
  toArgument :: AlignPosition -> Text
  toArgument :: AlignPosition -> Text
toArgument AlignPosition
AlignLeft = Text
"left"
  toArgument AlignPosition
AlignRight = Text
"right"
  toArgument AlignPosition
AlignCenter = Text
"center"
  toArgument AlignPosition
AlignJustify = Text
"justify"
  {-# INLINEABLE toArgument #-}

-- | Argument to 'Text.BBCode.listFlavor'
data ListFlavor where
  -- | Numeric 1, 2, 3,..
  Roman :: ListFlavor
  -- | Arabic I, II, III,..
  ArabicUpper :: ListFlavor
  -- | Arabic i, ii, iii,..
  ArabicLower :: ListFlavor
  -- | Alphabetical A, B, C,..
  LatinUpper :: ListFlavor
  -- | Alphabetical a, b, c,..
  LatinLower :: ListFlavor
  deriving (ListFlavor -> ListFlavor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFlavor -> ListFlavor -> Bool
$c/= :: ListFlavor -> ListFlavor -> Bool
== :: ListFlavor -> ListFlavor -> Bool
$c== :: ListFlavor -> ListFlavor -> Bool
Eq, Int -> ListFlavor -> ShowS
[ListFlavor] -> ShowS
ListFlavor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFlavor] -> ShowS
$cshowList :: [ListFlavor] -> ShowS
show :: ListFlavor -> String
$cshow :: ListFlavor -> String
showsPrec :: Int -> ListFlavor -> ShowS
$cshowsPrec :: Int -> ListFlavor -> ShowS
Show)

instance IsArgument ListFlavor where
  toArgument :: ListFlavor -> Text
  toArgument :: ListFlavor -> Text
toArgument ListFlavor
Roman = Text
"1"
  toArgument ListFlavor
ArabicUpper = Text
"I"
  toArgument ListFlavor
ArabicLower = Text
"i"
  toArgument ListFlavor
LatinUpper = Text
"A"
  toArgument ListFlavor
LatinLower = Text
"a"
  {-# INLINEABLE toArgument #-}

-- | Argument to 'Text.BBCode.imageAlign'
data ImagePosition where
  ImageLeft :: ImagePosition
  ImageRight :: ImagePosition
  deriving (ImagePosition -> ImagePosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImagePosition -> ImagePosition -> Bool
$c/= :: ImagePosition -> ImagePosition -> Bool
== :: ImagePosition -> ImagePosition -> Bool
$c== :: ImagePosition -> ImagePosition -> Bool
Eq, Int -> ImagePosition -> ShowS
[ImagePosition] -> ShowS
ImagePosition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImagePosition] -> ShowS
$cshowList :: [ImagePosition] -> ShowS
show :: ImagePosition -> String
$cshow :: ImagePosition -> String
showsPrec :: Int -> ImagePosition -> ShowS
$cshowsPrec :: Int -> ImagePosition -> ShowS
Show)

instance IsArgument ImagePosition where
  toArgument :: ImagePosition -> Text
  toArgument :: ImagePosition -> Text
toArgument ImagePosition
ImageLeft = Text
"left"
  toArgument ImagePosition
ImageRight = Text
"right"
  {-# INLINEABLE toArgument #-}

-- | Argument to 'Text.BBCode.boxAlign'
data BoxPosition where
  BoxLeft :: BoxPosition
  BoxCenter :: BoxPosition
  BoxRight :: BoxPosition
  deriving (BoxPosition -> BoxPosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxPosition -> BoxPosition -> Bool
$c/= :: BoxPosition -> BoxPosition -> Bool
== :: BoxPosition -> BoxPosition -> Bool
$c== :: BoxPosition -> BoxPosition -> Bool
Eq, Int -> BoxPosition -> ShowS
[BoxPosition] -> ShowS
BoxPosition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxPosition] -> ShowS
$cshowList :: [BoxPosition] -> ShowS
show :: BoxPosition -> String
$cshow :: BoxPosition -> String
showsPrec :: Int -> BoxPosition -> ShowS
$cshowsPrec :: Int -> BoxPosition -> ShowS
Show)

instance IsArgument BoxPosition where
  toArgument :: BoxPosition -> Text
  toArgument :: BoxPosition -> Text
toArgument BoxPosition
BoxLeft = Text
"left"
  toArgument BoxPosition
BoxCenter = Text
"center"
  toArgument BoxPosition
BoxRight = Text
"right"
  {-# INLINEABLE toArgument #-}

makePrisms ''BBCode
makePrisms ''AlignPosition
makePrisms ''ListFlavor
makePrisms ''ImagePosition
makePrisms ''El