{-# LANGUAGE OverloadedStrings #-} module Main where import Data.List ( sort ) import Data.Maybe ( catMaybes ) import Data.Text ( Text ) import qualified Data.Text as T import Lens.Micro ( (^.), (.~), (%~), (&) ) import Test.Tasty import Test.Tasty.HUnit import Data.KVITable import Prelude hiding ( filter, lookup ) import AsciiRenderTests import HTMLRenderTests import SampleTables main :: IO () main = defaultMain $ testGroup "kvitable tests" $ let kvi0 = mempty :: KVITable Text in [ testCase "empty table" $ (mempty :: KVITable Bool) @=? (mempty :: KVITable Bool) , testCase "to and from" $ length listing1 @=? length (toList kvi1) , testCase "length" $ length listing1 @=? length kvi1 , testCase "mappable" $ sum (snd <$> (fmap T.length) <$> listing1) @=? sum (snd <$> toList (T.length <$> kvi1)) , testCase "traversable" $ Just (sort $ snd <$> listing1) @=? sort . fmap snd . toList <$> (traverse Just kvi1) , testCaseSteps "semigroup" $ \step -> do step "empty to full" mempty <> kvi1 @?= kvi1 step "full to empty" kvi1 <> mempty @?= kvi1 step "idempotent" kvi1 <> kvi1 @?= kvi1 step "join parts" kvi1_1 <> kvi1_2 @?= kvi1 -- happens to be the right order -- note: it is *not* the case that -- -- > kvi1_2 <> kvi1_1 == kvi1 -- -- because the keyvals from a semigroup operation are -- built dynamically and this particular kvi1_1 / -- kvi1_2 will result in a different key order in -- reverse. However, specifying the keyVals -- explicitly can eliminate key detection ordering concerns. step "keyed" let keyed = mempty & keyVals .~ [ ("foo", ["baz", "", "bar"]) , ("moo", ["cow"]) , ("goose", ["honk", ""]) ] keyed <> kvi1_1 <> kvi1_2 @?= kvi1 , testCase "empty lookup fails" $ Nothing @=? lookup [("foo", "bar"), ("moo", "cow")] (mempty :: KVITable Bool) , testCase "regular lookup" $ Just "one" @=? lookup [("foo", "bar"), ("moo", "cow")] kvi1 , testCase "add to empty table" $ let keyvals = [ ("foo", "bar"), ("moo", "cow") ] in [ (keyvals, "hi") ] @=? toList (insert keyvals "hi" kvi0) , testCase "getRows on empty table" $ [] @=? rows kvi0 , testCase "rows in simple table" $ let keyvals = [ ("foo", "bar"), ("moo", "cow") ] in [ (["bar", "cow"], "hi") ] @=? rows (insert keyvals "hi" kvi0) , testCaseSteps "non-leaf kvitable insert uses default key value" $ \step -> do let keyvals = [ ("foo", "bar"), ("moo", "cow") ] t1 = insert keyvals "hi" kvi0 step "at start" let t2 = insert [ ("moo", "dog") ] "oops" t1 rows t2 @?= [ ([ "", "dog" ], "oops") , ([ "bar", "cow" ], "hi") ] step "at end" let t3 = insert [ ("foo", "dog") ] "oops" t1 rows t3 @?= [ ([ "dog", "" ], "oops") , ([ "bar", "cow" ], "hi") ] step "in middle" let keyvals' = [ ("foo", "bar"), ("moo", "cow"), ("oink", "pig") ] t1' = insert keyvals' "hi" kvi0 t4 = insert [ ("foo", "baz"), ("oink", "hog") ] "oops" t1' rows t4 @?= [ ([ "baz", "", "hog" ], "oops") , ([ "bar", "cow", "pig" ], "hi") ] , testCaseSteps "valueColName" $ \step -> do step "fetch" "Value" @=? kvi1 ^. valueColName step "set" "says" @=? (kvi1 & valueColName .~ "says") ^. valueColName step "update" "says Value" @=? (kvi1 & valueColName %~ ("says " <>)) ^. valueColName , testCase "keyVals fetch" $ [ ("foo", ["baz", "", "bar"]) , ("moo", ["cow"]) , ("goose", ["honk", ""]) ] @=? kvi1 ^. keyVals , testCaseSteps "lookup" $ \step -> do step "valid #1" Just "three" @=? lookup [("moo", "cow")] kvi1 step "valid #2" Just "two" @=? lookup [("goose", "honk"), ("moo", "cow"), ("foo", "bar")] kvi1 step "valid #3" Just "four" @=? lookup [("moo", "cow"), ("foo", "baz")] kvi1 step "valid #4" Just "one" @=? lookup [("moo", "cow"), ("foo", "bar")] kvi1 step "valid with dups" -- Note: ok to duplicate key values with identical entries Just "one" @=? lookup [("moo", "cow"), ("foo", "bar"), ("moo", "cow")] kvi1 step "invalid #1" Nothing @=? lookup [("moo", "bar")] kvi1 step "invalid #2" Nothing @=? lookup [("foo", "moo"), ("cow", "moo")] kvi1 step "invalid #3" Nothing @=? lookup [] kvi1 , testCase "multiply-specified lookups" $ -- one of these will work, one will fail, but it's -- indeterminate which one. This is not a recommended -- usage, but rather than waste computational resources -- to prevent it, this is simply documenting this as a -- known behavior and users are discouraged from using -- it. 1 @=? (length $ catMaybes [ lookup [("moo", "sheep"), ("foo", "bar"), ("moo", "cow")] kvi1 , lookup [("moo", "cow"), ("foo", "bar"), ("moo", "sheep")] kvi1 ]) , testCase "deep add" $ let t0 = mempty & keyVals .~ [ ("foo", ["bar", "baz"]) , ("moon", ["beam", "pie"]) ] & valueColName .~ "says" t1 = insert [ ("foo", "Bill"), ("moon", "Ted"), ("dog", "arf arf") ] "Excellent!" $ insert [ ("foo", "baz"), ("moon", "beam"), ("dog", "woof") ] "yo" $ insert [ ("foo", "bar"), ("moon", "pie") ] "hi" t0 in rows t1 @?= [ ([ "Bill", "Ted", "arf arf" ], "Excellent!") , ([ "bar", "pie", "" ], "hi") , ([ "baz", "beam", "woof"], "yo") ] , testCase "medium sized table rows" $ rows mediumKVI @?= [ ([ "gcc7", "yes", "0"], "good" ) , ([ "gcc7", "yes", "3"], "ugly" ) , ([ "gcc7", "no", "0"], "bad" ) , ([ "gcc7", "no", "1"], "good" ) , ([ "gcc8", "yes", "0"], "good" ) , ([ "gcc8", "yes", "1"], "bad" ) , ([ "gcc8", "yes", "3"], "true" ) , ([ "clang6", "yes", "0"], "ok" ) , ([ "clang10", "yes", "3"], "good" ) , ([ "clang10", "no", "3"], "good" ) , ([ "clang7", "yes", "3"], "good" ) , ([ "clang7", "no", "0"], "good" ) , ([ "clang7", "no", "1"], "good" ) , ([ "clang7", "no", "3"], "good" ) ] , testCase "filter" $ rows (filter (\(spec,val) -> ("compiler", "gcc7") `elem` spec) mediumKVI) @?= [ ([ "gcc7", "yes", "0"], "good" ) , ([ "gcc7", "yes", "3"], "ugly" ) , ([ "gcc7", "no", "0"], "bad" ) , ([ "gcc7", "no", "1"], "good" ) ] , testCaseSteps "zoo contents" $ \step -> do step "LA Lions" Just 4 @=? lookup [ ("Location", "LA"), ("Name", "Lion") , ("Diet", "Carnivore"), ("Category", "Animal") , ("Biome", "Savannah"), ("Subtype", "") ] zooTable2 step "No polar lions" Nothing @=? lookup [ ("Location", "LA"), ("Name", "Lion") , ("Diet", "Carnivore"), ("Category", "Animal") , ("Biome", "Polar"), ("Subtype", "") ] zooTable2 , testGroup "rendering" [ testAsciiRendering , testHTMLRendering ] ]