clifm 0.4.1.0 → 0.5.0.0
raw patch · 10 files changed
+612/−348 lines, 10 filesdep +conduitdep +containersdep +lensdep ~basedep ~brickdep ~time
Dependencies added: conduit, containers, lens
Dependency ranges changed: base, brick, time, vty
Files
- README.md +12/−6
- clifm.cabal +9/−6
- src/Commons.hs +4/−3
- src/Main.hs +11/−4
- src/Widgets/Entry.hs +114/−36
- src/Widgets/Manager.hs +170/−87
- src/Widgets/Menu.hs +42/−31
- src/Widgets/Pane.hs +42/−50
- src/Widgets/Prompt.hs +112/−60
- src/Widgets/Tab.hs +96/−65
README.md view
@@ -25,9 +25,9 @@ ``` ## 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.+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 (not on Windows), handles resizing and more. -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:+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 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@@ -68,8 +68,6 @@ The actions above will not work only if a prompt is up, or you try to do something not possible. -> NOTE: directory size is not guaranteed to be accurate, the function in the `directory` library seems to be filesystem/platform dependent and visiting a directory tree to sum it's files sizes takes way too much time. Until a better solution is found the directory size will still be shown, but do not trust what it says.- ## Command line arguments You can have a list of command line arguments by running `clifm --help`. @@ -114,6 +112,14 @@ > > Attribute names with multiple components (e.g. attr1 <> attr2) can be referenced in customization files by separating the names with a dot. For example, the attribute name "list" <> "selected" can be referenced by using the string "list.selected". +#### Threads for directory size computation+Directory size is calculated by visiting a directory tree to sum it's files sizes (using [conduit](http://hackage.haskell.org/package/conduit)) and it may take a while. For this reason these will be calculated in different threads. ++You can limit how many of these threads to have at the same time by using `--thread-num` or `-n`, for example: `clifm -n 8`.++You are likely to have the best results with as many threads as your processor's cores. The default limit is set to 4.+ ## TODOs-- mc directory comparison (need to solve the next point first)-- find a way to read correctly a directory size in reasonable time+Right now nothing is planned.++Suggestions and requests are always welcome, if you have any or you find a bug please [open a new issue](https://github.com/pasqu4le/clifm/issues/new).
clifm.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.4.1.0+version: 0.5.0.0 -- A short (one-line) description of the package. synopsis: Command Line Interface File Manager@@ -70,17 +70,20 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base >=4.10 && <4.11,+ build-depends: base >=4.11 && <4.12, directory >=1.3 && <1.4, optparse-applicative >=0.14 && <0.15,- brick >=0.34 && <0.35,+ brick >=0.36 && <0.38, filepath >=1.4 && <1.5,- vty >= 5.17 && <6,+ vty >= 5.21 && <6, vector >= 0.12 && <0.13,- time >=1.8 && <1.10,+ time >=1.8 && <1.9, process >=1.6 && <1.7, pointedlist >= 0.6 && <0.7,- byteunits >= 0.4 && <0.5+ byteunits >= 0.4 && <0.5,+ conduit >= 1.3 && <1.4,+ containers >= 0.5 && < 0.6,+ lens >= 4.16 && < 4.17 -- Directories containing source files. hs-source-dirs: src
src/Commons.hs view
@@ -1,12 +1,12 @@ 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 Graphics.Vty (Key(..), withStyle, underline, black, yellow, white, blue, red) import Brick.Util (on, fg, bg)+import Brick.BChan (BChan) import Brick.Widgets.Edit (editFocusedAttr) import Brick.Widgets.List (listSelectedFocusedAttr, listSelectedAttr) @@ -16,7 +16,8 @@ Label {pnName :: PaneName, labelNum :: Int} | PromptEditor | EntryList {pnName :: PaneName} deriving (Ord, Show, Eq)-data ThreadEvent a = ThreadClosed | ThreadSuccess a | ThreadError String+type EChan a = BChan (ThreadEvent a) +data ThreadEvent a = PromptClosed | PromptSuccess a | PromptError String | SizeFound FilePath Integer | SizeNotFound FilePath type PaneName = Int -- attributes and themes
src/Main.hs view
@@ -16,7 +16,7 @@ -- entry point: parses the arguments and starts the brick application -- options-data FMOptions = FMOptions {dirPath :: FilePath, editComm :: String, themeType :: ThemeType}+data FMOptions = FMOptions {dirPath :: FilePath, editComm :: String, themeType :: ThemeType, threadNum :: Int} data ThemeType = CustomTheme FilePath | DefaultTheme -- argument parsing functions@@ -36,7 +36,15 @@ <> showDefault <> value "nano") <*> (customTheme <|> defTheme)+ <*> option auto+ ( long "thread-num"+ <> short 'n'+ <> help "Max number of size-searching threads"+ <> showDefault+ <> value 4+ <> metavar "INT") + customTheme :: Parser ThemeType customTheme = CustomTheme <$> strOption ( long "theme"@@ -47,7 +55,6 @@ defTheme :: Parser ThemeType defTheme = flag DefaultTheme DefaultTheme ( long "default-theme"- <> short 'd' <> help "Use the default theme" ) main :: IO ()@@ -69,12 +76,12 @@ setMode (outputIface v) Mouse True return v eventChan <- Brick.BChan.newBChan 10- state <- Mngr.makeState path (editComm options) eventChan+ state <- Mngr.makeState path (editComm options) eventChan (threadNum options) void $ customMain buildVty (Just eventChan) (app atrm) state app :: AttrMap -> App Mngr.State (ThreadEvent Tab.Tab) Name app atrm = App {- appDraw = Mngr.drawUi,+ appDraw = Mngr.render, appStartEvent = return, appHandleEvent = Mngr.handleEvent, appAttrMap = const atrm,
src/Widgets/Entry.hs view
@@ -1,9 +1,12 @@ module Widgets.Entry where import Commons +import Control.Lens+import Data.Maybe (fromMaybe) import Data.Time.Clock (UTCTime) import Data.Time.Format (formatTime, defaultTimeLocale) import Control.Exception (try, SomeException)+import Conduit import System.FilePath (takeFileName) import System.Directory (Permissions, getPermissions, readable, writable, executable, searchable, getAccessTime, getModificationTime, doesFileExist, getFileSize)@@ -11,47 +14,94 @@ 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+data Entry = Dir {_name :: String, _path :: FilePath, _info :: Info} |+ File {_name :: String, _path :: FilePath, _info :: Info} deriving (Ord)+data Info = Info {_size :: Size, _perms :: Maybe Permissions, _times :: Maybe (UTCTime, UTCTime)} deriving (Show, Eq, Ord)+data Size = Waiting | Calculating | Known Integer | Unknown | Avoided deriving (Show, Eq) instance Show Entry where- show Dir {name = n} = "+ " ++ n- show File {name = n} = "- " ++ n+ 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+ Dir {_path = p1} == Dir {_path = p2} = p1 == p2+ File {_path = p1} == File {_path = p2} = p1 == p2 _ == _ = False --- creation functions+instance Ord Size where+ compare (Known a) (Known b) = compare a b+ compare (Known _) _ = GT+ compare _ (Known _) = LT+ compare _ _ = EQ++-- lenses+name :: Lens' Entry String+name = lens _name (\entry n -> entry {_name = n})++path :: Lens' Entry FilePath+path = lens _path (\entry p -> entry {_path = p})++info :: Lens' Entry Info+info = lens _info (\entry i -> entry {_info = i})++size :: Lens' Entry Size+size = info.infoSize++perms :: Lens' Entry (Maybe Permissions)+perms = info.infoPerms++times :: Lens' Entry (Maybe (UTCTime, UTCTime))+times = info.infoTimes++accessTime :: Traversal' Entry UTCTime+accessTime = times._Just._1++modifTime :: Traversal' Entry UTCTime+modifTime = times._Just._2++infoSize :: Lens' Info Size+infoSize = lens _size (\entry s -> entry {_size = s})++infoPerms :: Lens' Info (Maybe Permissions)+infoPerms = lens _perms (\entry p -> entry {_perms = p})++infoTimes :: Lens' Info (Maybe (UTCTime, UTCTime))+infoTimes = lens _times (\entry t -> entry {_times = t})++-- creation 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+ if isFile then File (takeFileName filePath) filePath <$> makeInfo filePath True+ else Dir (takeFileName filePath) filePath <$> makeInfo filePath False -makeInfo :: FilePath -> IO Info-makeInfo filePath = do- enSize <- getFileSize filePath+makeInfo :: FilePath -> Bool -> IO Info+makeInfo filePath isFile = do+ enSize <- getEntrySize filePath isFile enPerms <- toMaybe <$> try (getPermissions filePath)- enTimes <- toMaybe <$> try (getEntryTimes filePath)+ enTimes <- toMaybe <$> try (getTimes filePath) return $ Info enSize enPerms enTimes -getEntryTimes :: FilePath -> IO (UTCTime, UTCTime)-getEntryTimes filePath = do- accessTime <- getAccessTime filePath- modifTime <- getModificationTime filePath- return (accessTime, modifTime)+getTimes :: FilePath -> IO (UTCTime, UTCTime)+getTimes filePath = do+ accTime <- getAccessTime filePath+ modTime <- getModificationTime filePath+ return (accTime, modTime) --- rendering functions+makeBackDir :: FilePath -> IO Entry+makeBackDir filePath = do+ enPerms <- toMaybe <$> try (getPermissions filePath)+ enTimes <- toMaybe <$> try (getTimes filePath)+ return $ Dir ".." filePath (Info Avoided enPerms enTimes)++-- rendering render :: Bool -> Entry -> Widget Name-render _ en = let enInfo = info en in vLimit 1 $ hBox [- str $ show en,+render _ entry = vLimit 1 $ hBox [+ str $ show entry, fill ' ',- str $ shortSize enInfo,- renderPerms $ perms enInfo,- renderTime (times enInfo) False+ views size (str . shortSize) entry,+ views perms renderPerms entry,+ renderModTime $ preview modifTime entry ] renderPerms :: Maybe Permissions -> Widget Name@@ -64,12 +114,23 @@ 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"+renderModTime :: Maybe UTCTime -> Widget Name+renderModTime modTime = str $ case modTime of+ Just mtm -> formatTime defaultTimeLocale " %R %b %e %Y" mtm+ _ -> " -----------------" --- utility functions+-- utility+isDir :: Entry -> Bool+isDir Dir {} = True+isDir _ = False++isFile :: Entry -> Bool+isFile File {} = True+isFile _ = False++isWaiting :: Entry -> Bool+isWaiting entry = entry ^. size == Waiting+ toMaybe :: Either SomeException b -> Maybe b toMaybe = either (const Nothing) Just @@ -80,10 +141,27 @@ isReadable = hasPermission readable hasPermission :: (Permissions -> Bool) -> Entry -> Bool-hasPermission prop en = case perms $ info en of- Just enPerms -> prop enPerms- _ -> False+hasPermission p = maybe False p . view perms -shortSize :: Info -> String-shortSize enInfo = getShortHand . getAppropriateUnits $ ByteValue enSize Bytes- where enSize = fromInteger $ size enInfo+shortSize :: Size -> String+shortSize sz = case sz of+ Known enSize -> getShortHand . getAppropriateUnits $ ByteValue (fromInteger enSize) Bytes+ Unknown -> "???"+ Calculating -> "..."+ Waiting -> "..."+ _ -> ""++-- directory size+getEntrySize :: FilePath -> Bool -> IO Size+getEntrySize filePath isFile+ | isFile = toSizeResult <$> try (getFileSize filePath)+ | otherwise = return Waiting++toSizeResult :: Either SomeException Integer -> Size+toSizeResult = either (const Unknown) Known++getDirSize :: FilePath -> IO Integer+getDirSize filePath = runConduitRes+ $ sourceDirectoryDeep False filePath+ .| mapMC (liftIO . getFileSize)+ .| sumC
src/Widgets/Manager.hs view
@@ -6,77 +6,152 @@ import qualified Widgets.Menu as Menu import qualified Widgets.Prompt as Prompt +import Control.Lens+import Data.Set.Lens (setOf)+import Data.Maybe (isJust, fromJust) import System.Process (callCommand)+import Control.Concurrent (forkFinally, ThreadId) import Control.Exception (try, SomeException)+import Control.Monad ((<=<)) import Control.Monad.IO.Class (liftIO)+import qualified Data.Set as Set import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) import Brick.Main (continue, halt, suspendAndResume)-import Brick.Widgets.Core ((<+>), str, hBox, vBox, vLimit, withBorderStyle)+import Brick.Widgets.Core (hBox, vBox, vLimit, withBorderStyle) import Brick.Types (Widget, BrickEvent(..), EventM, Next, ViewportType(..), Location(..)) import Brick.Widgets.Border (vBorder, hBorder) import Brick.Widgets.Border.Style (unicodeBold)-import Brick.BChan (BChan)+import Brick.BChan (BChan, writeBChan) import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl)) import Data.Foldable (toList) import Data.List (intersperse)-import Data.List.PointedList (PointedList, _focus, replace, delete, singleton, insert, moveTo, withFocus, find)+import Data.List.PointedList (PointedList, focus, delete, singleton, insert, withFocus, find) import Data.List.PointedList.Circular (next, previous) -data State = State {paneZipper :: PaneZipper,- lastPaneName :: PaneName,- bottomMenu :: Menu.Menu,- prompt :: Maybe Prompt.Prompt,- lastClickedEntry :: Maybe (PaneName, Int, UTCTime),- editorCommand :: String,- eventChan :: BChan (ThreadEvent Tab.Tab)+data State = State {+ _paneZipper :: PaneZipper,+ _lastPaneName :: PaneName,+ _bottomMenu :: Menu.Menu,+ _prompt :: Maybe Prompt.Prompt,+ _lastClickedEntry :: Maybe (PaneName, Int, UTCTime),+ _editorCommand :: String,+ _eventChan :: EChan Tab.Tab,+ _searchers :: (Int, Int) } type PaneZipper = PointedList Pane.Pane --- creation functions-makeState :: FilePath -> String -> BChan (ThreadEvent Tab.Tab) -> IO State-makeState path editCom eChan = do+-- lenses+paneZipper :: Lens' State PaneZipper+paneZipper = lens _paneZipper (\state x -> state {_paneZipper = x})++lastPaneName :: Lens' State PaneName+lastPaneName = lens _lastPaneName (\state x -> state {_lastPaneName = x})++bottomMenu :: Lens' State Menu.Menu+bottomMenu = lens _bottomMenu (\state x -> state {_bottomMenu = x})++prompt :: Lens' State (Maybe Prompt.Prompt)+prompt = lens _prompt (\state x -> state {_prompt = x})++lastClickedEntry :: Lens' State (Maybe (PaneName, Int, UTCTime))+lastClickedEntry = lens _lastClickedEntry (\state x -> state {_lastClickedEntry = x})++editorCommand :: Lens' State String+editorCommand = lens _editorCommand (\state x -> state {_editorCommand = x})++eventChan :: Lens' State (EChan Tab.Tab)+eventChan = lens _eventChan (\state x -> state {_eventChan = x})++searchers :: Lens' State (Int, Int)+searchers = lens _searchers (\state x -> state {_searchers = x})++runningSNum :: Lens' State Int+runningSNum = searchers._1++maxSNum :: Lens' State Int+maxSNum = searchers._2++currentPane :: Lens' State Pane.Pane+currentPane = paneZipper.focus++currentTab :: Lens' State Tab.Tab+currentTab = currentPane . Pane.currentTab++menuType :: Lens' State Menu.MenuType+menuType = bottomMenu . Menu.menuType++clipboard :: Lens' State Menu.Clipboard+clipboard = bottomMenu . Menu.clipboard++entries :: Traversal' State Entry.Entry+entries = paneZipper.traverse.Pane.entries++waitingEntries :: Traversal' State Entry.Entry+waitingEntries = entries.filtered Entry.isWaiting++-- creation+makeState :: FilePath -> String -> EChan Tab.Tab -> Int -> IO State+makeState path editCom eChan tNum = do pane <- Pane.make 0 path- return $ State (singleton pane) 0 Menu.make Nothing Nothing editCom eChan+ let srcs = (0, if tNum < 1 then 1 else tNum)+ state = State (singleton pane) 0 Menu.make Nothing Nothing editCom eChan srcs+ startSearchers (snd srcs) state --- rendering functions-drawUi :: State -> [Widget Name]-drawUi state = case prompt state of- Just pr -> [Prompt.render pr, renderMainUI state]- _ -> [renderMainUI state]+-- rendering+render :: State -> [Widget Name]+render state = case view prompt state of+ Just pr -> [Prompt.render pr, renderMain state]+ _ -> [renderMain state] -renderMainUI :: State -> Widget Name-renderMainUI state = vBox [- renderPanes $ paneZipper state,+renderMain :: State -> Widget Name+renderMain state = vBox [+ views paneZipper renderPanes state, withBorderStyle unicodeBold hBorder,- vLimit 3 $ Menu.render (bottomMenu state) (currentPane state)+ vLimit 3 $ Menu.render (state ^. bottomMenu) (state ^. currentPane) ] renderPanes :: PaneZipper -> Widget Name renderPanes = hBox . intersperse vBorder . map Pane.render . toList . withFocus --- event handling functions+-- event handling 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+handleEvent state ev+ | isSizeEvent ev = handleSize ev state+ | isJust $ view prompt state = handlePrompt ev state+ | otherwise = handleMain ev state -handlePrompt :: BrickEvent Name (ThreadEvent Tab.Tab) -> Prompt.Prompt -> State -> EventM Name (Next State)-handlePrompt ev pr state = do- promptRes <- Prompt.handleEvent ev pr (eventChan state)+isSizeEvent :: BrickEvent Name (ThreadEvent Tab.Tab) -> Bool+isSizeEvent (AppEvent ev) = case ev of+ SizeFound _ _ -> True+ SizeNotFound _ -> True+ _ -> False+isSizeEvent _ = False++handleSize :: BrickEvent Name (ThreadEvent Tab.Tab) -> State -> EventM Name (Next State)+handleSize (AppEvent ev) state = case ev of+ SizeFound path val -> manageSearchers $ notifySize state path (Entry.Known val)+ SizeNotFound path -> manageSearchers $ notifySize state path Entry.Unknown+ _ -> continue state+handleSize _ state = continue state++--updates the prompt or replaces the current tab and closes the prompt+handlePrompt :: BrickEvent Name (ThreadEvent Tab.Tab) -> State -> EventM Name (Next State)+handlePrompt ev state = do+ promptRes <- Prompt.handleEvent ev (fromJust $ view prompt state) (view eventChan state) case promptRes of- Left pr -> updatePrompt pr state --updates the prompt and keeps it up- Right tab -> updateCurrentPane (Pane.replaceCurrentTab tab) state --updates with the resulting tab and closes the prompt+ Left pr -> continue $ state & prompt ?~ pr+ Right tab -> manageSearchers $ state & currentTab .~ tab & prompt .~ Nothing handleMain :: BrickEvent Name (ThreadEvent Tab.Tab) -> State -> EventM Name (Next State) handleMain (VtyEvent ev) = case ev of EvKey KEsc [] -> halt- EvKey KBS [] -> updateMenu Menu.Main- EvKey (KChar 'l') [] -> updateMenu Menu.Selection- EvKey (KChar 'a') [] -> updateMenu Menu.Tab- EvKey (KChar 'p') [] -> updateMenu Menu.Pane+ EvKey KBS [] -> continue . set menuType Menu.Main+ EvKey (KChar 'l') [] -> continue . set menuType Menu.Selection+ EvKey (KChar 'a') [] -> continue . set menuType Menu.Tab+ EvKey (KChar 'p') [] -> continue . set menuType Menu.Pane EvKey (KChar 'q') [] -> halt- EvKey (KChar 'x') [MCtrl] -> updateClipboard Menu.makeCutBoard- EvKey (KChar 'c') [MCtrl] -> updateClipboard Menu.makeCopyBoard+ EvKey (KChar 'x') [MCtrl] -> withSelectedEntry (set clipboard . Menu.CutBoard)+ EvKey (KChar 'c') [MCtrl] -> withSelectedEntry (set clipboard . Menu.CopyBoard) EvKey (KChar 'v') [MCtrl] -> openPromptWithClip Prompt.paste EvKey (KChar 'r') [MCtrl] -> openPrompt Prompt.rename EvKey (KChar 'd') [MCtrl] -> openPrompt Prompt.delete@@ -89,70 +164,57 @@ EvKey KEnter [] -> openEntry EvKey (KChar 'e') [MCtrl] -> addPane EvKey (KChar 'k') [MCtrl] -> closePane- EvKey KLeft [] -> previousPane- EvKey KRight [] -> nextPane- _ -> updateCurrentPane (Pane.handleEvent ev)+ EvKey KLeft [] -> continue . over paneZipper previous+ EvKey KRight [] -> continue . over paneZipper next+ _ -> manageSearchers <=< currentPane (Pane.handleEvent ev) handleMain (MouseUp name _ (Location pos)) = case name of EntryList {pnName = pName} -> clickedEntry pName (snd pos)- Label {pnName = pName, labelNum = n} -> updateCurrentPane (Pane.moveToNthTab n) . focusOnPane pName+ Label {pnName = pName, labelNum = n} -> continue . over currentPane (Pane.moveToNth n) . focusOnPane pName Button {keyBind = key, withCtrl = b} -> handleMain . VtyEvent $ EvKey key [MCtrl | b] _ -> continue handleMain _ = continue --- state-changing functions-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 :: Menu.MenuType -> State -> EventM Name (Next State)-updateMenu tp st = continue $ st {bottomMenu = Menu.change tp $ 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.Prompt -> State -> EventM Name (Next State)-updatePrompt pr st = continue $ st {prompt=Just pr}+-- state-changing+withSelectedEntry :: (Entry.Entry -> State -> State) -> State -> EventM Name (Next State)+withSelectedEntry func state = continue . maybe state (`func` state) $ selectedEntry state openPrompt :: (Tab.Tab -> PaneName -> Prompt.Prompt) -> State -> EventM Name (Next State)-openPrompt func state = continue $ state {prompt = Just $ func tab pName}+openPrompt func state = continue $ state & prompt ?~ func tab pName where- tab = Pane.currentTab $ currentPane state- pName = Pane.name $ currentPane state+ tab = view currentTab state+ pName = state ^. currentPane . Pane.name openPromptWithClip :: (Menu.Clipboard -> Tab.Tab -> PaneName -> Prompt.Prompt) -> State -> EventM Name (Next State)-openPromptWithClip func state = openPrompt (func . Menu.clipboard $ bottomMenu state) state+openPromptWithClip func state = openPrompt (func $ view clipboard state) state clickedEntry :: PaneName -> Int -> State -> EventM Name (Next State) clickedEntry pName row state = do- currTime <- liftIO $ getCurrentTime+ 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}+ doubleClick = isDoubleClick (view lastClickedEntry state) clicked+ if doubleClick then openEntry $ state & lastClickedEntry .~ Nothing+ else continue . over currentTab (Tab.moveToRow row) . focusOnPane pName $ state & lastClickedEntry ?~ 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]+ Just (pPane, pRow, pTime) -> (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+openEntry state = case selectedEntry state of Just Entry.Dir {} -> openDirEntry False state Just (Entry.File n p i) -> openFileEntry (Entry.File n p i) state _ -> continue state 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)+ | Entry.isExecutable fileEntry = suspendAndResume . runExternal (view Entry.path fileEntry)+ | Entry.isReadable fileEntry = suspendAndResume . runExternalEditor (view Entry.path fileEntry) | otherwise = continue runExternalEditor :: FilePath -> State -> IO State-runExternalEditor path s = runExternal (unwords [editorCommand s, path]) s+runExternalEditor path s = runExternal (unwords [view editorCommand s, path]) s runExternal :: String -> State -> IO State runExternal com s = do@@ -163,30 +225,51 @@ return s openDirEntry :: Bool -> State -> EventM Name (Next State)-openDirEntry inNew = updateCurrentPane (Pane.openDirEntry inNew)+openDirEntry inNew = manageSearchers <=< currentPane (Pane.openDirEntry inNew) addPane :: State -> EventM Name (Next State)-addPane state = continue $ state {paneZipper = newZipper, lastPaneName = newName}- where- newName = 1 + lastPaneName state- newZipper = insert (Pane.empty newName) $ paneZipper state+addPane state = continue $ state+ & paneZipper %~ insert (Pane.empty newName)+ & lastPaneName .~ newName+ where newName = 1 + view lastPaneName state closePane :: State -> EventM Name (Next State)-closePane state = continue $ case delete $ paneZipper state of- Just newZipper -> state {paneZipper = newZipper}+closePane state = continue $ case delete $ view paneZipper state of+ Just newZipper -> state & paneZipper .~ newZipper _ -> state -nextPane :: State -> EventM Name (Next State)-nextPane state = continue $ state {paneZipper = next $ paneZipper state}+-- directory entry size / threaded searchers / value update+manageSearchers :: State -> EventM Name (Next State)+manageSearchers state+ | running >= maxNum = continue state+ | otherwise = continue =<< liftIO (startSearchers (maxNum - running) state)+ where (running, maxNum) = view searchers state -previousPane :: State -> EventM Name (Next State)-previousPane state = continue $ state {paneZipper = previous $ paneZipper state}+startSearchers :: Int -> State -> IO State+startSearchers n state = do+ let toStart = Set.take n $ setOf waitingEntries state+ mapM_ (startSearcher (view eventChan state) . view Entry.path) $ Set.toList toStart+ return $ state+ & entries.filtered (`Set.member` toStart).Entry.size .~ Entry.Calculating+ & runningSNum +~ Set.size toStart --- pane and paneZipper utility functions-currentPane :: State -> Pane.Pane-currentPane = _focus . paneZipper+startSearcher :: EChan Tab.Tab -> FilePath -> IO ThreadId+startSearcher eChan path = forkFinally (Entry.getDirSize path) (reportSearch path eChan) +reportSearch :: FilePath -> EChan Tab.Tab -> Either SomeException Integer -> IO ()+reportSearch path eChan = writeBChan eChan . either (const (SizeNotFound path)) (SizeFound path)++notifySize :: State -> FilePath -> Entry.Size -> State+notifySize state path size = state+ & entries.filtered ((== path) . view Entry.path).Entry.size .~ size+ & runningSNum -~ 1+ & prompt %~ fmap (Prompt.notifySize path size)++-- pane and paneZipper utility+selectedEntry :: State -> Maybe Entry.Entry+selectedEntry = Pane.selectedEntry . view currentPane+ focusOnPane :: PaneName -> State -> State-focusOnPane pName state = case find (Pane.empty pName) $ paneZipper state of- Just newZipper -> state {paneZipper = newZipper}+focusOnPane pName state = case views paneZipper (find (Pane.empty pName)) state of+ Just newZipper -> state & paneZipper .~ newZipper _ -> state
src/Widgets/Menu.hs view
@@ -4,6 +4,7 @@ import qualified Widgets.Tab as Tab import qualified Widgets.Entry as Entry +import Control.Lens import Data.Char (toUpper) import System.FilePath (takeFileName) import Brick.Widgets.Core ((<+>), str, hLimit, hBox, clickable)@@ -11,33 +12,37 @@ import Brick.Widgets.Border (borderWithLabel, border) import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl)) -data Menu = Menu {clipboard :: Clipboard, menuType :: MenuType}+data Menu = Menu {_clipboard :: Clipboard, _menuType :: MenuType} data MenuType = Main | Selection | Tab | Pane-data Clipboard = CopyBoard {fromEntry :: Entry.Entry} | CutBoard {fromEntry :: Entry.Entry} | EmptyBoard+data Clipboard = CopyBoard {_fromEntry :: Entry.Entry} | CutBoard {_fromEntry :: Entry.Entry} | EmptyBoard instance Show Clipboard where show EmptyBoard = " -empty- "- show board = takeFileName . Entry.path $ fromEntry board+ show board = takeFileName $ board ^. fromEntry . Entry.path --- creation functions-make :: Menu-make = Menu {clipboard = EmptyBoard, menuType = Main}+-- lenses+clipboard :: Lens' Menu Clipboard+clipboard = lens _clipboard (\menu x -> menu {_clipboard = x}) -makeCopyBoard :: Entry.Entry -> Clipboard-makeCopyBoard = CopyBoard+menuType :: Lens' Menu MenuType+menuType = lens _menuType (\menu x -> menu {_menuType = x}) -makeCutBoard :: Entry.Entry -> Clipboard-makeCutBoard = CutBoard+fromEntry :: Lens' Clipboard Entry.Entry+fromEntry = lens _fromEntry (\board x -> board {_fromEntry = x}) --- rendering functions+-- creation+make :: Menu+make = Menu {_clipboard = EmptyBoard, _menuType = Main}++-- rendering render :: Menu -> Pane.Pane -> Widget Name-render m = hBox . (renderClipboard (clipboard m) :) . renderButtons (menuType m)+render m = hBox . (views clipboard renderClipboard m :) . views menuType renderButtons m renderButtons :: MenuType -> Pane.Pane -> [Widget Name] renderButtons tp pane = map renderButton $ case tp of Main -> mainButtons- Selection -> (backButton :) . selectionButtons $ Pane.selectedEntry pane- Tab -> (backButton :) . tabButtons $ Pane.currentTab pane+ Selection -> backButton : maybe [] selectionButtons (Pane.selectedEntry pane)+ Tab -> backButton : views Pane.currentTab tabButtons pane Pane -> backButton : paneButtons renderButton :: (Widget Name, Maybe String, Name) -> Widget Name@@ -53,11 +58,10 @@ (keybindStr "q" <+> str "uit", Nothing, Button {keyBind = KChar 'q', withCtrl = False}) ] -selectionButtons :: Maybe Entry.Entry -> [(Widget Name, Maybe String, Name)]-selectionButtons e = case e of- Just Entry.File {} -> anySelectionButtons- Just Entry.Dir {} -> anySelectionButtons ++ [(keybindStr "o" <+> str "pen in new tab", ctrlText 'o', Button {keyBind = KChar 'o', withCtrl = True})]- _ -> []+selectionButtons :: Entry.Entry -> [(Widget Name, Maybe String, Name)]+selectionButtons e+ | Entry.isDir e = anySelectionButtons ++ [(keybindStr "o" <+> str "pen in new tab", ctrlText 'o', Button {keyBind = KChar 'o', withCtrl = True})]+ | otherwise = anySelectionButtons anySelectionButtons :: [(Widget Name, Maybe String, Name)] anySelectionButtons = [@@ -69,10 +73,11 @@ ] tabButtons :: Tab.Tab -> [(Widget Name, Maybe String, Name)]-tabButtons tab = case tab of- Tab.Dir {Tab.entryOrder = order} -> dirTabButtons ++ entryTabButtons order ++ anyTabButtons- Tab.Search {Tab.entryOrder = order} -> entryTabButtons order ++ anyTabButtons- _ -> anyTabButtons+tabButtons tab+ | Tab.isDir tab = dirTabButtons ++ entryTabButtons orderType ++ anyTabButtons+ | Tab.isSearch tab = entryTabButtons orderType ++ anyTabButtons+ | otherwise = anyTabButtons+ where orderType = view Tab.orderType tab dirTabButtons :: [(Widget Name, Maybe String, Name)] dirTabButtons = [@@ -82,10 +87,10 @@ (keybindStr "t" <+> str "ouch file", Nothing, Button {keyBind = KChar 't', withCtrl = False}) ] -entryTabButtons :: Tab.EntryOrder -> [(Widget Name, Maybe String, Name)]-entryTabButtons order = [+entryTabButtons :: Tab.OrderType -> [(Widget Name, Maybe String, Name)]+entryTabButtons orderType = [ (keybindStr "r" <+> str "efresh", Nothing, Button {keyBind = KChar 'r', withCtrl = False}),- (keybindStr "o" <+> str ("rder by " ++ (show . Tab.nextOrderType $ Tab.orderType order)), Nothing, Button {keyBind = KChar 'o', withCtrl = False}),+ (keybindStr "o" <+> str ("rder by " ++ show (Tab.nextOrderType orderType)), Nothing, Button {keyBind = KChar 'o', withCtrl = False}), (keybindStr "i" <+> str "nvert order", Nothing, Button {keyBind = KChar 'i', withCtrl = False}) ] @@ -111,9 +116,15 @@ renderClipboard :: Clipboard -> Widget Name renderClipboard = hLimit 24 . borderWithLabel (str "clipboard") . str . show --- state changing functions-change :: MenuType -> Menu -> Menu-change tp menu = menu {menuType = tp}+-- utility+isEmpty :: Clipboard -> Bool+isEmpty EmptyBoard = True+isEmpty _ = False -changeClipboard :: Clipboard -> Menu -> Menu-changeClipboard cb menu = menu {clipboard = cb}+isCopy :: Clipboard -> Bool+isCopy CopyBoard {} = True+isCopy _ = False++isCut :: Clipboard -> Bool+isCut CutBoard {} = True+isCut _ = False
src/Widgets/Pane.hs view
@@ -3,33 +3,49 @@ import qualified Widgets.Tab as Tab import qualified Widgets.Entry as Entry +import Control.Lens+import Data.Maybe (fromMaybe) import Control.Monad.IO.Class (liftIO) import Brick.Widgets.Core (hBox, vBox, vLimit, viewport, clickable) import Brick.Types (Widget, BrickEvent(..), EventM, ViewportType(..)) import Graphics.Vty (Event(EvKey), Key(..), Modifier(MCtrl)) import Data.Foldable (toList)-import Data.List.PointedList (PointedList, _focus, replace, delete, singleton, insert, insertLeft, moveTo, withFocus, atStart, atEnd)+import Data.List.PointedList (PointedList, _focus, focus, replace, delete, singleton, insert, insertLeft, moveTo, withFocus, atStart, atEnd) import Data.List.PointedList.Circular (next, previous) -data Pane = Pane {name :: PaneName, tabZipper :: TabZipper}+data Pane = Pane {_name :: PaneName, _tabZipper :: TabZipper} type TabZipper = PointedList Tab.Tab instance Eq Pane where- Pane {name = p1} == Pane {name = p2} = p1 == p2+ Pane {_name = p1} == Pane {_name = p2} = p1 == p2 --- creation functions+-- lenses +name :: Lens' Pane PaneName+name = lens _name (\pane x -> pane {_name = x})++tabZipper :: Lens' Pane TabZipper+tabZipper = lens _tabZipper (\pane x -> pane {_tabZipper = x})++currentTab :: Lens' Pane Tab.Tab+currentTab = tabZipper.focus++--NOTE: needs to filter empty tabs, or it will fail+entries :: Traversal' Pane Entry.Entry+entries = tabZipper.traverse.filtered (not . Tab.isEmpty).Tab.entries++-- creation empty :: PaneName -> Pane empty pName = Pane pName . singleton $ Tab.empty make :: PaneName -> FilePath -> IO Pane make pName path = Pane pName . singleton <$> Tab.makeDirTab pName path --- rendering functions+-- rendering 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+render (pane, hasFocus) = let pName = view name pane in vBox [+ vLimit 2 . viewport LabelsRow {pnName = pName} Horizontal $ views tabZipper (renderLabels pName) pane,+ views currentTab Tab.renderSeparator pane,+ clickable EntryList {pnName = pName} $ views currentTab (Tab.renderContent hasFocus) pane ] renderLabels :: PaneName -> TabZipper -> Widget Name@@ -39,64 +55,40 @@ clickableLabel :: PaneName -> (Widget Name, Int) -> Widget Name clickableLabel pName (l, n) = clickable Label {pnName = pName, labelNum = n} l --- event handling functions+-- event handling handleEvent :: Event -> Pane -> EventM Name Pane handleEvent event = case event of- EvKey (KChar 'k') [] -> updateTabZipper removeTab- EvKey (KChar 'e') [] -> updateTabZipper (insert Tab.empty)+ EvKey (KChar 'k') [] -> return . over tabZipper removeTab+ EvKey (KChar 'e') [] -> return . over tabZipper (insert Tab.empty) EvKey (KChar 'r') [] -> reloadCurrentTab- EvKey (KChar '\t') [] -> updateTabZipper next- EvKey KBackTab [] -> updateTabZipper previous- EvKey KLeft [MCtrl] -> updateTabZipper swapPrev- EvKey KRight [MCtrl] -> updateTabZipper swapNext- _ -> updateCurrentTab event---- state-changing functions-updateTabZipper :: (TabZipper -> TabZipper) -> Pane -> EventM Name Pane-updateTabZipper func pane = return $ pane {tabZipper = func $ tabZipper pane}+ EvKey (KChar '\t') [] -> return . over tabZipper next+ EvKey KBackTab [] -> return . over tabZipper previous+ EvKey KLeft [MCtrl] -> return . over tabZipper swapPrev+ EvKey KRight [MCtrl] -> return . over tabZipper swapNext+ _ -> currentTab (Tab.handleEvent event) +-- state-changing reloadCurrentTab :: Pane -> EventM Name Pane-reloadCurrentTab pane = do- reloaded <- liftIO . Tab.reload (name pane) $ currentTab pane- updateTabZipper (replace reloaded) pane--updateCurrentTab :: Event -> Pane -> EventM Name Pane-updateCurrentTab event pane = do- updated <- Tab.handleEvent event $ currentTab pane- updateTabZipper (replace updated) pane+reloadCurrentTab pane = currentTab (liftIO . Tab.reload (view name pane)) 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+ Just entry -> if not $ Entry.isDir entry then return pane else do+ loaded <- liftIO $ Tab.makeDirTab (view name pane) $ view Entry.path entry+ return $ over tabZipper (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)+moveToNth :: Int -> Pane -> Pane+moveToNth n = over tabZipper (\z -> fromMaybe z $ moveTo n z) --- tab and tabZipper utility functions+-- utility selectedEntry :: Pane -> Maybe Entry.Entry-selectedEntry = Tab.selectedEntry . currentTab--moveTabToRow :: Int -> Pane -> EventM Name Pane-moveTabToRow row pane = updateTabZipper (replace (Tab.moveToRow row $ currentTab pane)) pane--currentTab :: Pane -> Tab.Tab-currentTab = _focus . tabZipper+selectedEntry = Tab.selectedEntry . view currentTab removeTab :: TabZipper -> TabZipper removeTab zipper = case delete zipper of Just newZipper -> newZipper _ -> singleton Tab.empty--moveToNth :: Int -> TabZipper -> TabZipper-moveToNth n zipper = case moveTo n zipper of- Just newZipper -> newZipper- _ -> zipper swapPrev :: TabZipper -> TabZipper swapPrev zipper
src/Widgets/Prompt.hs view
@@ -4,6 +4,7 @@ import qualified Widgets.Menu as Menu import qualified Widgets.Entry as Entry +import Control.Lens import Data.Monoid ((<>)) import Data.Functor (($>)) import Control.Monad(when,forM_)@@ -25,11 +26,11 @@ copyFileWithMetadata, removeFile, removeDirectoryRecursive, getDirectoryContents, readable, writable, executable, searchable) -data Prompt = Prompt {originTab :: Tab.Tab, originPane :: PaneName, action :: Action} deriving Show+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 |+ GoTo Editor | Search Editor FilePath | DisplayInfo Entry.Entry | DisplayError String | Performing String ThreadId instance Show Action where@@ -45,7 +46,17 @@ show (Performing name _) = " Performing" ++ name show _ = " Error " --- creation functions+-- lenses+originTab :: Lens' Prompt Tab.Tab+originTab = lens _originTab (\prompt x -> prompt {_originTab = x})++originPane :: Lens' Prompt PaneName+originPane = lens _originPane (\prompt x -> prompt {_originPane = x})++action :: Lens' Prompt Action+action = lens _action (\prompt x -> prompt {_action = x})++-- creation emptyEditor :: Editor emptyEditor = makeEditor [] @@ -53,19 +64,22 @@ makeEditor = Edit.editor PromptEditor (Just 1) paste :: Menu.Clipboard -> Tab.Tab -> PaneName -> Prompt-paste c tab pName = Prompt tab pName $ case (c, tab) of- (Menu.EmptyBoard, _) -> DisplayError "The clipboard is empty"- (_, Tab.Empty) -> DisplayError "You cannot paste into an empty tab"- (_, Tab.Search {}) -> DisplayError "You cannot paste into a search tab"- (Menu.CopyBoard {Menu.fromEntry = entry}, Tab.Dir{Tab.path = path}) -> Copy entry path- (Menu.CutBoard {Menu.fromEntry = entry}, Tab.Dir{Tab.path = path}) -> Cut entry path+paste clip tab pName = let+ checked+ | Menu.isEmpty clip = DisplayError "The clipboard is empty"+ | Tab.isEmpty tab = DisplayError "You cannot paste into an empty tab"+ | Tab.isSearch tab = DisplayError "You cannot paste into a search tab"+ | Menu.isCopy clip = Copy (clip ^. Menu.fromEntry) (tab ^. Tab.path)+ | Menu.isCut clip = Cut (clip ^. Menu.fromEntry) (tab ^. Tab.path)+ | otherwise = DisplayError "Cannot paste: unknown error"+ in Prompt tab pName checked goTo :: Tab.Tab -> PaneName -> Prompt goTo tab pName = Prompt tab pName $ GoTo emptyEditor rename :: Tab.Tab -> PaneName -> Prompt rename = withSelectedEntry (\en -> Rename (editorFromEntry en) en)- where editorFromEntry = makeEditor . takeFileName . Entry.path+ where editorFromEntry = makeEditor . takeFileName . view Entry.path delete :: Tab.Tab -> PaneName -> Prompt delete = withSelectedEntry Delete@@ -77,7 +91,7 @@ touch = withDirTabPath (Touch emptyEditor) displayInfo :: Tab.Tab -> PaneName -> Prompt-displayInfo = withSelectedEntry (DisplayInfo . Entry.info)+displayInfo = withSelectedEntry DisplayInfo search :: Tab.Tab -> PaneName -> Prompt search = withDirTabPath (Search emptyEditor)@@ -88,37 +102,42 @@ _ -> DisplayError "This tab does not have a selected entry" withDirTabPath :: (FilePath -> Action) -> Tab.Tab -> PaneName -> Prompt-withDirTabPath func tab pName = Prompt tab pName $ case tab of- Tab.Dir {Tab.path = path} -> func path- _ -> DisplayError "This tab does not represent a directory"+withDirTabPath func tab pName = Prompt tab pName $ if Tab.isDir tab+ then func $ view Tab.path tab+ else DisplayError "This tab does not represent a directory" --- rendering functions+-- rendering render :: Prompt -> Widget Name render prompt = centerLayer . box $ vBox [body, hBorder, footer] where- box = withDefAttr promptAttr . borderWithLabel (str . show $ action prompt) . hLimit 70+ box = withDefAttr promptAttr . borderWithLabel (str . show $ view action prompt) . hLimit 70 body = padLeftRight 2 . padTopBottom 1 $ renderBody prompt- footer = hCenter . renderFooter $ action prompt+ footer = hCenter . renderFooter $ view action prompt renderBody :: Prompt -> Widget Name-renderBody pr = vBox $ case action pr of- Copy en path -> disclaimer : map strWrap [tellEntry en <> " will be copied from:", takeDirectory $ Entry.path en, "to: ", path]- Cut en path -> disclaimer : map strWrap [tellEntry en <> " will be moved from:", takeDirectory $ Entry.path en, "to: ", path]+renderBody pr = vBox $ case view action pr of+ Copy en path -> disclaimer : map strWrap [tellEntry en <> " will be copied from:", takeDirectory $ view Entry.path en, "to: ", path]+ Cut en path -> disclaimer : map strWrap [tellEntry en <> " will be moved from:", takeDirectory $ view Entry.path en, "to: ", path] Rename edit en -> disclaimer : strWrap (tellEntry en <> " will be renamed to:") : renderValidatedEditor edit Delete en -> [disclaimer, strWrap $ tellEntry en <> " will be permanently deleted"] Mkdir edit _ -> str "Directory name:" : renderValidatedEditor edit Touch edit _ -> str "File name:" : renderValidatedEditor edit GoTo edit -> str "Directory to open:" : renderValidatedEditor edit Search edit _ -> str "Search for:" : renderValidatedEditor edit- DisplayInfo info -> map strWrap . (displaySize info :) $ displayPerms info ++ displayTimes info+ DisplayInfo en -> map strWrap . (displaySize en :) $ displayPerms en ++ displayTimes en DisplayError msg -> [str "Whoops, this went wrong:", withDefAttr errorAttr $ strWrap msg] Performing name _ -> [str $ "Performing" ++ name, str "Please wait"] -displaySize :: Entry.Info -> String-displaySize info = "Size: " ++ show (Entry.size info) ++ " Bytes (" ++ Entry.shortSize info ++ ")"+displaySize :: Entry.Entry -> String+displaySize entry = case view Entry.size entry of+ Entry.Known s -> "Size: " ++ show s ++ " Bytes (" ++ Entry.shortSize (Entry.Known s) ++ ")"+ Entry.Unknown -> "Size unknown (unable to read)"+ Entry.Calculating -> "Size is being calculated"+ Entry.Waiting -> "Size will soon be calculated"+ _ -> "" -displayPerms :: Entry.Info -> [String]-displayPerms info = case Entry.perms info of+displayPerms :: Entry.Entry -> [String]+displayPerms entry = case view Entry.perms entry of Nothing -> [" ", "Permissions unknown", "(could not read them)"] Just p -> [ " ",@@ -128,16 +147,17 @@ "Is searchable: " <> (if searchable p then "yes" else "no") ] -displayTimes :: Entry.Info -> [String]-displayTimes info = case Entry.times info of+displayTimes :: Entry.Entry -> [String]+displayTimes entry = case view Entry.times entry of Nothing -> [" ", "Last access and modification times unknown", "(could not read them)"] Just (acTm, mdTm) -> [" ", "Last access time:" <> format acTm, "Last modification time:" <> format mdTm] where format = formatTime defaultTimeLocale " %T %B %-d %Y" tellEntry :: Entry.Entry -> String-tellEntry e = case e of- Entry.Dir {Entry.name = name} -> "The directory " <> name <> " (and all it's content)"- Entry.File {Entry.name = name} -> "The file " <> name+tellEntry entry+ | Entry.isDir entry = "The directory " <> name <> " (and all it's content)"+ | otherwise = "The file " <> name+ where name = view Entry.name entry disclaimer :: Widget Name disclaimer = withDefAttr disclaimerAttr $ strWrap "NOTE: this will operate on \@@ -168,26 +188,28 @@ Search _ _ -> " to search, " _ -> " or " --- event-handling functions-handleEvent :: BrickEvent Name (ThreadEvent Tab.Tab) -> Prompt -> BChan (ThreadEvent Tab.Tab) -> EventM Name (Either Prompt Tab.Tab)+-- event-handling+handleEvent :: BrickEvent Name (ThreadEvent Tab.Tab) -> Prompt -> EChan Tab.Tab -> EventM Name (Either Prompt Tab.Tab) handleEvent (AppEvent ev) pr _ = case ev of- ThreadError err -> return $ Left pr {action = DisplayError err}- ThreadSuccess tab -> return $ Right tab- ThreadClosed -> return . Right $ originTab pr+ PromptError err -> return . Left $ pr & action .~ DisplayError err+ PromptSuccess tab -> return $ Right tab+ PromptClosed -> return . Right $ view originTab pr+ _ -> return $ Left pr handleEvent (VtyEvent ev) pr eChan = case ev of EvKey KEsc [] -> liftIO $ exit pr EvKey KEnter [] -> liftIO $ performAction pr eChan- _ -> Left . Prompt (originTab pr) (originPane pr) <$> handleEditor ev (action pr)+ _ -> Left <$> (pr & action %%~ handleEditor ev) handleEvent _ pr _ = return $ Left pr + -- if performing it will return the same prompt, the raised exception will trigger the closing exit :: Prompt -> IO (Either Prompt Tab.Tab)-exit pr = case 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+exit pr = case view action pr of+ Performing name tId -> killThread tId $> Left pr+ _ -> return . Right $ view originTab pr -- gets to decide if the action will be processed in a different thread or not-performAction :: Prompt -> BChan (ThreadEvent Tab.Tab) -> IO (Either Prompt Tab.Tab) ---performAction pr eChan = case action pr of+performAction :: Prompt -> EChan Tab.Tab -> IO (Either Prompt Tab.Tab) --+performAction pr eChan = case view action pr of Copy _ _ -> Left <$> processThreaded pr eChan Cut _ _ -> Left <$> processThreaded pr eChan Rename _ _ -> Left <$> processThreaded pr eChan@@ -196,44 +218,66 @@ Performing _ _ -> return $ Left pr -- doesn't really make sense _ -> processSafe pr -processThreaded :: Prompt -> BChan (ThreadEvent Tab.Tab) -> IO Prompt+processThreaded :: Prompt -> EChan Tab.Tab -> IO Prompt processThreaded pr eChan = do tId <- forkFinally (processUnsafe pr) (reportResult eChan)- return $ pr {action = Performing (show $ action pr) tId}+ return $ pr & action %~ (\act -> Performing (show act) tId) -reportResult :: BChan (ThreadEvent Tab.Tab) -> Either SomeException Tab.Tab -> IO ()-reportResult eChan res = writeBChan eChan $ case res of- Left e -> endingEvent e- Right tabRes -> ThreadSuccess tabRes+reportResult :: EChan Tab.Tab -> Either SomeException Tab.Tab -> IO ()+reportResult eChan = writeBChan eChan . either endingEvent PromptSuccess endingEvent :: SomeException -> ThreadEvent Tab.Tab endingEvent e = case (fromException e :: Maybe AsyncException) of- Just ThreadKilled -> ThreadClosed- _ -> ThreadError $ displayException e+ Just ThreadKilled -> PromptClosed+ _ -> PromptError $ displayException e processSafe :: Prompt -> IO (Either Prompt Tab.Tab) processSafe pr = do result <- (try $ processUnsafe pr) :: IO (Either SomeException Tab.Tab) return $ case result of- Left e -> Left $ pr {action = DisplayError $ displayException e}+ Left e -> Left $ pr & action .~ DisplayError (displayException e) Right tabRes -> Right tabRes processUnsafe :: Prompt -> IO Tab.Tab-processUnsafe Prompt {originTab = tab, originPane = pName, action = act} = case act of- Copy Entry.File {Entry.path = ePath} path -> copyFileWithMetadata ePath (path </> takeFileName ePath) *> Tab.reload pName tab- Copy Entry.Dir {Entry.path = ePath} path -> copyDirectoryRecursive ePath (path </> takeFileName ePath) *> Tab.reload pName tab- Cut Entry.File {Entry.path = ePath} path -> moveFileWithMetadata ePath (path </> takeFileName ePath) *> Tab.reload pName tab- Cut Entry.Dir {Entry.path = ePath} path -> moveDirectoryRecursive ePath (path </> takeFileName ePath) *> Tab.reload pName tab- Rename edit Entry.File {Entry.path = ePath} -> renameFile ePath (takeDirectory ePath </> editorLine edit) *> Tab.reload pName tab- Rename edit Entry.Dir {Entry.path = ePath} -> moveDirectoryRecursive ePath (takeDirectory ePath </> editorLine edit) *> Tab.reload pName tab- Delete Entry.File {Entry.path = ePath} -> removeFile ePath *> Tab.reload pName tab- Delete Entry.Dir {Entry.path = ePath} -> removeDirectoryRecursive ePath *> Tab.reload pName tab+processUnsafe prompt = case act of+ Copy entry path -> processCopy entry path pName tab+ Cut entry path -> processCut entry path pName tab+ Rename edit entry -> processRename entry (editorLine edit) pName tab+ Delete entry -> processDelete entry pName tab Mkdir edit path -> createDirectory (path </> editorLine edit) *> Tab.reload pName tab Touch edit path -> writeFile (path </> editorLine edit) "" *> Tab.reload pName tab GoTo edit -> processGoTo pName $ editorLine edit Search edit path -> Tab.makeSearchTab pName path $ editorLine edit _ -> return tab+ where+ tab = view originTab prompt+ pName = view originPane prompt+ act = view action prompt +processCopy :: Entry.Entry -> FilePath -> PaneName -> Tab.Tab -> IO Tab.Tab+processCopy entry path pName tab+ | Entry.isFile entry = copyFileWithMetadata ePath (path </> takeFileName ePath) *> Tab.reload pName tab+ | otherwise = copyDirectoryRecursive ePath (path </> takeFileName ePath) *> Tab.reload pName tab+ where ePath = view Entry.path entry++processCut :: Entry.Entry -> FilePath -> PaneName -> Tab.Tab -> IO Tab.Tab+processCut entry path pName tab+ | Entry.isFile entry = moveFileWithMetadata ePath (path </> takeFileName ePath) *> Tab.reload pName tab+ | otherwise = moveDirectoryRecursive ePath (path </> takeFileName ePath) *> Tab.reload pName tab+ where ePath = view Entry.path entry++processRename :: Entry.Entry -> String -> PaneName -> Tab.Tab -> IO Tab.Tab+processRename entry editLine pName tab+ | Entry.isFile entry = renameFile ePath (takeDirectory ePath </> editLine) *> Tab.reload pName tab+ | otherwise = moveDirectoryRecursive ePath (takeDirectory ePath </> editLine) *> Tab.reload pName tab+ where ePath = view Entry.path entry ++processDelete :: Entry.Entry -> PaneName -> Tab.Tab -> IO Tab.Tab+processDelete entry pName tab+ | Entry.isFile entry = removeFile ePath *> Tab.reload pName tab+ | otherwise = removeDirectoryRecursive ePath *> Tab.reload pName tab+ where ePath = view Entry.path entry + processGoTo :: PaneName -> FilePath -> IO Tab.Tab processGoTo pName path = do isFile <- doesFileExist path@@ -251,9 +295,17 @@ Search edit path -> (`Search` path) <$> Edit.handleEditorEvent ev edit _ -> return act --- utility functions+-- utility editorLine :: Editor -> String editorLine = head . Edit.getEditContents++notifySize :: FilePath -> Entry.Size -> Prompt -> Prompt+notifySize path size prompt = prompt & action %~ notifyActionSize path size++notifyActionSize :: FilePath -> Entry.Size -> Action -> Action+notifyActionSize path size act = case act of+ DisplayInfo en -> if path == en ^. Entry.path then DisplayInfo (en & Entry.size .~ size) else act+ _ -> act -- files functions not covered by System.Directory nor System.FilePath moveFileWithMetadata :: FilePath -> FilePath -> IO ()
src/Widgets/Tab.hs view
@@ -2,6 +2,7 @@ import Commons import qualified Widgets.Entry as Entry +import Control.Lens hiding (Empty) import Data.List (sortOn, isInfixOf, elemIndex) import Data.Char (toLower) import Data.Maybe (fromMaybe)@@ -12,26 +13,26 @@ import Brick.Types (Widget, EventM) import Brick.Widgets.Core (hLimit, hBox, vBox, (<+>), str, strWrap, fill, withBorderStyle, visible) import Brick.Widgets.List (List, list, renderList, handleListEvent, listMoveTo,- listSelectedElement, listReplace, listElements)+ listSelectedElement, listReplace, listElements, listElementsL, listSelectedL, listNameL, listItemHeightL) 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 -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} |+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 EntryOrder = EntryOrder {_orderType :: OrderType, _inverted :: Bool} data OrderType = FileName | FileSize | AccessTime | ModificationTime deriving (Eq, Enum, Bounded) instance Show Tab where show Empty = "\x276f -new tab-"- show Dir {name = n} = "\x2636 " ++ n- show Search {name = n} = "\x26B2 " ++ n+ 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 ")+ show order = show (_orderType order) ++ (if _inverted order then " \x2193 " else " \x2191 ") instance Show OrderType where show FileName = "name"@@ -39,7 +40,39 @@ show AccessTime = "access" show ModificationTime = "modified" --- creation functions+-- lenses+name :: Lens' Tab String+name = lens _name (\tab n -> tab {_name = n})++path :: Lens' Tab FilePath+path = lens _path (\tab n -> tab {_path = n})++entryList :: Lens' Tab (List Name Entry.Entry)+entryList = lens _entryList (\tab n -> tab {_entryList = n})++entryOrder :: Lens' Tab EntryOrder+entryOrder = lens _entryOrder (\tab n -> tab {_entryOrder = n})++query :: Lens' Tab String+query = lens _query (\tab n -> tab {_query = n})++orderType :: Lens' Tab OrderType+orderType = entryOrder.entryOrderType++orderInverted :: Lens' Tab Bool+orderInverted = entryOrder.entryOrderInverted++entryOrderType :: Lens' EntryOrder OrderType+entryOrderType = lens _orderType (\tab n -> tab {_orderType = n})++entryOrderInverted :: Lens' EntryOrder Bool+entryOrderInverted = lens _inverted (\tab n -> tab {_inverted = n})++--NOTE: remember that it will fail for Empty tabs+entries :: Traversal' Tab Entry.Entry+entries = entryList.traverse++-- creation empty :: Tab empty = Empty @@ -58,8 +91,8 @@ makeDirEntryList pName order dir = do sub <- listDirectory dir 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+ upDir <- Entry.makeBackDir $ takeDirectory dir+ return $ list EntryList {pnName = pName} (Vect.fromList . (upDir :) $ sortEntries order entries) 1 makeSearchTab :: PaneName -> FilePath -> String -> IO Tab makeSearchTab pName filePath searchQuery = do@@ -75,10 +108,10 @@ 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+ searchDir <- Entry.makeBackDir dir+ return $ list EntryList {pnName = pName} (Vect.fromList . (searchDir :) $ sortEntries order entries) 1 --- rendering functions+-- rendering renderLabel :: (Tab, Bool) -> Widget Name renderLabel (tab, hasFoc) = modifs . hLimit (wdt + 2) $ vBox [top, middle] where@@ -90,24 +123,24 @@ middle = hBox [vBorder, str $ take wdt txt, fill ' ', vBorder] renderSeparator :: Tab -> Widget Name-renderSeparator t = hBox [+renderSeparator tab = hBox [ borderElem bsHorizontal,- renderPath t,+ renderPath tab, hBorder,- renderEntryOrder t,+ renderEntryOrder tab, borderElem bsHorizontal ] renderEntryOrder :: Tab -> Widget Name renderEntryOrder tab = str $ case tab of Empty -> ""- _ -> " by " ++ show (entryOrder tab)+ _ -> " by " ++ views entryOrder show tab renderPath :: Tab -> Widget Name renderPath tab = str $ case tab of Empty -> " <empty tab> "- Dir {path = p} -> " " ++ p ++ " "- Search {path = p, query = q} -> " search for " ++ q ++ " in " ++ takeFileName p+ Dir {_path = p} -> " " ++ p ++ " "+ Search {_path = p, _query = q} -> " search for " ++ q ++ " in " ++ takeFileName p renderContent :: Bool -> Tab -> Widget Name renderContent _ Empty = vBox (lns ++ [fill ' '])@@ -121,72 +154,66 @@ \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 Entry.render hasFocus $ entryList tab+renderContent hasFocus tab = views entryList (renderList Entry.render hasFocus) tab --- event handling and state-changing functions+-- event handling and state-changing 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- newList <- handleListEvent event $ entryList tab- return $ tab {entryList = newList}+ _ -> entryList (handleListEvent event) tab changeOrder :: Tab -> Tab changeOrder Empty = Empty-changeOrder tab = tab {entryOrder = newOrder, entryList = newEntryList}+changeOrder tab = tab+ & entryOrder .~ newOrder+ & entryList.listElementsL._tail .~ sorted+ & entryList.listSelectedL ?~ maybe 0 (+1) ((`Vect.elemIndex` sorted) =<< selectedEntry tab) where- order = entryOrder tab- newOrder = order {orderType = nextOrderType $ orderType order}- eLst = entryList tab- (fstDir:entries) = toList eLst- sorted = fstDir : sortEntries newOrder entries- selected = fromMaybe fstDir $ selectedEntry tab- newIndex = Just . fromMaybe 0 $ elemIndex selected sorted- newEntryList = listReplace (Vect.fromList sorted) newIndex eLst+ newOrder = over entryOrderType nextOrderType $ view entryOrder tab+ sorted = Vect.fromList . sortEntries newOrder . toList $ view (entryList.listElementsL._tail) tab invertOrder :: Tab -> Tab invertOrder Empty = Empty-invertOrder tab = tab {entryOrder = newOrder, entryList = newEntryList}- where- order = entryOrder tab- newOrder = order {inverted = not $ inverted order}- eLst = entryList tab- entries = listElements eLst- index = selectedIndex eLst- newIndex = Just $ if index == 0 then 0 else Vect.length entries - index- reversed = Vect.cons (Vect.head entries) . Vect.reverse $ Vect.tail entries- newEntryList = listReplace reversed newIndex eLst+invertOrder tab = tab + & orderInverted %~ not + & entryList.listElementsL._tail %~ Vect.reverse+ & entryList.listSelectedL %~ fmap (\idx -> if idx == 0 then 0 else size - idx)+ where size = views (entryList.listElementsL) Vect.length tab reload :: PaneName -> Tab -> IO Tab reload pName tab = case tab of 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+ 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.Entry -> Tab-keepSelection tab newList = tab {entryList = listMoveTo index newList}- where- fstDir = Vect.head . listElements $ entryList tab- selected = fromMaybe fstDir $ selectedEntry tab- index = fromMaybe 0 . Vect.elemIndex selected $ listElements newList+keepSelection tab newList = tab + & entryList.listElementsL .~ newElems+ & entryList.listSelectedL ?~ fromMaybe 0 ((`Vect.elemIndex` newElems) =<< selectedEntry tab)+ where newElems = listElements newList moveToRow :: Int -> Tab -> Tab moveToRow _ Empty = Empty-moveToRow row tab = tab {entryList = listMoveTo row $ entryList tab}+moveToRow row tab = tab & entryList %~ listMoveTo row --- utility functions+-- utility+isDir :: Tab -> Bool+isDir Dir {} = True+isDir _ = False++isSearch :: Tab -> Bool+isSearch Search {} = True+isSearch _ = False++isEmpty :: Tab -> Bool+isEmpty Empty = True+isEmpty _ = False+ selectedEntry :: Tab -> Maybe Entry.Entry selectedEntry Empty = Nothing-selectedEntry tab = case listSelectedElement $ entryList tab of- Just (_, entry) -> Just entry- _ -> Nothing--selectedIndex :: List Name Entry.Entry -> Int-selectedIndex entries = case listSelectedElement entries of- Just (n, _) -> n- _ -> 0+selectedEntry tab = snd <$> listSelectedElement (view entryList tab) nextOrderType :: OrderType -> OrderType nextOrderType order@@ -194,11 +221,15 @@ | otherwise = succ order sortEntries :: EntryOrder -> [Entry.Entry] -> [Entry.Entry]-sortEntries order = (if inverted order then reverse else id) . case orderType order of- 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)+sortEntries order+ | view entryOrderInverted order = reverse . orderOn+ | otherwise = orderOn+ where + orderOn = case view entryOrderType order of+ FileName -> sortOn (map toLower . view Entry.name)+ FileSize -> sortOn (view Entry.size)+ AccessTime -> sortOn (fromMaybe zeroTime . preview Entry.accessTime)+ ModificationTime -> sortOn (fromMaybe zeroTime . preview Entry.modifTime) zeroTime :: UTCTime zeroTime = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0)