{-# 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 = forall a. Text -> Html a htmlText Text "‘" forall a. Semigroup a => a -> a -> a <> Html a x forall a. Semigroup a => a -> a -> a <> forall a. Text -> Html a htmlText Text "’" doubleQuoted :: Html a -> Html a doubleQuoted Html a x = forall a. Text -> Html a htmlText Text "“" forall a. Semigroup a => a -> a -> a <> Html a x forall a. Semigroup a => a -> a -> 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 = (forall il. HasQuoted il => il -> il singleQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> WithSourceMap i x) 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 = (forall il. HasQuoted il => il -> il doubleQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> WithSourceMap i x) 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 = forall a. Monoid a => a mempty { syntaxFormattingSpecs :: [FormattingSpec il] syntaxFormattingSpecs = [forall il. (IsInline il, HasQuoted il) => FormattingSpec il singleQuotedSpec, forall il. (IsInline il, HasQuoted il) => FormattingSpec il doubleQuotedSpec] , syntaxInlineParsers :: [InlineParser m il] syntaxInlineParsers = [forall (m :: * -> *) a. (Monad m, IsInline a) => InlineParser m a pEllipses, forall (m :: * -> *) a. (Monad m, IsInline a) => InlineParser m a pDash] } singleQuotedSpec :: (IsInline il, HasQuoted il) => FormattingSpec il singleQuotedSpec :: forall il. (IsInline il, HasQuoted il) => FormattingSpec il singleQuotedSpec = forall il. Char -> Bool -> Bool -> Maybe (il -> il) -> Maybe (il -> il) -> Char -> FormattingSpec il FormattingSpec Char '\'' Bool False Bool False (forall a. a -> Maybe a Just forall il. HasQuoted il => il -> il singleQuoted) forall a. Maybe a Nothing Char '’' doubleQuotedSpec :: (IsInline il, HasQuoted il) => FormattingSpec il doubleQuotedSpec :: forall il. (IsInline il, HasQuoted il) => FormattingSpec il doubleQuotedSpec = forall il. Char -> Bool -> Bool -> Maybe (il -> il) -> Maybe (il -> il) -> Char -> FormattingSpec il FormattingSpec Char '"' Bool False Bool False (forall a. a -> Maybe a Just forall il. HasQuoted il => il -> il doubleQuoted) 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a try forall a b. (a -> b) -> a -> b $ do forall s (m :: * -> *) t u a. Stream s m t => Int -> ParsecT s u m a -> ParsecT s u m [a] count Int 3 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok symbol Char '.') forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $! 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a try forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok symbol Char '-' Int numhyphens <- (forall a. Num a => a -> a -> a +Int 1) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) a. Foldable t => t a -> Int length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m [a] many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok symbol Char '-') let (Int emcount, Int encount) = case Int numhyphens of Int n | Int n forall a. Integral a => a -> a -> a `mod` Int 3 forall a. Eq a => a -> a -> Bool == Int 0 -> (Int n forall a. Integral a => a -> a -> a `div` Int 3, Int 0) | Int n forall a. Integral a => a -> a -> a `mod` Int 2 forall a. Eq a => a -> a -> Bool == Int 0 -> (Int 0, Int n forall a. Integral a => a -> a -> a `div` Int 2) | Int n forall a. Integral a => a -> a -> a `mod` Int 3 forall a. Eq a => a -> a -> Bool == Int 2 -> ((Int n forall a. Num a => a -> a -> a - Int 2) forall a. Integral a => a -> a -> a `div` Int 3, Int 1) | Bool otherwise -> ((Int n forall a. Num a => a -> a -> a - Int 4) forall a. Integral a => a -> a -> a `div` Int 3, Int 2) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $! forall a. Monoid a => [a] -> a mconcat forall a b. (a -> b) -> a -> b $ forall a. Int -> a -> [a] replicate Int emcount (forall a. IsInline a => Text -> a str Text "—") forall a. Semigroup a => a -> a -> a <> forall a. Int -> a -> [a] replicate Int encount (forall a. IsInline a => Text -> a str Text "–")