Source

Data.Sequitur / Test / SequiturUnit.hs

module Test.SequiturUnit (tests, runTests) where

import Test.HUnit
import Data.Foldable (toList)
import qualified Data.Sequence as S
import qualified Data.Sequitur as Seq


testRule :: Seq.Compressor Char -> Integer -> [Seq.Symbol Char] -> Assertion
testRule compressor name expected =
    assertEqual title expList actual
    where actual  = toList $ Seq.rule compressor name
          expList = expected
          title   = (show name) ++ " ->"

test_abcdbc = TestCase (do
    let compressed = Seq.compress "abcdbc"
    testRule compressed 0 [ Seq.Literal 'a'
                          , Seq.Rule 1
                          , Seq.Literal 'd'
                          , Seq.Rule 1
                          ]
    testRule compressed 1 [ Seq.Literal 'b', Seq.Literal 'c' ])

test_abcdbcabcdbc = TestCase (do
    let compressed = Seq.compress "abcdbcabcdbc"
    testRule compressed 0 [ Seq.Rule 1, Seq.Rule 1 ]
    testRule compressed 1 [ Seq.Literal 'a'
                          , Seq.Rule 2
                          , Seq.Literal 'd'
                          , Seq.Rule 2
                          ]
    testRule compressed 2 [ Seq.Literal 'b', Seq.Literal 'c' ])

-- This test actually has two valid outcomes.
test_aabaaab = TestCase (do
    let compressed = Seq.compress "aabaaab"
    case (toList $ Seq.rule compressed 0) of
        [ Seq.Rule 1, Seq.Literal 'a', Seq.Rule 1 ] ->
            testRule compressed 1 [ Seq.Literal 'a'
                                  , Seq.Literal 'a'
                                  , Seq.Literal 'b' ]
        [ Seq.Rule 1, Seq.Literal 'b', Seq.Rule 1, Seq.Literal 'a', Seq.Literal 'b' ] ->
            testRule compressed 1 [ Seq.Literal 'a', Seq.Literal 'a' ]
        _ ->
            assertFailure "aabbaaab not compressed correctly."
    )

test_abcdbcabcd = TestCase (do
    let c0 = Seq.init

    -- a
    let c1 = Seq.feed c0 'a'
    testRule c1 0 [ Seq.Literal 'a' ]
    assertEqual "rule count" 1 $ Seq.ruleCount c1

    -- ab
    let c2 = Seq.feed c1 'b'
    testRule c2 0 [ Seq.Literal 'a', Seq.Literal 'b' ]
    assertEqual "rule count" 1 $ Seq.ruleCount c2

    -- abc
    let c3 = Seq.feed c2 'c'
    testRule c3 0 [ Seq.Literal 'a', Seq.Literal 'b', Seq.Literal 'c' ]
    assertEqual "rule count" 1 $ Seq.ruleCount c3

    -- abcd
    let c4 = Seq.feed c3 'd'
    testRule c4 0 [ Seq.Literal 'a'
                  , Seq.Literal 'b'
                  , Seq.Literal 'c'
                  , Seq.Literal 'd'
                  ]
    assertEqual "rule count" 1 $ Seq.ruleCount c4

    -- abcdb
    let c5 = Seq.feed c4 'b'
    testRule c5 0 [ Seq.Literal 'a'
                  , Seq.Literal 'b'
                  , Seq.Literal 'c'
                  , Seq.Literal 'd'
                  , Seq.Literal 'b'
                  ]
    assertEqual "rule count" 1 $ Seq.ruleCount c5

    -- abcdbc
    let c6 = Seq.feed c5 'c'
    testRule c6 0 [ Seq.Literal 'a'
                  , Seq.Rule 1
                  , Seq.Literal 'd'
                  , Seq.Rule 1
                  ]
    testRule c6 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
    assertEqual "rule count" 2 $ Seq.ruleCount c6

    -- abcdbca
    let c7 = Seq.feed c6 'a'
    testRule c7 0 [ Seq.Literal 'a'
                  , Seq.Rule 1
                  , Seq.Literal 'd'
                  , Seq.Rule 1
                  , Seq.Literal 'a'
                  ]
    testRule c7 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
    assertEqual "rule count" 2 $ Seq.ruleCount c7

    -- abcdbcab
    let c8 = Seq.feed c7 'b'
    testRule c8 0 [ Seq.Literal 'a'
                  , Seq.Rule 1
                  , Seq.Literal 'd'
                  , Seq.Rule 1
                  , Seq.Literal 'a'
                  , Seq.Literal 'b'
                  ]
    testRule c8 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
    assertEqual "rule count" 2 $ Seq.ruleCount c8

    -- abcdbcabc
    let c9 = Seq.feed c8 'b'
    testRule c9 0 [ Seq.Rule 2
                  , Seq.Literal 'd'
                  , Seq.Rule 1
                  , Seq.Rule 2
                  ]
    testRule c9 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
    testRule c9 2 [ Seq.Literal 'a', Seq.Rule 1 ]
    assertEqual "rule count" 3 $ Seq.ruleCount c9

    -- abcdbcabcd
    let c10 = Seq.feed c9 'd'
    testRule c10 0 [ Seq.Rule 3
                   , Seq.Rule 1
                   , Seq.Rule 3
                   ]
    testRule c10 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
    testRule c10 3 [ Seq.Literal 'a', Seq.Rule 1, Seq.Literal 'd' ]
    assertEqual "rule count" 3 $ Seq.ruleCount c10
    )

test_aaa = TestCase (do
    let compress = Seq.compress "aaa"
    testRule compress 0 [ Seq.Literal 'a', Seq.Literal 'a', Seq.Literal 'a' ]
    assertEqual "rule count" 1 $ Seq.ruleCount compress)

test_ababcabcdabcdeabcdef = TestCase (do
    let compress = Seq.compress "ababcabcdabcdeabcdef"
    testRule compress 0 [ Seq.Rule 1
                        , Seq.Rule 2
                        , Seq.Rule 3
                        , Seq.Rule 4
                        , Seq.Rule 4
                        , Seq.Literal 'f'
                        ]
    testRule compress 1 [ Seq.Literal 'a', Seq.Literal 'b' ]
    testRule compress 2 [ Seq.Rule 1, Seq.Literal 'c' ]
    testRule compress 3 [ Seq.Rule 2, Seq.Literal 'd' ]
    testRule compress 4 [ Seq.Rule 3, Seq.Literal 'e' ])

test_yzxyzwxyzvwxy = TestCase (do
    let compress = Seq.compress "yzxyzwxyzvwxy"
    testRule compress 0 [ Seq.Rule 1
                        , Seq.Rule 2
                        , Seq.Literal 'w'
                        , Seq.Rule 2
                        , Seq.Literal 'v'
                        , Seq.Literal 'w'
                        , Seq.Literal 'x'
                        , Seq.Literal 'y'
                        ]
    testRule compress 1 [ Seq.Literal 'y', Seq.Literal 'z' ]
    testRule compress 2 [ Seq.Literal 'x', Seq.Rule 1 ])


tests = TestList [ TestLabel "test: abcdbc" test_abcdbc
                 , TestLabel "test: abcdbcabcdbc" test_abcdbcabcdbc
                 , TestLabel "test: aabaaab" test_aabaaab
                 , TestLabel "test: abcdbcabcd" test_abcdbcabcd
                 , TestLabel "test: aaa" test_aaa
                 , TestLabel "test: ababcabcdabcdeabcdef" test_ababcabcdabcdeabcdef
                 , TestLabel "test: yzxyzwxyzvwxy" test_yzxyzwxyzvwxy
                 ]

runTests = do
    runTestTT tests