Prompt.hs

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 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 qualified Brick.Widgets.Edit as Edit
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, removeFile, removeDirectoryRecursive, getDirectoryContents,
  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.Info |
  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 "

-- creation functions
emptyEditor :: Editor
emptyEditor = makeEditor []

makeEditor :: FilePath -> Editor
makeEditor = Edit.editor PromptEditor (Just 1)

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

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 . 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 . Entry.info)

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 $ case tab of
   Tab.Dir {Tab.path = path} -> func path
   _ -> DisplayError "This tab does not represent a directory"

-- rendering functions
render :: Prompt -> Widget Name
render 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 $ Entry.path en, "to: ", path]
  Cut en path -> disclaimer : map strWrap [tellEntry en <> " will be moved from:", takeDirectory $ 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 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 :: Entry.Info -> String
displaySize info = "Size: " ++ show (Entry.size info) ++ " Bytes (" ++ Entry.shortSize info ++ ")"

displayPerms :: Entry.Info -> [String]
displayPerms info = case Entry.perms 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 :: Entry.Info -> [String]
displayTimes info = case Entry.times 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.Entry -> String
tellEntry e = case e of
  Entry.Dir {Entry.name = name} -> "The directory " <> name <> " (and all it's content)"
  Entry.File {Entry.name = 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 :: 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 functions
handleEvent :: BrickEvent Name (ThreadEvent Tab.Tab) -> Prompt -> BChan (ThreadEvent Tab.Tab) -> EventM Name (Either Prompt Tab.Tab)
handleEvent (AppEvent ev) pr _ = case ev of
  ThreadError err -> return $ Left pr {action = DisplayError err}
  ThreadSuccess tab -> return $ Right tab
  ThreadClosed -> return . Right $ originTab pr
handleEvent (VtyEvent ev) pr eChan = case ev of
  EvKey KEsc [] -> liftIO $ exit pr
  EvKey KEnter [] -> liftIO $ performAction pr eChan
  _ -> Left . Prompt (originTab pr) (originPane pr) <$> handleEditor ev (action pr)
handleEvent _ pr _ = return $ Left pr

exit :: Prompt -> IO (Either Prompt Tab.Tab)
exit 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.Tab) -> IO (Either Prompt Tab.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
  _ -> processSafe pr

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

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

endingEvent :: SomeException -> ThreadEvent Tab.Tab
endingEvent e = case (fromException e :: Maybe AsyncException) of
  Just ThreadKilled -> ThreadClosed
  _ -> ThreadError $ 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 {originTab = tab, originPane = pName, action = act} = case act of
  Copy Entry.File {Entry.path = ePath} path -> copyFileWithMetadata ePath (path </> takeFileName ePath) *> Tab.reload pName tab
  Copy Entry.Dir {Entry.path = ePath} path -> copyDirectoryRecursive ePath (path </> takeFileName ePath) *> Tab.reload pName tab
  Cut Entry.File {Entry.path = ePath} path -> moveFileWithMetadata ePath (path </> takeFileName ePath) *> Tab.reload pName tab
  Cut Entry.Dir {Entry.path = ePath} path -> moveDirectoryRecursive ePath (path </> takeFileName ePath) *> Tab.reload pName tab
  Rename edit Entry.File {Entry.path = ePath} -> renameFile ePath (takeDirectory ePath </> editorLine edit) *> Tab.reload pName tab
  Rename edit Entry.Dir {Entry.path = ePath} -> moveDirectoryRecursive ePath (takeDirectory ePath </> editorLine edit) *> Tab.reload pName tab
  Delete Entry.File {Entry.path = ePath} -> removeFile ePath *> Tab.reload pName tab
  Delete Entry.Dir {Entry.path = ePath} -> removeDirectoryRecursive ePath *> Tab.reload 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

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 functions
editorLine :: Editor -> String
editorLine = head . Edit.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