Commits

Eric Rochester committed bffe6bd

Added enough code to run failing tests.

  • Participants
  • Parent commits 4f088d5

Comments (0)

Files changed (3)

File Test/SequiturQuick.hs

 module Test.SequiturQuick (tests, runTests) where
 
 import Data.Sequitur
+import Test.QuickCheck
 
 prop_idempotent :: [Char] -> Bool
 prop_idempotent xs =

File Test/SequiturUnit.hs

 import qualified Data.Sequitur as Seq
 
 
-testRule :: Compressor String -> Integer -> [Seq.Symbol] -> Assertion
+testRule :: Seq.Compressor Char -> Integer -> [Seq.Symbol Char] -> Assertion
 testRule compressor name expected =
     assertEqual title expected actual
     where actual = Seq.rule compressor name
           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' ]
-    where compressed = Seq.compress "abcdbc")
+    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' ]
-    where compressed = Seq.compress "abcdbcabcdbc")
+    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 (Seq.rule compressed 0) of
         [ Seq.Rule 1, Seq.Literal 'a', Seq.Rule 1 ] ->
             testRule compressed 1 [ Seq.Literal 'a'
             testRule compressed 1 [ Seq.Literal 'a', Seq.Literal 'a' ]
         _ ->
             assertFailure "aabbaaab not compressed correctly."
-    where compressed = Seq.compress "aabaaab"
     )
 
--- XXX: Seq.feed needs to be made functional.
 test_abcdbcabcd = TestCase (do
-    compressor <- Seq.init()
+    let c0 = Seq.init
 
     -- a
-    compressor <- Seq.feed compressor 'a'
-    testRule compressor 0 [ Seq.Literal 'a' ]
-    assertEqual "rule count" 1 $ Seq.ruleCount compressor
+    let c1 = Seq.feed c0 'a'
+    testRule c1 0 [ Seq.Literal 'a' ]
+    assertEqual "rule count" 1 $ Seq.ruleCount c1
 
     -- ab
-    compressor <- Seq.feed compressor 'b'
-    testRule compressor 0 [ Seq.Literal 'a', Seq.Literal 'b' ]
-    assertEqual "rule count" 1 $ Seq.ruleCount compressor
+    let c2 = Seq.feed c1 'b'
+    testRule c2 0 [ Seq.Literal 'a', Seq.Literal 'b' ]
+    assertEqual "rule count" 1 $ Seq.ruleCount c2
 
     -- abc
-    compressor <- Seq.feed compressor 'c'
-    testRule compressor 0 [ Seq.Literal 'a', Seq.Literal 'b', Seq.Literal 'c' ]
-    assertEqual "rule count" 1 $ Seq.ruleCount compressor
+    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
-    compressor <- Seq.feed compressor 'd'
-    testRule compressor 0 [ Seq.Literal 'a'
-                          , Seq.Literal 'b'
-                          , Seq.Literal 'c'
-                          , Seq.Literal 'd'
-                          ]
-    assertEqual "rule count" 1 $ Seq.ruleCount compressor
+    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
-    compressor <- Seq.feed compressor 'b'
-    testRule compressor 0 [ Seq.Literal 'a'
-                          , Seq.Literal 'b'
-                          , Seq.Literal 'c'
-                          , Seq.Literal 'd'
-                          , Seq.Literal 'b'
-                          ]
-    assertEqual "rule count" 1 $ Seq.ruleCount compressor
+    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
-    compressor <- Seq.feed compressor 'c'
-    testRule compressor 0 [ Seq.Literal 'a'
-                          , Seq.Rule 1
-                          , Seq.Literal 'd'
-                          , Seq.Rule 1
-                          ]
-    testRule compressor 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
-    assertEqual "rule count" 2 $ Seq.ruleCount compressor
+    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
-    compressor <- Seq.feed compressor 'a'
-    testRule compressor 0 [ Seq.Literal 'a'
-                          , Seq.Rule 1
-                          , Seq.Literal 'd'
-                          , Seq.Rule 1
-                          , Seq.Literal 'a'
-                          ]
-    testRule compressor 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
-    assertEqual "rule count" 2 $ Seq.ruleCount compressor
+    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
-    compressor <- Seq.feed compressor 'b'
-    testRule compressor 0 [ Seq.Literal 'a'
-                          , Seq.Rule 1
-                          , Seq.Literal 'd'
-                          , Seq.Rule 1
-                          , Seq.Literal 'a'
-                          , Seq.Literal 'b'
-                          ]
-    testRule compressor 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
-    assertEqual "rule count" 2 $ Seq.ruleCount compressor
+    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
-    compressor <- Seq.feed compressor 'b'
-    testRule compressor 0 [ Seq.Rule 2
-                          , Seq.Literal 'd'
-                          , Seq.Rule 1
-                          , Seq.Rule 2
-                          ]
-    testRule compressor 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
-    testRule compressor 2 [ Seq.Literal 'a', Seq.Rule 1 ]
-    assertEqual "rule count" 3 $ Seq.ruleCount compressor
+    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
-    compressor <- Seq.feed compressor 'd'
-    testRule compressor 0 [ Seq.Rule 3
-                          , Seq.Rule 1
-                          , Seq.Rule 3
-                          ]
-    testRule compressor 1 [ Seq.Literal 'b', Seq.Literal 'c' ]
-    testRule compressor 3 [ Seq.Literal 'a', Seq.Rule 1, Seq.Literal 'd' ]
-    assertEqual "rule count" 3 $ Seq.ruleCount compressor
+    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 compressor
-    where compress = Seq.compress "aaa")
+    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
     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' ]
-    where compress = Seq.compress "ababcabcdabcdeabcdef")
+    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.Literal 'y'
                         ]
     testRule compress 1 [ Seq.Literal 'y', Seq.Literal 'z' ]
-    testRule compress 2 [ Seq.Literal 'x', Seq.Rule 1 ]
-    where compress = Seq.compress "yzxyzwxyzvwxy")
+    testRule compress 2 [ Seq.Literal 'x', Seq.Rule 1 ])
 
 
-tests = [ 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
-        ]
+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

File src/Data/Sequitur.hs

-module Data.Sequitur (prop_identity) where
+module Data.Sequitur ( init
+                     , compress
+                     , expand
+                     , feed
+                     , rule
+                     , ruleCount
+                     , Symbol (Literal, Rule)
+                     , Compressor (Compressor)
+                     ) where
+
+import Prelude hiding (init)
+import qualified Data.Map as M
 
 -- Operations:
 --  * appending a symbol to rule S;
 --  * deleting a rule (removing rule and inserting its definition into another rule).
 
 
-data Compressor a =
-    Compressor a
-    deriving (Show)
+data Symbol a =
+      Literal a
+    | Rule Integer
+    deriving (Show, Eq)
 
+data Compressor a = Compressor {
+      rules     :: M.Map Integer [Symbol a]
+    , ruleCount :: Integer
+    }
+
+init :: Compressor a
+init = Compressor M.empty 0
 
 compress :: Eq a => [a] -> Compressor a
+compress = foldl feed init
 
 expand :: Eq a => Compressor a -> [a]
+expand _ = []
 
+feed :: Eq a => Compressor a -> a -> Compressor a
+feed compressor _ = compressor
 
+rule :: Eq a => Compressor a -> Integer -> [Symbol a]
+rule compressor key =
+    M.findWithDefault [] key $ rules compressor
+