layoutz-0.2.0.0: test/Test.hs

{-# LANGUAGE OverloadedStrings #-}

import Test.Tasty
import Test.Tasty.HUnit
import Layoutz
import Data.List (isInfixOf)
import Data.IORef (newIORef, readIORef, writeIORef)

-- Helper to strip ANSI codes for testing (re-export from Layoutz would be better, but this works)
stripAnsiTest :: String -> String
stripAnsiTest [] = []
stripAnsiTest ('\ESC':'[':rest) = stripAnsiTest (dropAfterM rest)
  where 
    dropAfterM [] = []
    dropAfterM ('m':xs) = xs
    dropAfterM (_:xs) = dropAfterM xs
stripAnsiTest (c:rest) = c : stripAnsiTest rest

main :: IO ()
main = defaultMain tests

tests :: TestTree
tests = testGroup "Layoutz Tests"
  [ basicElementTests
  , visualFeatureTests
  , dataVisualizationTests
  , containerTests
  , layoutTests
  , dimensionTests
  , colorTests
  , extendedColorTests
  , styleTests
  , commandTests
  ]

-- Basic element tests
basicElementTests :: TestTree
basicElementTests = testGroup "Basic Elements"
  [ testCase "text rendering" $
      render (text "Hello World") @?= "Hello World"
      
  , testCase "line break rendering" $
      render br @?= ""
      
  , testCase "underline default" $
      render (underline $ text "Test") @?= "Test\n────"
      
  , testCase "underline custom" $
      render (underline' "=" $ text "Test") @?= "Test\n===="
      
  , testCase "center default width" $
      -- center now uses smart auto-centering, test within a layout context
      render (layout [text "wide content here to establish context width", center $ text "Test"]) @?= "wide content here to establish context width\n                    Test                    "
      
  , testCase "center custom width" $
      render (center' 10 $ text "Test") @?= "   Test   "
  ]

-- Visual feature tests
visualFeatureTests :: TestTree
visualFeatureTests = testGroup "Visual Features"
  [ testCase "horizontal rule default" $
      render hr @?= "──────────────────────────────────────────────────"
      
  , testCase "horizontal rule custom char" $
      render (hr' "=") @?= "=================================================="
      
  , testCase "horizontal rule custom width" $
      render (hr'' "-" 10) @?= "----------"
      
  , testCase "vertical rule default" $
      length (lines $ render vr) @?= 10
      
  , testCase "vertical rule custom char" $
      head (lines $ render $ vr' "║") @?= "║"
      
  , testCase "vertical rule custom height" $
      length (lines $ render $ vr'' "|" 5) @?= 5
      
  , testCase "padding" $
      lines (render $ pad 2 $ text "Test") @?= ["        ", "        ", "  Test  ", "        ", "        "]
      
  , testCase "margin custom" $
      render (margin ">>>" [text "Line 1", text "Line 2"]) @?= ">>> Line 1\n>>> Line 2"
      
  , testCase "margin error" $
      render (margin "[error]" [text "Error message"]) @?= "[error] Error message"
  ]

-- Data visualization tests
dataVisualizationTests :: TestTree
dataVisualizationTests = testGroup "Data Visualization"
  [ testCase "inline bar 0%" $
      "Test [────────────────────] 0%" `elem` lines (render $ inlineBar "Test" 0.0) @?= True
      
  , testCase "inline bar 50%" $
      "Test [██████████──────────] 50%" `elem` lines (render $ inlineBar "Test" 0.5) @?= True
      
  , testCase "inline bar 100%" $
      "Test [████████████████████] 100%" `elem` lines (render $ inlineBar "Test" 1.0) @?= True
      
  , testCase "chart" $
      "Task │████████████████████████████████████████│ 50" `elem` lines (render $ chart [("Task", 50.0)]) @?= True
      
  , testCase "key-value pairs" $
      render (kv [("Key", "Value")]) @?= "Key: Value"
  ]

-- Container tests
containerTests :: TestTree
containerTests = testGroup "Containers"
  [ testCase "status card default border" $
      length (lines $ render $ statusCard "API" "UP") @?= 4
      
  , testCase "status card double border" $
      "╔═══════╗" `elem` lines (render $ withBorder BorderDouble $ statusCard "API" "UP") @?= True
      
  , testCase "box default border" $
      "┌──Title──┐" `elem` lines (render $ box "Title" [text "Content"]) @?= True
      
  , testCase "box double border" $
      "╔══Title══╗" `elem` lines (render $ withBorder BorderDouble $ box "Title" [text "Content"]) @?= True
  ]

-- Layout tests
layoutTests :: TestTree
layoutTests = testGroup "Layout"
  [ testCase "unordered list single level" $
      render (ul [text "Item 1", text "Item 2"]) @?= "• Item 1\n• Item 2"
      
  , testCase "unordered list nested" $
      "  ◦ Sub 1" `elem` lines (render $ ul [text "Item 1", ul [text "Sub 1", text "Sub 2"]]) @?= True
      
  , testCase "ordered list single level" $
      render (ol [text "First", text "Second"]) @?= "1. First\n2. Second"
      
  , testCase "ordered list nested with letters" $
      "  a. Nested" `elem` lines (render $ ol [text "Item 1", ol [text "Nested", text "Also nested"]]) @?= True
      
  , testCase "ordered list triple nested with roman numerals" $
      "    i. Deep" `elem` lines (render $ ol [text "L1", ol [text "L2", ol [text "Deep"]]]) @?= True
      
  , testCase "table basic" $
      "│ A │ B │" `elem` lines (render $ table ["A", "B"] [[text "1", text "2"]]) @?= True
      
  , testCase "tree structure" $
      "Root" `elem` lines (render $ tree "Root" [leaf "Child"]) @?= True
      
  , testCase "section" $
      "=== Title ===" `elem` lines (render $ section "Title" [text "Content"]) @?= True
      
  , testCase "row layout" $
      render (row [text "A", text "B"]) @?= "A B"
      
  , testCase "layout composition" $
      render (layout [text "Line 1", text "Line 2"]) @?= "Line 1\nLine 2"
      
  , testCase "align left" $
      render (alignLeft 10 "Hi") @?= "Hi        "
      
  , testCase "align right" $
      render (alignRight 10 "Hi") @?= "        Hi"
      
  , testCase "align center" $
      render (alignCenter 10 "Hi") @?= "    Hi    "
      
  , testCase "justify" $
      render (justify 20 "Hello world test") @?= "Hello   world   test"
  ]

-- Dimension tests
dimensionTests :: TestTree
dimensionTests = testGroup "Dimensions"
  [ testCase "width calculation" $
      width (text "Hello") @?= 5
      
  , testCase "height calculation" $
      height (layout [text "Line 1", text "Line 2"]) @?= 2
  ]

-- Color tests
colorTests :: TestTree
colorTests = testGroup "Colors"
  [ testCase "render includes ANSI codes" $
      "\ESC[31m" `isInfixOf` render (withColor ColorRed $ text "Hello") @?= True
      
  , testCase "render includes reset code" $
      "\ESC[0m" `isInfixOf` render (withColor ColorRed $ text "Hello") @?= True
      
  , testCase "colored element width ignores ANSI codes" $
      width (withColor ColorRed $ text "Hello") @?= 5
      
  , testCase "colored status card maintains structure" $
      let colored = render $ withColor ColorGreen $ withBorder BorderDouble $ statusCard "API" "UP"
          strippedLines = map stripAnsiTest (lines colored)
      in "╔═══════╗" `elem` strippedLines @?= True
      
  , testCase "colored box maintains structure" $
      let colored = render $ withColor ColorBlue $ box "Title" [text "Content"]
          strippedLines = map stripAnsiTest (lines colored)
      in "┌──Title──┐" `elem` strippedLines @?= True
      
  , testCase "nested colors work" $
      "\ESC[32m" `isInfixOf` render (withColor ColorRed $ layout [withColor ColorGreen $ text "Hi"]) @?= True
      
  , testCase "bright colors use correct codes" $
      "\ESC[91m" `isInfixOf` render (withColor ColorBrightRed $ text "Hi") @?= True
      
  , testCase "color with borders both work" $
      let colored = render $ withColor ColorYellow $ withBorder BorderThick $ statusCard "Test" "OK"
          strippedLines = map stripAnsiTest (lines colored)
      in "┏━━━━━━━━┓" `elem` strippedLines @?= True
      
  , testCase "colored underline includes ANSI codes" $
      "\ESC[31m" `isInfixOf` render (underlineColored "=" ColorRed $ text "Title") @?= True
      
  , testCase "colored underline maintains structure" $
      let underlined = render $ underlineColored "=" ColorRed $ text "Test"
          strippedLines = map stripAnsiTest (lines underlined)
      in "====" `elem` strippedLines @?= True
  ]

-- Extended color tests (256-color and RGB)
extendedColorTests :: TestTree
extendedColorTests = testGroup "Extended Colors"
  [ testCase "256-color palette (ColorFull)" $
      "\ESC[38;5;" `isInfixOf` render (withColor (ColorFull 196) $ text "Red") @?= True
      
  , testCase "256-color clamping max" $
      "\ESC[38;5;255" `isInfixOf` render (withColor (ColorFull 300) $ text "Clamped") @?= True
      
  , testCase "256-color clamping min" $
      "\ESC[38;5;0" `isInfixOf` render (withColor (ColorFull (-10)) $ text "Clamped") @?= True
      
  , testCase "RGB true color (ColorTrue)" $
      "\ESC[38;2;" `isInfixOf` render (withColor (ColorTrue 255 100 50) $ text "RGB") @?= True
      
  , testCase "RGB true color full spec" $
      "\ESC[38;2;255;100;50" `isInfixOf` render (withColor (ColorTrue 255 100 50) $ text "RGB") @?= True
      
  , testCase "RGB color clamping" $
      "\ESC[38;2;255;255;0" `isInfixOf` render (withColor (ColorTrue 300 300 (-10)) $ text "Clamped") @?= True
      
  , testCase "tightRow renders without spaces" $
      stripAnsiTest (render $ tightRow [withColor ColorRed $ text "A", withColor ColorGreen $ text "B"]) @?= "AB"
      
  , testCase "tightRow vs row spacing" $
      let tightResult = stripAnsiTest (render $ tightRow [text "A", text "B"])
          normalResult = render $ row [text "A", text "B"]
      in (tightResult == "AB" && normalResult == "A B") @?= True
  ]

-- Style tests (including combining)
styleTests :: TestTree
styleTests = testGroup "Styles"
  [ testCase "bold style" $
      "\ESC[1m" `isInfixOf` render (withStyle StyleBold $ text "Bold") @?= True
      
  , testCase "italic style" $
      "\ESC[3m" `isInfixOf` render (withStyle StyleItalic $ text "Italic") @?= True
      
  , testCase "combined styles with <>" $
      let combined = render $ withStyle (StyleBold <> StyleItalic) $ text "Fancy"
      in ("\ESC[1;3m" `isInfixOf` combined || "\ESC[3;1m" `isInfixOf` combined) @?= True
      
  , testCase "triple combined styles" $
      let combined = render $ withStyle (StyleBold <> StyleItalic <> StyleUnderline) $ text "Very Fancy"
          hasAll = "\ESC[" `isInfixOf` combined && "1" `isInfixOf` combined && "3" `isInfixOf` combined && "4" `isInfixOf` combined
      in hasAll @?= True
      
  , testCase "style with color both work" $
      let styled = render $ withColor ColorRed $ withStyle StyleBold $ text "Important"
      in ("\ESC[31m" `isInfixOf` styled && "\ESC[1m" `isInfixOf` styled) @?= True
      
  , testCase "style maintains element width" $
      width (withStyle StyleBold $ text "Hello") @?= 5
      
  , testCase "combined style maintains structure" $
      let styled = render $ withStyle (StyleBold <> StyleReverse) $ box "Title" [text "Content"]
          strippedLines = map stripAnsiTest (lines styled)
      in "┌──Title──┐" `elem` strippedLines @?= True
      
  , testCase "wrap text at word boundaries" $
      let wrapped = render $ wrap 10 "This is a very long text"
          wrappedLines = lines wrapped
      in length wrappedLines > 1 @?= True
      
  , testCase "wrap preserves words" $
      "This is a" `isInfixOf` render (wrap 10 "This is a test") @?= True
  ]

-- Command execution tests
commandTests :: TestTree
commandTests = testGroup "Commands"
  [ testCase "None produces Nothing" $ do
      result <- executeCmd (None :: Cmd String)
      result @?= Nothing
      
  , testCase "cmd executes IO without message" $ do
      ref <- newIORef (0 :: Int)
      result <- executeCmd (cmd $ writeIORef ref 42 :: Cmd String)
      val <- readIORef ref
      result @?= Nothing
      val @?= 42
      
  , testCase "cmdMsg executes IO and returns message" $ do
      result <- executeCmd (cmdMsg $ pure "hello" :: Cmd String)
      result @?= Just "hello"
      
  , testCase "Batch executes all commands" $ do
      ref <- newIORef (0 :: Int)
      _ <- executeCmd (Batch [cmd $ writeIORef ref 1, cmd $ writeIORef ref 2] :: Cmd String)
      val <- readIORef ref
      val @?= 2  -- Last write wins
      
  , testCase "Batch returns first Just message" $ do
      result <- executeCmd (Batch [Cmd (pure Nothing), cmdMsg (pure "first"), cmdMsg (pure "second")] :: Cmd String)
      result @?= Just "first"
  ]