packages feed

restman 0.7.2.1 → 0.7.2.2

raw patch · 10 files changed

+519/−11 lines, 10 files

Files

CHANGELOG.md view
@@ -1,3 +1,11 @@+# v7.2.2 (2026-05-01)++## ✨ New Features++## 🐛 Bug Fixes++## 🏗️ Architecture Changes+ # v7.2.1 (2026-04-30)  ## ✨ New Features
restman.cabal view
@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               restman-version:            0.7.2.1+version:            0.7.2.2 license:            BSD2 license-file:       LICENSE copyright:          Zac Slade or Boyd Stephen Smith Jr, 2024@@ -100,6 +100,7 @@         base >=4.7 && <5,         brick >=2.9 && <2.10,         bytestring >=0.12.2.0 && <0.13,+        case-insensitive >=1.2.1.0 && <1.3,         containers >=0.7 && <0.8,         hedgehog >=1.5 && <1.6,         http-client >=0.7.19 && <0.8,
src/Lib.hs view
@@ -21,7 +21,9 @@     , lbsToText     , moveFocusNext     , moveFocusPrev+    , noSyntaxFound     , splitExtraSpace+    , syntaxHighlightResponse     ) where  -- base
src/Skylighting/Format/Vty.hs view
@@ -11,6 +11,7 @@        , attrStyle        , attrColor        , colorDistance+       , vtyStyleAttr        ) where import Control.Monad (mplus) import Data.Binary (Binary)
test/HTTP/ClientSpec.hs view
@@ -6,12 +6,15 @@ import Test.Tasty import Test.Tasty.HUnit -import HTTP.Client (UseDefaultHeaders(..), knownMethods)+import qualified Network.HTTP.Client as HC +import HTTP.Client (UseDefaultHeaders(..), knownMethods, robustSettings)+ tests :: TestTree tests = testGroup "HTTP.Client"   [ knownMethodsTests   , useDefaultHeadersTests+  , robustSettingsTests   ]  -- ---------------------------------------------------------------------------@@ -83,4 +86,24 @@   , testCase "Enum: sorted [minBound..maxBound] equals [minBound..maxBound]" $       sort [minBound .. maxBound :: UseDefaultHeaders]         @?= [minBound .. maxBound]+  , testCase "Enum: fromEnum ReplaceDefaultHeaders == 0" $+      fromEnum ReplaceDefaultHeaders @?= 0+  , testCase "Enum: fromEnum AppendCustomToDefaultHeaders == 1" $+      fromEnum AppendCustomToDefaultHeaders @?= 1+  , testCase "Enum: succ ReplaceDefaultHeaders == AppendCustomToDefaultHeaders" $+      succ ReplaceDefaultHeaders @?= AppendCustomToDefaultHeaders+  , testCase "Enum: pred AppendCustomToDefaultHeaders == ReplaceDefaultHeaders" $+      pred AppendCustomToDefaultHeaders @?= ReplaceDefaultHeaders+  ]++-- ---------------------------------------------------------------------------+-- robustSettings+-- ---------------------------------------------------------------------------++robustSettingsTests :: TestTree+robustSettingsTests = testGroup "robustSettings"+  [ testCase "can create a manager from robustSettings without error" $ do+      mgr <- HC.newManager robustSettings+      -- Just confirm the manager was created; destroy it immediately.+      HC.closeManager mgr   ]
test/LibSpec.hs view
@@ -1,6 +1,9 @@ {-# language OverloadedStrings #-} module LibSpec (tests) where +import Data.Maybe (isJust, isNothing)++import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as Text @@ -9,20 +12,36 @@  import qualified Network.HTTP.Client as HC +import Brick.Types (CursorLocation(..), Location(..))+import Brick.Widgets.Edit (getEditContents)+import qualified Data.CaseInsensitive as CI+ import Graphics.Vty.Attributes   (Attr(attrStyle), MaybeDefault(..), Style, currentAttr, reverseVideo)+import qualified Graphics.Vty.Attributes as VA+import Graphics.Vty.Image (charFill, emptyImage, imageHeight, imageWidth)  import HTTP.Client (UseDefaultHeaders(..)) import Lib-  ( cleanPayload+  ( chooseCursor+  , cleanPayload   , focusAttr   , focusStyle+  , growWith   , lbsToText   , moveFocusNext   , moveFocusPrev+  , noSyntaxFound   , splitExtraSpace+  , syntaxHighlightResponse   )-import Types (AppR(..), AppS(..), RangeInAlign(..))+import Types+  ( AppR(..)+  , AppS(..)+  , CustomHeaderColumn(..)+  , CustomHeaderR(..)+  , RangeInAlign(..)+  ) import UI (mkInitialState)  tests :: TestTree@@ -34,6 +53,11 @@   , focusAttrTests   , moveFocusNextTests   , moveFocusPrevTests+  , moveFocusNextCustomHeaderTests+  , moveFocusPrevCustomHeaderTests+  , growSpacesTests+  , chooseCursorTests+  , syntaxHighlightResponseTests   ]  -- ---------------------------------------------------------------------------@@ -116,6 +140,12 @@       cleanPayload "line1\nline2" @?= "line1\nline2"   , testCase "carriage return is preserved" $       cleanPayload "foo\rbar" @?= "foo\rbar"+  , testCase "only special chars gives empty output" $+      cleanPayload "\ESC\v" @?= Text.empty+  , testCase "ESC and vtab together are both stripped" $+      cleanPayload "\ESC\vhello" @?= "hello"+  , testCase "tab followed by ESC: tab expands, ESC stripped" $+      cleanPayload "\t\ESC" @?= "    "   ]  -- ---------------------------------------------------------------------------@@ -203,6 +233,11 @@       let s = withFocus ResponseBodyView                 (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)       focus (moveFocusNext s) @?= MethodEditor+  , testCase "MethodSelector -> MethodEditor (invalid focus)" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = withFocus MethodSelector+                (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+      focus (moveFocusNext s) @?= MethodEditor   ]  where   withFocus f s = s { focus = f }@@ -239,6 +274,214 @@       let s = withFocus ResponseBodyView                 (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)       focus (moveFocusPrev s) @?= AddCustomHeader+  , testCase "MethodSelector -> ResponseBodyView (invalid focus)" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = withFocus MethodSelector+                (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+      focus (moveFocusPrev s) @?= ResponseBodyView   ]  where   withFocus f s = s { focus = f }++-- ---------------------------------------------------------------------------+-- moveFocusNext / moveFocusPrev with custom headers+-- ---------------------------------------------------------------------------++-- One fake header+oneHeader :: [(Bool, (CI.CI BS.ByteString, BS.ByteString))]+oneHeader = [(True, (CI.mk "X-Test", "value"))]++-- Two fake headers+twoHeaders :: [(Bool, (CI.CI BS.ByteString, BS.ByteString))]+twoHeaders = [ (True, (CI.mk "X-First", "one"))+             , (True, (CI.mk "X-Second", "two"))+             ]++moveFocusNextCustomHeaderTests :: TestTree+moveFocusNextCustomHeaderTests = testGroup "moveFocusNext (custom headers)"+  [ testCase "DefaultHeadersToggle -> ExistingCustomHeader 0 ActiveToggle (with 1 header)" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = DefaultHeadersToggle, customHeaders = oneHeader }+      focus (moveFocusNext s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 0, column = ActiveToggle })+  , testCase "ExistingCustomHeader 0 ActiveToggle -> NameEditor" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 0 ActiveToggle)+                , customHeaders = oneHeader }+      focus (moveFocusNext s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 0, column = NameEditor })+  , testCase "ExistingCustomHeader 0 NameEditor -> ValueEditor" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 0 NameEditor)+                , customHeaders = oneHeader }+      focus (moveFocusNext s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 0, column = ValueEditor })+  , testCase "ExistingCustomHeader 0 ValueEditor (last header) -> AddCustomHeader" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 0 ValueEditor)+                , customHeaders = oneHeader }+      focus (moveFocusNext s) @?= AddCustomHeader+  , testCase "ExistingCustomHeader 0 ValueEditor (2 headers) -> next header ActiveToggle" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 0 ValueEditor)+                , customHeaders = twoHeaders }+      focus (moveFocusNext s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 1, column = ActiveToggle })+  ]++moveFocusPrevCustomHeaderTests :: TestTree+moveFocusPrevCustomHeaderTests = testGroup "moveFocusPrev (custom headers)"+  [ testCase "AddCustomHeader -> ExistingCustomHeader 0 ValueEditor (1 header)" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = AddCustomHeader, customHeaders = oneHeader }+      focus (moveFocusPrev s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 0, column = ValueEditor })+  , testCase "ExistingCustomHeader 0 NameEditor -> ActiveToggle" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 0 NameEditor)+                , customHeaders = oneHeader }+      focus (moveFocusPrev s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 0, column = ActiveToggle })+  , testCase "ExistingCustomHeader 0 ValueEditor -> NameEditor" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 0 ValueEditor)+                , customHeaders = oneHeader }+      focus (moveFocusPrev s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 0, column = NameEditor })+  , testCase "ExistingCustomHeader 0 ActiveToggle (first header) -> DefaultHeadersToggle" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 0 ActiveToggle)+                , customHeaders = oneHeader }+      focus (moveFocusPrev s) @?= DefaultHeadersToggle+  , testCase "ExistingCustomHeader 1 ActiveToggle -> previous header ValueEditor" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { focus = ExistingCustomHeader (MkCustomHeaderR 1 ActiveToggle)+                , customHeaders = twoHeaders }+      focus (moveFocusPrev s) @?=+        ExistingCustomHeader (MkCustomHeaderR { listIndex = 0, column = ValueEditor })+  ]++-- ---------------------------------------------------------------------------+-- growWith / growSpaces+-- ---------------------------------------------------------------------------++growSpacesTests :: TestTree+growSpacesTests = testGroup "growSpaces"+  [ testCase "grow emptyImage to 5 wide 3 tall: width == 5" $ do+      let img = growWith (charFill VA.currentAttr ' ') 5 Min 3 Min emptyImage+      imageWidth img @?= 5+  , testCase "grow emptyImage to 5 wide 3 tall: height == 3" $ do+      let img = growWith (charFill VA.currentAttr ' ') 5 Min 3 Min emptyImage+      imageHeight img @?= 3+  , testCase "grow to 0 wide 0 tall is a no-op on emptyImage" $ do+      let img = growWith (charFill VA.currentAttr ' ') 0 Min 0 Min emptyImage+      imageWidth img @?= 0+      imageHeight img @?= 0+  , testCase "image already wider than min: width unchanged" $ do+      let src = charFill VA.currentAttr '*' 10 1+          img = growWith (charFill VA.currentAttr ' ') 5 Min 1 Min src+      imageWidth img @?= 10+  , testCase "image already taller than min: height unchanged" $ do+      let src = charFill VA.currentAttr '*' 1 10+          img = growWith (charFill VA.currentAttr ' ') 1 Min 5 Min src+      imageHeight img @?= 10+  , testCase "Max wide alignment: grows to min width" $ do+      let img = growWith (charFill VA.currentAttr ' ') 10 Max 1 Min (charFill VA.currentAttr '*' 2 1)+      imageWidth img @?= 10+  , testCase "Max vert alignment: grows to min height" $ do+      let img = growWith (charFill VA.currentAttr ' ') 1 Min 5 Max (charFill VA.currentAttr '*' 1 2)+      imageHeight img @?= 5+  , testCase "MidL wide alignment: grows to min width" $ do+      let img = growWith (charFill VA.currentAttr ' ') 6 MidL 1 Min (charFill VA.currentAttr '*' 2 1)+      imageWidth img @?= 6+  , testCase "MidG wide alignment: grows to min width" $ do+      let img = growWith (charFill VA.currentAttr ' ') 6 MidG 1 Min (charFill VA.currentAttr '*' 2 1)+      imageWidth img @?= 6+  ]++-- ---------------------------------------------------------------------------+-- chooseCursor+-- ---------------------------------------------------------------------------++chooseCursorTests :: TestTree+chooseCursorTests = testGroup "chooseCursor"+  [ testCase "no overlay, empty cursor list -> Nothing" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing+      assertBool "expected Nothing" (isNothing (chooseCursor s []))+  , testCase "no overlay, UrlEditor cursor in list -> returns it" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing+          loc = CursorLocation (Location (0, 0)) (Just UrlEditor) True+          result = chooseCursor s [loc]+      assertBool "expected Just" (isJust result)+  , testCase "no overlay, wrong name cursor -> Nothing" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing+          loc = CursorLocation (Location (0, 0)) (Just MethodEditor) True+      assertBool "expected Nothing" (isNothing (chooseCursor s [loc]))+  , testCase "overlay present, empty cursor list -> Nothing" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { overlayState = Just undefined }+      assertBool "expected Nothing" (isNothing (chooseCursor s []))+  , testCase "overlay present, MethodSelector cursor -> returns it" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { overlayState = Just undefined }+          loc = CursorLocation (Location (0, 0)) (Just MethodSelector) True+          result = chooseCursor s [loc]+      assertBool "expected Just" (isJust result)+  , testCase "overlay present, non-MethodSelector cursor -> Nothing" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = (mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing)+                { overlayState = Just undefined }+          loc = CursorLocation (Location (0, 0)) (Just UrlEditor) True+      assertBool "expected Nothing" (isNothing (chooseCursor s [loc]))+  ]++-- ---------------------------------------------------------------------------+-- syntaxHighlightResponse / noSyntaxFound+-- ---------------------------------------------------------------------------++syntaxHighlightResponseTests :: TestTree+syntaxHighlightResponseTests = testGroup "syntaxHighlightResponse"+  [ testCase "Nothing payload -> non-empty 'no response body' image" $ do+      let img = syntaxHighlightResponse Nothing Nothing+      assertBool "expected non-empty image" (imageWidth img > 0 || imageHeight img > 0)+  , testCase "Just payload, Nothing content-type -> non-empty image" $ do+      let img = syntaxHighlightResponse (Just "hello world") Nothing+      assertBool "expected non-empty image" (imageWidth img > 0 || imageHeight img > 0)+  , testCase "Just payload, Just application/json content-type -> non-empty image" $ do+      let img = syntaxHighlightResponse (Just "{\"a\":1}") (Just "application/json")+      assertBool "expected non-empty image" (imageWidth img > 0 || imageHeight img > 0)+  , testCase "Just payload, Just unknown content-type -> same height as noSyntaxFound" $ do+      let img = syntaxHighlightResponse (Just "data") (Just "application/x-unknown-restman-test")+          img2 = noSyntaxFound "data"+      imageHeight img @?= imageHeight img2+  , testCase "Just payload, Just text/plain content-type -> non-empty image" $ do+      let img = syntaxHighlightResponse (Just "hello world") (Just "text/plain")+      assertBool "expected non-empty image" (imageWidth img > 0 || imageHeight img > 0)+  , testCase "Just payload, Just text/html content-type -> non-empty image" $ do+      let img = syntaxHighlightResponse (Just "<p>hello</p>") (Just "text/html")+      assertBool "expected non-empty image" (imageWidth img > 0 || imageHeight img > 0)+  , testCase "noSyntaxFound empty text -> non-empty image (header line)" $ do+      let img = noSyntaxFound Text.empty+      assertBool "expected non-empty image" (imageWidth img > 0 || imageHeight img > 0)+  , testCase "noSyntaxFound single-line text -> height is 2 (header + 1 line)" $ do+      let img = noSyntaxFound "hello world"+      imageHeight img @?= 2+  , testCase "noSyntaxFound two-line text -> height is 3 (header + 2 lines)" $ do+      let img = noSyntaxFound "line1\nline2"+      imageHeight img @?= 3+  ]
test/Props/LibProps.hs view
@@ -1,12 +1,13 @@ {-# language OverloadedStrings #-} module Props.LibProps (tests) where --- base-import Data.List (foldl')- -- bytestring+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS +-- case-insensitive+import qualified Data.CaseInsensitive as CI+ -- hedgehog import Hedgehog import qualified Hedgehog.Gen as Gen@@ -25,12 +26,15 @@  -- vty import Graphics.Vty.Attributes (Style, reverseVideo)+import qualified Graphics.Vty.Attributes as VA+import Graphics.Vty.Image (charFill, imageHeight, imageWidth)  -- restman-import HTTP.Client (UseDefaultHeaders(..))+import HTTP.Client (Header, UseDefaultHeaders(..)) import Lib   ( cleanPayload   , focusStyle+  , growWith   , lbsToText   , moveFocusNext   , moveFocusPrev@@ -46,6 +50,7 @@   , lbsToTextProps   , focusStyleProps   , focusCycleProps+  , growSpacesProps   ]  -- ---------------------------------------------------------------------------@@ -185,10 +190,17 @@   _ <- evalNF (lbsToText bs)   success +-- Valid Unicode text encoded as UTF-8 decodes back to itself.+prop_lbsToText_unicode_roundtrip :: Property+prop_lbsToText_unicode_roundtrip = property $ do+  t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+  lbsToText (LBS.fromStrict $ encodeUtf8 t) === t+ lbsToTextProps :: TestTree lbsToTextProps = testGroup "lbsToText"   [ testProperty "ASCII encode/decode roundtrip" prop_lbsToText_ascii_roundtrip   , testProperty "never throws on arbitrary bytes" prop_lbsToText_never_throws+  , testProperty "valid Unicode encode/decode roundtrip" prop_lbsToText_unicode_roundtrip   ]  -- ---------------------------------------------------------------------------@@ -265,9 +277,85 @@   let s1 = s0 { focus = startFocus }   focus (moveFocusPrev (moveFocusNext s1)) === startFocus +-- Applying moveFocusNext 8 times with one custom header returns focus to its+-- starting position (5 non-header stops + 3 per header = 8 total).+prop_moveFocusNext_cycle8_one_header :: Property+prop_moveFocusNext_cycle8_one_header = property $ do+  mgr <- evalIO $ HC.newManager HC.defaultManagerSettings+  let oneHeader :: [Header]+      oneHeader = [(CI.mk ("X-Test" :: BS.ByteString), "value")]+      s0 = mkInitialState mgr "GET" ReplaceDefaultHeaders oneHeader Nothing Nothing+      sN = foldl' (flip ($)) s0 (replicate 8 moveFocusNext)+  focus sN === focus s0+ focusCycleProps :: TestTree focusCycleProps = testGroup "focus cycle"   [ testProperty "moveFocusNext: 5 steps is full cycle"              prop_moveFocusNext_cycle5   , testProperty "moveFocusPrev: 5 steps is full cycle"              prop_moveFocusPrev_cycle5   , testProperty "moveFocusNext then moveFocusPrev restores focus"   prop_moveFocusNext_then_prev_identity+  , testProperty "moveFocusNext: 8 steps with 1 header is full cycle" prop_moveFocusNext_cycle8_one_header+  ]++-- ---------------------------------------------------------------------------+-- growWith / growSpaces properties+--+-- growWith fillImg minW wa minH va img+-- Post-conditions: output width >= max(minW, imageWidth img)+--                  output height >= max(minH, imageHeight img)+-- ---------------------------------------------------------------------------++-- Output width is always at least the requested minimum.+prop_growSpaces_width_ge_min :: Property+prop_growSpaces_width_ge_min = property $ do+  minW <- forAll $ Gen.int (Range.linear 0 50)+  minH <- forAll $ Gen.int (Range.linear 1 50)+  srcW <- forAll $ Gen.int (Range.linear 1 50)+  srcH <- forAll $ Gen.int (Range.linear 1 50)+  align <- forAll genAlign+  let src = charFill VA.currentAttr ' ' srcW srcH+      img = growWith (charFill VA.currentAttr ' ') minW align minH align src+  assert (imageWidth img >= minW)++-- Output height is always at least the requested minimum.+prop_growSpaces_height_ge_min :: Property+prop_growSpaces_height_ge_min = property $ do+  minW <- forAll $ Gen.int (Range.linear 1 50)+  minH <- forAll $ Gen.int (Range.linear 0 50)+  srcW <- forAll $ Gen.int (Range.linear 1 50)+  srcH <- forAll $ Gen.int (Range.linear 1 50)+  align <- forAll genAlign+  let src = charFill VA.currentAttr ' ' srcW srcH+      img = growWith (charFill VA.currentAttr ' ') minW align minH align src+  assert (imageHeight img >= minH)++-- Output width is always at least the source image width.+prop_growSpaces_width_ge_src :: Property+prop_growSpaces_width_ge_src = property $ do+  minW <- forAll $ Gen.int (Range.linear 0 50)+  minH <- forAll $ Gen.int (Range.linear 1 50)+  srcW <- forAll $ Gen.int (Range.linear 1 50)+  srcH <- forAll $ Gen.int (Range.linear 1 50)+  align <- forAll genAlign+  let src = charFill VA.currentAttr ' ' srcW srcH+      img = growWith (charFill VA.currentAttr ' ') minW align minH align src+  assert (imageWidth img >= imageWidth src)++-- Output height is always at least the source image height.+prop_growSpaces_height_ge_src :: Property+prop_growSpaces_height_ge_src = property $ do+  minW <- forAll $ Gen.int (Range.linear 1 50)+  minH <- forAll $ Gen.int (Range.linear 0 50)+  srcW <- forAll $ Gen.int (Range.linear 1 50)+  srcH <- forAll $ Gen.int (Range.linear 1 50)+  align <- forAll genAlign+  let src = charFill VA.currentAttr ' ' srcW srcH+      img = growWith (charFill VA.currentAttr ' ') minW align minH align src+  assert (imageHeight img >= imageHeight src)++growSpacesProps :: TestTree+growSpacesProps = testGroup "growSpaces"+  [ testProperty "output width >= requested minimum"  prop_growSpaces_width_ge_min+  , testProperty "output height >= requested minimum" prop_growSpaces_height_ge_min+  , testProperty "output width >= source width"       prop_growSpaces_width_ge_src+  , testProperty "output height >= source height"     prop_growSpaces_height_ge_src   ]
test/Props/SkylightingProps.hs view
@@ -20,13 +20,15 @@ import Skylighting.Types (ANSIColorLevel(..), Color(..))  -- restman-import Skylighting.Format.Vty (attrColor, attrStyle, colorDistance)+import Skylighting.Format.Vty+  (attrColor, attrStyle, colorDistance, vtyStyleAttr)  tests :: TestTree tests = testGroup "Props.Skylighting.Format.Vty"   [ colorDistanceProps   , attrStyleProps   , attrColorProps+  , vtyStyleAttrProps   ]  -- ---------------------------------------------------------------------------@@ -183,4 +185,77 @@   [ testProperty "Nothing -> Nothing for all levels"  prop_attrColor_nothing_to_nothing   , testProperty "Just -> Just for all levels"        prop_attrColor_just_to_just   , testProperty "same input gives same output"       prop_attrColor_same_rgb_same_result+  ]++-- ---------------------------------------------------------------------------+-- vtyStyleAttr properties+--+-- vtyStyleAttr :: ANSIColorLevel -> Maybe Color -> Maybe Color+--              -> Bool -> Bool -> Bool -> VA.Attr+-- ---------------------------------------------------------------------------++-- fg Nothing -> attrForeColor is Default.+prop_vtyStyleAttr_fg_nothing_default :: Property+prop_vtyStyleAttr_fg_nothing_default = property $ do+  clv <- forAll genColorLevel+  bgc <- forAll (Gen.maybe genColor)+  b   <- forAll Gen.bool+  i   <- forAll Gen.bool+  u   <- forAll Gen.bool+  VA.attrForeColor (vtyStyleAttr clv Nothing bgc b i u) === VA.Default++-- fg Just -> attrForeColor is SetTo.+prop_vtyStyleAttr_fg_just_set :: Property+prop_vtyStyleAttr_fg_just_set = property $ do+  clv <- forAll genColorLevel+  fgc <- forAll genColor+  bgc <- forAll (Gen.maybe genColor)+  b   <- forAll Gen.bool+  i   <- forAll Gen.bool+  u   <- forAll Gen.bool+  case VA.attrForeColor (vtyStyleAttr clv (Just fgc) bgc b i u) of+    VA.SetTo _ -> success+    _ -> failure++-- bg Nothing -> attrBackColor is Default.+prop_vtyStyleAttr_bg_nothing_default :: Property+prop_vtyStyleAttr_bg_nothing_default = property $ do+  clv <- forAll genColorLevel+  fgc <- forAll (Gen.maybe genColor)+  b   <- forAll Gen.bool+  i   <- forAll Gen.bool+  u   <- forAll Gen.bool+  VA.attrBackColor (vtyStyleAttr clv fgc Nothing b i u) === VA.Default++-- bg Just -> attrBackColor is SetTo.+prop_vtyStyleAttr_bg_just_set :: Property+prop_vtyStyleAttr_bg_just_set = property $ do+  clv <- forAll genColorLevel+  fgc <- forAll (Gen.maybe genColor)+  bgc <- forAll genColor+  b   <- forAll Gen.bool+  i   <- forAll Gen.bool+  u   <- forAll Gen.bool+  case VA.attrBackColor (vtyStyleAttr clv fgc (Just bgc) b i u) of+    VA.SetTo _ -> success+    _ -> failure++-- attrURL is always Default.+prop_vtyStyleAttr_url_always_default :: Property+prop_vtyStyleAttr_url_always_default = property $ do+  clv <- forAll genColorLevel+  fgc <- forAll (Gen.maybe genColor)+  bgc <- forAll (Gen.maybe genColor)+  b   <- forAll Gen.bool+  i   <- forAll Gen.bool+  u   <- forAll Gen.bool+  VA.attrURL (vtyStyleAttr clv fgc bgc b i u) === VA.Default++vtyStyleAttrProps :: TestTree+vtyStyleAttrProps = testGroup "vtyStyleAttr"+  [ testProperty "fg Nothing -> Default foreground"    prop_vtyStyleAttr_fg_nothing_default+  , testProperty "fg Just -> SetTo foreground"         prop_vtyStyleAttr_fg_just_set+  , testProperty "bg Nothing -> Default background"    prop_vtyStyleAttr_bg_nothing_default+  , testProperty "bg Just -> SetTo background"         prop_vtyStyleAttr_bg_just_set+  , testProperty "attrURL is always Default"           prop_vtyStyleAttr_url_always_default   ]
test/Spec.hs view
@@ -20,7 +20,8 @@   , defaultFormatOpts   ) -import Skylighting.Format.Vty (attrColor, attrStyle, colorDistance, formatVty)+import Skylighting.Format.Vty+  (attrColor, attrStyle, colorDistance, formatVty, vtyStyleAttr)  import qualified HTTP.ClientSpec import qualified LibSpec@@ -55,6 +56,7 @@       , attrColorTests       , colorDistanceTests       , formatVtyTests+      , vtyStyleAttrTests       ]   , testGroup "property tests"       [ Props.HTTPClientProps.tests@@ -125,4 +127,50 @@                    }           img = formatVty opts emptyStyle [[(NormalTok, "hello")]]       VI.imageWidth img @?= 5+  , testCase "three source lines has height 3" $ do+      let opts = defaultFormatOpts { numberLines = False }+          img = formatVty opts emptyStyle+                  [ [(NormalTok, "a")]+                  , [(NormalTok, "b")]+                  , [(NormalTok, "c")]+                  ]+      VI.imageHeight img @?= 3+  , testCase "number lines enabled produces wider image than without" $ do+      let optsNums = defaultFormatOpts { numberLines = True,  ansiColorLevel = ANSITrueColor }+          optsNoNums = defaultFormatOpts { numberLines = False, ansiColorLevel = ANSITrueColor }+          src = [[(NormalTok, "hello")]]+          imgNums = formatVty optsNums   emptyStyle src+          imgNoNums = formatVty optsNoNums emptyStyle src+      assertBool "image with line numbers should be wider" (VI.imageWidth imgNums > VI.imageWidth imgNoNums)+  ]++vtyStyleAttrTests :: TestTree+vtyStyleAttrTests = testGroup "vtyStyleAttr"+  [ testCase "no color, no style -> all Default except style SetTo defaultStyleMask" $ do+      let a = vtyStyleAttr ANSITrueColor Nothing Nothing False False False+      VA.attrStyle a @?= VA.SetTo VA.defaultStyleMask+      VA.attrForeColor a @?= VA.Default+      VA.attrBackColor a @?= VA.Default+  , testCase "fg Just red -> attrForeColor is SetTo" $ do+      let a = vtyStyleAttr ANSITrueColor (Just (RGB 255 0 0)) Nothing False False False+      case VA.attrForeColor a of+        VA.SetTo _ -> pure ()+        _ -> assertFailure "expected SetTo for fg color"+  , testCase "bg Just green -> attrBackColor is SetTo" $ do+      let a = vtyStyleAttr ANSITrueColor Nothing (Just (RGB 0 255 0)) False False False+      case VA.attrBackColor a of+        VA.SetTo _ -> pure ()+        _ -> assertFailure "expected SetTo for bg color"+  , testCase "bold=True -> bold bit set in style" $ do+      let a = vtyStyleAttr ANSITrueColor Nothing Nothing True False False+      VA.attrStyle a @?= VA.SetTo VA.bold+  , testCase "italic=True -> italic bit set in style" $ do+      let a = vtyStyleAttr ANSITrueColor Nothing Nothing False True False+      VA.attrStyle a @?= VA.SetTo VA.italic+  , testCase "underline=True -> underline bit set in style" $ do+      let a = vtyStyleAttr ANSITrueColor Nothing Nothing False False True+      VA.attrStyle a @?= VA.SetTo VA.underline+  , testCase "attrURL is always Default" $ do+      let a = vtyStyleAttr ANSITrueColor (Just (RGB 1 2 3)) (Just (RGB 4 5 6)) True True True+      VA.attrURL a @?= VA.Default   ]
test/UISpec.hs view
@@ -6,11 +6,15 @@ import Test.Tasty import Test.Tasty.HUnit +import qualified Data.ByteString as BS+import qualified Data.CaseInsensitive as CI+ import qualified Network.HTTP.Client as HC  import Brick.Widgets.Edit (getEditContents)+import Graphics.Vty.Image (imageWidth) -import HTTP.Client (UseDefaultHeaders(..))+import HTTP.Client (Header, UseDefaultHeaders(..)) import Types (AppS(..)) import UI (mkInitialState) @@ -65,4 +69,19 @@       mgr <- HC.newManager HC.defaultManagerSettings       let s = mkInitialState mgr "GET" ReplaceDefaultHeaders [] (Just "request body") Nothing       payload s @?= Just "request body"+  , testCase "lastResponse starts as zero-width image" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let s = mkInitialState mgr "GET" ReplaceDefaultHeaders [] Nothing Nothing+      imageWidth (lastResponse s) @?= 0+  , testCase "supplied headers are initially active" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let hdr = (CI.mk ("X-Custom" :: BS.ByteString), "val" :: BS.ByteString)+          s = mkInitialState mgr "GET" ReplaceDefaultHeaders [hdr] Nothing Nothing+      customHeaders s @?= [(True, hdr)]+  , testCase "multiple supplied headers count is preserved" $ do+      mgr <- HC.newManager HC.defaultManagerSettings+      let hdrs :: [Header]+          hdrs = [(CI.mk "X-A", "1"), (CI.mk "X-B", "2")]+          s = mkInitialState mgr "GET" ReplaceDefaultHeaders hdrs Nothing Nothing+      length (customHeaders s) @?= 2   ]