    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE FlexibleInstances    #-}
    {-# LANGUAGE FlexibleContexts     #-}
    {-# LANGUAGE UndecidableInstances #-}
    module Commonmark.Extensions.Smart
      ( HasQuoted(..)
      , smartPunctuationSpec )
    where

    import Commonmark.Types
    import Commonmark.Syntax
    import Commonmark.Inlines
    import Commonmark.Html
    import Commonmark.SourceMap
    import Commonmark.TokParsers (symbol)
    import Text.Parsec

    class IsInline il => HasQuoted il where
      singleQuoted :: il -> il
      doubleQuoted :: il -> il

    instance Rangeable (Html a) => HasQuoted (Html a) where
      singleQuoted :: Html a -> Html a
    singleQuoted Html a
    x = Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    "‘" Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    x Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    "’"
      doubleQuoted :: Html a -> Html a
    doubleQuoted Html a
    x = Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    "“" Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    x Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    "”"

    instance (HasQuoted i, Monoid i, Semigroup i)
            => HasQuoted (WithSourceMap i) where
      singleQuoted :: WithSourceMap i -> WithSourceMap i
    singleQuoted WithSourceMap i
    x = (i -> i
    forall il. HasQuoted il => il -> il
    singleQuoted (i -> i) -> WithSourceMap i -> WithSourceMap i
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WithSourceMap i
    x) WithSourceMap i -> WithSourceMap () -> WithSourceMap i
    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
    "singleQuoted"
      doubleQuoted :: WithSourceMap i -> WithSourceMap i
    doubleQuoted WithSourceMap i
    x = (i -> i
    forall il. HasQuoted il => il -> il
    doubleQuoted (i -> i) -> WithSourceMap i -> WithSourceMap i
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WithSourceMap i
    x) WithSourceMap i -> WithSourceMap () -> WithSourceMap i
    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
    "doubleQuoted"

    smartPunctuationSpec :: (Monad m, IsBlock il bl, IsInline il, HasQuoted il)
                         => SyntaxSpec m il bl
    smartPunctuationSpec :: forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, IsInline il, HasQuoted il) =>
    SyntaxSpec m il bl
    smartPunctuationSpec = SyntaxSpec m il bl
    forall a. Monoid a => a
    mempty
      { syntaxFormattingSpecs = [singleQuotedSpec, doubleQuotedSpec]
      , syntaxInlineParsers = [pEllipses, pDash]
      }

    singleQuotedSpec :: (IsInline il, HasQuoted il) => FormattingSpec il
    singleQuotedSpec :: forall il. (IsInline il, HasQuoted il) => FormattingSpec il
    singleQuotedSpec = Char
    -> Bool
    -> Bool
    -> Maybe (il -> il)
    -> Maybe (il -> il)
    -> Char
    -> FormattingSpec il
    forall il.
    Char
    -> Bool
    -> Bool
    -> Maybe (il -> il)
    -> Maybe (il -> il)
    -> Char
    -> FormattingSpec il
    FormattingSpec Char
    '\'' Bool
    False Bool
    False ((il -> il) -> Maybe (il -> il)
    forall a. a -> Maybe a
    Just il -> il
    forall il. HasQuoted il => il -> il
    singleQuoted) Maybe (il -> il)
    forall a. Maybe a
    Nothing Char
    '’'

    doubleQuotedSpec :: (IsInline il, HasQuoted il) => FormattingSpec il
    doubleQuotedSpec :: forall il. (IsInline il, HasQuoted il) => FormattingSpec il
    doubleQuotedSpec = Char
    -> Bool
    -> Bool
    -> Maybe (il -> il)
    -> Maybe (il -> il)
    -> Char
    -> FormattingSpec il
    forall il.
    Char
    -> Bool
    -> Bool
    -> Maybe (il -> il)
    -> Maybe (il -> il)
    -> Char
    -> FormattingSpec il
    FormattingSpec Char
    '"' Bool
    False Bool
    False ((il -> il) -> Maybe (il -> il)
    forall a. a -> Maybe a
    Just il -> il
    forall il. HasQuoted il => il -> il
    doubleQuoted) Maybe (il -> il)
    forall a. Maybe a
    Nothing Char
    '“'

    pEllipses :: (Monad m, IsInline a) => InlineParser m a
    pEllipses :: forall (m :: * -> *) a. (Monad m, IsInline a) => InlineParser m a
    pEllipses = ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] (IPState m) (StateT Enders m) a
     -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a b. (a -> b) -> a -> b
    $ do
      Int
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    Int -> ParsecT s u m a -> ParsecT s u m [a]
    count Int
    3 (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '.')
      a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a b. (a -> b) -> a -> b
    $! Text -> a
    forall a. IsInline a => Text -> a
    str Text
    "…"

    pDash :: (Monad m, IsInline a) => InlineParser m a
    pDash :: forall (m :: * -> *) a. (Monad m, IsInline a) => InlineParser m a
    pDash = ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] (IPState m) (StateT Enders m) a
     -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a b. (a -> b) -> a -> b
    $ do
      Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '-'
      numhyphens <- (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Int -> Int) -> ([Tok] -> Int) -> [Tok] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tok] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Tok] -> Int)
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 (Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '-')
      let (emcount, encount) =
            case numhyphens of
                 Int
    n | Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    3 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 -> (Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    3, Int
    0)
                   | Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 -> (Int
    0, Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2)
                   | Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    3 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2 -> ((Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    3, Int
    1)
                   | Bool
    otherwise      -> ((Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    3, Int
    2)
      return $! mconcat $
        replicate emcount (str "—") <>
        replicate encount (str "–")