diff options
Diffstat (limited to 'test/Spec.hs')
| -rw-r--r-- | test/Spec.hs | 59 |
1 files changed, 31 insertions, 28 deletions
diff --git a/test/Spec.hs b/test/Spec.hs index a886816..fc7ff07 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -11,7 +11,7 @@ import Test.Hspec import Text.Hyphenation qualified as H import TextViewport.Buffer.Buffer (Buffer(..)) import TextViewport.Buffer.Buffer qualified as Buffer -import TextViewport.Buffer.Item (Item(..), SegmentStrategy(..)) +import TextViewport.Buffer.Item (Item(..)) import TextViewport.Render.CachedRender (CachedRender(..)) import TextViewport.Render.RenderBuffer import TextViewport.Render.RenderCache (RenderCache(..), emptyRenderCacheFor) @@ -39,19 +39,22 @@ shouldRunUnder action maxNs = do let dt = toNanoSecs (t2 - t1) dt `shouldSatisfy` (< maxNs) -mkItem :: String -> Item String +mkItem :: String -> Item String (BuiltinSeg String) mkItem t = Item t NoSegments -mkBuf :: [String] -> Buffer String +mkBuf :: [String] -> Buffer String (BuiltinSeg String) mkBuf xs = Buffer.fromList (map mkItem xs) -mkRS :: Int -> [String] -> RenderState String +mkBufSeg :: [String] -> seg -> Buffer String seg +mkBufSeg xs seg = Buffer.fromList (map (flip Item seg) xs) + +mkRS :: Int -> [String] -> RenderState String (BuiltinSeg String) mkRS w xs = mkRenderState w (mkBuf xs) emptyCache :: HM.HashMap String [(String, String)] emptyCache = HM.empty -emptyBuffer :: Buffer String +emptyBuffer :: Buffer String (BuiltinSeg String) emptyBuffer = Buffer.empty emptyStrings :: [String] @@ -138,17 +141,17 @@ main = hspec do RB.flatten rb `shouldSatisfy` (not . null) it "renderBuffer should reject mismatched cache size" do - let buf = Buffer.fromList [Item "a" NoSegments] + let buf = mkBuf ["a"] badCache = RenderCache Seq.empty evaluate (renderBuffer 10 buf badCache) `shouldThrow` anyException it "renderBuffer should reject non-positive width" do - let buf = Buffer.fromList [Item "hello" NoSegments] + let buf = mkBuf ["hello world"] cache = emptyRenderCacheFor buf evaluate (renderBuffer 0 buf cache) `shouldThrow` anyException it "renderBuffer should invalidate cache when width changes" do - let buf = Buffer.fromList [Item "hello world" NoSegments] + let buf = mkBuf ["hello world"] (cache1, _) = renderBuffer 10 buf (emptyRenderCacheFor buf) (_, rb2) = renderBuffer 5 buf cache1 length (RB.flatten rb2) `shouldSatisfy` (> 1) @@ -162,33 +165,33 @@ main = hspec do it "updateRenderedItem should reject mismatched rendered buffer size" do - let buf = Buffer.fromList [Item "a" NoSegments] + let buf = mkBuf ["a"] cache = emptyRenderCacheFor buf rb = RenderedBuffer Seq.empty evaluate (updateRenderedItem 10 0 buf cache rb) `shouldThrow` anyException it "updateRenderedItem should reject non-positive width" do - let buf = Buffer.fromList [Item "a" NoSegments] + let buf = mkBuf ["a"] cache = emptyRenderCacheFor buf rb = RenderedBuffer (Seq.singleton (RenderedItem V.empty)) evaluate (updateRenderedItem 0 0 buf cache rb) `shouldThrow` anyException it "updateRenderedItem should re-render when strategy changes" do - let buf0 = Buffer.fromList [Item "hello world" NoSegments] + let buf0 = mkBuf ["hello world"] (cache0, rb0) = renderBuffer 10 buf0 (emptyRenderCacheFor buf0) - buf1 = Buffer.fromList [Item "hello world" FixedWidthSegments] + buf1 = mkBufSeg ["hello world"] FixedWidthSegments (_, rb1) = updateRenderedItem 10 0 buf1 cache0 rb0 rb1 `shouldNotBe` rb0 it "updateRenderedItem should invalidate cache when strategy changes (cache must differ)" do - let buf0 = Buffer.fromList [mkItem "hello world"] + let buf0 = mkBuf ["hello world"] (cache0, rb0) = renderBuffer 10 buf0 (emptyRenderCacheFor buf0) - buf1 = Buffer.fromList [Item "hello world" FixedWidthSegments] + buf1 = mkBufSeg ["hello world"] FixedWidthSegments (cache1, _) = updateRenderedItem 10 0 buf1 cache0 rb0 cache1 `shouldNotBe` cache0 it "renderBuffer should reject negative indices" do - let buf = Buffer.fromList [Item "a" NoSegments] + let buf = mkBuf ["a"] cache = emptyRenderCacheFor buf evaluate (updateRenderedItem 10 (-1) buf cache (RenderedBuffer Seq.empty)) `shouldThrow` anyException @@ -212,7 +215,7 @@ main = hspec do it "renderItem should invalidate cache when strategy changes" do let old = CachedRender { crWidth = 10 - , crStrategy = NoSegments + , crStrategy = NoSegments :: BuiltinSeg String , crText = "hello world" , crRendered = RenderedItem mempty } @@ -223,7 +226,7 @@ main = hspec do it "renderItem should not reuse cache from a different item index" do let old = CachedRender { crWidth = 10 - , crStrategy = NoSegments + , crStrategy = NoSegments :: BuiltinSeg String , crText = "hello world" , crRendered = RenderedItem mempty } @@ -232,13 +235,13 @@ main = hspec do crRendered new `shouldNotBe` crRendered old it "renderItem should reject non-positive width" do - let itm = Item "hello" NoSegments + let itm = mkItem "hello" evaluate (renderItem 0 0 itm Nothing) `shouldThrow` anyException it "renderItem should invalidate cache when segmentation output changes" do let old = CachedRender { crWidth = 5 - , crStrategy = HyphenateSegments H.German_1996 mempty + , crStrategy = HyphenateSegments H.German_1996 emptyCache , crText = "Schifffahrt" , crRendered = RenderedItem mempty } @@ -283,30 +286,30 @@ main = hspec do RS.rsLineCount rs' `shouldBe` 0 it "updateRenderState should invalidate cache when width changes" do - let rs0 = mkRenderState 10 (Buffer.fromList [Item "hello world" NoSegments]) + let rs0 = mkRS 10 ["hello world"] rs1 = updateRenderState 5 (RS.rsBuffer rs0) rs0 RS.rsLineCount rs1 `shouldSatisfy` (> RS.rsLineCount rs0) it "modifyItemRS should fail on out-of-bounds index" do - evaluate (RS.modifyItemRS 99 id (mkRenderState 10 emptyBuffer)) + evaluate (RS.modifyItemRS 99 id (mkRS 10 [])) `shouldThrow` anyException it "insertItem should reject out-of-bounds index" do - let rs = mkRenderState 10 emptyBuffer + let rs = mkRS 10 [] rs' = RS.insertItem 5 (Item "x" NoSegments) rs RS.rsBuffer rs' `shouldBe` RS.rsBuffer rs it "deleteItem should fail on out-of-bounds index" do - let rs = mkRenderState 10 (Buffer.fromList [Item "a" NoSegments]) + let rs = mkRS 10 ["a"] evaluate (RS.deleteItem 5 rs) `shouldThrow` anyException it "replaceItem should handle out-of-bounds index consistently" do - let rs = mkRenderState 10 emptyBuffer + let rs = mkRS 10 [] evaluate (RS.replaceItem 0 (Item "x" NoSegments) rs) `shouldThrow` anyException it "clearBuffer should reset width or document that width persists" do - let rs = mkRenderState 10 (Buffer.fromList [Item "a" NoSegments]) + let rs = mkRS 10 ["a"] rs' = RS.clearBuffer rs RS.rsWidth rs' `shouldBe` 0 @@ -471,11 +474,11 @@ main = hspec do describe "Viewport" do it "mkViewport should reject non-positive width/height" do - let rs = mkRenderState 10 emptyBuffer + let rs = mkRS 10 [] evaluate (mkViewport 0 0 rs) `shouldThrow` anyException it "alignBottom should place viewport at last line even when height > total lines" do - let rs = mkRenderState 10 (Buffer.fromList [mkItem "a", mkItem "b"]) + let rs = mkRS 10 ["a","b"] vp = Viewport 10 5 0 vpOffset (VP.alignBottom rs vp) `shouldBe` 3 @@ -488,7 +491,7 @@ main = hspec do vpOffset (VP.pageUp vp) `shouldBe` 0 it "clampViewport should reject non-positive viewport height" do - let rs = mkRenderState 10 (Buffer.fromList [mkItem "a"]) + let rs = mkRS 10 ["a"] vp = Viewport 10 0 0 evaluate (clampViewport rs vp) `shouldThrow` anyException |