clifm 0.3.1.0 → 0.4.1.0
raw patch · 11 files changed
+492/−450 lines, 11 files
Files
- README.md +3/−1
- clifm.cabal +3/−2
- src/Commons.hs +48/−0
- src/Main.hs +8/−7
- src/Types.hs +0/−48
- src/Widgets/Entry.hs +89/−0
- src/Widgets/Manager.hs +86/−68
- src/Widgets/Menu.hs +28/−27
- src/Widgets/Pane.hs +45/−40
- src/Widgets/Prompt.hs +101/−100
- src/Widgets/Tab.hs +81/−157
README.md view
@@ -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
clifm.cabal view
@@ -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
+ src/Commons.hs view
@@ -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
src/Main.hs view
@@ -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 }
− src/Types.hs
@@ -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
+ src/Widgets/Entry.hs view
@@ -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
src/Widgets/Manager.hs view
@@ -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
src/Widgets/Menu.hs view
@@ -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}
src/Widgets/Pane.hs view
@@ -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
src/Widgets/Prompt.hs view
@@ -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 ()
src/Widgets/Tab.hs view
@@ -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 -> " <empty tab> "- DirTab {tabPath = path} -> " " ++ path ++ " "- SearchTab {tabPath = p, tabQuery = q} -> " search for " ++ q ++ " in " ++ takeFileName p+ Empty -> " <empty tab> "+ 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