module Chiasma.Test.Screenshot where

import qualified Data.ByteString as ByteString (writeFile)
import qualified Data.Text as Text (lines, unlines)
import qualified Data.Text.Encoding as Text (encodeUtf8)
import Data.Text.IO (readFile)
import Path (Abs, Dir, File, Path, parent, parseRelFile, toFilePath, (</>))
import Path.IO (createDirIfMissing, doesFileExist)

import Chiasma.Command.Pane (capturePane)
import Chiasma.Data.TmuxId (PaneId (PaneId))
import Chiasma.Effect.TmuxApi (Tmux)

loadScreenshot :: MonadIO m => Path Abs File -> m (Maybe Text)
loadScreenshot :: forall (m :: * -> *). MonadIO m => Path Abs File -> m (Maybe Text)
loadScreenshot Path Abs File
path =
  m Bool -> m (Maybe Text) -> m (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Path Abs File -> m Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
path) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> m Text -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
path))) (Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing)

storeScreenshot :: MonadIO m => Path Abs File -> [Text] -> m ()
storeScreenshot :: forall (m :: * -> *). MonadIO m => Path Abs File -> [Text] -> m ()
storeScreenshot Path Abs File
path [Text]
text = do
  Bool -> Path Abs Dir -> m ()
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
True (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
path)
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
ByteString.writeFile (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
path) (Text -> ByteString
Text.encodeUtf8 ([Text] -> Text
Text.unlines [Text]
text))

takeScreenshot ::
  Member Tmux r =>
  (Text -> Text) ->
  Int ->
  Sem r [Text]
takeScreenshot :: forall (r :: EffectRow).
Member Tmux r =>
(Text -> Text) -> Int -> Sem r [Text]
takeScreenshot Text -> Text
sanitize =
  ([Text] -> [Text]) -> Sem r [Text] -> Sem r [Text]
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
sanitize) (Sem r [Text] -> Sem r [Text])
-> (Int -> Sem r [Text]) -> Int -> Sem r [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PaneId -> Sem r [Text]
forall (r :: EffectRow). Member Tmux r => PaneId -> Sem r [Text]
capturePane (PaneId -> Sem r [Text]) -> (Int -> PaneId) -> Int -> Sem r [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PaneId
PaneId

recordScreenshot ::
  Members [Tmux, Embed IO] r =>
  (Text -> Text) ->
  Path Abs File ->
  Int ->
  Sem r ()
recordScreenshot :: forall (r :: EffectRow).
Members '[Tmux, Embed IO] r =>
(Text -> Text) -> Path Abs File -> Int -> Sem r ()
recordScreenshot Text -> Text
sanitize Path Abs File
path Int
paneId = do
  [Text]
current <- (Text -> Text) -> Int -> Sem r [Text]
forall (r :: EffectRow).
Member Tmux r =>
(Text -> Text) -> Int -> Sem r [Text]
takeScreenshot Text -> Text
sanitize Int
paneId
  Path Abs File -> [Text] -> Sem r ()
forall (m :: * -> *). MonadIO m => Path Abs File -> [Text] -> m ()
storeScreenshot Path Abs File
path [Text]
current

testScreenshot ::
  Members [Tmux, Embed IO] r =>
  (Text -> Text) ->
  Path Abs File ->
  Int ->
  Sem r (Maybe ([Text], [Text]))
testScreenshot :: forall (r :: EffectRow).
Members '[Tmux, Embed IO] r =>
(Text -> Text)
-> Path Abs File -> Int -> Sem r (Maybe ([Text], [Text]))
testScreenshot Text -> Text
sanitize Path Abs File
path Int
pane = do
  [Text]
current <- (Text -> Text) -> Int -> Sem r [Text]
forall (r :: EffectRow).
Member Tmux r =>
(Text -> Text) -> Int -> Sem r [Text]
takeScreenshot Text -> Text
sanitize Int
pane
  Path Abs File -> Sem r (Maybe Text)
forall (m :: * -> *). MonadIO m => Path Abs File -> m (Maybe Text)
loadScreenshot Path Abs File
path Sem r (Maybe Text)
-> (Maybe Text -> Sem r (Maybe ([Text], [Text])))
-> Sem r (Maybe ([Text], [Text]))
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Maybe Text -> Sem r (Maybe ([Text], [Text]))
check [Text]
current
  where
    check :: [Text] -> Maybe Text -> Sem r (Maybe ([Text], [Text]))
check [Text]
current (Just Text
existing) =
      Maybe ([Text], [Text]) -> Sem r (Maybe ([Text], [Text]))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ([Text], [Text]) -> Sem r (Maybe ([Text], [Text])))
-> Maybe ([Text], [Text]) -> Sem r (Maybe ([Text], [Text]))
forall a b. (a -> b) -> a -> b
$ ([Text], [Text]) -> Maybe ([Text], [Text])
forall a. a -> Maybe a
Just ([Text]
current, Text -> [Text]
Text.lines Text
existing)
    check [Text]
current Maybe Text
Nothing =
      Maybe ([Text], [Text])
forall a. Maybe a
Nothing Maybe ([Text], [Text])
-> Sem r () -> Sem r (Maybe ([Text], [Text]))
forall a b. a -> Sem r b -> Sem r a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Path Abs File -> [Text] -> Sem r ()
forall (m :: * -> *). MonadIO m => Path Abs File -> [Text] -> m ()
storeScreenshot Path Abs File
path [Text]
current

screenshotSanitized ::
  Members [Tmux, Error Text, Embed IO] r =>
  (Text -> Text) ->
  Bool ->
  Path Abs Dir ->
  Text ->
  Int ->
  Sem r (Maybe ([Text], [Text]))
screenshotSanitized :: forall (r :: EffectRow).
Members '[Tmux, Error Text, Embed IO] r =>
(Text -> Text)
-> Bool
-> Path Abs Dir
-> Text
-> Int
-> Sem r (Maybe ([Text], [Text]))
screenshotSanitized Text -> Text
sanitize Bool
record Path Abs Dir
storage Text
name Int
paneId = do
  Path Rel File
rel <- Either Text (Path Rel File) -> Sem r (Path Rel File)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither ((SomeException -> Text)
-> Either SomeException (Path Rel File)
-> Either Text (Path Rel File)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SomeException -> Text
forall b a. (Show a, IsString b) => a -> b
show (FilePath -> Either SomeException (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
name)))
  let path :: Path Abs File
path = Path Abs Dir
storage Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
rel
  if Bool
record then Maybe ([Text], [Text])
forall a. Maybe a
Nothing Maybe ([Text], [Text])
-> Sem r () -> Sem r (Maybe ([Text], [Text]))
forall a b. a -> Sem r b -> Sem r a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Text) -> Path Abs File -> Int -> Sem r ()
forall (r :: EffectRow).
Members '[Tmux, Embed IO] r =>
(Text -> Text) -> Path Abs File -> Int -> Sem r ()
recordScreenshot Text -> Text
sanitize Path Abs File
path Int
paneId else (Text -> Text)
-> Path Abs File -> Int -> Sem r (Maybe ([Text], [Text]))
forall (r :: EffectRow).
Members '[Tmux, Embed IO] r =>
(Text -> Text)
-> Path Abs File -> Int -> Sem r (Maybe ([Text], [Text]))
testScreenshot Text -> Text
sanitize Path Abs File
path Int
paneId

screenshot ::
  Members [Tmux, Error Text, Embed IO] r =>
  Bool ->
  Path Abs Dir ->
  Text ->
  Int ->
  Sem r (Maybe ([Text], [Text]))
screenshot :: forall (r :: EffectRow).
Members '[Tmux, Error Text, Embed IO] r =>
Bool
-> Path Abs Dir -> Text -> Int -> Sem r (Maybe ([Text], [Text]))
screenshot =
  (Text -> Text)
-> Bool
-> Path Abs Dir
-> Text
-> Int
-> Sem r (Maybe ([Text], [Text]))
forall (r :: EffectRow).
Members '[Tmux, Error Text, Embed IO] r =>
(Text -> Text)
-> Bool
-> Path Abs Dir
-> Text
-> Int
-> Sem r (Maybe ([Text], [Text]))
screenshotSanitized Text -> Text
forall a. a -> a
id