module Ribosome.Test.Screenshot where

import Chiasma.Data.TmuxError (TmuxError)
import Chiasma.Data.TmuxThunk (TmuxThunk)
import qualified Chiasma.Test.Screenshot as Chiasma (screenshot)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Free.Class (MonadFree)
import Hedgehog (TestT, (===))

import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim)
import Ribosome.Orphans ()
import Ribosome.Test.Orphans ()
import Ribosome.Test.Unit (fixture)
import Ribosome.Tmux.Run (runTmux)
import Ribosome.System.Time (sleep)
import Ribosome.Test.Await (await)

screenshot ::
  MonadFree TmuxThunk m =>
  MonadIO m =>
  Text ->
  Bool ->
  Int ->
  m (Maybe ([Text], [Text]))
screenshot :: Text -> Bool -> Int -> m (Maybe ([Text], [Text]))
screenshot Text
name Bool
record Int
pane = do
  FilePath
storage <- FilePath -> m FilePath
forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
fixture FilePath
"screenshots"
  Bool -> FilePath -> Text -> Int -> m (Maybe ([Text], [Text]))
forall (m :: * -> *).
(MonadFree TmuxThunk m, MonadIO m) =>
Bool -> FilePath -> Text -> Int -> m (Maybe ([Text], [Text]))
Chiasma.screenshot Bool
record FilePath
storage Text
name Int
pane

assertScreenshot ::
  MonadIO m =>
  MonadRibo m =>
  MonadDeepError e TmuxError m =>
  MonadBaseControl IO m =>
  MonadMask m =>
  Nvim m =>
  Text ->
  Bool ->
  Int ->
  TestT m ()
assertScreenshot :: Text -> Bool -> Int -> TestT m ()
assertScreenshot Text
name Bool
record Int
pane = do
  m (Maybe ([Text], [Text])) -> TestT m (Maybe ([Text], [Text]))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TmuxProg m (Maybe ([Text], [Text])) -> m (Maybe ([Text], [Text]))
forall (m :: * -> *) e a.
(MonadIO m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e TmuxError m, MonadMask m, Nvim m) =>
TmuxProg m a -> m a
runTmux (Text -> Bool -> Int -> TmuxProg m (Maybe ([Text], [Text]))
forall (m :: * -> *).
(MonadFree TmuxThunk m, MonadIO m) =>
Text -> Bool -> Int -> m (Maybe ([Text], [Text]))
screenshot Text
name Bool
record Int
pane)) TestT m (Maybe ([Text], [Text]))
-> (Maybe ([Text], [Text]) -> TestT m ()) -> TestT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe ([Text], [Text]) -> TestT m ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a) =>
Maybe (a, a) -> m ()
check
  where
    check :: Maybe (a, a) -> m ()
check (Just (a
current, a
existing)) =
      a
existing a -> a -> m ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== a
current
    check Maybe (a, a)
Nothing =
      () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

awaitScreenshot ::
  MonadIO m =>
  MonadMask m =>
  MonadRibo m =>
  MonadBaseControl IO m =>
  MonadDeepError e TmuxError m =>
  Nvim m =>
  Text ->
  Bool ->
  Int ->
  TestT m ()
awaitScreenshot :: Text -> Bool -> Int -> TestT m ()
awaitScreenshot Text
name Bool
True Int
pane =
  Double -> TestT m ()
forall (m :: * -> *). MonadIO m => Double -> m ()
sleep Double
1 TestT m () -> TestT m (Maybe ([Text], [Text])) -> TestT m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m (Maybe ([Text], [Text])) -> TestT m (Maybe ([Text], [Text]))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TmuxProg m (Maybe ([Text], [Text])) -> m (Maybe ([Text], [Text]))
forall (m :: * -> *) e a.
(MonadIO m, MonadRibo m, MonadBaseControl IO m,
 MonadDeepError e TmuxError m, MonadMask m, Nvim m) =>
TmuxProg m a -> m a
runTmux (Text -> Bool -> Int -> TmuxProg m (Maybe ([Text], [Text]))
forall (m :: * -> *).
(MonadFree TmuxThunk m, MonadIO m) =>
Text -> Bool -> Int -> m (Maybe ([Text], [Text]))
screenshot Text
name Bool
True Int
pane))
awaitScreenshot Text
name Bool
False Int
pane =
  (() -> TestT m ()) -> m () -> TestT m ()
forall e a b (m :: * -> *).
(MonadError e m, MonadIO m, MonadBaseControl IO m) =>
(a -> TestT m b) -> m a -> TestT m b
await (TestT m () -> () -> TestT m ()
forall a b. a -> b -> a
const (Text -> Bool -> Int -> TestT m ()
forall (m :: * -> *) e.
(MonadIO m, MonadRibo m, MonadDeepError e TmuxError m,
 MonadBaseControl IO m, MonadMask m, Nvim m) =>
Text -> Bool -> Int -> TestT m ()
assertScreenshot Text
name Bool
False Int
pane)) m ()
forall (f :: * -> *). Applicative f => f ()
unit