Mock.hs

{-# LANGUAGE OverloadedStrings #-}

module Redact.Monad.Terminal.Mock (tests) where

-- https://hackage.haskell.org/package/HMock
import Test.HMock ((|->), expect, inSequence, runMockT)

-- https://hackage.haskell.org/package/tasty
import Test.Tasty (TestTree, testGroup)

-- https://hackage.haskell.org/package/tasty-hunit
import Test.Tasty.HUnit (testCase)

-- (redact)
import qualified Redact.Monad.Terminal as RMT
import Redact.Monad.Terminal (resetSGRs)
import Redact.Types (Line(NormalLine, RedactLine), Part(Redact, Stet))

-- (redact:test)
import TestLib

------------------------------------------------------------------------------

testReset :: TestTree
testReset = testCase "reset" . runMockT $ do
    inSequence
      [ expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      ]
    RMT.reset

------------------------------------------------------------------------------

testPutLinesNone :: TestTree
testPutLinesNone = testCase "none" . runMockT $ RMT.putLines redactSGRs []

------------------------------------------------------------------------------

testPutLinesNormalEmpty :: TestTree
testPutLinesNormalEmpty = testCase "normal_empty" . runMockT $ do
    expect $ PutStrLn "" |-> ()
    RMT.putLines redactSGRs [NormalLine []]

------------------------------------------------------------------------------

testPutLinesNormalStet :: TestTree
testPutLinesNormalStet = testCase "normal_stet" . runMockT $ do
    inSequence
      [ expect $ PutStrLn "one" |-> ()
      , expect $ PutStrLn "two" |-> ()
      ]
    RMT.putLines redactSGRs
      [ NormalLine [Stet "one"]
      , NormalLine [Stet "two"]
      ]

------------------------------------------------------------------------------

testPutLinesNormalRedact :: TestTree
testPutLinesNormalRedact = testCase "normal_redact" . runMockT $ do
    inSequence
      [ expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStr "one" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStr "two" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      ]
    RMT.putLines redactSGRs
      [ NormalLine [Redact "one"]
      , NormalLine [Redact "two"]
      ]

------------------------------------------------------------------------------

testPutLinesNormalMixed :: TestTree
testPutLinesNormalMixed = testCase "normal_mixed" . runMockT $ do
    inSequence
      [ expect $ PutStrLn "one" |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStr "two" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStr "three" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStr "four" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStr "five" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStr "six" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStr "seven" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      ]
    RMT.putLines redactSGRs
      [ NormalLine [Stet "one"]
      , NormalLine []
      , NormalLine [Stet "two", Redact "three"]
      , NormalLine [Redact "four"]
      , NormalLine []
      , NormalLine [Redact "five", Stet "six", Redact "seven"]
      ]

------------------------------------------------------------------------------

testPutLinesRedactStet :: TestTree
testPutLinesRedactStet = testCase "redact_stet" . runMockT $ do
    inSequence
      [ expect $ PutStr "one" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStr "two" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStrLn "three" |-> ()
      ]
    RMT.putLines redactSGRs
      [ NormalLine [Stet "one"]
      , RedactLine "two"
      , NormalLine [Stet "three"]
      ]

------------------------------------------------------------------------------

testPutLinesRedactRedact :: TestTree
testPutLinesRedactRedact = testCase "redact_redact" . runMockT $ do
    inSequence
      [ expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStrLn "one" |-> ()
      , expect $ PutStr "two" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStr "three" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      ]
    RMT.putLines redactSGRs
      [ NormalLine [Redact "one"]
      , RedactLine "two"
      , NormalLine [Redact "three"]
      ]

------------------------------------------------------------------------------

testPutLinesRedactMultiple :: TestTree
testPutLinesRedactMultiple = testCase "redact_multiple" . runMockT $ do
    inSequence
      [ expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStrLn "one" |-> ()
      , expect $ PutStrLn "two" |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStr "three" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStrLn "four" |-> ()
      ]
    RMT.putLines redactSGRs
      [ NormalLine [Redact "one"]
      , RedactLine "two"
      , RedactLine ""
      , RedactLine "three"
      , NormalLine [Stet "four"]
      ]

------------------------------------------------------------------------------

testPutLinesRedactBegin :: TestTree
testPutLinesRedactBegin = testCase "redact_begin" . runMockT $ do
    inSequence
      [ expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStr "one" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStrLn "two" |-> ()
      ]
    RMT.putLines redactSGRs
      [ RedactLine "one"
      , NormalLine [Stet "two"]
      ]

------------------------------------------------------------------------------

testPutLinesRedactEnd :: TestTree
testPutLinesRedactEnd = testCase "redact_end" . runMockT $ do
    inSequence
      [ expect $ PutStr "one" |-> ()
      , expect $ SetSGR redactSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      , expect $ PutStr "two" |-> ()
      , expect $ SetSGR resetSGRs |-> ()
      , expect $ PutStrLn "" |-> ()
      ]
    RMT.putLines redactSGRs
      [ NormalLine [Stet "one"]
      , RedactLine "two"
      ]

------------------------------------------------------------------------------

tests :: TestTree
tests = testGroup "Redact.Monad.Terminal:Mock"
    [ testReset
    , testGroup "putLines"
        [ testPutLinesNone
        , testPutLinesNormalEmpty
        , testPutLinesNormalStet
        , testPutLinesNormalRedact
        , testPutLinesNormalMixed
        , testPutLinesRedactStet
        , testPutLinesRedactRedact
        , testPutLinesRedactMultiple
        , testPutLinesRedactBegin
        , testPutLinesRedactEnd
        ]
    ]