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

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

Parsers whch are shared between multiple modules.
-}
module Text.Jira.Parser.Shared
  ( icon
  , colorName
  ) where

import Data.Char (isLetter)
import Data.Text (Text)
import Text.Jira.Markup
import Text.Parsec

-- | Parses an icon
icon :: Parsec Text u Icon
icon :: Parsec Text u Icon
icon = Parsec Text u Icon
forall u. Parsec Text u Icon
smiley Parsec Text u Icon -> Parsec Text u Icon -> Parsec Text u Icon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text u Icon
forall u. Parsec Text u Icon
otherIcon

smiley :: Parsec Text u Icon
smiley :: Parsec Text u Icon
smiley = Parsec Text u Icon -> Parsec Text u Icon
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text u Icon -> Parsec Text u Icon)
-> Parsec Text u Icon -> Parsec Text u Icon
forall a b. (a -> b) -> a -> b
$ [Parsec Text u Icon] -> Parsec Text u Icon
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
  [ Icon
IconWinking Icon -> ParsecT Text u Identity String -> Parsec Text u Icon
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ";)"
  , Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':' ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text u Identity Char
-> (Char -> Parsec Text u Icon) -> Parsec Text u Icon
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      'D' -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconSmiling
      ')' -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconSlightlySmiling
      '(' -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconFrowning
      'P' -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconTongue
      c :: Char
c   -> String -> Parsec Text u Icon
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("unknown smiley: :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c])
  ]

otherIcon :: Parsec Text u Icon
otherIcon :: Parsec Text u Icon
otherIcon = Parsec Text u Icon -> Parsec Text u Icon
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text u Icon -> Parsec Text u Icon)
-> Parsec Text u Icon -> Parsec Text u Icon
forall a b. (a -> b) -> a -> b
$ do
  let isIconChar :: Char -> Bool
isIconChar c :: Char
c = Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| (Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("/!+-?*" :: String))
  String
name <- Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '('
          ParsecT Text u Identity Char
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIconChar)
          ParsecT Text u Identity String
-> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ')'
  case String
name of
    "y"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconThumbsUp
    "n"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconThumbsDown
    "i"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconInfo
    "/"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconCheckmark
    "x"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconX
    "!"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconAttention
    "+"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconPlus
    "-"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconMinus
    "?"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconQuestionmark
    "on"      -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconOn
    "off"     -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconOff
    "*"       -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStar
    "*r"      -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarRed
    "*g"      -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarGreen
    "*b"      -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarBlue
    "*y"      -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarYellow
    "flag"    -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconFlag
    "flagoff" -> Icon -> Parsec Text u Icon
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconFlagOff
    _         -> String -> Parsec Text u Icon
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("not a known emoji" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)

colorName :: Parsec Text u String
colorName :: Parsec Text u String
colorName = ParsecT Text u Identity Char -> Parsec Text u String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter Parsec Text u String
-> Parsec Text u String -> Parsec Text u String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text u String
forall u. ParsecT Text u Identity String
hexColor
  where
    hexColor :: ParsecT Text u Identity String
hexColor = (:) (Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option '#' (Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '#') ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 6 ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit