Internal.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module Data.String.AnsiEscapeCodes.Strip.Internal
  ( stripAnsiEscapeCodesP
  , Env (..)
  ) where


import           Control.Applicative            (optional, (<|>))
import           Control.Monad                  (void)
import qualified Data.Attoparsec.Combinator     as AC
import           Data.Attoparsec.Internal.Types (ChunkElem)
import           Data.Attoparsec.Types          (Chunk, Parser)
import           Data.Char                      (isDigit)
import           Data.Monoid                    (Monoid, mconcat)

{-
-- From: https://github.com/chalk/ansi-regex/blob/166a0d5eddedacf0db7ccd7ee137b862ab1dae70/index.js
  [\x001B\x009B]
  [[\]()#;?]*
    (?:
      (?:
        (?:
          [a-zA-Z\d]*
          (?:
            ;[-a-zA-Z\d\/#&.:=?%@~_]*
          )*
        )?
        \x0007
      )
      |
      (?:
        (?:
          \d{1,4}
          (?:;\d{0,4})*
        )?
        [\dA-PR-TZcf-ntqry=><~]
      )
    )
-}


{-# INLINE stripAnsiEscapeCodesP #-}
stripAnsiEscapeCodesP
  :: (Chunk str, ChunkElem str ~ Char, Monoid str) => Env (ChunkElem str) str -> Parser str str
stripAnsiEscapeCodesP e =
    mconcat <$> (AC.many' escapeSequencesSkipped <* skipLeftEscapeSequence)
 where
  escapeSequencesSkipped = do
    skipEscapeSequence
    takeWhile1 e (not . isEsc)

  isEsc :: Char -> Bool
  isEsc = (== '\x001B')

  esc = skip isEsc


  skipEscapeSequence = AC.skipMany $ do
    esc
    beginsWithOpenSquareBracket
      <|> beginsWithClosingSquareBracket
      <|> beginsWithParenthesis
      <|> beginsWithHash
      <|> singleChar
      <|> beginsWithDigit

   where
    singleChar =
      skip (`elem` "ABCDHIJKSTZ=>12<78HcNOME")

    beginsWithDigit = do
      skip (`elem` "5036")
      skip (== 'n')

    beginsWithClosingSquareBracket = do
      skip (== ']')
      skipWhile e (/= '\x0007') <* skipAny

    beginsWithOpenSquareBracket = do
      skip (== '[')
      _ <- optional $ skip (`elem` "?;")
      AC.skipMany $ do
        AC.skipMany1 digit
        AC.skipMany $ do
          skip (== ';')
          AC.skipMany1 digit
      skip isEndChar

     where
      isEndChar c =
        isDigit c
          || between 'A' 'P'
          || between 'R' 'T'
          || c == 'Z'
          || c == 'c'
          || between 'f' 'n'
          || c `elem` "tqry=><~"
       where
        between x y = x <= c && c <= y

    beginsWithParenthesis = do
      skip (`elem` "()")
      skip (`elem` "AB012")

    beginsWithHash = do
      skip (== '#')
      skip (`elem` "34568")

  skipLeftEscapeSequence = do
    skipEscapeSequence
    AC.endOfInput


data Env c str = Env
  { skipWhile  :: (c -> Bool) -> Parser str ()
  , takeWhile1 :: (c-> Bool) -> Parser str str
  }


{-# INLINE skip #-}
skip :: Chunk str => (ChunkElem str -> Bool) -> Parser str ()
skip = void . AC.satisfyElem


{-# INLINE skipAny #-}
skipAny :: Chunk str => Parser str ()
skipAny = skip (const True)


{-# INLINE digit #-}
digit :: (Chunk str, ChunkElem str ~ Char) => Parser str ()
digit = skip $ \c -> '0' <= c && c <= '9'