{-# LANGUAGE RankNTypes #-}
module Main where

import Control.Monad.Fix
import Control.Monad.Trans
import qualified Control.Exception as E
import Data.Bits
import Data.Text ()
import Data.Time
import Data.Time.Clock.POSIX

import Test.Tasty
import Test.Tasty.HUnit

import Reflex.Host.Class
import Reflex.Test

import Reflex
import Reflex.Time.UTCTime

assert :: Bool -> String -> IO ()
assert True _ = return ()
assert False err = E.throwIO . E.AssertionFailed $ err

main :: IO ()
main = do
    defaultMain tests

afterTimeSpec :: (Reflex t, MonadHold t m, MonadFix m)
              => TimeBits t -> UTCTime -> m (Dynamic t Bool)
afterTimeSpec (curTime, _) tgtTime = do
  n <- sample . current $ curTime
  case tgtTime <= n of
    True -> return . constDyn $ True
    False ->
      holdDyn False =<< (headE . ffilter (==True) . updated $ (((<) tgtTime) <$> curTime))

tests :: TestTree
tests = testGroup "reflex-time" $
    [ timeUpdateTests
    ]

testAlONCase :: (Eq b, Show b)
             => TestName
             -> (forall t. (ReflexHost t) => Event t a -> HostFrame t (Dynamic t b))
             -> b -> [(Maybe a, Maybe b, b)]
             -> TestTree
testAlONCase tnm frm initVal cgen = testCase tnm $ eventTrace cgen initVal frm

sameBehavior :: (Reflex t, Eq a, MonadSample t m, MonadIO m, Show a) => Behavior t a -> Behavior t a -> m ()
sameBehavior ba bb = do
  va <- sample ba
  vb <- sample bb
  liftIO $ va @=? vb

timeUpdateTests :: TestTree
timeUpdateTests =
    testGroup "AlON update tests" $
      [ testAlONCase "test utc2TimeBits" (\e -> do
                                             (t, tbs) <- utc2TimeBits <$> holdDyn (posixSecondsToUTCTime 0) e
                                             -- We drop 12 because POSIX time is in terms of seconds.
                                             let dbs = sequenceA . take 28 . drop 12 $ tbs
                                             return $ (,) <$> t <*> dbs)
        (posixSecondsToUTCTime 0, take 28 . repeat $ 0) $
          let second1  = [1000000000000 `shiftR` b | b <- [12..39]]
              second2  = [2000000000000 `shiftR` b | b <- [12..39]]
              second60 = [60000000000000 `shiftR` b | b <- [12..39]]
          in [ (Nothing, Nothing
                       , (posixSecondsToUTCTime 0, take 28 . repeat $ 0))
             , (Just (posixSecondsToUTCTime 1), Just (posixSecondsToUTCTime 1, second1)
                                              , (posixSecondsToUTCTime 1, second1))
             , (Just (posixSecondsToUTCTime 2), Just (posixSecondsToUTCTime 2, second2)
                                              , (posixSecondsToUTCTime 2, second2))
             , (Just (posixSecondsToUTCTime 60), Just (posixSecondsToUTCTime 60, second60)
                                               , (posixSecondsToUTCTime 60, second60))
             ]
      , testAlONCase "test afterTimeSpec" (\e -> do
                                          tbs <- utc2TimeBits <$> holdDyn (posixSecondsToUTCTime 0) e
                                          afterTimeSpec tbs . posixSecondsToUTCTime $ 4)
        False
        [ (Nothing, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 1, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 4, Nothing, False) -- Why doesn't it fire here?
        , (Just . posixSecondsToUTCTime $ 5, Just True, True)
        , (Just . posixSecondsToUTCTime $ 6, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 3, Nothing, True)
        ]
      , testAlONCase "test afterTimeSpec skipping" (\e -> do
                                          tbs <- utc2TimeBits <$> holdDyn (posixSecondsToUTCTime 0) e
                                          afterTimeSpec tbs . posixSecondsToUTCTime $ 4)
        False
        [ (Nothing, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 1, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 5, Just True, True)
        , (Just . posixSecondsToUTCTime $ 6, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 3, Nothing, True)
        ]
      , testAlONCase "test afterTimeSpec starting after" (\e -> do
                                          tbs <- utc2TimeBits <$> holdDyn (posixSecondsToUTCTime 5) e
                                          afterTimeSpec tbs . posixSecondsToUTCTime $ 4)
        True
        [ (Just . posixSecondsToUTCTime $ 5, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 6, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 3, Nothing, True)
        ]
      , testAlONCase "test afterTime" (\e -> do
                                          tbs <- utc2TimeBits <$> holdDyn (posixSecondsToUTCTime 0) e
                                          afterTime tbs . posixSecondsToUTCTime $ 4)
        False
        [ (Nothing, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 1, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 4, Just True, True)
        , (Just . posixSecondsToUTCTime $ 5, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 6, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 3, Nothing, True)
        ]
      , testAlONCase "test afterTime skipping" (\e -> do
                                          tbs <- utc2TimeBits <$> holdDyn (posixSecondsToUTCTime 0) e
                                          afterTime tbs . posixSecondsToUTCTime $ 4)
        False
        [ (Nothing, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 1, Nothing, False)
        , (Just . posixSecondsToUTCTime $ 5, Just True, True)
        , (Just . posixSecondsToUTCTime $ 6, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 3, Nothing, True)
        ]
      , testAlONCase "test afterTimeSpec starting after" (\e -> do
                                          tbs <- utc2TimeBits <$> holdDyn (posixSecondsToUTCTime 5) e
                                          afterTime tbs . posixSecondsToUTCTime $ 4)
        True
        [ (Just . posixSecondsToUTCTime $ 5, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 6, Nothing, True)
        , (Just . posixSecondsToUTCTime $ 3, Nothing, True)
        ]
      ]