    {-# 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
                 pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
                 _ <- symbol '>'
                 _ <- option 0 (gobbleSpaces 1)
                 _ <- symbol '['
                 _ <- symbol '!'
                 let eqCI Text
    x Text
    y = Text
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Text
    T.toUpper Text
    y
                 alertType <- (NoteAlert <$ satisfyWord (eqCI "NOTE"))
                          <|> (TipAlert <$ satisfyWord (eqCI "TIP"))
                          <|> (ImportantAlert <$ satisfyWord (eqCI "IMPORTANT"))
                          <|> (WarningAlert <$ satisfyWord (eqCI "WARNING"))
                          <|> (CautionAlert <$ satisfyWord (eqCI "CAUTION"))
                 _ <-  symbol ']'
                 skipWhile (hasType Spaces)
                 lookAhead $ void lineEnd <|> eof
                 addNodeToStack $
                    Node (defBlockData alertBlockSpec){
                              blockData = toDyn alertType,
                              blockStartPos = [pos] } []
                 return 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
                 pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
                 _ <- symbol '>'
                 _ <- gobbleUpToSpaces 1
                 return (pos, 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 = LazyText -> Text
    TL.toStrict (LazyText -> Text) -> (AlertType -> LazyText) -> AlertType -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html (ZonkAny 0) -> LazyText
    forall a. Html a -> LazyText
    renderHtml (Html (ZonkAny 0) -> LazyText)
    -> (AlertType -> Html (ZonkAny 0)) -> AlertType -> LazyText
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AlertType -> Html (ZonkAny 0)
    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"