{-# 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]