module Widgets.Prompt where import Commons import qualified Widgets.Tab as Tab import qualified Widgets.Menu as Menu import qualified Widgets.Entry as Entry import Control.Lens import Data.Monoid ((<>)) import Data.Functor (($>)) import Control.Monad(when,forM_) import Data.Maybe (fromJust) import Control.Monad.IO.Class (liftIO) import Control.Concurrent (forkFinally, ThreadId, killThread) import Control.Exception (try, throw, displayException, SomeException, fromException) import Control.Exception.Base (AsyncException(ThreadKilled)) import Control.Applicative ((*>), (<$>)) import Brick.Widgets.Core ((<+>), str, strWrap, vBox, hLimit, padLeftRight, padTopBottom, withDefAttr) import Brick.Widgets.Border (borderWithLabel, hBorder) import Brick.Types (Widget, EventM, BrickEvent(..)) import Brick.Widgets.Center (centerLayer, hCenter) import qualified Brick.Widgets.Edit as Edit import Brick.BChan (BChan, writeBChan) import Graphics.Vty (Event(EvKey), Key(..)) import Data.Time.Format (formatTime, defaultTimeLocale) import Conduit import System.FilePath (isValid, takeDirectory, (), takeFileName, makeRelative) import System.Directory (doesFileExist, doesDirectoryExist, createDirectory, renameFile, copyFileWithMetadata, removeFile, removeDirectoryRecursive, createDirectoryIfMissing, readable, writable, executable, searchable) data Prompt = Prompt {_originTab :: Tab.Tab, _originPane :: PaneName, _action :: Action} deriving Show type Editor = Edit.Editor FilePath Name data Action = Copy Entry.Entry FilePath | Cut Entry.Entry FilePath | Rename Editor Entry.Entry | Delete Entry.Entry | Mkdir Editor FilePath | Touch Editor FilePath | GoTo Editor | Search Editor FilePath | DisplayInfo Entry.Entry | DisplayError String | Performing String ThreadId instance Show Action where show (Copy _ _) = " Copy " show (Cut _ _) = " Cut " show (Rename _ _) = " Rename " show (Delete _) = " Delete " show (Mkdir _ _) = " Make Directory " show (Touch _ _) = " Touch File " show (GoTo _) = " Go To " show (DisplayInfo _) = " Entry Info " show (Search _ _) = " Search " show (Performing name _) = " Performing" ++ name show _ = " Error " -- lenses originTab :: Lens' Prompt Tab.Tab originTab = lens _originTab (\prompt x -> prompt {_originTab = x}) originPane :: Lens' Prompt PaneName originPane = lens _originPane (\prompt x -> prompt {_originPane = x}) action :: Lens' Prompt Action action = lens _action (\prompt x -> prompt {_action = x}) -- creation emptyEditor :: Editor emptyEditor = makeEditor [] makeEditor :: FilePath -> Editor makeEditor = Edit.editor PromptEditor (Just 1) paste :: Menu.Clipboard -> Tab.Tab -> PaneName -> Prompt paste clip tab pName = let checked | Menu.isEmpty clip = DisplayError "The clipboard is empty" | Tab.isEmpty tab = DisplayError "You cannot paste into an empty tab" | Tab.isSearch tab = DisplayError "You cannot paste into a search tab" | Menu.isCopy clip = Copy (fromJust $ preview Menu.fromEntry clip) (tab ^. Tab.path) | Menu.isCut clip = Cut (fromJust $ preview Menu.fromEntry clip) (tab ^. Tab.path) | otherwise = DisplayError "Cannot paste: unknown error" in Prompt tab pName checked goTo :: Tab.Tab -> PaneName -> Prompt goTo tab pName = Prompt tab pName $ GoTo emptyEditor rename :: Tab.Tab -> PaneName -> Prompt rename = withSelectedEntry (\en -> Rename (editorFromEntry en) en) where editorFromEntry = makeEditor . takeFileName . view Entry.path delete :: Tab.Tab -> PaneName -> Prompt delete = withSelectedEntry Delete mkdir :: Tab.Tab -> PaneName -> Prompt mkdir = withDirTabPath (Mkdir emptyEditor) touch :: Tab.Tab -> PaneName -> Prompt touch = withDirTabPath (Touch emptyEditor) displayInfo :: Tab.Tab -> PaneName -> Prompt displayInfo = withSelectedEntry DisplayInfo search :: Tab.Tab -> PaneName -> Prompt search = withDirTabPath (Search emptyEditor) withSelectedEntry :: (Entry.Entry -> Action) -> Tab.Tab -> PaneName -> Prompt withSelectedEntry func tab pName = Prompt tab pName $ case Tab.selectedEntry tab of Just entry -> func entry _ -> DisplayError "This tab does not have a selected entry" withDirTabPath :: (FilePath -> Action) -> Tab.Tab -> PaneName -> Prompt withDirTabPath func tab pName = Prompt tab pName $ if Tab.isDir tab then func $ view Tab.path tab else DisplayError "This tab does not represent a directory" -- rendering render :: Prompt -> Widget Name render prompt = centerLayer . box $ vBox [body, hBorder, footer] where box = withDefAttr promptAttr . borderWithLabel (str . show $ view action prompt) . hLimit 70 body = padLeftRight 2 . padTopBottom 1 $ renderBody prompt footer = hCenter . renderFooter $ view action prompt renderBody :: Prompt -> Widget Name renderBody pr = vBox $ case view action pr of Copy en path -> disclaimer : map strWrap [tellEntry en <> " will be copied from:", takeDirectory $ view Entry.path en, "to: ", path] Cut en path -> disclaimer : map strWrap [tellEntry en <> " will be moved from:", takeDirectory $ view Entry.path en, "to: ", path] Rename edit en -> disclaimer : strWrap (tellEntry en <> " will be renamed to:") : renderValidatedEditor edit Delete en -> [disclaimer, strWrap $ tellEntry en <> " will be permanently deleted"] Mkdir edit _ -> str "Directory name:" : renderValidatedEditor edit Touch edit _ -> str "File name:" : renderValidatedEditor edit GoTo edit -> str "Directory to open:" : renderValidatedEditor edit Search edit _ -> str "Search for:" : renderValidatedEditor edit DisplayInfo en -> map strWrap . (displaySize en :) $ displayPerms en ++ displayTimes en DisplayError msg -> [str "Whoops, this went wrong:", withDefAttr errorAttr $ strWrap msg] Performing name _ -> [str $ "Performing" ++ name, str "Please wait"] displaySize :: Entry.Entry -> String displaySize entry = case view Entry.size entry of Entry.Known s -> "Size: " ++ show s ++ " Bytes (" ++ Entry.shortSize (Entry.Known s) ++ ")" Entry.Unknown -> "Size unknown (unable to read)" Entry.Calculating -> "Size is being calculated" Entry.Waiting -> "Size will soon be calculated" _ -> "" displayPerms :: Entry.Entry -> [String] displayPerms entry = case view Entry.perms entry of Nothing -> [" ", "Permissions unknown", "(could not read them)"] Just p -> [ " ", "Is readable: " <> (if readable p then "yes" else "no"), "Is writable: " <> (if writable p then "yes" else "no"), "Is executable: " <> (if executable p then "yes" else "no"), "Is searchable: " <> (if searchable p then "yes" else "no") ] displayTimes :: Entry.Entry -> [String] displayTimes entry = case view Entry.times entry of Nothing -> [" ", "Last access and modification times unknown", "(could not read them)"] Just (acTm, mdTm) -> [" ", "Last access time:" <> format acTm, "Last modification time:" <> format mdTm] where format = formatTime defaultTimeLocale " %T %B %-d %Y" tellEntry :: Entry.Entry -> String tellEntry entry | Entry.isDir entry = "The directory " <> name <> " (and all it's content)" | otherwise = "The file " <> name where name = view Entry.name entry disclaimer :: Widget Name disclaimer = withDefAttr disclaimerAttr $ strWrap "NOTE: this will operate on \ \your file system and may be irreversible, double check it! Also please note \ \that the operation can be stopped, but will not revert what was already done." renderValidatedEditor :: Editor -> [Widget Name] renderValidatedEditor e = [Edit.renderEditor (str . unlines) True e, validLine] where validLine = if isValid $ editorLine e then str " " else withDefAttr errorAttr $ str " ^ invalid filepath!" renderFooter :: Action -> Widget Name renderFooter act = case act of Performing _ _ -> kb "Esc" <+> str " to Cancel. NOTE: will not revert what was already done." _ -> kb "Enter" <+> str txt <+> kb "Esc" <+> str " to close and go back" where kb = withDefAttr keybindAttr . str txt = case act of Copy _ _ -> " to copy, " Cut _ _ -> " to move, " Rename _ _ -> " to rename, " Delete _ -> " to delete, " Mkdir _ _ -> " to make the directory, " Touch _ _ -> " to touch the file, " GoTo _ -> " to change directory, " Search _ _ -> " to search, " _ -> " or " -- event-handling handleEvent :: BrickEvent Name (ThreadEvent Tab.Tab) -> Prompt -> EChan Tab.Tab -> EventM Name (Either Prompt Tab.Tab) handleEvent (AppEvent ev) pr _ = case ev of PromptError err -> return . Left $ pr & action .~ DisplayError err PromptSuccess tab -> return $ Right tab PromptClosed -> return . Right $ view originTab pr _ -> return $ Left pr handleEvent (VtyEvent ev) pr eChan = case ev of EvKey KEsc [] -> liftIO $ exit pr EvKey KEnter [] -> liftIO $ performAction pr eChan _ -> Left <$> (pr & action %%~ handleEditor ev) handleEvent _ pr _ = return $ Left pr -- if performing it will return the same prompt, the raised exception will trigger the closing exit :: Prompt -> IO (Either Prompt Tab.Tab) exit pr = case view action pr of Performing name tId -> killThread tId $> Left pr _ -> return . Right $ view originTab pr -- gets to decide if the action will be processed in a different thread or not performAction :: Prompt -> EChan Tab.Tab -> IO (Either Prompt Tab.Tab) -- performAction pr eChan = case view action pr of Copy _ _ -> Left <$> processThreaded pr eChan Cut _ _ -> Left <$> processThreaded pr eChan Rename _ _ -> Left <$> processThreaded pr eChan Delete _ -> Left <$> processThreaded pr eChan Search _ _ -> Left <$> processThreaded pr eChan Performing _ _ -> return $ Left pr -- doesn't really make sense _ -> processSafe pr processThreaded :: Prompt -> EChan Tab.Tab -> IO Prompt processThreaded pr eChan = do tId <- forkFinally (processUnsafe pr) (reportResult eChan) return $ pr & action %~ (\act -> Performing (show act) tId) reportResult :: EChan Tab.Tab -> Either SomeException Tab.Tab -> IO () reportResult eChan = writeBChan eChan . either endingEvent PromptSuccess endingEvent :: SomeException -> ThreadEvent Tab.Tab endingEvent e = case (fromException e :: Maybe AsyncException) of Just ThreadKilled -> PromptClosed _ -> PromptError $ displayException e processSafe :: Prompt -> IO (Either Prompt Tab.Tab) processSafe pr = do result <- (try $ processUnsafe pr) :: IO (Either SomeException Tab.Tab) return $ case result of Left e -> Left $ pr & action .~ DisplayError (displayException e) Right tabRes -> Right tabRes processUnsafe :: Prompt -> IO Tab.Tab processUnsafe prompt = case act of Copy entry path -> processCopy entry path pName tab Cut entry path -> processCut entry path pName tab Rename edit entry -> processRename entry (editorLine edit) pName tab Delete entry -> processDelete entry pName tab Mkdir edit path -> createDirectory (path editorLine edit) *> Tab.reload pName tab Touch edit path -> writeFile (path editorLine edit) "" *> Tab.reload pName tab GoTo edit -> processGoTo pName $ editorLine edit Search edit path -> Tab.makeSearchTab pName path $ editorLine edit _ -> return tab where tab = view originTab prompt pName = view originPane prompt act = view action prompt processCopy :: Entry.Entry -> FilePath -> PaneName -> Tab.Tab -> IO Tab.Tab processCopy entry path pName tab | Entry.isFile entry = copyFileWithMetadata ePath (path takeFileName ePath) *> Tab.reload pName tab | otherwise = copyDirectoryRecursive ePath (path takeFileName ePath) *> Tab.reload pName tab where ePath = view Entry.path entry processCut :: Entry.Entry -> FilePath -> PaneName -> Tab.Tab -> IO Tab.Tab processCut entry path pName tab | Entry.isFile entry = moveFileWithMetadata ePath (path takeFileName ePath) *> Tab.reload pName tab | otherwise = moveDirectoryRecursive ePath (path takeFileName ePath) *> Tab.reload pName tab where ePath = view Entry.path entry processRename :: Entry.Entry -> String -> PaneName -> Tab.Tab -> IO Tab.Tab processRename entry editLine pName tab | Entry.isFile entry = renameFile ePath (takeDirectory ePath editLine) *> Tab.reload pName tab | otherwise = moveDirectoryRecursive ePath (takeDirectory ePath editLine) *> Tab.reload pName tab where ePath = view Entry.path entry processDelete :: Entry.Entry -> PaneName -> Tab.Tab -> IO Tab.Tab processDelete entry pName tab | Entry.isFile entry = removeFile ePath *> Tab.reload pName tab | otherwise = removeDirectoryRecursive ePath *> Tab.reload pName tab where ePath = view Entry.path entry processGoTo :: PaneName -> FilePath -> IO Tab.Tab processGoTo pName path = do isFile <- doesFileExist path isDir <- doesDirectoryExist path if isFile || not isDir then throw . userError $ path <> " does not exist or is not a directory" else Tab.makeDirTab pName path handleEditor :: Event -> Action -> EventM Name Action handleEditor ev act = case act of Rename edit en -> (`Rename` en) <$> Edit.handleEditorEvent ev edit Mkdir edit path -> (`Mkdir` path) <$> Edit.handleEditorEvent ev edit Touch edit path -> (`Touch` path) <$> Edit.handleEditorEvent ev edit GoTo edit -> GoTo <$> Edit.handleEditorEvent ev edit Search edit path -> (`Search` path) <$> Edit.handleEditorEvent ev edit _ -> return act -- utility editorLine :: Editor -> String editorLine = head . Edit.getEditContents notifySize :: FilePath -> Entry.Size -> Prompt -> Prompt notifySize path size prompt = prompt & action %~ notifyActionSize path size notifyActionSize :: FilePath -> Entry.Size -> Action -> Action notifyActionSize path size act = case act of DisplayInfo en -> if path == en ^. Entry.path then DisplayInfo (en & Entry.size .~ size) else act _ -> act -- files functions not covered by System.Directory nor System.FilePath moveFileWithMetadata :: FilePath -> FilePath -> IO () moveFileWithMetadata src dst = do copyFileWithMetadata src dst removeFile src moveDirectoryRecursive :: FilePath -> FilePath -> IO () moveDirectoryRecursive src dst = do copyDirectoryRecursive src dst removeDirectoryRecursive src copyDirectoryRecursive :: FilePath -> FilePath -> IO () copyDirectoryRecursive src dst = runConduitRes $ sourceDirectoryDeep False src .| mapC (\fPath -> (fPath, dst (makeRelative src fPath))) .| iterMC (liftIO . createDirectoryIfMissing True . takeDirectory . snd) .| mapM_C (\(srcFile, dstFile) -> liftIO $ copyFileWithMetadata srcFile dstFile)