module IOUtils
  ( sleep,
    encodeFileToBase64,
    exceptionTextIncludes,
    logNothingLogger,
    lwrTxtIncludes,
    DemoActions (..),
    noOpUtils,
    mkDemoActions,
    (===),
    findWebDriverRoot,
    Logger (..),
    loopForever,
    catchLog,
    defToLogNothing
  )
where

import AesonUtils (prettyJSON)
import Const (Timeout (..), seconds)
import Control.Concurrent (threadDelay)
import Control.Exception (Exception (..), Handler (..), SomeException, catches)
import Control.Monad (void, when)
import Data.Aeson (Value)
import Data.Base64.Types qualified as B64T
import Data.ByteString qualified as BS
import Data.ByteString.Base64 qualified as B64
import Data.Maybe (fromMaybe)
import Data.Text (Text, isInfixOf, pack, toLower, unpack)
import GHC.Base (coerce)
import System.FilePath (joinPath, splitDirectories, (</>))
import Test.Tasty.HUnit as HUnit (Assertion, HasCallStack, (@=?))
import UnliftIO (AsyncCancelled, async, atomically, race_, readTMVar, throwIO, tryPutTMVar)
import UnliftIO.Async (Async)
import UnliftIO.STM (newEmptyTMVarIO)
import Utils (txt)
import Prelude hiding (log)

findWebDriverRoot :: FilePath -> Maybe FilePath
findWebDriverRoot path =
  if rootDir `elem` dirs
    then Just webDriverPath
    else Nothing
  where
    rootDir = "webdriver"
    dirs = splitDirectories path
    webDriverPath = (joinPath $ takeWhile (/= rootDir) dirs) </> rootDir

newtype Logger = MkLogger
  { log :: Text -> IO ()
  }

logNothingLogger :: Logger
logNothingLogger = MkLogger . const $ pure ()

-- default Nothing to Logger that does nothing
defToLogNothing :: Maybe Logger -> Logger
defToLogNothing = fromMaybe logNothingLogger

mkDemoActions :: Logger -> Timeout -> DemoActions
mkDemoActions qLog pause =
  MkDemoActions
    { sleep,
      log = log',
      logShow = logShow',
      logJSON,
      logM = \l mt -> mt >>= log' l,
      logShowM = \l t -> t >>= logShow' l,
      logTxt = logTxt',
      pause = sleep pause,
      pauseAtLeast = pauseAtLeast pause,
      timeLimitLog = timeLimitLog hasEventFired,
      timeLimitLogMany = timeLimitLogMany hasEventFired,
      timeLimitLog' = \msg tmo -> timeLimitLog' msg hasEventFired tmo
    }
  where
    logTxt' :: Text -> IO ()
    logTxt' = qLog.log
    log' l t = logTxt' $ l <> ": " <> t
    logJSON msg val = prettyJSON msg val >>= logTxt'
    logShow' :: forall a. (Show a) => Text -> a -> IO ()
    logShow' l = log' l . txt
    hasEventFired :: forall a b. (Show a, Show b) => b -> a -> IO Bool
    hasEventFired b a = logShow' ("!!!!! " <> txt b <> " Event Fired !!!!!\n") a >> pure True

exceptionTextIncludes :: Text -> SomeException -> Bool
exceptionTextIncludes expected = lwrTxtIncludes expected . pack . displayException

lwrTxtIncludes :: Text -> Text -> Bool
lwrTxtIncludes expected = (toLower expected `isInfixOf`) . toLower

data DemoActions = MkDemoActions
  { sleep :: Timeout -> IO (),
    pause :: IO (),
    pauseAtLeast :: Timeout -> IO (),
    logTxt :: Text -> IO (),
    log :: Text -> Text -> IO (),
    logShow :: forall a. (Show a) => Text -> a -> IO (),
    logJSON :: Text -> Value -> IO (),
    logM :: Text -> IO Text -> IO (),
    logShowM :: forall a. (Show a) => Text -> IO a -> IO (),
    -- timeout functions for testing events TODO: rename
    timeLimitLog :: forall a b. (Show a, Show b) => b -> IO (a -> IO (), IO ()),
    timeLimitLogMany :: forall a b. (Show a, Show b) => b -> IO (a -> IO (), IO ()),
    timeLimitLog' :: forall a b. (Show a, Show b) => Text -> Timeout -> b -> IO (a -> IO (), IO ())
  }

noOpUtils :: DemoActions
noOpUtils =
  MkDemoActions
    { sleep = noOp1,
      logTxt = noOp1,
      log = noOp2,
      logShow = noOp2,
      logJSON = noOp2,
      logM = noOp2,
      logShowM = noOp2,
      pause = pure (),
      -- even for no-op, ensure sleep for passed in ms
      pauseAtLeast = sleep,
      timeLimitLog = timeLimitLog hasEventFired,
      timeLimitLogMany = timeLimitLogMany hasEventFired,
      timeLimitLog' = \msg tmo -> timeLimitLog' msg hasEventFired tmo
    }
  where
    noOp1 = const $ pure ()
    noOp2 = const . const $ pure ()

    hasEventFired :: b -> a -> IO Bool
    hasEventFired _b _a = pure True

sleep :: Timeout -> IO ()
sleep = threadDelay . coerce

pauseAtLeast :: Timeout -> Timeout -> IO ()
pauseAtLeast defaultSleep = sleep . MkTimeout . max (coerce defaultSleep) . coerce

timeLimit :: forall a b. (Show b) => Text -> Timeout -> b -> (a -> IO Bool) -> IO (a -> IO (), IO ())
timeLimit timeoutMsg (MkTimeout mu) eventDesc action = do
  triggered <- newEmptyTMVarIO
  let waitTriggered = atomically $ readTMVar triggered
      waitLimit = threadDelay mu >> (fail . unpack $ "Timeout - " <> timeoutMsg <> ": " <> txt eventDesc <> " after " <> txt (mu `div` 1000) <> " milliseconds")
      interceptedAction = \a -> do
        result <- action a
        when result $
          void $
            atomically $
              tryPutTMVar triggered ()
        pure ()
  pure $ (interceptedAction, race_ waitLimit waitTriggered)

timeLimitLog' :: forall a b. (Show b) => Text -> (b -> a -> IO Bool) -> Timeout -> b -> IO (a -> IO (), IO ())
timeLimitLog' timeoutMsg prd timeout b =
  timeLimit timeoutMsg timeout b (\a -> prd b a >> pure True)

timeLimitLog :: forall a b. (Show b) => (b -> a -> IO Bool) -> b -> IO (a -> IO (), IO ())
timeLimitLog prd = timeLimitLog' "Expected event did not fire" prd (10 * seconds)

timeLimitLogMany :: forall a b. (Show b) => (b -> a -> IO Bool) -> b -> IO (a -> IO (), IO ())
timeLimitLogMany prd = timeLimitLog' "Expected event(s) did not fire (Many Subscription)" prd (10 * seconds)

encodeFileToBase64 :: FilePath -> IO Text
encodeFileToBase64 filePath =
  B64T.extractBase64 . B64.encodeBase64 <$> BS.readFile filePath

(===) ::
  (Eq a, Show a, HasCallStack) =>
  -- | The actual value
  a ->
  -- | The expected value
  a ->
  Assertion
(===) = (@=?)

catchLog :: Text -> (Text -> IO ()) -> IO () -> IO ()
catchLog name logAction action =
  action
    `catches` [ Handler $ \(e :: AsyncCancelled) -> do
                  logAction $ name <> " thread cancelled"
                  throwIO e,
                Handler $ \(e :: SomeException) -> do
                  logAction $ "Exception thrown in " <> name <> " thread" <> ": " <> (pack $ displayException e)
                  throwIO e
              ]

-- | like forever but, unlike forever, it fails if an exception is thrown
loopForever :: (Text -> IO ()) -> Text -> IO () -> IO (Async ())
loopForever logger name action = async $ do
  logger $ "Starting " <> name <> " thread"
  loop
  where
    loop = catchLog name logger action >> loop