Types.hs

{-# 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
    ( Eq
    , -- |Don't use it to render BBCode!
      Show
    )

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

{- |
Identity is defined as zero-width Text

>>> mempty :: BBCode
ElText ""
-}
instance Monoid BBCode where
  mempty :: BBCode
  mempty = ElText ""
  {-# 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 = ElText . 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
    ( Eq
    , Ord -- ^ Allows having 'Data.Map.Map' with key type 'El' (used in Parser)
    , Show
    , Enum -- ^ Allows internal module to quickly list elements of different categories (Void, Simple, Optional, One)
    , 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 (Eq, Show)

instance IsArgument AlignPosition where
  toArgument :: AlignPosition -> Text
  toArgument AlignLeft = "left"
  toArgument AlignRight = "right"
  toArgument AlignCenter = "center"
  toArgument AlignJustify = "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 (Eq, Show)

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

-- | Argument to 'Text.BBCode.imageAlign'
data ImagePosition where
  ImageLeft :: ImagePosition
  ImageRight :: ImagePosition
  deriving (Eq, Show)

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

-- | Argument to 'Text.BBCode.boxAlign'
data BoxPosition where
  BoxLeft :: BoxPosition
  BoxCenter :: BoxPosition
  BoxRight :: BoxPosition
  deriving (Eq, Show)

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

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