module Chiasma.Test.Screenshot where import Control.Monad.Free.Class (MonadFree) import qualified Data.ByteString as ByteString (writeFile) import qualified Data.Text as Text (lines, unlines) import qualified Data.Text.Encoding as Text (encodeUtf8) import System.FilePath (takeDirectory, (</>)) import UnliftIO.Directory (createDirectoryIfMissing, doesFileExist) import Chiasma.Command.Pane (capturePane) import Chiasma.Data.TmuxId (PaneId(PaneId)) import Chiasma.Data.TmuxThunk (TmuxThunk) loadScreenshot :: MonadIO m => FilePath -> m (Maybe Text) loadScreenshot :: FilePath -> m (Maybe Text) loadScreenshot FilePath 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 (FilePath -> m Bool forall (m :: * -> *). MonadIO m => FilePath -> m Bool doesFileExist FilePath path) (Text -> Maybe Text forall a. a -> Maybe a Just (Text -> Maybe Text) -> (FilePath -> Text) -> FilePath -> Maybe Text forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> Text forall a. ToText a => a -> Text toText (FilePath -> Maybe Text) -> m FilePath -> m (Maybe Text) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO FilePath -> m FilePath forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (FilePath -> IO FilePath forall (m :: * -> *). MonadIO m => FilePath -> m FilePath readFile FilePath path)) (Maybe Text -> m (Maybe Text) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Text forall a. Maybe a Nothing) storeScreenshot :: MonadIO m => FilePath -> [Text] -> m () storeScreenshot :: FilePath -> [Text] -> m () storeScreenshot FilePath path [Text] text = do Bool -> FilePath -> m () forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m () createDirectoryIfMissing Bool True (FilePath -> FilePath takeDirectory FilePath path) IO () -> m () 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 FilePath path (Text -> ByteString Text.encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . [Text] -> Text Text.unlines ([Text] -> ByteString) -> [Text] -> ByteString forall a b. (a -> b) -> a -> b $ [Text] text) takeScreenshot :: MonadFree TmuxThunk m => MonadIO m => Int -> m [Text] takeScreenshot :: Int -> m [Text] takeScreenshot = PaneId -> m [Text] forall (m :: * -> *). MonadFree TmuxThunk m => PaneId -> m [Text] capturePane (PaneId -> m [Text]) -> (Int -> PaneId) -> Int -> m [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> PaneId PaneId recordScreenshot :: MonadFree TmuxThunk m => MonadIO m => FilePath -> Int -> m () recordScreenshot :: FilePath -> Int -> m () recordScreenshot FilePath path Int paneId = do [Text] current <- Int -> m [Text] forall (m :: * -> *). (MonadFree TmuxThunk m, MonadIO m) => Int -> m [Text] takeScreenshot Int paneId FilePath -> [Text] -> m () forall (m :: * -> *). MonadIO m => FilePath -> [Text] -> m () storeScreenshot FilePath path [Text] current testScreenshot :: MonadFree TmuxThunk m => MonadIO m => FilePath -> Int -> m (Maybe ([Text], [Text])) testScreenshot :: FilePath -> Int -> m (Maybe ([Text], [Text])) testScreenshot FilePath path Int pane = do [Text] current <- Int -> m [Text] forall (m :: * -> *). (MonadFree TmuxThunk m, MonadIO m) => Int -> m [Text] takeScreenshot Int pane FilePath -> m (Maybe Text) forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe Text) loadScreenshot FilePath path m (Maybe Text) -> (Maybe Text -> m (Maybe ([Text], [Text]))) -> m (Maybe ([Text], [Text])) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= [Text] -> Maybe Text -> m (Maybe ([Text], [Text])) check [Text] current where check :: [Text] -> Maybe Text -> m (Maybe ([Text], [Text])) check [Text] current (Just Text existing) = Maybe ([Text], [Text]) -> m (Maybe ([Text], [Text])) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe ([Text], [Text]) -> m (Maybe ([Text], [Text]))) -> Maybe ([Text], [Text]) -> m (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]) -> m () -> m (Maybe ([Text], [Text])) forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ FilePath -> [Text] -> m () forall (m :: * -> *). MonadIO m => FilePath -> [Text] -> m () storeScreenshot FilePath path [Text] current screenshot :: MonadFree TmuxThunk m => MonadIO m => Bool -> FilePath -> Text -> Int -> m (Maybe ([Text], [Text])) screenshot :: Bool -> FilePath -> Text -> Int -> m (Maybe ([Text], [Text])) screenshot Bool record FilePath storage Text name Int paneId = if Bool record then Maybe ([Text], [Text]) forall a. Maybe a Nothing Maybe ([Text], [Text]) -> m () -> m (Maybe ([Text], [Text])) forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ FilePath -> Int -> m () forall (m :: * -> *). (MonadFree TmuxThunk m, MonadIO m) => FilePath -> Int -> m () recordScreenshot FilePath path Int paneId else FilePath -> Int -> m (Maybe ([Text], [Text])) forall (m :: * -> *). (MonadFree TmuxThunk m, MonadIO m) => FilePath -> Int -> m (Maybe ([Text], [Text])) testScreenshot FilePath path Int paneId where path :: FilePath path = FilePath storage FilePath -> FilePath -> FilePath </> Text -> FilePath forall a. ToString a => a -> FilePath toString Text name