{-# LANGUAGE LambdaCase #-}
{-|
Module      : Text.Jira.Markup
Copyright   : © 2019–2023 Albert Krewinkel
License     : MIT

Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>
Stability   : alpha
Portability : portable

Jira markup types.
-}
module Text.Jira.Markup
  ( Doc (..)
  , Block (..)
  , Inline (..)
  , InlineStyle (..)
  , LinkType (..)
  , ListStyle (..)
  , URL (..)
  , ColorName (..)
  , Icon (..)
  , Row (..)
  , Cell (..)
  , Language (..)
  , Parameter (..)
  , normalizeInlines
  , iconText
  ) where

import Data.Text (Text, append)

-- | Jira document
newtype Doc = Doc { Doc -> [Block]
fromDoc :: [Block] }
  deriving (Doc -> Doc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Doc -> Doc -> Bool
$c/= :: Doc -> Doc -> Bool
== :: Doc -> Doc -> Bool
$c== :: Doc -> Doc -> Bool
Eq, Eq Doc
Doc -> Doc -> Bool
Doc -> Doc -> Ordering
Doc -> Doc -> Doc
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 :: Doc -> Doc -> Doc
$cmin :: Doc -> Doc -> Doc
max :: Doc -> Doc -> Doc
$cmax :: Doc -> Doc -> Doc
>= :: Doc -> Doc -> Bool
$c>= :: Doc -> Doc -> Bool
> :: Doc -> Doc -> Bool
$c> :: Doc -> Doc -> Bool
<= :: Doc -> Doc -> Bool
$c<= :: Doc -> Doc -> Bool
< :: Doc -> Doc -> Bool
$c< :: Doc -> Doc -> Bool
compare :: Doc -> Doc -> Ordering
$ccompare :: Doc -> Doc -> Ordering
Ord, Int -> Doc -> ShowS
[Doc] -> ShowS
Doc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Doc] -> ShowS
$cshowList :: [Doc] -> ShowS
show :: Doc -> String
$cshow :: Doc -> String
showsPrec :: Int -> Doc -> ShowS
$cshowsPrec :: Int -> Doc -> ShowS
Show)

-- | Inline Jira markup elements.
data Inline
  = Anchor Text                         -- ^ anchor for internal links
  | AutoLink URL                        -- ^ URL which is also a link
  | Citation [Inline]                   -- ^ source of a citation
  | ColorInline ColorName [Inline]      -- ^ colored inline text
  | Emoji Icon                          -- ^ emoticon
  | Entity Text                         -- ^ named or numeric HTML entity
  | Image [Parameter] URL               -- ^ an image
  | Linebreak                           -- ^ hard linebreak
  | Link LinkType [Inline] URL          -- ^ hyperlink with alias
  | Monospaced [Inline]                 -- ^ text rendered with monospaced font
  | Space                               -- ^ space between words
  | SpecialChar Char                    -- ^ single char with special meaning
  | Str Text                            -- ^ simple, markup-less string
  | Styled InlineStyle [Inline]         -- ^ styled text
  deriving (Inline -> Inline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c== :: Inline -> Inline -> Bool
Eq, Eq Inline
Inline -> Inline -> Bool
Inline -> Inline -> Ordering
Inline -> Inline -> Inline
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 :: Inline -> Inline -> Inline
$cmin :: Inline -> Inline -> Inline
max :: Inline -> Inline -> Inline
$cmax :: Inline -> Inline -> Inline
>= :: Inline -> Inline -> Bool
$c>= :: Inline -> Inline -> Bool
> :: Inline -> Inline -> Bool
$c> :: Inline -> Inline -> Bool
<= :: Inline -> Inline -> Bool
$c<= :: Inline -> Inline -> Bool
< :: Inline -> Inline -> Bool
$c< :: Inline -> Inline -> Bool
compare :: Inline -> Inline -> Ordering
$ccompare :: Inline -> Inline -> Ordering
Ord, Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inline] -> ShowS
$cshowList :: [Inline] -> ShowS
show :: Inline -> String
$cshow :: Inline -> String
showsPrec :: Int -> Inline -> ShowS
$cshowsPrec :: Int -> Inline -> ShowS
Show)

-- | Supported inline text effect styles.
data InlineStyle
  = Emphasis                            -- ^ emphasized text
  | Insert                              -- ^ text marked as having been inserted
  | Strikeout                           -- ^ deleted (struk-out) text
  | Strong                              -- ^ strongly emphasized text
  | Subscript                           -- ^ subscript text
  | Superscript                         -- ^ superscript text
  deriving (InlineStyle -> InlineStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineStyle -> InlineStyle -> Bool
$c/= :: InlineStyle -> InlineStyle -> Bool
== :: InlineStyle -> InlineStyle -> Bool
$c== :: InlineStyle -> InlineStyle -> Bool
Eq, Eq InlineStyle
InlineStyle -> InlineStyle -> Bool
InlineStyle -> InlineStyle -> Ordering
InlineStyle -> InlineStyle -> InlineStyle
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 :: InlineStyle -> InlineStyle -> InlineStyle
$cmin :: InlineStyle -> InlineStyle -> InlineStyle
max :: InlineStyle -> InlineStyle -> InlineStyle
$cmax :: InlineStyle -> InlineStyle -> InlineStyle
>= :: InlineStyle -> InlineStyle -> Bool
$c>= :: InlineStyle -> InlineStyle -> Bool
> :: InlineStyle -> InlineStyle -> Bool
$c> :: InlineStyle -> InlineStyle -> Bool
<= :: InlineStyle -> InlineStyle -> Bool
$c<= :: InlineStyle -> InlineStyle -> Bool
< :: InlineStyle -> InlineStyle -> Bool
$c< :: InlineStyle -> InlineStyle -> Bool
compare :: InlineStyle -> InlineStyle -> Ordering
$ccompare :: InlineStyle -> InlineStyle -> Ordering
Ord, Int -> InlineStyle -> ShowS
[InlineStyle] -> ShowS
InlineStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineStyle] -> ShowS
$cshowList :: [InlineStyle] -> ShowS
show :: InlineStyle -> String
$cshow :: InlineStyle -> String
showsPrec :: Int -> InlineStyle -> ShowS
$cshowsPrec :: Int -> InlineStyle -> ShowS
Show)

-- | Type of a link.
data LinkType
  = Attachment                          -- ^ link to an attachment
  | Email                               -- ^ link to an email address
  | External                            -- ^ external resource, like a website
  | SmartCard                           -- ^ smart-card link (external)
  | SmartLink                           -- ^ "smart" link with icon, short-name
  | User                                -- ^ link to a user
  deriving (LinkType -> LinkType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkType -> LinkType -> Bool
$c/= :: LinkType -> LinkType -> Bool
== :: LinkType -> LinkType -> Bool
$c== :: LinkType -> LinkType -> Bool
Eq, Eq LinkType
LinkType -> LinkType -> Bool
LinkType -> LinkType -> Ordering
LinkType -> LinkType -> LinkType
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 :: LinkType -> LinkType -> LinkType
$cmin :: LinkType -> LinkType -> LinkType
max :: LinkType -> LinkType -> LinkType
$cmax :: LinkType -> LinkType -> LinkType
>= :: LinkType -> LinkType -> Bool
$c>= :: LinkType -> LinkType -> Bool
> :: LinkType -> LinkType -> Bool
$c> :: LinkType -> LinkType -> Bool
<= :: LinkType -> LinkType -> Bool
$c<= :: LinkType -> LinkType -> Bool
< :: LinkType -> LinkType -> Bool
$c< :: LinkType -> LinkType -> Bool
compare :: LinkType -> LinkType -> Ordering
$ccompare :: LinkType -> LinkType -> Ordering
Ord, Int -> LinkType -> ShowS
[LinkType] -> ShowS
LinkType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkType] -> ShowS
$cshowList :: [LinkType] -> ShowS
show :: LinkType -> String
$cshow :: LinkType -> String
showsPrec :: Int -> LinkType -> ShowS
$cshowsPrec :: Int -> LinkType -> ShowS
Show)

-- | Blocks of text.
data Block
  = Code Language [Parameter] Text      -- ^ Code block with panel parameters
  | Color ColorName [Block]             -- ^ text displayed in a specific color
  | BlockQuote [Block]                  -- ^ Block of quoted content
  | Header Int [Inline]                 -- ^ Header with level and text
  | HorizontalRule                      -- ^ horizontal ruler
  | List ListStyle [[Block]]            -- ^ List
  | NoFormat [Parameter] Text           -- ^ Unformatted text
  | Panel [Parameter] [Block]           -- ^ Formatted panel
  | Para [Inline]                       -- ^ Paragraph of text
  | Table [Row]                         -- ^ Table
  deriving (Block -> Block -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq, Eq Block
Block -> Block -> Bool
Block -> Block -> Ordering
Block -> Block -> Block
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 :: Block -> Block -> Block
$cmin :: Block -> Block -> Block
max :: Block -> Block -> Block
$cmax :: Block -> Block -> Block
>= :: Block -> Block -> Bool
$c>= :: Block -> Block -> Bool
> :: Block -> Block -> Bool
$c> :: Block -> Block -> Bool
<= :: Block -> Block -> Bool
$c<= :: Block -> Block -> Bool
< :: Block -> Block -> Bool
$c< :: Block -> Block -> Bool
compare :: Block -> Block -> Ordering
$ccompare :: Block -> Block -> Ordering
Ord, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)

-- | Style used for list items.
data ListStyle
  = CircleBullets                       -- ^ List with round bullets
  | SquareBullets                       -- ^ List with square bullets
  | Enumeration                         -- ^ Enumeration, i.e., numbered items
  deriving (ListStyle -> ListStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStyle -> ListStyle -> Bool
$c/= :: ListStyle -> ListStyle -> Bool
== :: ListStyle -> ListStyle -> Bool
$c== :: ListStyle -> ListStyle -> Bool
Eq, Eq ListStyle
ListStyle -> ListStyle -> Bool
ListStyle -> ListStyle -> Ordering
ListStyle -> ListStyle -> ListStyle
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 :: ListStyle -> ListStyle -> ListStyle
$cmin :: ListStyle -> ListStyle -> ListStyle
max :: ListStyle -> ListStyle -> ListStyle
$cmax :: ListStyle -> ListStyle -> ListStyle
>= :: ListStyle -> ListStyle -> Bool
$c>= :: ListStyle -> ListStyle -> Bool
> :: ListStyle -> ListStyle -> Bool
$c> :: ListStyle -> ListStyle -> Bool
<= :: ListStyle -> ListStyle -> Bool
$c<= :: ListStyle -> ListStyle -> Bool
< :: ListStyle -> ListStyle -> Bool
$c< :: ListStyle -> ListStyle -> Bool
compare :: ListStyle -> ListStyle -> Ordering
$ccompare :: ListStyle -> ListStyle -> Ordering
Ord, Int -> ListStyle -> ShowS
[ListStyle] -> ShowS
ListStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStyle] -> ShowS
$cshowList :: [ListStyle] -> ShowS
show :: ListStyle -> String
$cshow :: ListStyle -> String
showsPrec :: Int -> ListStyle -> ShowS
$cshowsPrec :: Int -> ListStyle -> ShowS
Show)

-- | Text color
newtype ColorName = ColorName Text
  deriving (ColorName -> ColorName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorName -> ColorName -> Bool
$c/= :: ColorName -> ColorName -> Bool
== :: ColorName -> ColorName -> Bool
$c== :: ColorName -> ColorName -> Bool
Eq, Eq ColorName
ColorName -> ColorName -> Bool
ColorName -> ColorName -> Ordering
ColorName -> ColorName -> ColorName
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 :: ColorName -> ColorName -> ColorName
$cmin :: ColorName -> ColorName -> ColorName
max :: ColorName -> ColorName -> ColorName
$cmax :: ColorName -> ColorName -> ColorName
>= :: ColorName -> ColorName -> Bool
$c>= :: ColorName -> ColorName -> Bool
> :: ColorName -> ColorName -> Bool
$c> :: ColorName -> ColorName -> Bool
<= :: ColorName -> ColorName -> Bool
$c<= :: ColorName -> ColorName -> Bool
< :: ColorName -> ColorName -> Bool
$c< :: ColorName -> ColorName -> Bool
compare :: ColorName -> ColorName -> Ordering
$ccompare :: ColorName -> ColorName -> Ordering
Ord, Int -> ColorName -> ShowS
[ColorName] -> ShowS
ColorName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorName] -> ShowS
$cshowList :: [ColorName] -> ShowS
show :: ColorName -> String
$cshow :: ColorName -> String
showsPrec :: Int -> ColorName -> ShowS
$cshowsPrec :: Int -> ColorName -> ShowS
Show)

-- | Unified resource location
newtype URL = URL { URL -> Text
fromURL :: Text }
  deriving (URL -> URL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq, Eq URL
URL -> URL -> Bool
URL -> URL -> Ordering
URL -> URL -> URL
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 :: URL -> URL -> URL
$cmin :: URL -> URL -> URL
max :: URL -> URL -> URL
$cmax :: URL -> URL -> URL
>= :: URL -> URL -> Bool
$c>= :: URL -> URL -> Bool
> :: URL -> URL -> Bool
$c> :: URL -> URL -> Bool
<= :: URL -> URL -> Bool
$c<= :: URL -> URL -> Bool
< :: URL -> URL -> Bool
$c< :: URL -> URL -> Bool
compare :: URL -> URL -> Ordering
$ccompare :: URL -> URL -> Ordering
Ord, Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show)

-- | Table row, containing an arbitrary number of cells.
newtype Row = Row { Row -> [Cell]
fromRow :: [Cell] }
  deriving (Row -> Row -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Eq Row
Row -> Row -> Bool
Row -> Row -> Ordering
Row -> Row -> Row
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 :: Row -> Row -> Row
$cmin :: Row -> Row -> Row
max :: Row -> Row -> Row
$cmax :: Row -> Row -> Row
>= :: Row -> Row -> Bool
$c>= :: Row -> Row -> Bool
> :: Row -> Row -> Bool
$c> :: Row -> Row -> Bool
<= :: Row -> Row -> Bool
$c<= :: Row -> Row -> Bool
< :: Row -> Row -> Bool
$c< :: Row -> Row -> Bool
compare :: Row -> Row -> Ordering
$ccompare :: Row -> Row -> Ordering
Ord, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show)

-- | Table cell with block content
data Cell
  = BodyCell [Block]
  | HeaderCell [Block]
  deriving (Cell -> Cell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, Eq Cell
Cell -> Cell -> Bool
Cell -> Cell -> Ordering
Cell -> Cell -> Cell
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 :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmax :: Cell -> Cell -> Cell
>= :: Cell -> Cell -> Bool
$c>= :: Cell -> Cell -> Bool
> :: Cell -> Cell -> Bool
$c> :: Cell -> Cell -> Bool
<= :: Cell -> Cell -> Bool
$c<= :: Cell -> Cell -> Bool
< :: Cell -> Cell -> Bool
$c< :: Cell -> Cell -> Bool
compare :: Cell -> Cell -> Ordering
$ccompare :: Cell -> Cell -> Ordering
Ord, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show)

-- | Programming language used for syntax highlighting.
newtype Language = Language Text
  deriving (Language -> Language -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Eq Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
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 :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
Ord, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show)

-- | Panel parameter
data Parameter = Parameter
  { Parameter -> Text
parameterKey :: Text
  , Parameter -> Text
parameterValue :: Text
  } deriving (Parameter -> Parameter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameter -> Parameter -> Bool
$c/= :: Parameter -> Parameter -> Bool
== :: Parameter -> Parameter -> Bool
$c== :: Parameter -> Parameter -> Bool
Eq, Eq Parameter
Parameter -> Parameter -> Bool
Parameter -> Parameter -> Ordering
Parameter -> Parameter -> Parameter
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 :: Parameter -> Parameter -> Parameter
$cmin :: Parameter -> Parameter -> Parameter
max :: Parameter -> Parameter -> Parameter
$cmax :: Parameter -> Parameter -> Parameter
>= :: Parameter -> Parameter -> Bool
$c>= :: Parameter -> Parameter -> Bool
> :: Parameter -> Parameter -> Bool
$c> :: Parameter -> Parameter -> Bool
<= :: Parameter -> Parameter -> Bool
$c<= :: Parameter -> Parameter -> Bool
< :: Parameter -> Parameter -> Bool
$c< :: Parameter -> Parameter -> Bool
compare :: Parameter -> Parameter -> Ordering
$ccompare :: Parameter -> Parameter -> Ordering
Ord, Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameter] -> ShowS
$cshowList :: [Parameter] -> ShowS
show :: Parameter -> String
$cshow :: Parameter -> String
showsPrec :: Int -> Parameter -> ShowS
$cshowsPrec :: Int -> Parameter -> ShowS
Show)

-- | Graphical emoticons
data Icon
  = IconSlightlySmiling
  | IconFrowning
  | IconTongue
  | IconSmiling
  | IconWinking
  | IconThumbsUp
  | IconThumbsDown
  | IconInfo
  | IconCheckmark
  | IconX
  | IconAttention
  | IconPlus
  | IconMinus
  | IconQuestionmark
  | IconOn
  | IconOff
  | IconStar
  | IconStarRed
  | IconStarGreen
  | IconStarBlue
  | IconStarYellow
  | IconFlag
  | IconFlagOff
  deriving (Int -> Icon
Icon -> Int
Icon -> [Icon]
Icon -> Icon
Icon -> Icon -> [Icon]
Icon -> Icon -> Icon -> [Icon]
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 :: Icon -> Icon -> Icon -> [Icon]
$cenumFromThenTo :: Icon -> Icon -> Icon -> [Icon]
enumFromTo :: Icon -> Icon -> [Icon]
$cenumFromTo :: Icon -> Icon -> [Icon]
enumFromThen :: Icon -> Icon -> [Icon]
$cenumFromThen :: Icon -> Icon -> [Icon]
enumFrom :: Icon -> [Icon]
$cenumFrom :: Icon -> [Icon]
fromEnum :: Icon -> Int
$cfromEnum :: Icon -> Int
toEnum :: Int -> Icon
$ctoEnum :: Int -> Icon
pred :: Icon -> Icon
$cpred :: Icon -> Icon
succ :: Icon -> Icon
$csucc :: Icon -> Icon
Enum, Icon -> Icon -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Icon -> Icon -> Bool
$c/= :: Icon -> Icon -> Bool
== :: Icon -> Icon -> Bool
$c== :: Icon -> Icon -> Bool
Eq, Eq Icon
Icon -> Icon -> Bool
Icon -> Icon -> Ordering
Icon -> Icon -> Icon
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 :: Icon -> Icon -> Icon
$cmin :: Icon -> Icon -> Icon
max :: Icon -> Icon -> Icon
$cmax :: Icon -> Icon -> Icon
>= :: Icon -> Icon -> Bool
$c>= :: Icon -> Icon -> Bool
> :: Icon -> Icon -> Bool
$c> :: Icon -> Icon -> Bool
<= :: Icon -> Icon -> Bool
$c<= :: Icon -> Icon -> Bool
< :: Icon -> Icon -> Bool
$c< :: Icon -> Icon -> Bool
compare :: Icon -> Icon -> Ordering
$ccompare :: Icon -> Icon -> Ordering
Ord, Int -> Icon -> ShowS
[Icon] -> ShowS
Icon -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Icon] -> ShowS
$cshowList :: [Icon] -> ShowS
show :: Icon -> String
$cshow :: Icon -> String
showsPrec :: Int -> Icon -> ShowS
$cshowsPrec :: Int -> Icon -> ShowS
Show)

-- | Normalize a list of inlines, merging elements where possible.
normalizeInlines :: [Inline] -> [Inline]
normalizeInlines :: [Inline] -> [Inline]
normalizeInlines = \case
  []                     -> []
  [Inline
Space]                -> []
  [Inline
Linebreak]            -> []
  Inline
Space : Inline
Space : [Inline]
xs     -> Inline
Space forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
normalizeInlines [Inline]
xs
  Inline
Space : Inline
Linebreak : [Inline]
xs -> Inline
Linebreak forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
normalizeInlines [Inline]
xs
  Inline
Linebreak : Inline
Space : [Inline]
xs -> Inline
Linebreak forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
normalizeInlines [Inline]
xs
  Str Text
s1 : Str Text
s2 : [Inline]
xs   -> Text -> Inline
Str (Text
s1 Text -> Text -> Text
`append` Text
s2) forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
normalizeInlines [Inline]
xs
  Inline
x : [Inline]
xs                 -> Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
normalizeInlines [Inline]
xs

-- | Gets the characters used to represent an emoji.
iconText :: Icon -> Text
iconText :: Icon -> Text
iconText = \case
  Icon
IconSlightlySmiling -> Text
":)"
  Icon
IconFrowning        -> Text
":("
  Icon
IconTongue          -> Text
":P"
  Icon
IconSmiling         -> Text
":D"
  Icon
IconWinking         -> Text
";)"
  Icon
IconThumbsUp        -> Text
"(y)"
  Icon
IconThumbsDown      -> Text
"(n)"
  Icon
IconInfo            -> Text
"(i)"
  Icon
IconCheckmark       -> Text
"(/)"
  Icon
IconX               -> Text
"(x)"
  Icon
IconAttention       -> Text
"(!)"
  Icon
IconPlus            -> Text
"(+)"
  Icon
IconMinus           -> Text
"(-)"
  Icon
IconQuestionmark    -> Text
"(?)"
  Icon
IconOn              -> Text
"(on)"
  Icon
IconOff             -> Text
"(off)"
  Icon
IconStar            -> Text
"(*)"
  Icon
IconStarRed         -> Text
"(*r)"
  Icon
IconStarGreen       -> Text
"(*g)"
  Icon
IconStarBlue        -> Text
"(*b)"
  Icon
IconStarYellow      -> Text
"(*y)"
  Icon
IconFlag            -> Text
"(flag)"
  Icon
IconFlagOff         -> Text
"(flagoff)"