inilist-0.2.0.0: UnitTest.hs
{-# Language OverloadedStrings, FlexibleInstances #-}
module Main where
import Control.DeepSeq (deepseq)
import Control.Exception (ErrorCall(ErrorCall), evaluate)
import Data.List (isInfixOf)
import Data.Monoid ((<>), mconcat, mempty)
import qualified Data.Map as M
import Text.Trifecta (TokenParsing, Result(Success, Failure))
import Test.Tasty
import Test.Tasty.HUnit
import Test.HUnit.Tools
import Data.AList as AL
import Data.Ini.List as IL
-- Add some Eq instances. Not in general valid, but we want them for testing.
instance Eq a => Eq (Result a) where
(Success a) == (Success b) = a == b
_ == _ = False -- Can't test failures for equality.
instance (Eq k, Eq v) => Eq (AL.AList k v) where
a == b = AL.toList a == AL.toList b
instance Eq Config where
a == b = getDefault a == getDefault b && IL.toList a == IL.toList b
testError msg err code =
testCase msg . assertRaises "Check error" (ErrorCall err) . evaluate
$ deepseq (show code) ()
testFailure msg err code =
let expect = "Expected failure containg: " ++ err ++ "\n"
in testCase msg $ case code of
Success _ -> assertFailure $ expect ++ "but succeeded"
Failure x -> let res = show x
in assertBool (expect ++ "but got " ++ res)
. isInfixOf err $ res
trues = ["1", "yes", "on", "enabled", "true"]
falses = ["0", "no", "off", "disabled", "false"]
section1 = IL.fromList [("Value1", "23"), ("Value1", "35"), ("Value 2", "foo bar")]
section2 = IL.fromList [("Value1", "34"), ("Value2", "")]
def = IL.fromList $ ("Value1", "12"):(map (\x -> (x, x)) $ trues ++ falses)
test = config def [("Section1", section1),
("Section 2", section2),
("Section1", section2)]
updateValue "Value1" _ = Just "Updated"
updateValue _ _ = Nothing
updateOption "Value1" _ = Just ("Changed", "New")
updateOption _ _ = Nothing
def2 = IL.fromList $ ("Value1", "Updated"):(map (\x -> (x, x)) $ trues ++ falses)
updateSection "Section 2" o v = updateValue o v
updateSection _ _ _ = Nothing
def3 = IL.fromList $ ("Changed", "New"):(map (\x -> (x, x)) $ trues ++ falses)
updateSO "Section 2" o v = updateOption o v
updateSO _ _ _ = Nothing
testString = "Value1=12\n1=1\nyes=yes\non=on\nenabled=enabled\ntrue=true\n0=0\nno=no\noff=off\ndisabled=disabled\nfalse=false\n\n[Section1]\nValue1=23\nValue1=35\nValue 2=foo bar\n\n[Section 2]\nValue1=34\nValue2=\n\n[Section1]\nValue1=34\nValue2=\n"
commentString = ";c\n#c\n ;c\n #c\nValue1=12\n\n1=1 ;c \n#c\nyes=yes\n;\non=on\n ; \nenabled=enabled\n # \ntrue=true\n0=0\nno=no\noff=off\ndisabled=disabled\nfalse=false\n\n[Section1] garbage\nValue1=23\nValue1=35\nValue 2=foo bar ; c\n\n[Section 2]\n\nValue1=34\nValue2=\n\n[Section1]\n;c\n#c\nValue1=34\nValue2=\n"
testAList = testGroup "AList" [
testGroup "isEmpty" [
testCase "True" . assertBool "" . isEmpty $ mempty,
testCase "False" . assertBool "" . not . isEmpty $ AL.fromList [(1, 2)]
],
testGroup "lookupAll" [
testCase "empty" $ [] @=? lookupAll 1 (AL.fromList [(2,3)]),
testCase "singleton" $ [3] @=? lookupAll 2 (AL.fromList [(2,3)]),
testCase "list"
$ [3, 5] @=? lookupAll 2 (AL.fromList [(1, 2), (2,3), (3, 4), (2,5)])
],
testGroup "lookupFirst" [
testCase "Something" $ Just 5 @=? lookupFirst 3 (AL.fromList [(3, 5)]),
testCase "Nothing" $ Nothing @=? lookupFirst 3 (AL.fromList [(2, 5)])
],
testGroup "lookupBy" [
testCase "empty" $ mempty @=? AL.lookupBy odd (AL.fromList [(2, 3)]),
testCase "singleton"
$ AL.fromList [(2, 3)] @=? AL.lookupBy even (AL.fromList [(2, 3)]),
testCase "list"
$ lookupBy even (AL.fromList [(1, 2), (2,3), (3, 4), (4, 5)])
@?= AL.fromList [(2, 3), (4, 5)]
],
testGroup "member" [
testCase "True" . assertBool "" . member 1 $ AL.fromList [(1, 2)],
testCase "False" . assertBool "" . not . member 1 $ AL.fromList [(3, 2)]
],
testGroup "values" [
testCase "empty" $ [] @=? AL.values (mempty :: AList Int Int),
testCase "singleton" $ [3] @=? AL.values (AL.fromList [(2, 3)]),
testCase "list" $ [3, 5] @=? AL.values (AL.fromList [(2, 3), (4, 5)])
],
testGroup "keys" [
testCase "empty" $ [] @=? AL.keys (mempty :: AList Int Int),
testCase "singleton" $ [2] @=? AL.keys (AL.fromList [(2, 3)]),
testCase "list" $ [2, 4] @=? AL.keys (AL.fromList [(2, 3), (4, 5)])
],
testGroup "insert" [
testCase "empty" $ AL.fromList [(1, 2)] @=? insert 1 2 mempty,
testCase "full"
$ AL.fromList [(1, 2), (3, 4)] @=? insert 1 2 (AL.fromList [(3, 4)])
],
testGroup "append" [
testCase "empty" $ AL.fromList [(1, 2)] @=? append 1 2 mempty,
testCase "full"
$ AL.fromList [(3, 4), (1, 2)] @=? append 1 2 (AL.fromList [(3, 4)])
],
testGroup "deleteAll" [
testCase "empty" $ mempty @=? deleteAll 2 (AL.fromList [(2,3)]),
testCase "singleton"
$ AL.fromList[(2, 3)] @=? deleteAll 1 (AL.fromList [(2,3)]),
testCase "list"
$ deleteAll 2 (AL.fromList [(1, 2), (2,3), (3, 4), (2,5)])
@?= AL.fromList [(1, 2), (3, 4)]
],
testGroup "deleteFirst" [
testCase "empty" $ mempty @=? deleteAll 2 (AL.fromList [(2,3)]),
testCase "singleton"
$ AL.fromList[(2, 3)] @=? deleteAll 1 (AL.fromList [(2,3)]),
testCase "list"
$ deleteFirst 2 (AL.fromList [(1, 2), (2,3), (3, 4), (2,5)])
@?= AL.fromList [(1, 2), (3, 4), (2, 5)]
],
testGroup "deleteBy" [
testCase "empty" $ mempty @=? AL.deleteBy even (AL.fromList [(2, 3)]),
testCase "singleton"
$ AL.fromList [(2, 3)] @=? AL.deleteBy odd (AL.fromList [(2, 3)]),
testCase "list"
$ deleteBy odd (AL.fromList [(1, 2), (2,3), (3, 4), (4, 5)])
@?= AL.fromList [(2, 3), (4, 5)]
],
testGroup "convert" [
testCase "fromList"
$ (AL.insert 1 2 . AL.insert 3 4 $ AL.insert 5 6 mempty)
@=? AL.fromList [(1, 2), (3, 4), (5, 6)],
testCase "toList"
$ AL.toList (AL.insert 1 2 . AL.insert 3 4 $ AL.insert 5 6 mempty)
@=? [(1, 2), (3, 4), (5, 6)],
testCase "toMap" $ M.fromList [(1, 2), (3, 4), (5, 6)]
@=? AL.toMap (AL.fromList[(3, 4), (1, 2), (5, 6)]),
-- This probably depends on the Map implementation
testCase "fromMap" $ AL.fromMap (M.fromList [(1, 2), (3, 4), (5, 6)])
@=? (AL.fromList[(1, 2), (3, 4), (5, 6)])
]
]
testIO = testGroup "IO" [
testCase "format" $ testString @=? formatConfig test,
testCase "parse" $ Success test @=? parseConfig testString,
testCase "comments" $ Success test @=? parseConfig commentString,
testGroup "errors" [
testFailure "Missing config" "config" $ parseConfig "=23\n",
testFailure "Missing section name" "section name" $ parseConfig "[]\nx=23",
testFailure "Empty section" "option line" $ parseConfig "[a]\n[b]\n",
testFailure "Broken section name" "\"]\"" $ parseConfig "[a\n",
testFailure "Missing option name" "new-line" $ parseConfig "[a]\n=23"
]
]
testCreate = testGroup "create" [
-- Ought to test config/section/option, but without access to the
-- constuctors, that would be pointless.
testCase "default" $ section1 @=? (getDefault $ setDefault test section1),
testCase "section <+"
$ section1 @=? mempty <+ ("Value1", "23") <+ ("Value1", "35")
<+ ("Value 2", "foo bar"),
testCase "section +>"
$ section1 @=? ("Value 2", "foo bar") +> ("Value1", "35")
+> ("Value1", "23") +> mempty,
testCase "config <+"
$ test @=? setDefault mempty def <+ ("Section1", section1)
<+ ("Section 2", section2)
<+ ("Section1", section2),
testCase "config +>"
$ test @=? ("Section1", section2) +> ("Section 2", section2)
+> ("Section1", section1) +> setDefault mempty def,
testGroup "update" [
testCase "defaultValues"
$ def2 @=? getDefault (updateDefaultValues updateValue test),
testCase "sectionValues" $ def2 @=? updateSectionValues updateValue def,
testCase "configValues"
$ Just ("Updated" :: String) @=? get (updateValues updateSection test)
(Just "Section 2") "Value1",
testCase "defaultOptions"
$ def3 @=? getDefault(updateDefaultOptions updateOption test),
testCase "sectionOptions" $ def3 @=? updateSectionOptions updateOption def,
testCase "configOptions"
$ Just ("New" :: String) @=? get (updateOptions updateSO test)
(Just "Section 2") "Changed"
]
]
testGet = testGroup "gets" [
testGroup "get sections" [
testCase "Default" $ def @=? getDefault test,
testCase "Section 1" $ Just section2 @=? getSection test "Section 2",
testCase "Section 2" $ Nothing @=? getSection test "NoSection",
testCase "Sections 1" $ [] @=? getSections test "NoSection",
testCase "Sections 2"
$ [section1, section2] @=? getSections test "Section1",
testCase "SectionsBy" $
["Section 2"] @=? map fst (getSectionsBy test $ elem ' ')
],
testGroup "value" [
testCase "Nothing" $ (Nothing :: Maybe Int) @=? getValue "NoValue" def,
testCase "String" $ (Just "12" :: Maybe String) @=? getValue "Value1" def
],
testGroup "get" [
testCase "Nothing" $ (Nothing :: Maybe Int) @=? get test Nothing "NoValue",
testCase "String"
$ (Just "12" :: Maybe String) @=? get test Nothing "Value1",
testGroup "Bool" $ (testError "Error" "couldn't parse '12' as Bool"
$ (get test Nothing "Value1" :: Maybe Bool)):
map (\x -> testCase x $ Just True @=? get test Nothing x) trues
++ map (\x -> testCase x $ Just False @=? get test Nothing x)
falses,
testGroup "List" [
testCase "[]"
$ Just ([] :: [Int]) @=? get test (Just "Section1") "NoValue",
testCase "[x]"
$ Just ([23, 35] :: [Int])
@=? get test (Just "Section1") "Value1"
],
testGroup "Num" [
testCase "Int" $ Just (12 :: Int) @=? get test Nothing "Value1",
testCase "Float" $ Just (12.0 :: Float) @=? get test Nothing "Value1",
testError "Error" "couldn't parse 'false'"
$ (get test Nothing "false" :: Maybe Int)
]
]
]
main :: IO ()
main = defaultMain $ testGroup "All" [testAList, testGet, testCreate, testIO]