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