hs-term-emulator 0.1.0.3 → 0.1.0.4

raw patch · 8 files changed

+247/−23 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hs-term-emulator.cabal +7/−3
• src/System/Terminal/Emulator/DECPrivateMode.hs +1/−1
• src/System/Terminal/Emulator/Parsing/Types.hs +11/−11
• src/System/Terminal/Emulator/Term/Process.hs +1/−1
• src/System/Terminal/Emulator/Term/TermChange.hs +0/−5
• src/System/Terminal/Emulator/TermLines.hs +12/−2
• test/System/Terminal/Emulator/Term/ProcessSpec.hs +185/−0
• test/System/Terminal/Emulator/Term/SimpleTerm.hs +30/−0

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               hs-term-emulator-version:            0.1.0.3+version:            0.1.0.4 synopsis:           Terminal Emulator written in 100% Haskell description:        See: https://github.com/bitc/hs-term-emulator#readme homepage:           https://github.com/bitc/hs-term-emulator@@ -29,7 +29,6 @@     System.Terminal.Emulator.Term     System.Terminal.Emulator.Term.Process     System.Terminal.Emulator.Term.Resize-    System.Terminal.Emulator.Term.TermChange     System.Terminal.Emulator.TermLines    build-depends:@@ -51,7 +50,11 @@   main-is:            Spec.hs    -- cabal-fmt: expand test -Spec-  other-modules:      System.Terminal.Emulator.Parsing.InternalSpec+  other-modules:+    System.Terminal.Emulator.Parsing.InternalSpec+    System.Terminal.Emulator.Term.ProcessSpec+    System.Terminal.Emulator.Term.SimpleTerm+   hs-source-dirs:     test   build-depends:     , ansi-terminal     ^>=0.11@@ -59,6 +62,7 @@     , base              >=4.10     && <5     , hs-term-emulator     , hspec             ^>=2.8.2+    , lens              ^>=5.0.1     , text     , vector            ^>=0.12.3.0 

@@ -137,7 +137,7 @@     --     -- @DECRST@: Reset bracketed paste mode.     BracketedPasteMode-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  intToDECPrivateMode :: Int -> Maybe DECPrivateMode intToDECPrivateMode 1 = Just DECCKM

@@ -12,7 +12,7 @@   | TermAtom_SingleCharacterFunctionUnknown !Char   | TermAtom_EscapeSequence !EscapeSequence   | TermAtom_EscapeSequenceUnknown !Text-  deriving (Eq, Show)+  deriving (Show, Eq)  data SingleCharacterFunction   = -- | @BEL@ Bell (BEL  is Ctrl-G).@@ -35,7 +35,7 @@     Control_Tab   | -- | @VT@ Vertical Tab (VT  is Ctrl-K).  This is treated the same as LF.     Control_VerticalTab-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  data EscapeSequence   = -- | @ESC M@ Reverse Index (RI  is 0x8d).@@ -50,7 +50,7 @@     ESC_SetG0CharacterSet !Text   | Esc_CSI !ControlSequenceIntroducer   | Esc_OSC !OperatingSystemCommand-  deriving (Eq, Show)+  deriving (Show, Eq)  data ControlSequenceIntroducer   = -- | @CSI Ps `@  Character Position Absolute  [column] (default = [row,1]) (HPA).@@ -120,7 +120,7 @@   | -- | Unknown DECRST (DEC Private Mode Reset) code     CSI_DECRST_Unknown !Int   | CSI_SGR !(Vector SGR)-  deriving (Eq, Show)+  deriving (Show, Eq)  data EraseInLineParam   = -- | @Ps = 0@ Erase to Right (default).@@ -129,7 +129,7 @@     ClearFromCursorToBeginningOfLine   | -- | @Ps = 2@  Erase All.     ClearEntireLine-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  data EraseInDisplayParam   = -- | @Ps = 0@ Erase Below (default).@@ -140,21 +140,21 @@     EraseAll   | -- | @Ps = 3@ Erase Saved Lines, xterm.     EraseSavedLines-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  data WindowManipulation   = -- | @22;0@ Save xterm icon and window title on stack.     SaveIconAndWindowTitleOnStack   | -- | @23;0@ Restore xterm icon and window title from stack.     RestoreIconAndWindowTitleOnStack-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  data DeviceStatusReport   = -- | Status Report. Result ("OK") is @CSI 0 n@     StatusReport   | -- | Report Cursor Position (CPR) [row;column]. Result is @CSI r ; c R@     ReportCursorPosition-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  data Mode   = -- | Keyboard Action Mode (KAM)@@ -165,11 +165,11 @@     SendReceive   | -- | Automatic Newline / Normal Linefeed (LNM).     AutomaticNewlineNormalLinefeed-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  data SendDeviceAttributesSecondary   = RequestTerminalIdentificationCode-  deriving (Eq, Show)+  deriving (Show, Eq, Ord, Enum, Bounded)  data OperatingSystemCommand   = -- | Change Icon Name and Window Title@@ -190,7 +190,7 @@     OSC_RequestTextBackgroundColor   | -- | @Ps = 112@ Reset text cursor color.     OSC_ResetTextCursorColor-  deriving (Eq, Show)+  deriving (Show, Eq, Ord)  codeToSGR :: Int -> Maybe SGR.SGR codeToSGR 0 = Just SGR.Reset

@@ -90,7 +90,7 @@ processEscapeSequence (Esc_CSI (CSI_DeleteLines n)) = nw $ deleteLines n processEscapeSequence (Esc_CSI (CSI_CursorCharacterAbsolute col)) = nw $ \term -> cursorMoveTo (term ^. cursorPos . _1, col - 1) term processEscapeSequence (Esc_CSI (CSI_CharacterPositionAbsolute col)) = nw $ \term -> cursorMoveTo (term ^. cursorPos . _1, col - 1) term-processEscapeSequence (Esc_CSI (CSI_CursorPosition row col)) = nw $ cursorMoveAbsoluteTo (row - 1, col -1)+processEscapeSequence (Esc_CSI (CSI_CursorPosition row col)) = nw $ cursorMoveAbsoluteTo (row - 1, col - 1) processEscapeSequence (Esc_CSI (CSI_HorizontalVerticalPosition row col)) = nw $ cursorMoveAbsoluteTo (row - 1, col - 1) processEscapeSequence (Esc_CSI (CSI_LinePositionAbsolute row)) = nw $ \term -> cursorMoveAbsoluteTo (row - 1, term ^. cursorPos . _2) term processEscapeSequence (Esc_CSI (CSI_ScrollUp n)) = nw $ \term -> scrollUp (term ^. scrollTop) n term

@@ -1,5 +0,0 @@-module System.Terminal.Emulator.Term.TermChange where--data TermChange-  = MoveCursor !Int !Int-  | X

@@ -6,6 +6,7 @@     TermLines,     empty,     length,+    singleton,     replicate,     vIndex,     head,@@ -15,6 +16,7 @@     drop,     dropLast,     traverseWithIndex,+    toSeq,   ) where @@ -31,7 +33,7 @@ type TermLines = StrictSeq TermLine  newtype StrictSeq a = StrictSeq (Seq a)-  deriving (Show, Eq, Ord, Functor, Semigroup)+  deriving (Show, Eq, Ord, Functor, Semigroup, Monoid, Foldable)  -- | The empty sequence. empty :: StrictSeq a@@ -43,9 +45,13 @@ length (StrictSeq v) = Seq.length v {-# INLINE length #-} +singleton :: a -> StrictSeq a+singleton x = x `seq` (StrictSeq (Seq.singleton x))+{-# INLINE singleton #-}+ -- | @replicate n x@ is a sequence consisting of n copies of x. replicate :: Int -> a -> StrictSeq a-replicate n x = StrictSeq $ Seq.replicate n x+replicate n x = x `seq` (StrictSeq (Seq.replicate n x)) {-# INLINE replicate #-}  -- | A lens to the specified index of the sequence. Must be in range.@@ -104,3 +110,7 @@ traverseWithIndex :: Applicative f => (Int -> a -> f b) -> StrictSeq a -> f (StrictSeq b) traverseWithIndex f (StrictSeq v) = StrictSeq <$> (Seq.traverseWithIndex f v) {-# INLINE traverseWithIndex #-}++toSeq :: StrictSeq a -> Seq a+toSeq (StrictSeq v) = v+{-# INLINE toSeq #-}

@@ -0,0 +1,185 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Terminal.Emulator.Term.ProcessSpec where++import Control.Applicative (many)+import Data.Attoparsec.Text+import Data.Text (Text)+import System.Terminal.Emulator.Parsing (parseTermAtom)+import System.Terminal.Emulator.Term (Term, mkTerm)+import System.Terminal.Emulator.Term.Process (processTermAtoms)+import System.Terminal.Emulator.Term.SimpleTerm (SimpleTerm (..), termToSimpleTerm)+import Test.Hspec++blankTerm :: Term+blankTerm = mkTerm (10, 4)++runTerminal :: Term -> Text -> Term+runTerminal term input =+  case parseOnly (many parseTermAtom <* endOfInput) input of+    Left err -> error $ "Error parsing terminal input: " <> err+    Right ts ->+      let (_, term') = processTermAtoms ts term+       in term'++testCase :: (Term, Text) -> SimpleTerm -> Expectation+testCase (initialTerm, input) expected =+  let term' = runTerminal initialTerm input+      actual = termToSimpleTerm term'+   in actual `shouldBe` expected++spec :: Spec+spec = do+  describe "ProcessSpec" $ do+    it "No Input" $+      testCase+        (blankTerm, "")+        SimpleTerm+          { st_ScrollBackLines = [],+            st_Screen =+              [ "          ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (0, 0)+          }++    it "Single char" $+      testCase+        (blankTerm, "A")+        SimpleTerm+          { st_ScrollBackLines = [],+            st_Screen =+              [ "A         ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (0, 1)+          }++    it "Multiple chars" $+      testCase+        (blankTerm, "AB")+        SimpleTerm+          { st_ScrollBackLines = [],+            st_Screen =+              [ "AB        ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (0, 2)+          }++    it "Newlines" $+      testCase+        (blankTerm, "A\n\n\n")+        SimpleTerm+          { st_ScrollBackLines = [],+            st_Screen =+              [ "A         ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (3, 1)+          }++    it "Scroll up" $+      testCase+        (blankTerm, "A\n\n\n\n")+        SimpleTerm+          { st_ScrollBackLines =+              [ "A         "+              ],+            st_Screen =+              [ "          ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (3, 1)+          }++    it "Scroll up 2" $+      testCase+        (blankTerm, "A\nB\n\n\n\n")+        SimpleTerm+          { st_ScrollBackLines =+              [ "A         ",+                " B        "+              ],+            st_Screen =+              [ "          ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (3, 2)+          }++    it "Cursor Down 1" $+      testCase+        (blankTerm, "A\ESC[B")+        SimpleTerm+          { st_ScrollBackLines = [],+            st_Screen =+              [ "A         ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (1, 1)+          }++    it "Cursor Down past bottom" $+      testCase+        (blankTerm, "A\ESC[B\ESC[B\ESC[B\ESC[B")+        SimpleTerm+          { st_ScrollBackLines = [],+            st_Screen =+              [ "A         ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (3, 1)+          }++    -- TODO modern terminals don't add to the scrollback+    it "Scroll up 2" $+      testCase+        (blankTerm, "A\ESC[2S")+        SimpleTerm+          { st_ScrollBackLines =+              [ "A         ",+                "          "+              ],+            st_Screen =+              [ "          ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (0, 1)+          }++    -- TODO modern terminals don't add to the scrollback+    it "Delete lines 2" $+      testCase+        (blankTerm, "A\ESC[2M")+        SimpleTerm+          { st_ScrollBackLines =+              [ "A         ",+                "          "+              ],+            st_Screen =+              [ "          ",+                "          ",+                "          ",+                "          "+              ],+            st_CursorPos = (0, 1)+          }

@@ -0,0 +1,30 @@+module System.Terminal.Emulator.Term.SimpleTerm+  ( SimpleTerm (..),+    termToSimpleTerm,+  )+where++import Control.Lens+import Data.Foldable (toList)+import qualified Data.Vector.Unboxed as VU+import System.Terminal.Emulator.Term (Term, cursorPos, scrollBackLines, termScreen)+import System.Terminal.Emulator.TermLines (TermLine)++-- | A simplified terminal that doesn't have an alt screen or colors+data SimpleTerm = SimpleTerm+  { st_ScrollBackLines :: [[Char]],+    st_Screen :: [[Char]],+    st_CursorPos :: (Int, Int)+  }+  deriving (Show, Eq, Ord)++termToSimpleTerm :: Term -> SimpleTerm+termToSimpleTerm term =+  SimpleTerm+    { st_ScrollBackLines = map termLineToStLine $ toList $ term ^. scrollBackLines,+      st_Screen = map termLineToStLine $ toList $ term ^. termScreen,+      st_CursorPos = term ^. cursorPos+    }++termLineToStLine :: TermLine -> [Char]+termLineToStLine = map fst . VU.toList