{-# LANGUAGE LambdaCase #-}
module Text.Jira.Parser.Shared
( icon
, icon'
, colorName
) where
import Data.Char (isLetter)
import Data.Text (Text)
import Text.Jira.Markup
import Text.Parsec
icon :: Parsec Text u Icon
icon :: forall u. Parsec Text u Icon
icon = Parsec Text u Icon
forall u. Parsec Text u Icon
icon' Parsec Text u Icon
-> ParsecT Text u Identity () -> Parsec Text u Icon
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text u Identity Char -> ParsecT Text u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
icon' :: Parsec Text u Icon
icon' :: forall u. 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 :: forall u. Parsec Text u Icon
smiley = ParsecT Text u Identity Icon -> ParsecT Text u Identity Icon
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u Identity Icon -> ParsecT Text u Identity Icon)
-> ParsecT Text u Identity Icon -> ParsecT Text u Identity Icon
forall a b. (a -> b) -> a -> b
$ [ParsecT Text u Identity Icon] -> ParsecT Text u Identity 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 [Char] -> ParsecT Text u Identity Icon
forall a b.
a -> ParsecT Text u Identity b -> ParsecT Text u Identity a
forall (f :: * -> *) a b. Functor 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]
string [Char]
";)"
, Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity b
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 -> ParsecT Text u Identity Icon)
-> ParsecT Text u Identity Icon
forall a b.
ParsecT Text u Identity a
-> (a -> ParsecT Text u Identity b) -> ParsecT Text u Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'D' -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconSmiling
Char
')' -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconSlightlySmiling
Char
'(' -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconFrowning
Char
'P' -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconTongue
Char
c -> [Char] -> ParsecT Text u Identity Icon
forall a. [Char] -> ParsecT Text u Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"unknown smiley: :" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c])
]
otherIcon :: Parsec Text u Icon
otherIcon :: forall u. Parsec Text u Icon
otherIcon = ParsecT Text u Identity Icon -> ParsecT Text u Identity Icon
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u Identity Icon -> ParsecT Text u Identity Icon)
-> ParsecT Text u Identity Icon -> ParsecT Text u Identity Icon
forall a b. (a -> b) -> a -> b
$ do
let isIconChar :: Char -> Bool
isIconChar Char
c = Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| (Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"/!+-?*" :: String))
[Char]
name <- Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
ParsecT Text u Identity Char
-> ParsecT Text u Identity [Char] -> ParsecT Text u Identity [Char]
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
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 [Char]
-> ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity a
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 Char
')'
case [Char]
name of
[Char]
"y" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconThumbsUp
[Char]
"n" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconThumbsDown
[Char]
"i" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconInfo
[Char]
"/" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconCheckmark
[Char]
"x" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconX
[Char]
"!" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconAttention
[Char]
"+" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconPlus
[Char]
"-" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconMinus
[Char]
"?" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconQuestionmark
[Char]
"on" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconOn
[Char]
"off" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconOff
[Char]
"*" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStar
[Char]
"*r" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarRed
[Char]
"*g" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarGreen
[Char]
"*b" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarBlue
[Char]
"*y" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconStarYellow
[Char]
"flag" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconFlag
[Char]
"flagoff" -> Icon -> ParsecT Text u Identity Icon
forall a. a -> ParsecT Text u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Icon
IconFlagOff
[Char]
_ -> [Char] -> ParsecT Text u Identity Icon
forall a. [Char] -> ParsecT Text u Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"not a known emoji" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name)
colorName :: Parsec Text u String
colorName :: forall u. Parsec Text u [Char]
colorName = ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
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 ParsecT Text u Identity [Char]
-> ParsecT Text u Identity [Char] -> ParsecT Text u Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity [Char]
forall u. Parsec Text u [Char]
hexColor
where
hexColor :: ParsecT Text u Identity [Char]
hexColor = (:) (Char -> [Char] -> [Char])
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity ([Char] -> [Char])
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
'#' (Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#') ParsecT Text u Identity ([Char] -> [Char])
-> ParsecT Text u Identity [Char] -> ParsecT Text u Identity [Char]
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
6 ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit