{-# LANGUAGE TypeFamilies #-}
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)
{-# 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'