Prompt.hs

module Widgets.Prompt where
import Types
import Widgets.Tab
import Widgets.Menu

import Data.Monoid ((<>))
import Data.Functor (($>))
import Control.Monad(when,forM_)
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 Brick.Widgets.Edit (Editor, editor, renderEditor, getEditContents, handleEditorEvent)
import Brick.BChan (BChan, writeBChan)
import Graphics.Vty (Event(EvKey), Key(..))
import Data.Time.Format (formatTime, defaultTimeLocale)
import System.FilePath (isValid, takeDirectory, (</>), takeFileName)
import System.Directory (doesFileExist, doesDirectoryExist, createDirectory, renameFile,
  copyFileWithMetadata, renameFile, removeFile, removeDirectoryRecursive, getDirectoryContents,
  readable, writable, executable, searchable)

data Prompt = Prompt {originTab :: Tab, originPane :: PaneName, action :: PromptAction} deriving Show
type PathEditor = Editor FilePath Name
data PromptAction = Copy Entry FilePath | Cut Entry FilePath | Rename PathEditor Entry |
  Delete Entry | Mkdir PathEditor FilePath | Touch PathEditor FilePath |
  GoTo PathEditor | Search PathEditor FilePath | DisplayInfo EntryInfo |
  DisplayError String | Performing String ThreadId

instance Show PromptAction 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 "

-- creation functions
emptyPathEditor :: PathEditor
emptyPathEditor = makePathEditor []

makePathEditor :: FilePath -> PathEditor
makePathEditor = editor PromptEditor (Just 1)

makePastePrompt :: Clipboard -> Tab -> PaneName -> Prompt
makePastePrompt c tab pName = Prompt tab pName $ case (c, tab) of
  (EmptyBoard, _) -> DisplayError "The clipboard is empty"
  (_, EmptyTab) -> DisplayError "You cannot paste into an empty tab"
  (_, SearchTab {}) -> DisplayError "You cannot paste into a search tab"
  (CopyBoard {fromEntry = entry}, DirTab{tabPath = path}) -> Copy entry path
  (CutBoard {fromEntry = entry}, DirTab{tabPath = path}) -> Cut entry path

makeGoToPrompt :: Tab -> PaneName -> Prompt
makeGoToPrompt tab pName = Prompt tab pName $ GoTo emptyPathEditor

makeRenamePrompt :: Tab -> PaneName -> Prompt
makeRenamePrompt = withSelectedEntry (\en -> Rename (editorFromEntry en) en)
  where editorFromEntry = makePathEditor . takeFileName . entryPath

makeDeletePrompt :: Tab -> PaneName -> Prompt
makeDeletePrompt = withSelectedEntry Delete

makeMkdirPrompt :: Tab -> PaneName -> Prompt
makeMkdirPrompt = withDirTabPath (Mkdir emptyPathEditor)

makeTouchPrompt :: Tab -> PaneName -> Prompt
makeTouchPrompt = withDirTabPath (Touch emptyPathEditor)

makeDisplayInfoPrompt :: Tab -> PaneName -> Prompt
makeDisplayInfoPrompt = withSelectedEntry (DisplayInfo . entryInfo)

makeSearchPrompt :: Tab -> PaneName -> Prompt
makeSearchPrompt = withDirTabPath (Search emptyPathEditor)

withSelectedEntry :: (Entry -> PromptAction) -> Tab -> PaneName -> Prompt
withSelectedEntry func tab pName = Prompt tab pName $ case selectedEntry tab of
  Just entry -> func entry
  _ -> DisplayError "This tab does not have a selected entry"

withDirTabPath :: (FilePath -> PromptAction) -> Tab -> PaneName -> Prompt
withDirTabPath func tab pName = Prompt tab pName $ case tab of
   DirTab {tabPath = path} -> func path
   _ -> DisplayError "This tab does not represent a directory"

-- rendering functions
renderPrompt :: Prompt -> Widget Name
renderPrompt prompt = centerLayer . box $ vBox [body, hBorder, footer]
  where
    box = withDefAttr promptAttr . borderWithLabel (str . show $ action prompt) . hLimit 70
    body = padLeftRight 2 . padTopBottom 1 $ renderBody prompt
    footer = hCenter . renderFooter $ action prompt

renderBody :: Prompt -> Widget Name
renderBody pr = vBox $ case action pr of
  Copy en path -> disclaimer : map strWrap [tellEntry en <> " will be copied from:", takeDirectory $ entryPath en, "to: ", path]
  Cut en path -> disclaimer : map strWrap [tellEntry en <> " will be moved from:", takeDirectory $ entryPath 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 info -> map strWrap . (displaySize info :) $ displayPerms info ++ displayTimes info
  DisplayError msg -> [str "Whoops, this went wrong:", withDefAttr errorAttr $ strWrap msg]
  Performing name _ -> [str $ "Performing" ++ name, str "Please wait"]

displaySize :: EntryInfo -> String
displaySize info = "Size: " ++ show (entrySize info) ++ " Bytes (" ++ shortEntrySize info ++ ")"

displayPerms :: EntryInfo -> [String]
displayPerms info = case entryPerms info 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 :: EntryInfo -> [String]
displayTimes info = case entryTimes info 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 -> String
tellEntry e = case e of
  DirEntry {entryName = name} -> "The directory " <> name <> " (and all it's content)"
  FileEntry {entryName = name} -> "The file " <> name

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 :: PathEditor -> [Widget Name]
renderValidatedEditor e = [renderEditor (str . unlines) True e, validLine]
  where
    validLine = if isValid $ getEditLine e
      then str " "
      else withDefAttr errorAttr $ str " ^ invalid filepath!"

renderFooter :: PromptAction -> 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 functions
handlePromptEvent :: BrickEvent Name (ThreadEvent Tab) -> Prompt -> BChan (ThreadEvent Tab) -> EventM Name (Either Prompt Tab)
handlePromptEvent (AppEvent ev) pr _ = case ev of
  ThreadError err -> return $ Left pr {action = DisplayError err}
  ThreadSuccess tab -> return $ Right tab
  ThreadClosed -> return . Right $ originTab pr
handlePromptEvent (VtyEvent ev) pr eChan = case ev of
  EvKey KEsc [] -> liftIO $ exitPrompt pr
  EvKey KEnter [] -> liftIO $ performAction pr eChan
  _ -> Left . Prompt (originTab pr) (originPane pr) <$> handleActionEditor ev (action pr)
handlePromptEvent _ pr _ = return $ Left pr

exitPrompt :: Prompt -> IO (Either Prompt Tab)
exitPrompt pr = case action pr of
  Performing name tId -> killThread tId $> Left pr -- returns the same prompt because the actual exiting will happen because of the exception that killThread raises
  _ -> return . Right $ originTab pr

-- gets to decide if the action will be processed in a different thread or not
performAction :: Prompt -> BChan (ThreadEvent Tab) -> IO (Either Prompt Tab) --
performAction pr eChan = case 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
  _ -> tryProcessAction pr

processThreaded :: Prompt -> BChan (ThreadEvent Tab) -> IO Prompt
processThreaded pr eChan = do
  tId <- forkFinally (processAction pr) (reportResult eChan)
  return $ pr {action = Performing (show $ action pr) tId}

reportResult :: BChan (ThreadEvent Tab) -> Either SomeException Tab -> IO ()
reportResult eChan res = writeBChan eChan $ case res of
  Left e -> endingEvent e
  Right tabRes -> ThreadSuccess tabRes

endingEvent :: SomeException -> ThreadEvent Tab
endingEvent e = case (fromException e :: Maybe AsyncException) of
  Just ThreadKilled -> ThreadClosed
  _ -> ThreadError $ displayException e

tryProcessAction :: Prompt -> IO (Either Prompt Tab)
tryProcessAction pr = do
  result <- (try $ processAction pr) :: IO (Either SomeException Tab)
  return $ case result of
    Left e -> Left $ pr {action = DisplayError $ displayException e}
    Right tabRes -> Right tabRes

processAction :: Prompt -> IO Tab
processAction Prompt {originTab = tab, originPane = pName, action = act} = case act of
  Copy FileEntry {entryPath = ePath} path -> copyFileWithMetadata ePath (path </> takeFileName ePath) *> reload pName tab
  Copy DirEntry {entryPath = ePath} path -> copyDirectoryRecursive ePath (path </> takeFileName ePath) *> reload pName tab
  Cut FileEntry {entryPath = ePath} path -> moveFileWithMetadata ePath (path </> takeFileName ePath) *> reload pName tab
  Cut DirEntry {entryPath = ePath} path -> moveDirectoryRecursive ePath (path </> takeFileName ePath) *> reload pName tab
  Rename edit FileEntry {entryPath = ePath} -> renameFile ePath (takeDirectory ePath </> getEditLine edit) *> reload pName tab
  Rename edit DirEntry {entryPath = ePath} -> moveDirectoryRecursive ePath (takeDirectory ePath </> getEditLine edit) *> reload pName tab
  Delete FileEntry {entryPath = ePath} -> removeFile ePath *> reload pName tab
  Delete DirEntry {entryPath = ePath} -> removeDirectoryRecursive ePath *> reload pName tab
  Mkdir edit path -> createDirectory (path </> getEditLine edit) *> reload pName tab
  Touch edit path -> writeFile (path </> getEditLine edit) "" *> reload pName tab
  GoTo edit -> processGoTo pName $ getEditLine edit
  Search edit path -> makeSearchTab pName path $ getEditLine edit
  _ -> return tab

processGoTo :: PaneName -> FilePath -> IO 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 makeDirTab pName path

handleActionEditor :: Event -> PromptAction -> EventM Name PromptAction
handleActionEditor ev act = case act of
  Rename edit en -> (`Rename` en) <$> handleEditorEvent ev edit
  Mkdir edit path -> (`Mkdir` path) <$> handleEditorEvent ev edit
  Touch edit path -> (`Touch` path) <$> handleEditorEvent ev edit
  GoTo edit -> GoTo <$> handleEditorEvent ev edit
  Search edit path -> (`Search` path) <$> handleEditorEvent ev edit
  _ -> return act

-- utility functions
getEditLine :: PathEditor -> String
getEditLine = head . getEditContents

-- files functions not covered by System.Directory nor System.FilePath
moveFileWithMetadata :: FilePath -> FilePath -> IO ()
moveFileWithMetadata o d = do
  copyFileWithMetadata o d
  removeFile o

moveDirectoryRecursive :: FilePath -> FilePath -> IO ()
moveDirectoryRecursive o d = do
  copyDirectoryRecursive o d
  removeDirectoryRecursive o

-- taken from https://stackoverflow.com/questions/6807025/what-is-the-haskell-way-to-copy-a-directory
copyDirectoryRecursive ::  FilePath -> FilePath -> IO ()
copyDirectoryRecursive src dst = do
  whenM (not <$> doesDirectoryExist src) $ throw (userError "source does not exist")
  whenM (doesFileOrDirectoryExist dst) $ throw (userError "destination already exists")
  createDirectory dst
  content <- getDirectoryContents src
  let xs = filter (`notElem` [".", ".."]) content
  forM_ xs $ \name -> do
    let srcPath = src </> name
    let dstPath = dst </> name
    isDirectory <- doesDirectoryExist srcPath
    if isDirectory
      then copyDirectoryRecursive srcPath dstPath
      else copyFileWithMetadata srcPath dstPath
  where
    doesFileOrDirectoryExist x = orM [doesDirectoryExist x, doesFileExist x]
    orM xs = or <$> sequence xs
    whenM s r = s >>= flip when r