diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,6 +6,8 @@ > Note: this is still an experiment. Directory navigation will do no harm, but double-check before starting operations on your file system. I take no responsibility for what you do with this software. ## Installation +> Note: You may need to install `ncurses` on your system before using clifm + For ArchLinux the binary from [the latest github release](https://github.com/pasqu4le/clifm/releases/latest) should work. For other Linux distro the binary may work as well, or you can build from source. @@ -25,7 +27,7 @@ ## Features Clifm is a [brick](https://github.com/jtdaugherty/brick) application, that in turn builds upon [vty](https://github.com/jtdaugherty/vty). As such it supports a large number of terminals, but not on Windows, handles windows resizing and more. -If your terminal supports a mouse you can use it to change Tab/Pane, click a button on the bottom or change your selection, but only using the keyboard you can perform every possible action. This is the list of all the keybindings: +If your terminal supports a mouse you can use it to change Tab/Pane, click a button on the bottom, change your selection or open it (double-click), but only using the keyboard you can perform every possible action. This is the list of all the keybindings: #### Bottom menu - L: open Se**l**ection menu diff --git a/clifm.cabal b/clifm.cabal --- a/clifm.cabal +++ b/clifm.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.3.1.0 +version: 0.4.1.0 -- A short (one-line) description of the package. synopsis: Command Line Interface File Manager @@ -58,10 +58,11 @@ main-is: Main.hs -- Modules included in this executable, other than Main. - other-modules: Types + other-modules: Commons Widgets.Manager Widgets.Pane Widgets.Tab + Widgets.Entry Widgets.Menu Widgets.Prompt diff --git a/src/Commons.hs b/src/Commons.hs new file mode 100644 --- /dev/null +++ b/src/Commons.hs @@ -0,0 +1,48 @@ +module Commons where + +import Data.Monoid ((<>)) +import Brick.Widgets.Core (withDefAttr, str) +import Brick.Types (Widget) +import Brick.Themes (Theme, newTheme) +import Brick.AttrMap (AttrName, AttrMap, attrName, attrMap) +import Graphics.Vty (Key(..), defAttr, withStyle, underline, black, yellow, white, blue, red) +import Brick.Util (on, fg, bg) +import Brick.Widgets.Edit (editFocusedAttr) +import Brick.Widgets.List (listSelectedFocusedAttr, listSelectedAttr) + +-- data definitions +data Name = Button {keyBind :: Key, withCtrl :: Bool} | + LabelsRow {pnName :: PaneName} | + Label {pnName :: PaneName, labelNum :: Int} | + PromptEditor | + EntryList {pnName :: PaneName} deriving (Ord, Show, Eq) +data ThreadEvent a = ThreadClosed | ThreadSuccess a | ThreadError String +type PaneName = Int + +-- attributes and themes +defaultTheme :: Theme +defaultTheme = newTheme (white `on` black) [ + (listSelectedAttr, fg yellow), + (listSelectedFocusedAttr, black `on` yellow), + (keybindAttr, fg white `withStyle` underline), + (promptAttr, bg blue), + (errorAttr, bg red), + (editFocusedAttr, black `on` yellow), + (disclaimerAttr, black `on` white) + ] + +keybindAttr :: AttrName +keybindAttr = attrName "keybind" + +promptAttr :: AttrName +promptAttr = attrName "prompt" + +errorAttr :: AttrName +errorAttr = attrName "error" + +disclaimerAttr :: AttrName +disclaimerAttr = attrName "disclaimer" + +-- utility functions +keybindStr :: String -> Widget Name +keybindStr = withDefAttr keybindAttr . str diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,7 @@ module Main where -import Types -import Widgets.Manager -import Widgets.Tab (Tab) +import Commons +import qualified Widgets.Manager as Mngr +import qualified Widgets.Tab as Tab import Options.Applicative import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute) @@ -69,13 +69,14 @@ setMode (outputIface v) Mouse True return v eventChan <- Brick.BChan.newBChan 10 - state <- makeState path (editComm options) eventChan + state <- Mngr.makeState path (editComm options) eventChan void $ customMain buildVty (Just eventChan) (app atrm) state -app :: AttrMap -> App State (ThreadEvent Tab) Name -app atrm = App { appDraw = drawUi, +app :: AttrMap -> App Mngr.State (ThreadEvent Tab.Tab) Name +app atrm = App { + appDraw = Mngr.drawUi, appStartEvent = return, - appHandleEvent = handleEvent, + appHandleEvent = Mngr.handleEvent, appAttrMap = const atrm, appChooseCursor = showFirstCursor } diff --git a/src/Types.hs b/src/Types.hs deleted file mode 100644 --- a/src/Types.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Types where - -import Data.Monoid ((<>)) -import Brick.Widgets.Core (withDefAttr, str) -import Brick.Types (Widget) -import Brick.Themes (Theme, newTheme) -import Brick.AttrMap (AttrName, AttrMap, attrName, attrMap) -import Graphics.Vty (Key(..), defAttr, withStyle, underline, black, yellow, white, blue, red) -import Brick.Util (on, fg, bg) -import Brick.Widgets.Edit (editFocusedAttr) -import Brick.Widgets.List (listSelectedFocusedAttr, listSelectedAttr) - --- data definitions -data Name = Button {keyBind :: Key, withCtrl :: Bool} | - LabelsRow {pnName :: PaneName} | - Label {pnName :: PaneName, labelNum :: Int} | - PromptEditor | - EntryList {pnName :: PaneName} deriving (Ord, Show, Eq) -data ThreadEvent a = ThreadClosed | ThreadSuccess a | ThreadError String -type PaneName = Int - --- attributes and themes -defaultTheme :: Theme -defaultTheme = newTheme (white `on` black) [ - (listSelectedAttr, fg yellow), - (listSelectedFocusedAttr, black `on` yellow), - (keybindAttr, fg white `withStyle` underline), - (promptAttr, bg blue), - (errorAttr, bg red), - (editFocusedAttr, black `on` yellow), - (disclaimerAttr, black `on` white) - ] - -keybindAttr :: AttrName -keybindAttr = attrName "keybind" - -promptAttr :: AttrName -promptAttr = attrName "prompt" - -errorAttr :: AttrName -errorAttr = attrName "error" - -disclaimerAttr :: AttrName -disclaimerAttr = attrName "disclaimer" - --- utility functions -keybindStr :: String -> Widget Name -keybindStr = withDefAttr keybindAttr . str diff --git a/src/Widgets/Entry.hs b/src/Widgets/Entry.hs new file mode 100644 --- /dev/null +++ b/src/Widgets/Entry.hs @@ -0,0 +1,89 @@ +module Widgets.Entry where +import Commons + +import Data.Time.Clock (UTCTime) +import Data.Time.Format (formatTime, defaultTimeLocale) +import Control.Exception (try, SomeException) +import System.FilePath (takeFileName) +import System.Directory (Permissions, getPermissions, readable, writable, executable, searchable, + getAccessTime, getModificationTime, doesFileExist, getFileSize) +import Brick.Types (Widget) +import Brick.Widgets.Core (vLimit, hBox, str, fill) +import Data.ByteUnits (ByteValue(..), ByteUnit(Bytes), getShortHand, getAppropriateUnits) + +data Entry = Dir {name :: String, path :: FilePath, info :: Info} | + File {name :: String, path :: FilePath, info :: Info} +data Info = Info {size :: Integer, perms :: Maybe Permissions, times :: Maybe (UTCTime, UTCTime)} deriving Show + +instance Show Entry where + show Dir {name = n} = "+ " ++ n + show File {name = n} = "- " ++ n + +instance Eq Entry where + Dir {path = p1} == Dir {path = p2} = p1 == p2 + File {path = p1} == File {path = p2} = p1 == p2 + _ == _ = False + +-- creation functions +make :: FilePath -> IO Entry +make filePath = do + isFile <- doesFileExist filePath + if isFile then File (takeFileName filePath) filePath <$> makeInfo filePath + else Dir (takeFileName filePath) filePath <$> makeInfo filePath + +makeInfo :: FilePath -> IO Info +makeInfo filePath = do + enSize <- getFileSize filePath + enPerms <- toMaybe <$> try (getPermissions filePath) + enTimes <- toMaybe <$> try (getEntryTimes filePath) + return $ Info enSize enPerms enTimes + +getEntryTimes :: FilePath -> IO (UTCTime, UTCTime) +getEntryTimes filePath = do + accessTime <- getAccessTime filePath + modifTime <- getModificationTime filePath + return (accessTime, modifTime) + +-- rendering functions +render :: Bool -> Entry -> Widget Name +render _ en = let enInfo = info en in vLimit 1 $ hBox [ + str $ show en, + fill ' ', + str $ shortSize enInfo, + renderPerms $ perms enInfo, + renderTime (times enInfo) False + ] + +renderPerms :: Maybe Permissions -> Widget Name +renderPerms Nothing = str " ----" +renderPerms (Just p) = str [ + ' ', + if readable p then 'r' else '-', + if writable p then 'w' else '-', + if executable p then 'x' else '-', + if searchable p then 's' else '-' + ] + +renderTime :: Maybe (UTCTime, UTCTime) -> Bool -> Widget Name +renderTime Nothing _ = str " -----------------" +renderTime (Just tms) sel = str . format $ (if sel then fst else snd) tms + where format = formatTime defaultTimeLocale " %R %b %e %Y" + +-- utility functions +toMaybe :: Either SomeException b -> Maybe b +toMaybe = either (const Nothing) Just + +isExecutable :: Entry -> Bool +isExecutable = hasPermission executable + +isReadable :: Entry -> Bool +isReadable = hasPermission readable + +hasPermission :: (Permissions -> Bool) -> Entry -> Bool +hasPermission prop en = case perms $ info en of + Just enPerms -> prop enPerms + _ -> False + +shortSize :: Info -> String +shortSize enInfo = getShortHand . getAppropriateUnits $ ByteValue enSize Bytes + where enSize = fromInteger $ size enInfo diff --git a/src/Widgets/Manager.hs b/src/Widgets/Manager.hs --- a/src/Widgets/Manager.hs +++ b/src/Widgets/Manager.hs @@ -1,12 +1,15 @@ module Widgets.Manager where -import Types -import Widgets.Pane -import Widgets.Tab -import Widgets.Menu -import Widgets.Prompt +import Commons +import qualified Widgets.Pane as Pane +import qualified Widgets.Tab as Tab +import qualified Widgets.Entry as Entry +import qualified Widgets.Menu as Menu +import qualified Widgets.Prompt as Prompt import System.Process (callCommand) import Control.Exception (try, SomeException) +import Control.Monad.IO.Class (liftIO) +import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) import Brick.Main (continue, halt, suspendAndResume) import Brick.Widgets.Core ((<+>), str, hBox, vBox, vLimit, withBorderStyle) import Brick.Types (Widget, BrickEvent(..), EventM, Next, ViewportType(..), Location(..)) @@ -21,116 +24,131 @@ data State = State {paneZipper :: PaneZipper, lastPaneName :: PaneName, - bottomMenu :: Menu, - prompt :: Maybe Prompt, + bottomMenu :: Menu.Menu, + prompt :: Maybe Prompt.Prompt, + lastClickedEntry :: Maybe (PaneName, Int, UTCTime), editorCommand :: String, - eventChan :: BChan (ThreadEvent Tab) + eventChan :: BChan (ThreadEvent Tab.Tab) } -type PaneZipper = PointedList Pane +type PaneZipper = PointedList Pane.Pane -- creation functions -makeState :: FilePath -> String -> BChan (ThreadEvent Tab) -> IO State +makeState :: FilePath -> String -> BChan (ThreadEvent Tab.Tab) -> IO State makeState path editCom eChan = do - pane <- makePane 0 path - return $ State (singleton pane) 0 makeMenu Nothing editCom eChan + pane <- Pane.make 0 path + return $ State (singleton pane) 0 Menu.make Nothing Nothing editCom eChan -- rendering functions drawUi :: State -> [Widget Name] drawUi state = case prompt state of - Just pr -> [renderPrompt pr, renderMainUI state] + Just pr -> [Prompt.render pr, renderMainUI state] _ -> [renderMainUI state] renderMainUI :: State -> Widget Name -renderMainUI state = vBox [panes, botSep, menu] - where - panes = renderPanes $ paneZipper state - botSep = withBorderStyle unicodeBold hBorder - menu = vLimit 3 $ renderMenu (bottomMenu state) (currentPane state) +renderMainUI state = vBox [ + renderPanes $ paneZipper state, + withBorderStyle unicodeBold hBorder, + vLimit 3 $ Menu.render (bottomMenu state) (currentPane state) + ] renderPanes :: PaneZipper -> Widget Name -renderPanes = hBox . intersperse vBorder . map renderPane . toList . withFocus +renderPanes = hBox . intersperse vBorder . map Pane.render . toList . withFocus -- event handling functions -handleEvent :: State -> BrickEvent Name (ThreadEvent Tab) -> EventM Name (Next State) +handleEvent :: State -> BrickEvent Name (ThreadEvent Tab.Tab) -> EventM Name (Next State) handleEvent state event = case prompt state of Just pr -> handlePrompt event pr state _ -> handleMain event state -handlePrompt :: BrickEvent Name (ThreadEvent Tab) -> Prompt -> State -> EventM Name (Next State) +handlePrompt :: BrickEvent Name (ThreadEvent Tab.Tab) -> Prompt.Prompt -> State -> EventM Name (Next State) handlePrompt ev pr state = do - promptRes <- handlePromptEvent ev pr (eventChan state) + promptRes <- Prompt.handleEvent ev pr (eventChan state) case promptRes of Left pr -> updatePrompt pr state --updates the prompt and keeps it up - Right tab -> updateCurrentPane (updateTabZipper (replace tab)) state --updates with the resulting tab and closes the prompt + Right tab -> updateCurrentPane (Pane.replaceCurrentTab tab) state --updates with the resulting tab and closes the prompt -handleMain :: BrickEvent Name (ThreadEvent Tab) -> State -> EventM Name (Next State) +handleMain :: BrickEvent Name (ThreadEvent Tab.Tab) -> State -> EventM Name (Next State) handleMain (VtyEvent ev) = case ev of EvKey KEsc [] -> halt - EvKey KBS [] -> updateMenu MainMenu - EvKey (KChar 'l') [] -> updateMenu SelectionMenu - EvKey (KChar 'a') [] -> updateMenu TabMenu - EvKey (KChar 'p') [] -> updateMenu PaneMenu + EvKey KBS [] -> updateMenu Menu.Main + EvKey (KChar 'l') [] -> updateMenu Menu.Selection + EvKey (KChar 'a') [] -> updateMenu Menu.Tab + EvKey (KChar 'p') [] -> updateMenu Menu.Pane EvKey (KChar 'q') [] -> halt - EvKey (KChar 'x') [MCtrl] -> updateClipboard makeCutBoard - EvKey (KChar 'c') [MCtrl] -> updateClipboard makeCopyBoard - EvKey (KChar 'v') [MCtrl] -> openPromptWithClip makePastePrompt - EvKey (KChar 'r') [MCtrl] -> openPrompt makeRenamePrompt - EvKey (KChar 'd') [MCtrl] -> openPrompt makeDeletePrompt - EvKey (KChar 'o') [MCtrl] -> openTabDir True - EvKey (KChar 's') [MCtrl] -> openPrompt makeSearchPrompt - EvKey (KChar 's') [] -> openPrompt makeDisplayInfoPrompt - EvKey (KChar 'm') [] -> openPrompt makeMkdirPrompt - EvKey (KChar 't') [] -> openPrompt makeTouchPrompt - EvKey (KChar 'g') [] -> openPrompt makeGoToPrompt - EvKey KEnter [] -> openTabEntry + EvKey (KChar 'x') [MCtrl] -> updateClipboard Menu.makeCutBoard + EvKey (KChar 'c') [MCtrl] -> updateClipboard Menu.makeCopyBoard + EvKey (KChar 'v') [MCtrl] -> openPromptWithClip Prompt.paste + EvKey (KChar 'r') [MCtrl] -> openPrompt Prompt.rename + EvKey (KChar 'd') [MCtrl] -> openPrompt Prompt.delete + EvKey (KChar 'o') [MCtrl] -> openDirEntry True + EvKey (KChar 's') [MCtrl] -> openPrompt Prompt.search + EvKey (KChar 's') [] -> openPrompt Prompt.displayInfo + EvKey (KChar 'm') [] -> openPrompt Prompt.mkdir + EvKey (KChar 't') [] -> openPrompt Prompt.touch + EvKey (KChar 'g') [] -> openPrompt Prompt.goTo + EvKey KEnter [] -> openEntry EvKey (KChar 'e') [MCtrl] -> addPane EvKey (KChar 'k') [MCtrl] -> closePane EvKey KLeft [] -> previousPane EvKey KRight [] -> nextPane - _ -> updateCurrentPane (handlePaneEvent ev) + _ -> updateCurrentPane (Pane.handleEvent ev) handleMain (MouseUp name _ (Location pos)) = case name of - EntryList {pnName = pName} -> updateCurrentPane (moveTabToRow $ snd pos) . focusOnPane pName - Label {pnName = pName, labelNum = n} -> updateCurrentPane (updateTabZipper (moveToNth n)) . focusOnPane pName + EntryList {pnName = pName} -> clickedEntry pName (snd pos) + Label {pnName = pName, labelNum = n} -> updateCurrentPane (Pane.moveToNthTab n) . focusOnPane pName Button {keyBind = key, withCtrl = b} -> handleMain . VtyEvent $ EvKey key [MCtrl | b] _ -> continue handleMain _ = continue -- state-changing functions -updateCurrentPane :: (Pane -> EventM Name Pane) -> State -> EventM Name (Next State) +updateCurrentPane :: (Pane.Pane -> EventM Name Pane.Pane) -> State -> EventM Name (Next State) updateCurrentPane func state = do newPane <- func $ currentPane state continue $ state {paneZipper = replace newPane $ paneZipper state, prompt = Nothing} -updateMenu :: MenuType -> State -> EventM Name (Next State) -updateMenu tp st = continue $ st {bottomMenu = changeMenu tp $ bottomMenu st} +updateMenu :: Menu.MenuType -> State -> EventM Name (Next State) +updateMenu tp st = continue $ st {bottomMenu = Menu.change tp $ bottomMenu st} -updateClipboard :: (Entry -> Clipboard) -> State -> EventM Name (Next State) -updateClipboard f st = continue $ case selectedEntry . currentTab $ currentPane st of - (Just entry) -> st {bottomMenu = changeClipboard (f entry) $ bottomMenu st} +updateClipboard :: (Entry.Entry -> Menu.Clipboard) -> State -> EventM Name (Next State) +updateClipboard f st = continue $ case Pane.selectedEntry $ currentPane st of + (Just entry) -> st {bottomMenu = Menu.changeClipboard (f entry) $ bottomMenu st} _ -> st -updatePrompt :: Prompt -> State -> EventM Name (Next State) +updatePrompt :: Prompt.Prompt -> State -> EventM Name (Next State) updatePrompt pr st = continue $ st {prompt=Just pr} -openPrompt :: (Tab -> PaneName -> Prompt) -> State -> EventM Name (Next State) +openPrompt :: (Tab.Tab -> PaneName -> Prompt.Prompt) -> State -> EventM Name (Next State) openPrompt func state = continue $ state {prompt = Just $ func tab pName} where - tab = currentTab $ currentPane state - pName = paneName $ currentPane state + tab = Pane.currentTab $ currentPane state + pName = Pane.name $ currentPane state -openPromptWithClip :: (Clipboard -> Tab -> PaneName -> Prompt) -> State -> EventM Name (Next State) -openPromptWithClip func state = openPrompt (func . clipboard $ bottomMenu state) state +openPromptWithClip :: (Menu.Clipboard -> Tab.Tab -> PaneName -> Prompt.Prompt) -> State -> EventM Name (Next State) +openPromptWithClip func state = openPrompt (func . Menu.clipboard $ bottomMenu state) state -openTabEntry :: State -> EventM Name (Next State) -openTabEntry state = case selectedEntry . currentTab $ currentPane state of - Just DirEntry {} -> openTabDir False state - Just (FileEntry n p i) -> openTabFile (FileEntry n p i) state +clickedEntry :: PaneName -> Int -> State -> EventM Name (Next State) +clickedEntry pName row state = do + currTime <- liftIO $ getCurrentTime + let clicked = (pName, row, currTime) + doubleClick = isDoubleClick (lastClickedEntry state) clicked + if doubleClick then openEntry $ state {lastClickedEntry = Nothing} + else updateCurrentPane (Pane.moveTabToRow row) . focusOnPane pName $ state {lastClickedEntry = Just clicked} + +isDoubleClick :: Maybe (PaneName, Int, UTCTime) -> (PaneName, Int, UTCTime) -> Bool +isDoubleClick lastClick (nPane, nRow, nTime) = case lastClick of + Nothing -> False + Just (pPane, pRow, pTime) -> and [pPane == nPane, pRow == nRow, isSmallDiff] + where isSmallDiff = toRational (diffUTCTime nTime pTime) <= toRational 0.2 + +openEntry :: State -> EventM Name (Next State) +openEntry state = case Pane.selectedEntry $ currentPane state of + Just Entry.Dir {} -> openDirEntry False state + Just (Entry.File n p i) -> openFileEntry (Entry.File n p i) state _ -> continue state -openTabFile :: Entry -> State -> EventM Name (Next State) -openTabFile fileEntry - | isExecutable fileEntry = suspendAndResume . runExternal (entryPath fileEntry) - | isReadable fileEntry = suspendAndResume . runExternalEditor (entryPath fileEntry) +openFileEntry :: Entry.Entry -> State -> EventM Name (Next State) +openFileEntry fileEntry + | Entry.isExecutable fileEntry = suspendAndResume . runExternal (Entry.path fileEntry) + | Entry.isReadable fileEntry = suspendAndResume . runExternalEditor (Entry.path fileEntry) | otherwise = continue runExternalEditor :: FilePath -> State -> IO State @@ -144,14 +162,14 @@ getLine return s -openTabDir :: Bool -> State -> EventM Name (Next State) -openTabDir inNew = updateCurrentPane (openSelectedDir inNew) +openDirEntry :: Bool -> State -> EventM Name (Next State) +openDirEntry inNew = updateCurrentPane (Pane.openDirEntry inNew) addPane :: State -> EventM Name (Next State) addPane state = continue $ state {paneZipper = newZipper, lastPaneName = newName} where newName = 1 + lastPaneName state - newZipper = insert (makeEmptyPane newName) $ paneZipper state + newZipper = insert (Pane.empty newName) $ paneZipper state closePane :: State -> EventM Name (Next State) closePane state = continue $ case delete $ paneZipper state of @@ -165,10 +183,10 @@ previousPane state = continue $ state {paneZipper = previous $ paneZipper state} -- pane and paneZipper utility functions -currentPane :: State -> Pane +currentPane :: State -> Pane.Pane currentPane = _focus . paneZipper focusOnPane :: PaneName -> State -> State -focusOnPane pName state = case find (makeEmptyPane pName) $ paneZipper state of +focusOnPane pName state = case find (Pane.empty pName) $ paneZipper state of Just newZipper -> state {paneZipper = newZipper} _ -> state diff --git a/src/Widgets/Menu.hs b/src/Widgets/Menu.hs --- a/src/Widgets/Menu.hs +++ b/src/Widgets/Menu.hs @@ -1,7 +1,8 @@ module Widgets.Menu where -import Types -import Widgets.Pane -import Widgets.Tab +import Commons +import qualified Widgets.Pane as Pane +import qualified Widgets.Tab as Tab +import qualified Widgets.Entry as Entry import Data.Char (toUpper) import System.FilePath (takeFileName) @@ -11,33 +12,33 @@ import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl)) data Menu = Menu {clipboard :: Clipboard, menuType :: MenuType} -data MenuType = MainMenu | SelectionMenu | TabMenu | PaneMenu -data Clipboard = CopyBoard {fromEntry :: Entry} | CutBoard {fromEntry :: Entry} | EmptyBoard +data MenuType = Main | Selection | Tab | Pane +data Clipboard = CopyBoard {fromEntry :: Entry.Entry} | CutBoard {fromEntry :: Entry.Entry} | EmptyBoard instance Show Clipboard where show EmptyBoard = " -empty- " - show board = takeFileName . entryPath $ fromEntry board + show board = takeFileName . Entry.path $ fromEntry board -- creation functions -makeMenu :: Menu -makeMenu = Menu {clipboard = EmptyBoard, menuType = MainMenu} +make :: Menu +make = Menu {clipboard = EmptyBoard, menuType = Main} -makeCopyBoard :: Entry -> Clipboard +makeCopyBoard :: Entry.Entry -> Clipboard makeCopyBoard = CopyBoard -makeCutBoard :: Entry -> Clipboard +makeCutBoard :: Entry.Entry -> Clipboard makeCutBoard = CutBoard -- rendering functions -renderMenu :: Menu -> Pane -> Widget Name -renderMenu m = hBox . (renderClipboard (clipboard m) :) . renderButtons (menuType m) +render :: Menu -> Pane.Pane -> Widget Name +render m = hBox . (renderClipboard (clipboard m) :) . renderButtons (menuType m) -renderButtons :: MenuType -> Pane -> [Widget Name] +renderButtons :: MenuType -> Pane.Pane -> [Widget Name] renderButtons tp pane = map renderButton $ case tp of - MainMenu -> mainButtons - SelectionMenu -> (backButton :) . selectionButtons . selectedEntry $ currentTab pane - TabMenu -> (backButton :) . tabButtons $ currentTab pane - PaneMenu -> backButton : paneButtons + Main -> mainButtons + Selection -> (backButton :) . selectionButtons $ Pane.selectedEntry pane + Tab -> (backButton :) . tabButtons $ Pane.currentTab pane + Pane -> backButton : paneButtons renderButton :: (Widget Name, Maybe String, Name) -> Widget Name renderButton (bContent, bLabel, bName) = clickable bName $ case bLabel of @@ -52,10 +53,10 @@ (keybindStr "q" <+> str "uit", Nothing, Button {keyBind = KChar 'q', withCtrl = False}) ] -selectionButtons :: Maybe Entry -> [(Widget Name, Maybe String, Name)] +selectionButtons :: Maybe Entry.Entry -> [(Widget Name, Maybe String, Name)] selectionButtons e = case e of - Just FileEntry {} -> anySelectionButtons - Just DirEntry {} -> anySelectionButtons ++ [(keybindStr "o" <+> str "pen in new tab", ctrlText 'o', Button {keyBind = KChar 'o', withCtrl = True})] + Just Entry.File {} -> anySelectionButtons + Just Entry.Dir {} -> anySelectionButtons ++ [(keybindStr "o" <+> str "pen in new tab", ctrlText 'o', Button {keyBind = KChar 'o', withCtrl = True})] _ -> [] anySelectionButtons :: [(Widget Name, Maybe String, Name)] @@ -67,10 +68,10 @@ (keybindStr "s" <+> str "how info", Nothing, Button {keyBind = KChar 's', withCtrl = False}) ] -tabButtons :: Tab -> [(Widget Name, Maybe String, Name)] +tabButtons :: Tab.Tab -> [(Widget Name, Maybe String, Name)] tabButtons tab = case tab of - DirTab {entryOrder = order} -> dirTabButtons ++ entryTabButtons order ++ anyTabButtons - SearchTab {entryOrder = order} -> entryTabButtons order ++ anyTabButtons + Tab.Dir {Tab.entryOrder = order} -> dirTabButtons ++ entryTabButtons order ++ anyTabButtons + Tab.Search {Tab.entryOrder = order} -> entryTabButtons order ++ anyTabButtons _ -> anyTabButtons dirTabButtons :: [(Widget Name, Maybe String, Name)] @@ -81,10 +82,10 @@ (keybindStr "t" <+> str "ouch file", Nothing, Button {keyBind = KChar 't', withCtrl = False}) ] -entryTabButtons :: EntryOrder -> [(Widget Name, Maybe String, Name)] +entryTabButtons :: Tab.EntryOrder -> [(Widget Name, Maybe String, Name)] entryTabButtons order = [ (keybindStr "r" <+> str "efresh", Nothing, Button {keyBind = KChar 'r', withCtrl = False}), - (keybindStr "o" <+> str ("rder by " ++ (show . nextOrderType $ orderType order)), Nothing, Button {keyBind = KChar 'o', withCtrl = False}), + (keybindStr "o" <+> str ("rder by " ++ (show . Tab.nextOrderType $ Tab.orderType order)), Nothing, Button {keyBind = KChar 'o', withCtrl = False}), (keybindStr "i" <+> str "nvert order", Nothing, Button {keyBind = KChar 'i', withCtrl = False}) ] @@ -111,8 +112,8 @@ renderClipboard = hLimit 24 . borderWithLabel (str "clipboard") . str . show -- state changing functions -changeMenu :: MenuType -> Menu -> Menu -changeMenu tp menu = menu {menuType = tp} +change :: MenuType -> Menu -> Menu +change tp menu = menu {menuType = tp} changeClipboard :: Clipboard -> Menu -> Menu changeClipboard cb menu = menu {clipboard = cb} diff --git a/src/Widgets/Pane.hs b/src/Widgets/Pane.hs --- a/src/Widgets/Pane.hs +++ b/src/Widgets/Pane.hs @@ -1,6 +1,7 @@ module Widgets.Pane where -import Types -import Widgets.Tab +import Commons +import qualified Widgets.Tab as Tab +import qualified Widgets.Entry as Entry import Control.Monad.IO.Class (liftIO) import Brick.Widgets.Core (hBox, vBox, vLimit, viewport, clickable) @@ -10,45 +11,44 @@ import Data.List.PointedList (PointedList, _focus, replace, delete, singleton, insert, insertLeft, moveTo, withFocus, atStart, atEnd) import Data.List.PointedList.Circular (next, previous) -data Pane = Pane {paneName :: PaneName, tabZipper :: TabZipper} -type TabZipper = PointedList Tab +data Pane = Pane {name :: PaneName, tabZipper :: TabZipper} +type TabZipper = PointedList Tab.Tab instance Eq Pane where - Pane {paneName = p1} == Pane {paneName = p2} = p1 == p2 + Pane {name = p1} == Pane {name = p2} = p1 == p2 -- creation functions -makePane :: PaneName -> FilePath -> IO Pane -makePane pName path = Pane pName . singleton <$> makeDirTab pName path +empty :: PaneName -> Pane +empty pName = Pane pName . singleton $ Tab.empty -makeEmptyPane :: PaneName -> Pane -makeEmptyPane pName = Pane pName . singleton $ makeEmptyTab +make :: PaneName -> FilePath -> IO Pane +make pName path = Pane pName . singleton <$> Tab.makeDirTab pName path -- rendering functions -renderPane :: (Pane, Bool) -> Widget Name -renderPane (pane, hasFocus) = vBox [labels, topSep, content] - where - pName = paneName pane - labels = vLimit 2 . viewport LabelsRow {pnName = pName} Horizontal . renderLabels pName $ tabZipper pane - topSep = renderPathSeparator $ currentTab pane - content = clickable EntryList {pnName = pName} . renderContent hasFocus $ currentTab pane +render :: (Pane, Bool) -> Widget Name +render (pane, hasFocus) = let pName = name pane in vBox [ + vLimit 2 . viewport LabelsRow {pnName = pName} Horizontal . renderLabels pName $ tabZipper pane, + Tab.renderSeparator $ currentTab pane, + clickable EntryList {pnName = pName} . Tab.renderContent hasFocus $ currentTab pane + ] renderLabels :: PaneName -> TabZipper -> Widget Name renderLabels pName zipper = hBox . map (clickableLabel pName) $ zip labels [0..] - where labels = map renderLabel . toList $ withFocus zipper + where labels = map Tab.renderLabel . toList $ withFocus zipper clickableLabel :: PaneName -> (Widget Name, Int) -> Widget Name clickableLabel pName (l, n) = clickable Label {pnName = pName, labelNum = n} l -- event handling functions -handlePaneEvent :: Event -> Pane -> EventM Name Pane -handlePaneEvent event = case event of +handleEvent :: Event -> Pane -> EventM Name Pane +handleEvent event = case event of EvKey (KChar 'k') [] -> updateTabZipper removeTab - EvKey (KChar 'e') [] -> updateTabZipper (insert makeEmptyTab) + EvKey (KChar 'e') [] -> updateTabZipper (insert Tab.empty) EvKey (KChar 'r') [] -> reloadCurrentTab EvKey (KChar '\t') [] -> updateTabZipper next EvKey KBackTab [] -> updateTabZipper previous - EvKey KLeft [MCtrl] -> updateTabZipper swapWithPrevious - EvKey KRight [MCtrl] -> updateTabZipper swapWithNext + EvKey KLeft [MCtrl] -> updateTabZipper swapPrev + EvKey KRight [MCtrl] -> updateTabZipper swapNext _ -> updateCurrentTab event -- state-changing functions @@ -57,51 +57,56 @@ reloadCurrentTab :: Pane -> EventM Name Pane reloadCurrentTab pane = do - reloaded <- liftIO . reload (paneName pane) $ currentTab pane + reloaded <- liftIO . Tab.reload (name pane) $ currentTab pane updateTabZipper (replace reloaded) pane updateCurrentTab :: Event -> Pane -> EventM Name Pane updateCurrentTab event pane = do - updated <- handleTabEvent event $ currentTab pane + updated <- Tab.handleEvent event $ currentTab pane updateTabZipper (replace updated) pane -openSelectedDir :: Bool -> Pane -> EventM Name Pane -openSelectedDir inNew pane = case selectedEntry $ currentTab pane of - Just DirEntry {entryPath = path} -> do - loaded <- liftIO $ makeDirTab (paneName pane) path - let modify = if inNew then insertFixed else replace - updateTabZipper (modify loaded) pane +openDirEntry :: Bool -> Pane -> EventM Name Pane +openDirEntry inNew pane = case selectedEntry pane of + Just Entry.Dir {Entry.path = path} -> do + loaded <- liftIO $ Tab.makeDirTab (name pane) path + updateTabZipper (if inNew then previous . insert loaded else replace loaded) pane _ -> return pane +replaceCurrentTab :: Tab.Tab -> Pane -> EventM Name Pane +replaceCurrentTab tab = updateTabZipper (replace tab) + +moveToNthTab :: Int -> Pane -> EventM Name Pane +moveToNthTab n = updateTabZipper (moveToNth n) + -- tab and tabZipper utility functions +selectedEntry :: Pane -> Maybe Entry.Entry +selectedEntry = Tab.selectedEntry . currentTab + moveTabToRow :: Int -> Pane -> EventM Name Pane -moveTabToRow row pane = updateTabZipper (replace (moveToRow row $ currentTab pane)) pane +moveTabToRow row pane = updateTabZipper (replace (Tab.moveToRow row $ currentTab pane)) pane -currentTab :: Pane -> Tab +currentTab :: Pane -> Tab.Tab currentTab = _focus . tabZipper removeTab :: TabZipper -> TabZipper removeTab zipper = case delete zipper of Just newZipper -> newZipper - _ -> singleton makeEmptyTab + _ -> singleton Tab.empty moveToNth :: Int -> TabZipper -> TabZipper moveToNth n zipper = case moveTo n zipper of Just newZipper -> newZipper _ -> zipper -insertFixed :: Tab -> TabZipper -> TabZipper -insertFixed tab = previous . insert tab - -swapWithPrevious :: TabZipper -> TabZipper -swapWithPrevious zipper +swapPrev :: TabZipper -> TabZipper +swapPrev zipper | atStart zipper && atEnd zipper = zipper | atStart zipper = insert (_focus zipper) . previous $ removeTab zipper | atEnd zipper = insertLeft (_focus zipper) $ removeTab zipper | otherwise = insertLeft (_focus zipper) . previous $ removeTab zipper -swapWithNext :: TabZipper -> TabZipper -swapWithNext zipper +swapNext :: TabZipper -> TabZipper +swapNext zipper | atStart zipper && atEnd zipper = zipper | atEnd zipper = insertLeft (_focus zipper) . next $ removeTab zipper | otherwise = insert (_focus zipper) $ removeTab zipper diff --git a/src/Widgets/Prompt.hs b/src/Widgets/Prompt.hs --- a/src/Widgets/Prompt.hs +++ b/src/Widgets/Prompt.hs @@ -1,7 +1,8 @@ module Widgets.Prompt where -import Types -import Widgets.Tab -import Widgets.Menu +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 (($>)) @@ -15,23 +16,23 @@ 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 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, renameFile, removeFile, removeDirectoryRecursive, getDirectoryContents, + copyFileWithMetadata, 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 | +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 PromptAction where +instance Show Action where show (Copy _ _) = " Copy " show (Cut _ _) = " Cut " show (Rename _ _) = " Rename " @@ -45,55 +46,55 @@ show _ = " Error " -- creation functions -emptyPathEditor :: PathEditor -emptyPathEditor = makePathEditor [] +emptyEditor :: Editor +emptyEditor = makeEditor [] -makePathEditor :: FilePath -> PathEditor -makePathEditor = editor PromptEditor (Just 1) +makeEditor :: FilePath -> Editor +makeEditor = Edit.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 +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 -makeGoToPrompt :: Tab -> PaneName -> Prompt -makeGoToPrompt tab pName = Prompt tab pName $ GoTo emptyPathEditor +goTo :: Tab.Tab -> PaneName -> Prompt +goTo tab pName = Prompt tab pName $ GoTo emptyEditor -makeRenamePrompt :: Tab -> PaneName -> Prompt -makeRenamePrompt = withSelectedEntry (\en -> Rename (editorFromEntry en) en) - where editorFromEntry = makePathEditor . takeFileName . entryPath +rename :: Tab.Tab -> PaneName -> Prompt +rename = withSelectedEntry (\en -> Rename (editorFromEntry en) en) + where editorFromEntry = makeEditor . takeFileName . Entry.path -makeDeletePrompt :: Tab -> PaneName -> Prompt -makeDeletePrompt = withSelectedEntry Delete +delete :: Tab.Tab -> PaneName -> Prompt +delete = withSelectedEntry Delete -makeMkdirPrompt :: Tab -> PaneName -> Prompt -makeMkdirPrompt = withDirTabPath (Mkdir emptyPathEditor) +mkdir :: Tab.Tab -> PaneName -> Prompt +mkdir = withDirTabPath (Mkdir emptyEditor) -makeTouchPrompt :: Tab -> PaneName -> Prompt -makeTouchPrompt = withDirTabPath (Touch emptyPathEditor) +touch :: Tab.Tab -> PaneName -> Prompt +touch = withDirTabPath (Touch emptyEditor) -makeDisplayInfoPrompt :: Tab -> PaneName -> Prompt -makeDisplayInfoPrompt = withSelectedEntry (DisplayInfo . entryInfo) +displayInfo :: Tab.Tab -> PaneName -> Prompt +displayInfo = withSelectedEntry (DisplayInfo . Entry.info) -makeSearchPrompt :: Tab -> PaneName -> Prompt -makeSearchPrompt = withDirTabPath (Search emptyPathEditor) +search :: Tab.Tab -> PaneName -> Prompt +search = withDirTabPath (Search emptyEditor) -withSelectedEntry :: (Entry -> PromptAction) -> Tab -> PaneName -> Prompt -withSelectedEntry func tab pName = Prompt tab pName $ case selectedEntry tab of +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 -> PromptAction) -> Tab -> PaneName -> Prompt +withDirTabPath :: (FilePath -> Action) -> Tab.Tab -> PaneName -> Prompt withDirTabPath func tab pName = Prompt tab pName $ case tab of - DirTab {tabPath = path} -> func path + Tab.Dir {Tab.path = 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] +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 @@ -101,8 +102,8 @@ 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] + 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 @@ -113,11 +114,11 @@ 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 ++ ")" +displaySize :: Entry.Info -> String +displaySize info = "Size: " ++ show (Entry.size info) ++ " Bytes (" ++ Entry.shortSize info ++ ")" -displayPerms :: EntryInfo -> [String] -displayPerms info = case entryPerms info of +displayPerms :: Entry.Info -> [String] +displayPerms info = case Entry.perms info of Nothing -> [" ", "Permissions unknown", "(could not read them)"] Just p -> [ " ", @@ -127,30 +128,30 @@ "Is searchable: " <> (if searchable p then "yes" else "no") ] -displayTimes :: EntryInfo -> [String] -displayTimes info = case entryTimes info of +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 -> String +tellEntry :: Entry.Entry -> String tellEntry e = case e of - DirEntry {entryName = name} -> "The directory " <> name <> " (and all it's content)" - FileEntry {entryName = name} -> "The file " <> name + 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 :: PathEditor -> [Widget Name] -renderValidatedEditor e = [renderEditor (str . unlines) True e, validLine] +renderValidatedEditor :: Editor -> [Widget Name] +renderValidatedEditor e = [Edit.renderEditor (str . unlines) True e, validLine] where - validLine = if isValid $ getEditLine e + validLine = if isValid $ editorLine e then str " " else withDefAttr errorAttr $ str " ^ invalid filepath!" -renderFooter :: PromptAction -> Widget Name +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" @@ -168,24 +169,24 @@ _ -> " 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 +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 -handlePromptEvent (VtyEvent ev) pr eChan = case ev of - EvKey KEsc [] -> liftIO $ exitPrompt 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) <$> handleActionEditor ev (action pr) -handlePromptEvent _ pr _ = return $ Left pr + _ -> Left . Prompt (originTab pr) (originPane pr) <$> handleEditor ev (action pr) +handleEvent _ pr _ = return $ Left pr -exitPrompt :: Prompt -> IO (Either Prompt Tab) -exitPrompt pr = case action pr of +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) -> IO (Either Prompt Tab) -- +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 @@ -193,66 +194,66 @@ Delete _ -> Left <$> processThreaded pr eChan Search _ _ -> Left <$> processThreaded pr eChan Performing _ _ -> return $ Left pr -- doesn't really make sense - _ -> tryProcessAction pr + _ -> processSafe pr -processThreaded :: Prompt -> BChan (ThreadEvent Tab) -> IO Prompt +processThreaded :: Prompt -> BChan (ThreadEvent Tab.Tab) -> IO Prompt processThreaded pr eChan = do - tId <- forkFinally (processAction pr) (reportResult eChan) + tId <- forkFinally (processUnsafe pr) (reportResult eChan) return $ pr {action = Performing (show $ action pr) tId} -reportResult :: BChan (ThreadEvent Tab) -> Either SomeException Tab -> IO () +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 +endingEvent :: SomeException -> ThreadEvent Tab.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) +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 -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 +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 +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 makeDirTab pName path + else Tab.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 +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 -getEditLine :: PathEditor -> String -getEditLine = head . getEditContents +editorLine :: Editor -> String +editorLine = head . Edit.getEditContents -- files functions not covered by System.Directory nor System.FilePath moveFileWithMetadata :: FilePath -> FilePath -> IO () diff --git a/src/Widgets/Tab.hs b/src/Widgets/Tab.hs --- a/src/Widgets/Tab.hs +++ b/src/Widgets/Tab.hs @@ -1,49 +1,34 @@ module Widgets.Tab where -import Types +import Commons +import qualified Widgets.Entry as Entry import Data.List (sortOn, isInfixOf, elemIndex) import Data.Char (toLower) import Data.Maybe (fromMaybe) import Data.Time.Clock (UTCTime(..), secondsToDiffTime) import Data.Time.Calendar (Day(ModifiedJulianDay)) -import Data.Time.Format (formatTime, defaultTimeLocale) -import Control.Exception (try, SomeException) import System.FilePath (takeFileName, takeDirectory, ()) -import System.Directory (Permissions, getPermissions, readable, writable, executable, searchable, - getAccessTime, getModificationTime, doesDirectoryExist, doesFileExist, getFileSize, listDirectory) +import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import Brick.Types (Widget, EventM) -import Brick.Widgets.Core (hLimit, vLimit, hBox, vBox, (<+>), str, strWrap, fill, withBorderStyle, visible) +import Brick.Widgets.Core (hLimit, hBox, vBox, (<+>), str, strWrap, fill, withBorderStyle, visible) import Brick.Widgets.List (List, list, renderList, handleListEvent, listMoveTo, - listSelectedElement, listInsert, listRemove, listReverse, listReplace, listElements) + listSelectedElement, listReplace, listElements) import Brick.Widgets.Border (hBorder, vBorder, borderElem, border) import Brick.Widgets.Border.Style (unicodeRounded, unicodeBold, bsHorizontal, bsCornerTL, bsCornerTR) import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl)) import Data.Foldable (toList) import qualified Data.Vector as Vect -import Data.ByteUnits (ByteValue(..), ByteUnit(Bytes), getShortHand, getAppropriateUnits) -data Tab = DirTab {tabName :: String, tabPath :: FilePath, entryList :: List Name Entry, entryOrder :: EntryOrder} | - SearchTab {tabName :: String, tabPath :: FilePath, tabQuery :: String, entryList :: List Name Entry, entryOrder :: EntryOrder} | - EmptyTab -data Entry = DirEntry {entryName :: String, entryPath :: FilePath, entryInfo :: EntryInfo} | - FileEntry {entryName :: String, entryPath :: FilePath, entryInfo :: EntryInfo} -data EntryInfo = EntryInfo {entrySize :: Integer, entryPerms :: Maybe Permissions, entryTimes :: Maybe (UTCTime, UTCTime)} deriving Show +data Tab = Dir {name :: String, path :: FilePath, entryList :: List Name Entry.Entry, entryOrder :: EntryOrder} | + Search {name :: String, path :: FilePath, query :: String, entryList :: List Name Entry.Entry, entryOrder :: EntryOrder} | + Empty data EntryOrder = EntryOrder {orderType :: OrderType, inverted :: Bool} data OrderType = FileName | FileSize | AccessTime | ModificationTime deriving (Eq, Enum, Bounded) instance Show Tab where - show EmptyTab = "\x276f -new tab-" - show DirTab {tabName = name} = "\x2636 " ++ name - show SearchTab {tabName = name} = "\x26B2 " ++ name - -instance Show Entry where - show DirEntry {entryName = n} = "+ " ++ n - show FileEntry {entryName = n} = "- " ++ n - -instance Eq Entry where - DirEntry {entryPath = p1} == DirEntry {entryPath = p2} = p1 == p2 - FileEntry {entryPath = p1} == FileEntry {entryPath = p2} = p1 == p2 - _ == _ = False + show Empty = "\x276f -new tab-" + show Dir {name = n} = "\x2636 " ++ n + show Search {name = n} = "\x26B2 " ++ n instance Show EntryOrder where show order = show (orderType order) ++ (if inverted order then " \x2193 " else " \x2191 ") @@ -55,63 +40,43 @@ show ModificationTime = "modified" -- creation functions -makeEmptyTab :: Tab -makeEmptyTab = EmptyTab +empty :: Tab +empty = Empty makeDirTab :: PaneName -> FilePath -> IO Tab -makeDirTab pName path = do - isFile <- doesFileExist path - isDir <- doesDirectoryExist path +makeDirTab pName filePath = do + isFile <- doesFileExist filePath + isDir <- doesDirectoryExist filePath if isDir && not isFile then do - let fName = takeFileName path + let fName = takeFileName filePath order = EntryOrder FileName False - entryLst <- makeDirEntryList pName order path - return $ DirTab (if null fName then "-root-" else fName) path entryLst order - else return makeEmptyTab + entryLst <- makeDirEntryList pName order filePath + return $ Dir (if null fName then "-root-" else fName) filePath entryLst order + else return empty -makeDirEntryList :: PaneName -> EntryOrder -> FilePath -> IO (List Name Entry) +makeDirEntryList :: PaneName -> EntryOrder -> FilePath -> IO (List Name Entry.Entry) makeDirEntryList pName order dir = do sub <- listDirectory dir - entries <- mapM (makeEntry . (dir )) sub - let upPath = takeDirectory dir - upDir <- DirEntry ".." upPath <$> makeEntryInfo upPath - return $ list EntryList {pnName = pName} (Vect.fromList . (upDir :) $ sortEntries order entries) 1 + entries <- mapM (Entry.make . (dir )) sub + upDir <- Entry.make $ takeDirectory dir + return $ list EntryList {pnName = pName} (Vect.fromList . (upDir {Entry.name = ".."} :) $ sortEntries order entries) 1 makeSearchTab :: PaneName -> FilePath -> String -> IO Tab -makeSearchTab pName path query = do - isFile <- doesFileExist path - isDir <- doesDirectoryExist path +makeSearchTab pName filePath searchQuery = do + isFile <- doesFileExist filePath + isDir <- doesDirectoryExist filePath if isDir && not isFile then do let order = EntryOrder FileName False - entryLst <- makeSearchEntryList pName order path query - return $ SearchTab query path query entryLst order - else return makeEmptyTab - -makeSearchEntryList :: PaneName -> EntryOrder -> FilePath -> String -> IO (List Name Entry) -makeSearchEntryList pName order dir query = do - searchResult <- searchRecursive dir query - entries <- mapM makeEntry searchResult - searchDir <- DirEntry "." dir <$> makeEntryInfo dir - return $ list EntryList {pnName = pName} (Vect.fromList . (searchDir :) $ sortEntries order entries) 1 - -makeEntry :: FilePath -> IO Entry -makeEntry path = do - isFile <- doesFileExist path - if isFile then FileEntry (takeFileName path) path <$> makeEntryInfo path - else DirEntry (takeFileName path) path <$> makeEntryInfo path - -makeEntryInfo :: FilePath -> IO EntryInfo -makeEntryInfo path = do - size <- getFileSize path - perms <- toMaybe <$> try (getPermissions path) - times <- toMaybe <$> try (getEntryTimes path) - return $ EntryInfo size perms times + entryLst <- makeSearchEntryList pName order filePath searchQuery + return $ Search searchQuery filePath searchQuery entryLst order + else return empty -getEntryTimes :: FilePath -> IO (UTCTime, UTCTime) -getEntryTimes path = do - accessTime <- getAccessTime path - modifTime <- getModificationTime path - return (accessTime, modifTime) +makeSearchEntryList :: PaneName -> EntryOrder -> FilePath -> String -> IO (List Name Entry.Entry) +makeSearchEntryList pName order dir searchQuery = do + searchResult <- searchRecursive dir searchQuery + entries <- mapM Entry.make searchResult + searchDir <- Entry.make dir + return $ list EntryList {pnName = pName} (Vect.fromList . (searchDir {Entry.name = "."} :) $ sortEntries order entries) 1 -- rendering functions renderLabel :: (Tab, Bool) -> Widget Name @@ -124,27 +89,28 @@ top = hBox [borderElem bsCornerTL, hBorder, borderElem bsCornerTR] middle = hBox [vBorder, str $ take wdt txt, fill ' ', vBorder] -renderPathSeparator :: Tab -> Widget Name -renderPathSeparator t = hBox [ - borderElem bsHorizontal, - renderPath t, - hBorder, - renderEntryOrder t, - borderElem bsHorizontal] +renderSeparator :: Tab -> Widget Name +renderSeparator t = hBox [ + borderElem bsHorizontal, + renderPath t, + hBorder, + renderEntryOrder t, + borderElem bsHorizontal + ] renderEntryOrder :: Tab -> Widget Name renderEntryOrder tab = str $ case tab of - EmptyTab -> "" + Empty -> "" _ -> " by " ++ show (entryOrder tab) renderPath :: Tab -> Widget Name renderPath tab = str $ case tab of - EmptyTab -> " " - DirTab {tabPath = path} -> " " ++ path ++ " " - SearchTab {tabPath = p, tabQuery = q} -> " search for " ++ q ++ " in " ++ takeFileName p + Empty -> " " + Dir {path = p} -> " " ++ p ++ " " + Search {path = p, query = q} -> " search for " ++ q ++ " in " ++ takeFileName p renderContent :: Bool -> Tab -> Widget Name -renderContent _ EmptyTab = vBox (lns ++ [fill ' ']) +renderContent _ Empty = vBox (lns ++ [fill ' ']) where lns = map strWrap $ lines "Command Line Interface File Manager\n \n\ \clifm allows you to explore directories on multiple tabs.\nIf your terminal\ \ has mouse support you can click on some elements to interact with them, \ @@ -155,36 +121,12 @@ \BackTab key or use Ctrl + Left or Right arrow key to swap them.\n \nYou can \ \see every other possible action as a button in the bottom, or you can use \ \them as Keys combination.\n \nTo see them all please refer to the README" -renderContent hasFocus tab = renderList renderEntry hasFocus $ entryList tab - -renderEntry :: Bool -> Entry -> Widget Name -renderEntry _ en = let info = entryInfo en in vLimit 1 $ hBox [ - str $ show en, - fill ' ', - str $ shortEntrySize info, - renderEntryPerms $ entryPerms info, - renderEntryTime (entryTimes info) False - ] - -renderEntryPerms :: Maybe Permissions -> Widget Name -renderEntryPerms Nothing = str " ----" -renderEntryPerms (Just p) = str [ - ' ', - if readable p then 'r' else '-', - if writable p then 'w' else '-', - if executable p then 'x' else '-', - if searchable p then 's' else '-' - ] - -renderEntryTime :: Maybe (UTCTime, UTCTime) -> Bool -> Widget Name -renderEntryTime Nothing _ = str " -----------------" -renderEntryTime (Just tms) sel = str . format $ (if sel then fst else snd) tms - where format = formatTime defaultTimeLocale " %R %b %e %Y" +renderContent hasFocus tab = renderList Entry.render hasFocus $ entryList tab -- event handling and state-changing functions -handleTabEvent :: Event -> Tab -> EventM Name Tab -handleTabEvent _ EmptyTab = return EmptyTab -handleTabEvent event tab = case event of +handleEvent :: Event -> Tab -> EventM Name Tab +handleEvent _ Empty = return Empty +handleEvent event tab = case event of EvKey (KChar 'o') [] -> return $ changeOrder tab EvKey (KChar 'i') [] -> return $ invertOrder tab _ -> do @@ -192,7 +134,7 @@ return $ tab {entryList = newList} changeOrder :: Tab -> Tab -changeOrder EmptyTab = EmptyTab +changeOrder Empty = Empty changeOrder tab = tab {entryOrder = newOrder, entryList = newEntryList} where order = entryOrder tab @@ -205,7 +147,7 @@ newEntryList = listReplace (Vect.fromList sorted) newIndex eLst invertOrder :: Tab -> Tab -invertOrder EmptyTab = EmptyTab +invertOrder Empty = Empty invertOrder tab = tab {entryOrder = newOrder, entryList = newEntryList} where order = entryOrder tab @@ -219,11 +161,11 @@ reload :: PaneName -> Tab -> IO Tab reload pName tab = case tab of - EmptyTab -> return EmptyTab - DirTab {tabPath=p, entryOrder=o} -> keepSelection tab <$> makeDirEntryList pName o p - SearchTab {tabPath=p, entryOrder=o, tabQuery=q} -> keepSelection tab <$> makeSearchEntryList pName o p q + Empty -> return Empty + Dir {path=p, entryOrder=o} -> keepSelection tab <$> makeDirEntryList pName o p + Search {path=p, entryOrder=o, query=q} -> keepSelection tab <$> makeSearchEntryList pName o p q -keepSelection :: Tab -> List Name Entry -> Tab +keepSelection :: Tab -> List Name Entry.Entry -> Tab keepSelection tab newList = tab {entryList = listMoveTo index newList} where fstDir = Vect.head . listElements $ entryList tab @@ -231,68 +173,50 @@ index = fromMaybe 0 . Vect.elemIndex selected $ listElements newList moveToRow :: Int -> Tab -> Tab -moveToRow _ EmptyTab = EmptyTab +moveToRow _ Empty = Empty moveToRow row tab = tab {entryList = listMoveTo row $ entryList tab} -- utility functions -selectedEntry :: Tab -> Maybe Entry -selectedEntry EmptyTab = Nothing +selectedEntry :: Tab -> Maybe Entry.Entry +selectedEntry Empty = Nothing selectedEntry tab = case listSelectedElement $ entryList tab of Just (_, entry) -> Just entry _ -> Nothing -selectedIndex :: List Name Entry -> Int +selectedIndex :: List Name Entry.Entry -> Int selectedIndex entries = case listSelectedElement entries of Just (n, _) -> n _ -> 0 -toMaybe :: Either SomeException b -> Maybe b -toMaybe = either (const Nothing) Just - -isExecutable :: Entry -> Bool -isExecutable = hasPermission executable - -isReadable :: Entry -> Bool -isReadable = hasPermission readable - -hasPermission :: (Permissions -> Bool) -> Entry -> Bool -hasPermission prop en = case entryPerms $ entryInfo en of - Just perms -> prop perms - _ -> False - nextOrderType :: OrderType -> OrderType nextOrderType order - | order == (maxBound :: OrderType) = minBound + | order == maxBound = minBound | otherwise = succ order -sortEntries :: EntryOrder -> [Entry] -> [Entry] +sortEntries :: EntryOrder -> [Entry.Entry] -> [Entry.Entry] sortEntries order = (if inverted order then reverse else id) . case orderType order of - FileName -> sortOn (map toLower . entryName) - FileSize -> sortOn (entrySize . entryInfo) - AccessTime -> sortOn (fst . fromMaybe (zeroTime, zeroTime) . entryTimes . entryInfo) - ModificationTime -> sortOn (snd . fromMaybe (zeroTime, zeroTime) . entryTimes . entryInfo) + FileName -> sortOn (map toLower . Entry.name) + FileSize -> sortOn (Entry.size . Entry.info) + AccessTime -> sortOn (fst . fromMaybe (zeroTime, zeroTime) . Entry.times . Entry.info) + ModificationTime -> sortOn (snd . fromMaybe (zeroTime, zeroTime) . Entry.times . Entry.info) zeroTime :: UTCTime zeroTime = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) searchRecursive :: FilePath -> String -> IO [FilePath] -searchRecursive path query = do - subNames <- listDirectory path - paths <- listRecursive $ map (path ) subNames - return $ filter (isInfixOf query . takeFileName) paths +searchRecursive filePath searchQuery = do + subNames <- listDirectory filePath + filePaths <- listRecursive $ map (filePath ) subNames + return $ filter (isInfixOf searchQuery . takeFileName) filePaths listRecursive :: [FilePath] -> IO [FilePath] listRecursive [] = return [] -listRecursive (path:paths) = do - isDir <- doesDirectoryExist path - isFile <- doesFileExist path - if isFile then (path :) <$> listRecursive paths +listRecursive (filePath:filePaths) = do + isDir <- doesDirectoryExist filePath + isFile <- doesFileExist filePath + if isFile then (filePath :) <$> listRecursive filePaths else if isDir then do - subNames <- listDirectory path - let subPaths = map (path ) subNames - (path :) <$> listRecursive (subPaths ++ paths) - else listRecursive paths - -shortEntrySize :: EntryInfo -> String -shortEntrySize info = getShortHand . getAppropriateUnits $ ByteValue size Bytes - where size = fromInteger $ entrySize info + subNames <- listDirectory filePath + let subPaths = map (filePath ) subNames + (filePath :) <$> listRecursive (subPaths ++ filePaths) + else listRecursive filePaths