packages feed

strip-ansi-escape (empty) → 0.1.0.0

raw patch · 10 files changed

+560/−0 lines, 10 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed

Dependencies added: QuickCheck, attoparsec, base, hspec, strip-ansi-escape, text

Files

+ LICENSE view
@@ -0,0 +1,13 @@+Copyright Yuji Yamamoto (c) 2019++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ README.md view
@@ -0,0 +1,3 @@+# strip-ansi-escape++Strip ANSI escape code from string. Haskell port of <https://github.com/chalk/strip-ansi>.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/String/AnsiEscapeCodes/Strip/Internal.hs view
@@ -0,0 +1,133 @@+{-# 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'
+ src/Data/String/AnsiEscapeCodes/Strip/Text.hs view
@@ -0,0 +1,15 @@+module Data.String.AnsiEscapeCodes.Strip.Text+  ( stripAnsiEscapeCodes+  ) where++import qualified Data.Attoparsec.Text                       as AT+import qualified Data.Text                                  as T++import           Data.String.AnsiEscapeCodes.Strip.Internal++{-# INLINE stripAnsiEscapeCodes #-}+stripAnsiEscapeCodes :: T.Text -> T.Text+stripAnsiEscapeCodes str =+  either (const str) id $ AT.parseOnly (stripAnsiEscapeCodesP e) str+ where+  e = Env AT.skipWhile AT.takeWhile1
+ src/Data/String/AnsiEscapeCodes/Strip/Text/Lazy.hs view
@@ -0,0 +1,17 @@+module Data.String.AnsiEscapeCodes.Strip.Text.Lazy+  ( stripAnsiEscapeCodes+  ) where++import qualified Data.Attoparsec.Text.Lazy                  as AT+import qualified Data.Text.Lazy                             as T++import           Data.String.AnsiEscapeCodes.Strip.Internal++{-# INLINE stripAnsiEscapeCodes #-}+stripAnsiEscapeCodes :: T.Text -> T.Text+stripAnsiEscapeCodes str =+  case AT.parse (stripAnsiEscapeCodesP e) str of+      AT.Done _ r -> T.fromStrict r+      AT.Fail {}  -> str+ where+  e = Env AT.skipWhile AT.takeWhile1
+ strip-ansi-escape.cabal view
@@ -0,0 +1,42 @@+name:                strip-ansi-escape+version:             0.1.0.0+synopsis:            Strip ANSI escape code from string.+description:         Strip ANSI escape code from string. Haskell port of https://github.com/chalk/strip-ansi.+homepage:            https://gitlab.com/igrep/strip-ansi-escape#readme+license:             Apache-2.0+license-file:        LICENSE+author:              Yuji Yamamoto+maintainer:          whosekiteneverfly@gmail.com+copyright:           2019 Yuji Yamamoto+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.String.AnsiEscapeCodes.Strip.Text+                     , Data.String.AnsiEscapeCodes.Strip.Text.Lazy+                     , Data.String.AnsiEscapeCodes.Strip.Internal+  build-depends:       base >= 4.7 && < 5+                     , attoparsec+                     , text+  default-language:    Haskell2010++test-suite strip-ansi-escape-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Data.String.StripSpec+                     , Data.String.StripSpec.Table+  build-depends:       base+                     , strip-ansi-escape+                     , QuickCheck+                     , hspec+                     , text+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://gitlab.com/igrep/strip-ansi-escape
+ test/Data/String/StripSpec.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++-- | All tests are translated from https://github.com/chalk/ansi-regex/blob/166a0d5eddedacf0db7ccd7ee137b862ab1dae70/test.js++module Data.String.StripSpec (main, spec) where++import           Data.Char                              (isPrint, isSpace)+import           Data.Foldable                          (for_)+import qualified Data.Text                              as T+import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Test.QuickCheck.Arbitrary              (Arbitrary, arbitrary,+                                                         shrink)+import           Test.QuickCheck.Gen                    (listOf, suchThat)++import           Data.String.StripSpec.Table++import           Data.String.AnsiEscapeCodes.Strip.Text++-- `main` is here so that this module can be run from GHCi on its own.  It is+-- not needed for automatic spec discovery.+main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "stripAnsiEscapeCodes" $ do+  it "match ansi code in a string" $ do+    stripAnsiEscapeCodes "foo\x001B[4mcake\x001B[0m" `shouldBe` "foocake"+    stripAnsiEscapeCodes "\x001B[4mcake\x001B[0m" `shouldBe` "cake"+    stripAnsiEscapeCodes "foo\x001B[4mcake\x001B[0m" `shouldBe` "foocake"+    stripAnsiEscapeCodes "\x001B[0m\x001B[4m\x001B[42m\x001B[31mfoo\x001B[39m\x001B[49m\x001B[24mfoo\x001B[0m" `shouldBe` "foofoo"+    stripAnsiEscapeCodes "foo\x001B[mfoo" `shouldBe` "foofoo"++  it "match ansi code from ls command" $+    stripAnsiEscapeCodes "\x001B[00;38;5;244m\x001B[m\x001B[00;38;5;33mfoo\x001B[0m" `shouldBe` "foo"++  it "match reset;setfg;setbg;italics;strike;underline sequence in a string" $ do+    stripAnsiEscapeCodes "\x001B[0;33;49;3;9;4mbar\x001B[0m" `shouldBe` "bar"+    stripAnsiEscapeCodes "foo\x001B[0;33;49;3;9;4mbar" `shouldBe` "foobar"++  it "match clear tabs sequence in a string" $+    stripAnsiEscapeCodes "foo\x001B[0gbar" `shouldBe` "foobar"++  it "match clear line from cursor right in a string" $+    stripAnsiEscapeCodes "foo\x001B[Kbar" `shouldBe` "foobar"++  it "match clear screen in a string" $+    stripAnsiEscapeCodes "foo\x001B[2Jbar" `shouldBe` "foobar"++  it "match terminal link" $ do+    stripAnsiEscapeCodes ("\x001B]8;k=v;https://example-a.com/?a_b=1&c=2#tit%20le\x0007" <> "click\x001B]8;;\x0007") `shouldBe` "click"+    stripAnsiEscapeCodes "\x001B]8;;mailto:no-reply@mail.com\x0007mail\x001B]8;;\x0007" `shouldBe` "mail"++  it "match \"change icon name and window title\" in string" $+    stripAnsiEscapeCodes "\x001B]0;sg@tota:~/git/\x0007\x001B[01;32m[sg@tota\x001B[01;37m misc-tests\x001B[01;32m]$" `shouldBe` "[sg@tota misc-tests]$"++  for_ ansiCodeTable $ \(category, entries) ->+    describe category $+      for_ entries $ \entry -> do+        let code = entryCode entry+            ecode = "\x001B" <> code+            comment = entryComment entry++        prop (" - " ++ T.unpack code ++ " -- " ++ comment) $+          \(PrintableOrSpace phed, PrintableOrSpace pbody, PrintableOrSpace pfoot, onlyHead) -> do+            let input =+                  if onlyHead+                    then hed <> ecode <> body <> foot+                    else hed <> ecode <> body <> ecode <> foot+                expected = hed <> body <> foot++                hed = T.pack phed+                body = T.pack pbody+                foot = T.pack pfoot++            stripAnsiEscapeCodes input `shouldBe` expected+++newtype PrintableOrSpace = PrintableOrSpace String deriving (Eq, Show)++instance Arbitrary PrintableOrSpace where+  arbitrary = PrintableOrSpace <$> listOf ac+   where+    ac = arbitrary `suchThat` (\c -> isPrint c || isSpace c)++  shrink (PrintableOrSpace s) = PrintableOrSpace <$> shrink s
+ test/Data/String/StripSpec/Table.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Translated from https://github.com/chalk/ansi-regex/blob/166a0d5eddedacf0db7ccd7ee137b862ab1dae70/fixtures/ansi-codes.js++module Data.String.StripSpec.Table+  ( ansiCodeTable+  , Entry (..)+  ) where++import           Data.Text (Text)++data Entry = Entry+  { entryCode    :: Text+  , entryComment :: String+  } deriving (Eq, Show)+++(=:) :: a -> b -> (a, b)+(=:) = (,)++ansiCodeTable :: [(String, [Entry])]+ansiCodeTable =+  [ "vt52Codes" =: -- http://www.umich.edu/~archive/apple2/misc/programmers/vt100.codes.txt+    [ Entry "A" "Cursor up"+    , Entry "B" "Cursor down"+    , Entry "C" "Cursor right"+    , Entry "D" "Cursor left"+    , Entry "H" "Cursor to home"+    , Entry "I" "Reverse line feed"+    , Entry "J" "Erase to end of screen"+    , Entry "K" "Erase to end of line"+    , Entry "S" "Scroll up"+    , Entry "T" "Scroll down"+    , Entry "Z" "Identify"+    , Entry "=" "Enter alternate keypad mode"+    , Entry ">" "Exit alternate keypad mode"+    , Entry "1" "Graphics processor on"+    , Entry "2" "Graphics processor off"+    , Entry "<" "Enter ANSI mode"+    ]+  , "ansiCompatible" =: -- http://www.umich.edu/~archive/apple2/misc/programmers/vt100.codes.txt+    [ Entry "[176A" "Cursor up Pn lines"+    , Entry "[176B" "Cursor down Pn lines"+    , Entry "[176C" "Cursor forward Pn characters (right)"+    , Entry "[176D" "Cursor backward Pn characters (left)"+    , Entry "[176;176H" "Direct cursor addressing, where Pl is line#, Pc is column#"+    , Entry "[176;176f" "Direct cursor addressing, where Pl is line#, Pc is column#"++    , Entry "7" "Save cursor and attributes"+    , Entry "8" "Restore cursor and attributes"++    , Entry "#3" "Change this line to double-height top half"+    , Entry "#4" "Change this line to double-height bottom half"+    , Entry "#5" "Change this line to single-width single-height"+    , Entry "#6" "Change this line to double-width single-height"++    , Entry "[176;176;176;176;176;176;176m" "Text Styles"+    , Entry "[176;176;176;176;176;176;176q" "Programmable LEDs"++    , Entry "[K" "Erase from cursor to end of line"+    , Entry "[0K" "Same"+    , Entry "[1K" "Erase from beginning of line to cursor"+    , Entry "[2K" "Erase line containing cursor"+    , Entry "[J" "Erase from cursor to end of screen"+    , Entry "[0J" "Same"+    , Entry "[2J" "Erase entire screen"+    , Entry "[P" "Delete character"+    , Entry "[0P" "Delete character (0P)"+    , Entry "[2P" "Delete 2 characters"++    , Entry "(A" "United Kingdom (UK) (Character Set G0)"+    , Entry ")A" "United Kingdom (UK) (Character Set G1)"+    , Entry "(B" "United States (USASCII) (Character Set G0)"+    , Entry ")B" "United States (USASCII) (Character Set G1)"+    , Entry "(0" "Special graphics/line drawing set (Character Set G0)"+    , Entry ")0" "Special graphics/line drawing set (Character Set G1)"+    , Entry "(1" "Alternative character ROM (Character Set G0)"+    , Entry ")1" "Alternative character ROM (Character Set G1)"+    , Entry "(2" "Alternative graphic ROM (Character Set G0)"+    , Entry ")2" "Alternative graphic ROM (Character Set G1)"++    , Entry "H" "Set tab at current column"+    , Entry "[g" "Clear tab at current column"+    , Entry "[0g" "Same"+    , Entry "[3g" "Clear all tabs"++    , Entry "[6n" "Cursor position report"+    , Entry "[176;176R" "(response; Pl=line#; Pc=column#)"+    , Entry "[5n" "Status report"+    , Entry "[c" "(response; terminal Ok)"+    , Entry "[0c" "(response; teminal not Ok)"+    , Entry "[?1;176c" "response; where Ps is option present:"++    , Entry "c" "Causes power-up reset routine to be executed"+    , Entry "#8" "Fill screen with \"E\""+    , Entry "[2;176y" "Invoke Test(s), where Ps is a decimal computed by adding the numbers of the desired tests to be executed"+    ]++  , "commonCodes" =: -- http://ascii-table.com/ansi-escape-sequences-vt-100.php+    [ Entry "[176A" "Move cursor up n lines"+    , Entry "[176B" "Move cursor down n lines"+    , Entry "[176C" "Move cursor right n lines"+    , Entry "[176D" "Move cursor left n lines"+    , Entry "[176;176H" "Move cursor to screen location v,h"+    , Entry "[176;176f" "Move cursor to screen location v,h"+    , Entry "[176;176r" "Set top and bottom lines of a window"+    , Entry "[176;176R" "Response: cursor is at v,h"++    , Entry "[?1;1760c" "Response: terminal type code n"++    , Entry "[20h" "Set new line mode"+    , Entry "[?1h" "Set cursor key to application"+    , Entry "[?3h" "Set number of columns to 132"+    , Entry "[?4h" "Set smooth scrolling"+    , Entry "[?5h" "Set reverse video on screen"+    , Entry "[?6h" "Set origin to relative"+    , Entry "[?7h" "Set auto-wrap mode"+    , Entry "[?8h" "Set auto-repeat mode"+    , Entry "[?9h" "Set interlacing mode"+    , Entry "[20l" "Set line feed mode"+    , Entry "[?1l" "Set cursor key to cursor"+    , Entry "[?2l" "Set VT52 (versus ANSI)"+    , Entry "[?3l" "Set number of columns to 80"+    , Entry "[?4l" "Set jump scrolling"+    , Entry "[?5l" "Set normal video on screen"+    , Entry "[?6l" "Set origin to absolute"+    , Entry "[?7l" "Reset auto-wrap mode"+    , Entry "[?8l" "Reset auto-repeat mode"+    , Entry "[?9l" "Reset interlacing mode"++    , Entry "N" "Set single shift 2"+    , Entry "O" "Set single shift 3"++    , Entry "[m" "Turn off character attributes"+    , Entry "[0m" "Turn off character attributes"+    , Entry "[1m" "Turn bold mode on"+    , Entry "[2m" "Turn low intensity mode on"+    , Entry "[4m" "Turn underline mode on"+    , Entry "[5m" "Turn blinking mode on"+    , Entry "[7m" "Turn reverse video on"+    , Entry "[8m" "Turn invisible text mode on"++    , Entry "[9m" "strikethrough on"+    , Entry "[22m" "bold off (see below)"+    , Entry "[23m" "italics off"+    , Entry "[24m" "underline off"+    , Entry "[27m" "inverse off"+    , Entry "[29m" "strikethrough off"+    , Entry "[30m" "set foreground color to black"+    , Entry "[31m" "set foreground color to red"+    , Entry "[32m" "set foreground color to green"+    , Entry "[33m" "set foreground color to yellow"+    , Entry "[34m" "set foreground color to blue"+    , Entry "[35m" "set foreground color to magenta (purple)"+    , Entry "[36m" "set foreground color to cyan"+    , Entry "[37m" "set foreground color to white"+    , Entry "[39m" "set foreground color to default (white)"+    , Entry "[40m" "set background color to black"+    , Entry "[41m" "set background color to red"+    , Entry "[42m" "set background color to green"+    , Entry "[43m" "set background color to yellow"+    , Entry "[44m" "set background color to blue"+    , Entry "[45m" "set background color to magenta (purple)"+    , Entry "[46m" "set background color to cyan"+    , Entry "[47m" "set background color to white"+    , Entry "[49m" "set background color to default (black)"++    , Entry "[H" "Move cursor to upper left corner"+    , Entry "[;H" "Move cursor to upper left corner"+    , Entry "[f" "Move cursor to upper left corner"+    , Entry "[;f" "Move cursor to upper left corner"+    , Entry "M" "Move/scroll window down one line"+    , Entry "E" "Move to next line"++    , Entry "H" "Set a tab at the current column"+    , Entry "[g" "Clear a tab at the current column"+    , Entry "[0g" "Clear a tab at the current column"+    , Entry "[3g" "Clear all tabs"++    , Entry "[K" "Clear line from cursor right"+    , Entry "[0K" "Clear line from cursor right"+    , Entry "[1K" "Clear line from cursor left"+    , Entry "[2K" "Clear entire line"+    , Entry "[J" "Clear screen from cursor down"+    , Entry "[0J" "Clear screen from cursor down"+    , Entry "[1J" "Clear screen from cursor up"+    , Entry "[2J" "Clear entire screen"++    , Entry "[c" "Identify what terminal type"+    , Entry "[0c" "Identify what terminal type (another)"+    , Entry "c" "Reset terminal to initial state"+    , Entry "[2;1y" "Confidence power up test"+    , Entry "[2;2y" "Confidence loopback test"+    , Entry "[2;9y" "Repeat power up test"+    , Entry "[2;10y" "Repeat loopback test"+    , Entry "[0q" "Turn off all four leds"+    , Entry "[1q" "Turn on LED #1"+    , Entry "[2q" "Turn on LED #2"+    , Entry "[3q" "Turn on LED #3"+    , Entry "[4q" "Turn on LED #4"+    ]++  , "otherCodes" =: -- http://ascii-table.com/ansi-escape-sequences-vt-100.php+    [ Entry "7" "Save cursor position and attributes"+    , Entry "8" "Restore cursor position and attributes"++    , Entry "=" "Set alternate keypad mode"+    , Entry ">" "Set numeric keypad mode"++    , Entry "(A" "Set United Kingdom G0 character set"+    , Entry ")A" "Set United Kingdom G1 character set"+    , Entry "(B" "Set United States G0 character set"+    , Entry ")B" "Set United States G1 character set"+    , Entry "(0" "Set G0 special chars. & line set"+    , Entry ")0" "Set G1 special chars. & line set"+    , Entry "(1" "Set G0 alternate character ROM"+    , Entry ")1" "Set G1 alternate character ROM"+    , Entry "(2" "Set G0 alt char ROM and spec. graphics"+    , Entry ")2" "Set G1 alt char ROM and spec. graphics"++    , Entry "#3" "Double-height letters, top half"+    , Entry "#4" "Double-height letters, bottom half"+    , Entry "#5" "Single width, single height letters"+    , Entry "#6" "Double width, single height letters"+    , Entry "#8" "Screen alignment display"++    , Entry "5n" "Device status report"+    , Entry "0n" "Response: terminal is OK"+    , Entry "3n" "Response: terminal is not OK"+    , Entry "6n" "Get cursor position"+    ]++  , "urxvtCodes" =: -- https://linux.die.net/man/7/urxvt+    [ Entry "[5~" "URxvt.keysym.Prior"+    , Entry "[6~" "URxvt.keysym.Next"+    , Entry "[7~" "URxvt.keysym.Home"+    , Entry "[8~" "URxvt.keysym.End"+    , Entry "[A" "URxvt.keysym.Up"+    , Entry "[B" "URxvt.keysym.Down"+    , Entry "[C" "URxvt.keysym.Right"+    , Entry "[D" "URxvt.keysym.Left"+    , Entry "[3;5;5t" "URxvt.keysym.C-M-q"+    , Entry "[3;5;606t" "URxvt.keysym.C-M-y"+    , Entry "[3;1605;5t" "URxvt.keysym.C-M-e"+    , Entry "[3;1605;606t" "URxvt.keysym.C-M-c"+    , Entry "]710;9x15bold\x0007" "URxvt.keysym.font"+    ]+  ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}