{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, NamedFieldPuns, FlexibleContexts #-}

module Test.Sandwich.WebDriver.Internal.Util where

import Control.Exception
import qualified Control.Exception.Lifted as E
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Convertible
import Data.String.Interpolate
import qualified Data.Text as T
import System.Directory
import System.Process
import qualified System.Random as R

-- * Truncating log files

moveAndTruncate :: FilePath -> String -> IO ()
moveAndTruncate :: FilePath -> FilePath -> IO ()
moveAndTruncate FilePath
from FilePath
to = do
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
from
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> FilePath -> IO ()
copyFile FilePath
from FilePath
to
    FilePath -> IO ()
tryTruncateFile FilePath
from

  where
    tryTruncateFile :: FilePath -> IO ()
    tryTruncateFile :: FilePath -> IO ()
tryTruncateFile FilePath
path = IO () -> (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
E.catch (FilePath -> IO ()
truncateFile FilePath
path)
                                   (\(SomeException
e :: E.SomeException) -> FilePath -> IO ()
putStrLn [i|Failed to truncate file #{path}: #{e}|])

    truncateFile :: FilePath -> IO ()
#ifdef mingw32_HOST_OS
    truncateFile path = withFile path WriteMode $ flip hPutStr "\n" -- Not exactly truncation, but close enough?
#else
    truncateFile :: FilePath -> IO ()
truncateFile FilePath
path = IO FilePath -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|> #{path}|]) FilePath
""
#endif

-- * Exceptions

leftOnException :: (MonadIO m, MonadBaseControl IO m) => m (Either T.Text a) -> m (Either T.Text a)
leftOnException :: m (Either Text a) -> m (Either Text a)
leftOnException = (SomeException -> m (Either Text a))
-> m (Either Text a) -> m (Either Text a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle (\(SomeException
e :: SomeException) -> Either Text a -> m (Either Text a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> m (Either Text a))
-> Either Text a -> m (Either Text a)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a b. Convertible a b => a -> b
convert (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
e)

leftOnException' :: (MonadIO m, MonadBaseControl IO m) => m a -> m (Either T.Text a)
leftOnException' :: m a -> m (Either Text a)
leftOnException' m a
action = m (Either Text a)
-> (SomeException -> m (Either Text a)) -> m (Either Text a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
E.catch (a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a) -> m a -> m (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action) (\(SomeException
e :: SomeException) -> Either Text a -> m (Either Text a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> m (Either Text a))
-> Either Text a -> m (Either Text a)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a b. Convertible a b => a -> b
convert (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
e)

-- * Util

whenJust :: (Monad m) => Maybe a -> (a -> m b) -> m ()
whenJust :: Maybe a -> (a -> m b) -> m ()
whenJust Maybe a
Nothing a -> m b
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenJust (Just a
x) a -> m b
action = m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> m b -> m ()
forall a b. (a -> b) -> a -> b
$ a -> m b
action a
x

whenLeft :: (Monad m) => Either a b -> (a -> m ()) -> m ()
whenLeft :: Either a b -> (a -> m ()) -> m ()
whenLeft (Left a
x) a -> m ()
action = a -> m ()
action a
x
whenLeft (Right b
_) a -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

whenRight :: (Monad m) => Either a b -> (b -> m ()) -> m ()
whenRight :: Either a b -> (b -> m ()) -> m ()
whenRight (Left a
_) b -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenRight (Right b
x) b -> m ()
action = b -> m ()
action b
x

makeUUID :: IO T.Text
makeUUID :: IO Text
makeUUID = (FilePath -> Text
forall a b. Convertible a b => a -> b
convert (FilePath -> Text) -> (StdGen -> FilePath) -> StdGen -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
10 (FilePath -> FilePath)
-> (StdGen -> FilePath) -> StdGen -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> StdGen -> FilePath
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
R.randomRs (Char
'a',Char
'z')) (StdGen -> Text) -> IO StdGen -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
R.newStdGen