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