{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Commonmark.Extensions.Alerts
  ( alertSpec
  , alertSvgText
  , alertClass
  , alertName
  , AlertType(..)
  , HasAlerts(..)
  )
where
import Commonmark.Types
import Commonmark.Syntax
import Commonmark.Blocks
import Commonmark.SourceMap
import Commonmark.TokParsers
import Commonmark.Tokens
import Commonmark.Html
import Control.Monad (void)
import Data.Dynamic
import Data.Tree
import Text.Parsec
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

alertSpec :: (Monad m, Typeable m, IsBlock il bl, IsInline il,
                 Typeable il, Typeable bl, HasAlerts il bl)
             => SyntaxSpec m il bl
alertSpec :: forall (m :: * -> *) il bl.
(Monad m, Typeable m, IsBlock il bl, IsInline il, Typeable il,
 Typeable bl, HasAlerts il bl) =>
SyntaxSpec m il bl
alertSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs = [alertBlockSpec]
  }


alertBlockSpec :: (Monad m, IsBlock il bl, HasAlerts il bl)
               => BlockSpec m il bl
alertBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasAlerts il bl) =>
BlockSpec m il bl
alertBlockSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"Alert"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Tok
_ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
             Int
_ <- Int
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
1)
             Tok
_ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
             Tok
_ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
             let eqCI :: Text -> Text -> Bool
eqCI Text
x Text
y = Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toUpper Text
y
             AlertType
alertType <- (AlertType
NoteAlert AlertType
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
eqCI Text
"NOTE"))
                      ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (AlertType
TipAlert AlertType
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
eqCI Text
"TIP"))
                      ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (AlertType
ImportantAlert AlertType
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
eqCI Text
"IMPORTANT"))
                      ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (AlertType
WarningAlert AlertType
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
eqCI Text
"WARNING"))
                      ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (AlertType
CautionAlert AlertType
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m AlertType
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
eqCI Text
"CAUTION"))
             Tok
_ <-  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
                BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree a] -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasAlerts il bl) =>
BlockSpec m il bl
alertBlockSpec){
                          blockData = toDyn alertType,
                          blockStartPos = [pos] } []
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
forall a b. a -> b -> a
const Bool
True
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl (SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$ do
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Tok
_ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
             Int
_ <- Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
1
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, BlockNode m il bl
n)
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node -> do
         let alertType :: AlertType
alertType = Dynamic -> AlertType -> AlertType
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) AlertType
NoteAlert
         AlertType -> bl -> bl
forall il bl. HasAlerts il bl => AlertType -> bl -> bl
alert AlertType
alertType (bl -> bl) -> ([bl] -> bl) -> [bl] -> bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [bl] -> bl
forall a. Monoid a => [a] -> a
mconcat ([bl] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl]
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren BlockNode m il bl
node
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

data AlertType =
     NoteAlert
   | TipAlert
   | ImportantAlert
   | WarningAlert
   | CautionAlert
  deriving (Int -> AlertType -> ShowS
[AlertType] -> ShowS
AlertType -> String
(Int -> AlertType -> ShowS)
-> (AlertType -> String)
-> ([AlertType] -> ShowS)
-> Show AlertType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlertType -> ShowS
showsPrec :: Int -> AlertType -> ShowS
$cshow :: AlertType -> String
show :: AlertType -> String
$cshowList :: [AlertType] -> ShowS
showList :: [AlertType] -> ShowS
Show, Typeable, AlertType -> AlertType -> Bool
(AlertType -> AlertType -> Bool)
-> (AlertType -> AlertType -> Bool) -> Eq AlertType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlertType -> AlertType -> Bool
== :: AlertType -> AlertType -> Bool
$c/= :: AlertType -> AlertType -> Bool
/= :: AlertType -> AlertType -> Bool
Eq, Eq AlertType
Eq AlertType =>
(AlertType -> AlertType -> Ordering)
-> (AlertType -> AlertType -> Bool)
-> (AlertType -> AlertType -> Bool)
-> (AlertType -> AlertType -> Bool)
-> (AlertType -> AlertType -> Bool)
-> (AlertType -> AlertType -> AlertType)
-> (AlertType -> AlertType -> AlertType)
-> Ord AlertType
AlertType -> AlertType -> Bool
AlertType -> AlertType -> Ordering
AlertType -> AlertType -> AlertType
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
$ccompare :: AlertType -> AlertType -> Ordering
compare :: AlertType -> AlertType -> Ordering
$c< :: AlertType -> AlertType -> Bool
< :: AlertType -> AlertType -> Bool
$c<= :: AlertType -> AlertType -> Bool
<= :: AlertType -> AlertType -> Bool
$c> :: AlertType -> AlertType -> Bool
> :: AlertType -> AlertType -> Bool
$c>= :: AlertType -> AlertType -> Bool
>= :: AlertType -> AlertType -> Bool
$cmax :: AlertType -> AlertType -> AlertType
max :: AlertType -> AlertType -> AlertType
$cmin :: AlertType -> AlertType -> AlertType
min :: AlertType -> AlertType -> AlertType
Ord)

alertClass :: AlertType -> Text
alertClass :: AlertType -> Text
alertClass AlertType
NoteAlert = Text
"alert-note"
alertClass AlertType
TipAlert = Text
"alert-tip"
alertClass AlertType
ImportantAlert = Text
"alert-important"
alertClass AlertType
WarningAlert = Text
"alert-warning"
alertClass AlertType
CautionAlert = Text
"alert-caution"

alertName :: AlertType -> Text
alertName :: AlertType -> Text
alertName AlertType
NoteAlert = Text
"Note"
alertName AlertType
TipAlert = Text
"Tip"
alertName AlertType
ImportantAlert = Text
"Important"
alertName AlertType
WarningAlert = Text
"Warning"
alertName AlertType
CautionAlert = Text
"Caution"

alertSvg :: AlertType -> Html a
alertSvg :: forall a. AlertType -> Html a
alertSvg AlertType
alertType =
  Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"viewBox", Text
"0 0 16 16") (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$
  Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"width", Text
"16") (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$
  Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"height", Text
"16") (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$
  Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"aria-hidden", Text
"true") (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$
  Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"svg" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$
    Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
      Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"d", AlertType -> Text
svgPath AlertType
alertType)
        (Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"path" (Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just Html a
forall a. Monoid a => a
mempty))

alertSvgText :: AlertType -> Text
alertSvgText :: AlertType -> Text
alertSvgText = Text -> Text
TL.toStrict (Text -> Text) -> (AlertType -> Text) -> AlertType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html Any -> Text
forall a. Html a -> Text
renderHtml (Html Any -> Text) -> (AlertType -> Html Any) -> AlertType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlertType -> Html Any
forall a. AlertType -> Html a
alertSvg

svgPath :: AlertType -> Text
svgPath :: AlertType -> Text
svgPath AlertType
NoteAlert = Text
"M0 8a8 8 0 1 1 16 0A8 8 0 0 1 0 8Zm8-6.5a6.5 6.5 0 1 0 0 13 6.5 6.5 0 0 0 0-13ZM6.5 7.75A.75.75 0 0 1 7.25 7h1a.75.75 0 0 1 .75.75v2.75h.25a.75.75 0 0 1 0 1.5h-2a.75.75 0 0 1 0-1.5h.25v-2h-.25a.75.75 0 0 1-.75-.75ZM8 6a1 1 0 1 1 0-2 1 1 0 0 1 0 2Z"
svgPath AlertType
TipAlert = Text
"M8 1.5c-2.363 0-4 1.69-4 3.75 0 .984.424 1.625.984 2.304l.214.253c.223.264.47.556.673.848.284.411.537.896.621 1.49a.75.75 0 0 1-1.484.211c-.04-.282-.163-.547-.37-.847a8.456 8.456 0 0 0-.542-.68c-.084-.1-.173-.205-.268-.32C3.201 7.75 2.5 6.766 2.5 5.25 2.5 2.31 4.863 0 8 0s5.5 2.31 5.5 5.25c0 1.516-.701 2.5-1.328 3.259-.095.115-.184.22-.268.319-.207.245-.383.453-.541.681-.208.3-.33.565-.37.847a.751.751 0 0 1-1.485-.212c.084-.593.337-1.078.621-1.489.203-.292.45-.584.673-.848.075-.088.147-.173.213-.253.561-.679.985-1.32.985-2.304 0-2.06-1.637-3.75-4-3.75ZM5.75 12h4.5a.75.75 0 0 1 0 1.5h-4.5a.75.75 0 0 1 0-1.5ZM6 15.25a.75.75 0 0 1 .75-.75h2.5a.75.75 0 0 1 0 1.5h-2.5a.75.75 0 0 1-.75-.75Z"
svgPath AlertType
ImportantAlert = Text
"M0 1.75C0 .784.784 0 1.75 0h12.5C15.216 0 16 .784 16 1.75v9.5A1.75 1.75 0 0 1 14.25 13H8.06l-2.573 2.573A1.458 1.458 0 0 1 3 14.543V13H1.75A1.75 1.75 0 0 1 0 11.25Zm1.75-.25a.25.25 0 0 0-.25.25v9.5c0 .138.112.25.25.25h2a.75.75 0 0 1 .75.75v2.19l2.72-2.72a.749.749 0 0 1 .53-.22h6.5a.25.25 0 0 0 .25-.25v-9.5a.25.25 0 0 0-.25-.25Zm7 2.25v2.5a.75.75 0 0 1-1.5 0v-2.5a.75.75 0 0 1 1.5 0ZM9 9a1 1 0 1 1-2 0 1 1 0 0 1 2 0Z"
svgPath AlertType
WarningAlert = Text
"M6.457 1.047c.659-1.234 2.427-1.234 3.086 0l6.082 11.378A1.75 1.75 0 0 1 14.082 15H1.918a1.75 1.75 0 0 1-1.543-2.575Zm1.763.707a.25.25 0 0 0-.44 0L1.698 13.132a.25.25 0 0 0 .22.368h12.164a.25.25 0 0 0 .22-.368Zm.53 3.996v2.5a.75.75 0 0 1-1.5 0v-2.5a.75.75 0 0 1 1.5 0ZM9 11a1 1 0 1 1-2 0 1 1 0 0 1 2 0Z"
svgPath AlertType
CautionAlert = Text
"M4.47.22A.749.749 0 0 1 5 0h6c.199 0 .389.079.53.22l4.25 4.25c.141.14.22.331.22.53v6a.749.749 0 0 1-.22.53l-4.25 4.25A.749.749 0 0 1 11 16H5a.749.749 0 0 1-.53-.22L.22 11.53A.749.749 0 0 1 0 11V5c0-.199.079-.389.22-.53Zm.84 1.28L1.5 5.31v5.38l3.81 3.81h5.38l3.81-3.81V5.31L10.69 1.5ZM8 4a.75.75 0 0 1 .75.75v3.5a.75.75 0 0 1-1.5 0v-3.5A.75.75 0 0 1 8 4Zm0 8a1 1 0 1 1 0-2 1 1 0 0 1 0 2Z"

class IsBlock il bl => HasAlerts il bl | il -> bl where
  alert :: AlertType -> bl -> bl

instance Rangeable (Html a) =>
         HasAlerts (Html a) (Html a) where
  alert :: AlertType -> Html a -> Html a
alert AlertType
alertType Html a
bs =
    Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"class", Text
"alert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AlertType -> Text
alertClass AlertType
alertType) (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$
    Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"div" (Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
      Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"class", Text
"alert-title")
        (Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"p" (Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
           AlertType -> Html a
forall a. AlertType -> Html a
alertSvg AlertType
alertType Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
           Text -> Html a
forall a. Text -> Html a
htmlText (AlertType -> Text
alertName AlertType
alertType))) Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<> Html a
bs)

instance (HasAlerts il bl, Semigroup bl, Semigroup il)
        => HasAlerts (WithSourceMap il) (WithSourceMap bl) where
  alert :: AlertType -> WithSourceMap bl -> WithSourceMap bl
alert AlertType
alertType WithSourceMap bl
bs = AlertType -> bl -> bl
forall il bl. HasAlerts il bl => AlertType -> bl -> bl
alert AlertType
alertType (bl -> bl) -> WithSourceMap bl -> WithSourceMap bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap bl
bs WithSourceMap bl -> WithSourceMap () -> WithSourceMap bl
forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"alert"