content: {-# 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.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 -> (Config -> 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] -> Config -> 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" $ \cfg -> do
      aa  <- lookup cfg "aa"
      assertEqual "int property" aa $ (Just 1 :: Maybe Int)
  
      ab  <- lookup cfg "ab"
      assertEqual "string property" ab (Just "foo" :: Maybe Text)
  
      acx <- lookup cfg "ac.x"
      assertEqual "nested int" acx (Just 1 :: Maybe Int)
  
      acy <- lookup cfg "ac.y"
      assertEqual "nested bool" acy (Just True :: Maybe Bool)
  
      ad <- lookup cfg "ad"
      assertEqual "simple bool" ad (Just False :: Maybe Bool)
  
      ae <- lookup cfg "ae"
      assertEqual "simple int 2" ae (Just 1 :: Maybe Int)
  
      af <- lookup cfg "af"
      assertEqual "list property" af (Just (2,3) :: Maybe (Int,Int))
  
      deep <- lookup cfg "ag.q-e.i_u9.a"
      assertEqual "deep bool" deep (Just False :: Maybe Bool)
  
  typesTest :: Assertion
  typesTest =
    withLoad "pathological.cfg" $ \cfg -> do
      asInt <- lookup cfg "aa" :: IO (Maybe Int)
      assertEqual "int" asInt (Just 1)
  
      asInteger <- lookup cfg "aa" :: IO (Maybe Integer)
      assertEqual "int" asInteger (Just 1)
  
      asWord <- lookup cfg "aa" :: IO (Maybe Word)
      assertEqual "int" asWord (Just 1)
  
      asInt8 <- lookup cfg "aa" :: IO (Maybe Int8)
      assertEqual "int8" asInt8 (Just 1)
  
      asInt16 <- lookup cfg "aa" :: IO (Maybe Int16)
      assertEqual "int16" asInt16 (Just 1)
  
      asInt32 <- lookup cfg "aa" :: IO (Maybe Int32)
      assertEqual "int32" asInt32 (Just 1)
  
      asInt64 <- lookup cfg "aa" :: IO (Maybe Int64)
      assertEqual "int64" asInt64 (Just 1)
  
      asWord8 <- lookup cfg "aa" :: IO (Maybe Word8)
      assertEqual "word8" asWord8 (Just 1)
  
      asWord16 <- lookup cfg "aa" :: IO (Maybe Word16)
      assertEqual "word16" asWord16 (Just 1)
  
      asWord32 <- lookup cfg "aa" :: IO (Maybe Word32)
      assertEqual "word32" asWord32 (Just 1)
  
      asWord64 <- lookup cfg "aa" :: IO (Maybe Word64)
      assertEqual "word64" asWord64 (Just 1)
  
      asTextBad <- lookup cfg "aa" :: IO (Maybe Text)
      assertEqual "bad text" asTextBad Nothing
  
      asTextGood <- lookup cfg "ab" :: IO (Maybe Text)
      assertEqual "good text" asTextGood (Just "foo")
  
      asStringGood <- lookup cfg "ab" :: IO (Maybe String)
      assertEqual "string" asStringGood (Just "foo")
  
      asInts <- lookup cfg "xs" :: IO (Maybe [Int])
      assertEqual "ints" asInts (Just [1,2,3])
  
      asChar <- lookup cfg "c" :: IO (Maybe Char)
      assertEqual "char" asChar (Just 'x')
  
  interpTest :: Assertion
  interpTest =
    withLoad "pathological.cfg" $ \cfg -> do
      home    <- getEnv "HOME"
      cfgHome <- lookup cfg "ba"
      assertEqual "home interp" (Just home) cfgHome
  
  scopedInterpTest :: Assertion
  scopedInterpTest = withLoad "interp.cfg" $ \cfg -> do
      home    <- getEnv "HOME"
  
      lookup cfg "myprogram.exec"
          >>= assertEqual "myprogram.exec" (Just $ home++"/services/myprogram/myprogram")
  
      lookup cfg "myprogram.stdout"
          >>= assertEqual "myprogram.stdout" (Just $ home++"/services/myprogram/stdout")
  
      lookup cfg "top.layer1.layer2.dir"
          >>= assertEqual "nested scope" (Just $ home++"/top/layer1/layer2")
  
  importTest :: Assertion
  importTest =
    withLoad "import.cfg" $ \cfg -> do
      aa  <- lookup cfg "x.aa" :: IO (Maybe Int)
      assertEqual "simple" aa (Just 1)
      acx <- lookup cfg "x.ac.x" :: IO (Maybe Int)
      assertEqual "nested" acx (Just 1)
  
  reloadTest :: Assertion
  reloadTest =
    withReload "pathological.cfg" $ \[Just f] cfg -> 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
  