{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Text.MMark.Extension.PunctuationPrettifier
-- Copyright   :  © 2018–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Punctuation prettifier.
module Text.MMark.Extension.PunctuationPrettifier
  ( punctuationPrettifier,
  )
where

import Data.Char (isSpace)
import Data.Text (Text)
import qualified Data.Text as T
import Text.MMark.Extension (Extension, Inline (..))
import qualified Text.MMark.Extension as Ext

-- | Prettify punctuation (only affects plain text in inlines):
--
--     * Replace @...@ with ellipsis @…@
--     * Replace @---@ with em-dash @—@
--     * Replace @--@ with en-dash @–@
--     * Replace @\"@ with left double quote @“@ when previous character was
--       a space character, otherwise replace it with right double quote @”@
--     * Replace @'@ with left single quote @‘@ when previous character was
--       a space character, otherwise replace it with right single quote @’@
--       aka apostrophe
punctuationPrettifier :: Extension
punctuationPrettifier :: Extension
punctuationPrettifier = (Inline -> Inline) -> Extension
Ext.inlineTrans ((Inline -> Inline) -> Extension)
-> (Inline -> Inline) -> Extension
forall a b. (a -> b) -> a -> b
$ \case
  Plain Text
txt -> Text -> Inline
Plain (((Bool, Text) -> Maybe (Char, (Bool, Text)))
-> (Bool, Text) -> Text
forall a. (a -> Maybe (Char, a)) -> a -> Text
T.unfoldr (Bool, Text) -> Maybe (Char, (Bool, Text))
gen (Bool
True, Text
txt))
  Inline
other -> Inline
other

gen ::
  -- | Whether the previous character was a space and remaining input
  (Bool, Text) ->
  -- | Next generated char and the state
  Maybe (Char, (Bool, Text))
gen :: (Bool, Text) -> Maybe (Char, (Bool, Text))
gen (Bool
s, Text
i) =
  case Text -> Maybe (Char, Text)
T.uncons Text
i of
    Maybe (Char, Text)
Nothing -> Maybe (Char, (Bool, Text))
forall a. Maybe a
Nothing
    Just (Char
'.', Text
i') ->
      case Int -> Text -> (Text, Text)
T.splitAt Int
2 Text
i' of
        (Text
"..", Text
i'') -> (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'…', (Bool
False, Text
i''))
        (Text, Text)
_ -> (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'.', (Bool
False, Text
i'))
    Just (Char
'-', Text
i') ->
      case Int -> Text -> (Text, Text)
T.splitAt Int
2 Text
i' of
        (Text
"--", Text
i'') -> (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'—', (Bool
False, Text
i''))
        (Text, Text)
_ ->
          case Int -> Text -> (Text, Text)
T.splitAt Int
1 Text
i' of
            (Text
"-", Text
i'') -> (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'–', (Bool
False, Text
i''))
            (Text, Text)
_ -> (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'-', (Bool
False, Text
i'))
    Just (Char
'\"', Text
i') ->
      if Bool
s -- whether previous character was a space character
        then (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'“', (Bool
False, Text
i'))
        else (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'”', (Bool
False, Text
i'))
    Just (Char
'\'', Text
i') ->
      if Bool
s
        then (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'‘', (Bool
False, Text
i'))
        else (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
'’', (Bool
False, Text
i'))
    Just (Char
ch, Text
i') ->
      (Char, (Bool, Text)) -> Maybe (Char, (Bool, Text))
forall a. a -> Maybe a
Just (Char
ch, (Char -> Bool
isSpace Char
ch, Text
i'))