{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings   #-}

module Main where

import Prelude hiding (lookup)

import           Control.Concurrent
import           Control.Exception
import           Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L
import           Data.Configurator
import           Data.Configurator.Parser
import           Data.Configurator.Types
import           Data.Functor
import           Data.Int
import           Data.Maybe
import           Data.Text (Text)
import           Data.Word
import           System.Directory
import           System.Environment
import           System.FilePath
import           System.IO
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit hiding (Test)

main :: IO ()
main = defaultMain tests

tests :: [Test]
tests =
    [ testCase "load" loadTest
    , testCase "types" typesTest
    , testCase "interp" interpTest
    , testCase "scoped-interp" scopedInterpTest
    , testCase "import" importTest
--    , testCase "reload" reloadTest
    ]

withLoad :: FilePath -> (ConfigCache -> IO ()) -> IO ()
withLoad name t = do
    mb <- try $ load (testFile name)
    case mb of
        Left (err :: SomeException) -> assertFailure (show err)
        Right cfg -> t cfg

withReload :: FilePath -> ([Maybe FilePath] -> ConfigCache -> IO ()) -> IO ()
withReload name t = do
    tmp   <- getTemporaryDirectory
    temps <- forM (testFile name) $ \f -> do
        exists <- doesFileExist (worth f)
        if exists
            then do
                (p,h) <- openBinaryTempFile tmp "test.cfg"
                L.hPut h =<< L.readFile (worth f)
                hClose h
                return (p <$ f, Just p)
            else do
                return (f, Nothing)
    flip finally (mapM_ removeFile (catMaybes (map snd temps))) $ do
        mb <- try $ autoReload autoConfig (map fst temps)
        case mb of
            Left (err :: SomeException) -> assertFailure (show err)
            Right (cfg, tid) -> t (map snd temps) cfg >> killThread tid

testFile :: FilePath -> [Worth FilePath]
testFile name = [Required $ "tests" </> "resources" </> name]

takeMVarTimeout :: Int -> MVar a -> IO (Maybe a)
takeMVarTimeout millis v = do
    w <- newEmptyMVar
    tid <- forkIO $ do
        putMVar w . Just =<< takeMVar v
    forkIO $ do
        threadDelay (millis * 1000)
        killThread tid
        tryPutMVar w Nothing
        return ()
    takeMVar w

loadTest :: Assertion
loadTest =
  withLoad "pathological.cfg" $ \cfgcache -> do
    cfg <- readConfig cfgcache

    let (aa, _errs) = runParserM (key "aa") cfg
    assertEqual "int property" aa $ (Just 1 :: Maybe Int)

    let (ab, _errs) = runParserM (key "ab") cfg
    assertEqual "string property" ab (Just "foo" :: Maybe Text)

    let (acx, _errs) = runParserM (key "ac.x") cfg
    assertEqual "nested int" acx (Just 1 :: Maybe Int)

    let (acy, _errs) = runParserM (key "ac.y") cfg
    assertEqual "nested bool" acy (Just True :: Maybe Bool)

    let (ad, _errs) = runParserM (key "ad") cfg
    assertEqual "simple bool" ad (Just False :: Maybe Bool)

    let (ae, _errs) = runParserM (key "ae") cfg
    assertEqual "simple int 2" ae (Just 1 :: Maybe Int)

    let (af, _errs) = runParserM (key "af") cfg
    assertEqual "list property" af (Just (2,3) :: Maybe (Int,Int))

    let (deep, _errs) = runParserM (key "ag.q-e.i_u9.a") cfg
    assertEqual "deep bool" deep (Just False :: Maybe Bool)

    let (notacomment, _errs) = runParserM (key "notacomment") cfg
    assertEqual "not a comment" notacomment (Just 42 :: Maybe Int)

    let (comment, _errs) = runParserM (key "comment.x") cfg
    assertEqual "comment" comment (Nothing :: Maybe Value)

typesTest :: Assertion
typesTest =
  withLoad "pathological.cfg" $ \cfgcache -> do
    cfg <- readConfig cfgcache

    let (asInt, _errs) = runParserM (key "aa" :: ConfigParserM Int) cfg
    assertEqual "int" asInt (Just 1)

    let (asInteger, _errs) = runParserM (key "aa" :: ConfigParserM Integer) cfg
    assertEqual "int" asInteger (Just 1)

    let (asWord, _errs) = runParserM (key "aa" :: ConfigParserM Word) cfg
    assertEqual "int" asWord (Just 1)

    let (asInt8, _errs) = runParserM (key "aa" :: ConfigParserM Int8) cfg
    assertEqual "int8" asInt8 (Just 1)

    let (asInt16, _errs) = runParserM (key "aa" :: ConfigParserM Int16) cfg
    assertEqual "int16" asInt16 (Just 1)

    let (asInt32, _errs) = runParserM (key "aa" :: ConfigParserM Int32) cfg
    assertEqual "int32" asInt32 (Just 1)

    let (asInt64, _errs) = runParserM (key "aa" :: ConfigParserM Int64) cfg
    assertEqual "int64" asInt64 (Just 1)

    let (asWord8, _errs) = runParserM (key "aa" :: ConfigParserM Word8) cfg
    assertEqual "word8" asWord8 (Just 1)

    let (asWord16, _errs) = runParserM (key "aa" :: ConfigParserM Word16) cfg
    assertEqual "word16" asWord16 (Just 1)

    let (asWord32, _errs) = runParserM (key "aa" :: ConfigParserM Word32) cfg
    assertEqual "word32" asWord32 (Just 1)

    let (asWord64, _errs) = runParserM (key "aa" :: ConfigParserM Word64) cfg
    assertEqual "word64" asWord64 (Just 1)

    let (asTextBad, _errs) = runParserM (key "aa" :: ConfigParserM Text) cfg
    assertEqual "bad text" asTextBad Nothing

    let (asTextGood, _errs) = runParserM (key "ab" :: ConfigParserM Text) cfg
    assertEqual "good text" asTextGood (Just "foo")

    let (asStringGood, _errs) = runParserM (key "ab" :: ConfigParserM String) cfg
    assertEqual "string" asStringGood (Just "foo")

    let (asInts, _errs) = runParserM (key "xs" :: ConfigParserM [Int]) cfg
    assertEqual "ints" asInts (Just [1,2,3])

    let (asChar, _errs) = runParserM (key "c" :: ConfigParserM Char) cfg
    assertEqual "char" asChar (Just 'x')

interpTest :: Assertion
interpTest =
  withLoad "pathological.cfg" $ \cfgcache -> do
    cfg <- readConfig cfgcache

    home    <- getEnv "HOME"
    let (cfgHome, _errs) = runParserM (key "ba") cfg
    assertEqual "home interp" (Just home) cfgHome

scopedInterpTest :: Assertion
scopedInterpTest = withLoad "interp.cfg" $ \cfgcache -> do
    cfg <- readConfig cfgcache
    home    <- getEnv "HOME"

    let (a, _err) = runParserM (key "myprogram.exec") cfg
    assertEqual "myprogram.exec" (Just $ home++"/services/myprogram/myprogram") a

    let (b, _err) = runParserM (key "myprogram.stdout") cfg
    assertEqual "myprogram.stdout" (Just $ home++"/services/myprogram/stdout") b

    let (c, _err) = runParserM (key "top.layer1.layer2.dir") cfg
    assertEqual "nested scope" (Just $ home++"/top/layer1/layer2") c

importTest :: Assertion
importTest =
  withLoad "import.cfg" $ \cfgcache -> do
    cfg <- readConfig cfgcache
    let (aa, _errs) = runParserM (key "x.aa" :: ConfigParserM Int) cfg
    assertEqual "simple" aa (Just 1)
    let (acx, _errs) = runParserM (key "x.ac.x" :: ConfigParserM Int) cfg
    assertEqual "nested" acx (Just 1)

{--
reloadTest :: Assertion
reloadTest =
  withReload "pathological.cfg" $ \[Just f] cfgcache -> do
    aa <- lookup cfg "aa"
    assertEqual "simple property 1" aa $ Just (1 :: Int)

    dongly <- newEmptyMVar
    wongly <- newEmptyMVar
    subscribe cfg "dongly" $ \ _ _ -> putMVar dongly ()
    subscribe cfg "wongly" $ \ _ _ -> putMVar wongly ()
    L.appendFile f "\ndongly = 1"
    r1 <- takeMVarTimeout 2000 dongly
    assertEqual "notify happened" r1 (Just ())
    r2 <- takeMVarTimeout 2000 wongly
    assertEqual "notify not happened" r2 Nothing
--}