summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpasqu4le <>2018-04-16 09:17:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-04-16 09:17:00 (GMT)
commit5b6f36563056166ac9918249ac1accca18818a66 (patch)
tree7895fd06dde7d0b5110a43e119c65f4feabe255e
version 0.3.1.00.3.1.0
-rw-r--r--LICENSE30
-rw-r--r--README.md117
-rw-r--r--Setup.hs2
-rw-r--r--clifm.cabal88
-rw-r--r--src/Main.hs93
-rw-r--r--src/Types.hs48
-rw-r--r--src/Widgets/Manager.hs174
-rw-r--r--src/Widgets/Menu.hs118
-rw-r--r--src/Widgets/Pane.hs107
-rw-r--r--src/Widgets/Prompt.hs286
-rw-r--r--src/Widgets/Tab.hs298
11 files changed, 1361 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..07995f6
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2018, pasqu4le
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of pasqu4le nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..25daa66
--- /dev/null
+++ b/README.md
@@ -0,0 +1,117 @@
+# Command Line Interface File Manager
+Clifm is a small file manager written in Haskell with a terminal-based interface. It allows you to explore directories in multiple Panes/Tabs and perform basic operations.
+
+![screenshot](screenshot.png)
+
+> 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
+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.
+
+To build from source you will need [GHC](https://www.haskell.org/ghc/) and [cabal-install](http://hackage.haskell.org/package/cabal-install).
+Since clifm is on Hackage you can just use:
+
+```
+$ cabal install clifm
+```
+or install from the cloned repository:
+```
+$ git clone https://github.com/pasqu4le/clifm.git
+$ cd clifm
+$ cabal install
+```
+
+## 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:
+
+#### Bottom menu
+- L: open Se**l**ection menu
+- A: open T**a**b menu
+- P: open **P**ane menu
+- BackSpace: go **back** to main menu
+- Esc/Q: **Q**uit
+
+#### Selection
+- Enter: Open directory/run executable file/open readable file in editor
+- Ctrl+(X/C): Cut/Copy the selected Item
+- Up/Down Arrow: move the selection in the current Tab
+- PageUp/PageDown: move the selection in the current Tab by one page at a time
+- Home/End: move the selection in the current Tab to beginning or end of list
+- Ctrl+R: **R**ename the selected Item
+- Ctrl+D: **D**elete the selected Item
+- Ctrl+O: **O**pen the selected directory in a New Tab
+- S: **S**how info about the selected Item
+
+#### Tabs
+- Tab/BackTab: Move to the next/previous tab
+- Ctrl+(Left/Right Arrow): Swap current tab's position with the previous/next one
+- Ctrl+V: Paste in the current Tab's directory
+- Ctrl+S: **S**earch for a file/folder in the current Tab's directory
+- K: **K**ill (close) the current Tab
+- M: **M**ake a new directory
+- T: **T**ouch (create an empty) file
+- G: **G**o to another directory
+- E: Open **E**mpty Tab
+- R: **R**efresh the current Tab
+- O: **O**rder by file name/file size/access time/modification time
+- I: **I**nvert order
+
+#### Panes
+- Left/Right Arrow: Focus on the previous/next Pane
+- Ctrl+E: Open **E**mpty Pane
+- Ctrl+K: **K**ill (close) the current Pane
+
+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`.
+
+#### Starting directory
+If you specify nothing `clifm` will open the current directory, but you can select another directory using `--dir-path` or `-d`, for example: `clifm -d "/home"`.
+
+If the directory path is not valid `clifm` will open on an empty tab.
+
+#### Themes
+You can load a theme from a file using `--theme` or `-t`, for example: `clifm -t "theme/phosphor.ini"`. If the file does not exists or cannot be loaded `clifm` will use the default theme.
+
+You can use one of the existing themes in the `themes/` folder:
+- blackAndWhite.ini
+- paper.ini (inverted blackAndWhite)
+- phosphor.ini (like old monochrome monitors)
+- ocean.ini (very blue)
+
+You can also write and use your own themes: copy the `themes/template.ini` file, fill in the attributes you want to change and delete those you like as default.
+
+Complete explanation from [Brick.Themes](https://hackage.haskell.org/package/brick-0.35/docs/Brick-Themes.html):
+> The file format is as follows:
+>
+> Customization files are INI-style files with two sections, both optional: "default" and "other".
+>
+> The "default" section specifies three optional fields:
+>
+> - "default.fg" - a color specification
+> - "default.bg" - a color specification
+> - "default.style" - a style specification
+>
+> A color specification can be any of the strings *black*, *red*, *green*, *yellow*, *blue*, *magenta*, *cyan*, *white*, *brightBlack*, *brightRed*, *brightGreen*, *brightYellow*, *brightBlue*, *brightMagenta*, *brightCyan*, *brightWhite*, or *default*.
+>
+> A style specification can be either one of the following values (without quotes) or a comma-delimited list of one or more of the following values (e.g. "[bold,underline]") indicating that all of the specified styles be used. Valid styles are *standout*, *underline*, *reverseVideo*, *blink*, *dim*, and *bold*.
+>
+> The other section specifies for each attribute name in the theme the same fg, bg, and style settings as for the default attribute. Furthermore, if an attribute name has multiple components, the fields in the INI file should use periods as delimiters. For example, if a theme has an attribute name ("foo" <> "bar"), then the file may specify three fields:
+>
+> - foo.bar.fg - a color specification
+> - foo.bar.bg - a color specification
+> - foo.bar.style - a style specification
+>
+> Any color or style specifications omitted from the file mean that those attribute or style settings will use the theme's default value instead.
+>
+> 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".
+
+## TODOs
+- mc directory comparison (need to solve the next point first)
+- find a way to read correctly a directory size in reasonable time
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/clifm.cabal b/clifm.cabal
new file mode 100644
index 0000000..1e999e7
--- /dev/null
+++ b/clifm.cabal
@@ -0,0 +1,88 @@
+-- Initial clifm.cabal generated by cabal init. For further documentation,
+-- see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name: clifm
+
+-- The package version. See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- https://wiki.haskell.org/Package_versioning_policy
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.3.1.0
+
+-- A short (one-line) description of the package.
+synopsis: Command Line Interface File Manager
+
+-- A longer description of the package.
+description: A terminal-based File Manager with multiple panes/tabs interface, basic file operations and mouse support.
+
+-- URL for the project homepage or repository.
+homepage: https://github.com/pasqu4le/clifm
+
+-- The license under which the package is released.
+license: BSD3
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: pasqu4le
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer: pasqu4le@gmail.com
+
+-- A copyright notice.
+-- copyright:
+
+category: System
+
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+extra-source-files: README.md
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version: >=1.10
+
+source-repository head
+ type: git
+ location: git://github.com/pasqu4le/clifm.git
+
+executable clifm
+ ghc-options: -threaded
+ -- .hs or .lhs file containing the Main module.
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ other-modules: Types
+ Widgets.Manager
+ Widgets.Pane
+ Widgets.Tab
+ Widgets.Menu
+ Widgets.Prompt
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends: base >=4.10 && <4.11,
+ directory >=1.3 && <1.4,
+ optparse-applicative >=0.14 && <0.15,
+ brick >=0.34 && <0.35,
+ filepath >=1.4 && <1.5,
+ vty >= 5.17 && <6,
+ vector >= 0.12 && <0.13,
+ time >=1.8 && <1.10,
+ process >=1.6 && <1.7,
+ pointedlist >= 0.6 && <0.7,
+ byteunits >= 0.4 && <0.5
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..03aeb89
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,93 @@
+module Main where
+import Types
+import Widgets.Manager
+import Widgets.Tab (Tab)
+
+import Options.Applicative
+import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute)
+import Data.Semigroup ((<>))
+import Control.Monad (void)
+import Brick.Main (customMain, showFirstCursor, App(..))
+import Brick.Themes (Theme, themeToAttrMap, loadCustomizations)
+import Brick.AttrMap (AttrMap)
+import Brick.BChan (newBChan)
+import Graphics.Vty (mkVty, standardIOConfig, setMode, outputIface, Mode(Mouse))
+
+-- entry point: parses the arguments and starts the brick application
+
+-- options
+data FMOptions = FMOptions {dirPath :: FilePath, editComm :: String, themeType :: ThemeType}
+data ThemeType = CustomTheme FilePath | DefaultTheme
+
+-- argument parsing functions
+opts :: Parser FMOptions
+opts = FMOptions
+ <$> strOption
+ ( long "dir-path"
+ <> short 'd'
+ <> metavar "FILEPATH"
+ <> help "Directory to open"
+ <> showDefault
+ <> value ".")
+ <*> strOption
+ ( long "editor"
+ <> short 'e'
+ <> help "Editor command/path (file path will be appended to this)"
+ <> showDefault
+ <> value "nano")
+ <*> (customTheme <|> defTheme)
+
+customTheme :: Parser ThemeType
+customTheme = CustomTheme <$> strOption
+ ( long "theme"
+ <> short 't'
+ <> metavar "FILEPATH"
+ <> help "Load a custom theme from an INI file" )
+
+defTheme :: Parser ThemeType
+defTheme = flag DefaultTheme DefaultTheme
+ ( long "default-theme"
+ <> short 'd'
+ <> help "Use the default theme" )
+
+main :: IO ()
+main = runUI =<< execParser options
+ where
+ options = info (opts <**> helper)
+ ( fullDesc
+ <> header "Command Line Interface File Manager"
+ <> progDesc "A simple CLI-based File Manager" )
+
+runUI :: FMOptions -> IO ()
+runUI options = do
+ isDir <- doesDirectoryExist $ dirPath options
+ path <- if isDir then makeAbsolute $ dirPath options else return []
+ theme <- loadTheme $ themeType options
+ let atrm = themeToAttrMap theme
+ buildVty = do
+ v <- mkVty =<< standardIOConfig
+ setMode (outputIface v) Mouse True
+ return v
+ eventChan <- Brick.BChan.newBChan 10
+ state <- 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,
+ appStartEvent = return,
+ appHandleEvent = handleEvent,
+ appAttrMap = const atrm,
+ appChooseCursor = showFirstCursor
+ }
+
+loadTheme :: ThemeType -> IO Theme
+loadTheme selTheme = case selTheme of
+ DefaultTheme -> return defaultTheme
+ CustomTheme path -> do
+ isFile <- doesFileExist path
+ if not isFile then return defaultTheme
+ else do
+ customTheme <- loadCustomizations path defaultTheme
+ return $ case customTheme of
+ Right theme -> theme
+ Left _ -> defaultTheme
diff --git a/src/Types.hs b/src/Types.hs
new file mode 100644
index 0000000..30b8384
--- /dev/null
+++ b/src/Types.hs
@@ -0,0 +1,48 @@
+module Types where
+
+import Data.Monoid ((<>))
+import Brick.Widgets.Core (withDefAttr, str)
+import Brick.Types (Widget)
+import Brick.Themes (Theme, newTheme)
+import Brick.AttrMap (AttrName, AttrMap, attrName, attrMap)
+import Graphics.Vty (Key(..), defAttr, withStyle, underline, black, yellow, white, blue, red)
+import Brick.Util (on, fg, bg)
+import Brick.Widgets.Edit (editFocusedAttr)
+import Brick.Widgets.List (listSelectedFocusedAttr, listSelectedAttr)
+
+-- data definitions
+data Name = Button {keyBind :: Key, withCtrl :: Bool} |
+ LabelsRow {pnName :: PaneName} |
+ Label {pnName :: PaneName, labelNum :: Int} |
+ PromptEditor |
+ EntryList {pnName :: PaneName} deriving (Ord, Show, Eq)
+data ThreadEvent a = ThreadClosed | ThreadSuccess a | ThreadError String
+type PaneName = Int
+
+-- attributes and themes
+defaultTheme :: Theme
+defaultTheme = newTheme (white `on` black) [
+ (listSelectedAttr, fg yellow),
+ (listSelectedFocusedAttr, black `on` yellow),
+ (keybindAttr, fg white `withStyle` underline),
+ (promptAttr, bg blue),
+ (errorAttr, bg red),
+ (editFocusedAttr, black `on` yellow),
+ (disclaimerAttr, black `on` white)
+ ]
+
+keybindAttr :: AttrName
+keybindAttr = attrName "keybind"
+
+promptAttr :: AttrName
+promptAttr = attrName "prompt"
+
+errorAttr :: AttrName
+errorAttr = attrName "error"
+
+disclaimerAttr :: AttrName
+disclaimerAttr = attrName "disclaimer"
+
+-- utility functions
+keybindStr :: String -> Widget Name
+keybindStr = withDefAttr keybindAttr . str
diff --git a/src/Widgets/Manager.hs b/src/Widgets/Manager.hs
new file mode 100644
index 0000000..4837386
--- /dev/null
+++ b/src/Widgets/Manager.hs
@@ -0,0 +1,174 @@
+module Widgets.Manager where
+import Types
+import Widgets.Pane
+import Widgets.Tab
+import Widgets.Menu
+import Widgets.Prompt
+
+import System.Process (callCommand)
+import Control.Exception (try, SomeException)
+import Brick.Main (continue, halt, suspendAndResume)
+import Brick.Widgets.Core ((<+>), str, 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 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.Circular (next, previous)
+
+data State = State {paneZipper :: PaneZipper,
+ lastPaneName :: PaneName,
+ bottomMenu :: Menu,
+ prompt :: Maybe Prompt,
+ editorCommand :: String,
+ eventChan :: BChan (ThreadEvent Tab)
+ }
+type PaneZipper = PointedList Pane
+
+-- creation functions
+makeState :: FilePath -> String -> BChan (ThreadEvent Tab) -> IO State
+makeState path editCom eChan = do
+ pane <- makePane 0 path
+ return $ State (singleton pane) 0 makeMenu Nothing editCom eChan
+
+-- rendering functions
+drawUi :: State -> [Widget Name]
+drawUi state = case prompt state of
+ Just pr -> [renderPrompt 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)
+
+renderPanes :: PaneZipper -> Widget Name
+renderPanes = hBox . intersperse vBorder . map renderPane . toList . withFocus
+
+-- event handling functions
+handleEvent :: State -> BrickEvent Name (ThreadEvent 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 ev pr state = do
+ promptRes <- handlePromptEvent 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
+
+handleMain :: BrickEvent Name (ThreadEvent 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 (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 'e') [MCtrl] -> addPane
+ EvKey (KChar 'k') [MCtrl] -> closePane
+ EvKey KLeft [] -> previousPane
+ EvKey KRight [] -> nextPane
+ _ -> updateCurrentPane (handlePaneEvent 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
+ 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 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}
+
+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}
+ _ -> st
+
+updatePrompt :: Prompt -> State -> EventM Name (Next State)
+updatePrompt pr st = continue $ st {prompt=Just pr}
+
+openPrompt :: (Tab -> PaneName -> 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
+
+openPromptWithClip :: (Clipboard -> Tab -> PaneName -> Prompt) -> State -> EventM Name (Next State)
+openPromptWithClip func state = openPrompt (func . 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
+ _ -> continue state
+
+openTabFile :: Entry -> State -> EventM Name (Next State)
+openTabFile fileEntry
+ | isExecutable fileEntry = suspendAndResume . runExternal (entryPath fileEntry)
+ | isReadable fileEntry = suspendAndResume . runExternalEditor (entryPath fileEntry)
+ | otherwise = continue
+
+runExternalEditor :: FilePath -> State -> IO State
+runExternalEditor path s = runExternal (unwords [editorCommand s, path]) s
+
+runExternal :: String -> State -> IO State
+runExternal com s = do
+ try $ callCommand com :: IO (Either SomeException ())
+ putStrLn " "
+ putStrLn "Done. Press ENTER to go back to clifm"
+ getLine
+ return s
+
+openTabDir :: Bool -> State -> EventM Name (Next State)
+openTabDir inNew = updateCurrentPane (openSelectedDir 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
+
+closePane :: State -> EventM Name (Next State)
+closePane state = continue $ case delete $ paneZipper state of
+ Just newZipper -> state {paneZipper = newZipper}
+ _ -> state
+
+nextPane :: State -> EventM Name (Next State)
+nextPane state = continue $ state {paneZipper = next $ paneZipper state}
+
+previousPane :: State -> EventM Name (Next State)
+previousPane state = continue $ state {paneZipper = previous $ paneZipper state}
+
+-- pane and paneZipper utility functions
+currentPane :: State -> Pane
+currentPane = _focus . paneZipper
+
+focusOnPane :: PaneName -> State -> State
+focusOnPane pName state = case find (makeEmptyPane pName) $ paneZipper state of
+ Just newZipper -> state {paneZipper = newZipper}
+ _ -> state
diff --git a/src/Widgets/Menu.hs b/src/Widgets/Menu.hs
new file mode 100644
index 0000000..89edc4b
--- /dev/null
+++ b/src/Widgets/Menu.hs
@@ -0,0 +1,118 @@
+module Widgets.Menu where
+import Types
+import Widgets.Pane
+import Widgets.Tab
+
+import Data.Char (toUpper)
+import System.FilePath (takeFileName)
+import Brick.Widgets.Core ((<+>), str, hLimit, hBox, clickable)
+import Brick.Types (Widget)
+import Brick.Widgets.Border (borderWithLabel, border)
+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
+
+instance Show Clipboard where
+ show EmptyBoard = " -empty- "
+ show board = takeFileName . entryPath $ fromEntry board
+
+-- creation functions
+makeMenu :: Menu
+makeMenu = Menu {clipboard = EmptyBoard, menuType = MainMenu}
+
+makeCopyBoard :: Entry -> Clipboard
+makeCopyBoard = CopyBoard
+
+makeCutBoard :: Entry -> Clipboard
+makeCutBoard = CutBoard
+
+-- rendering functions
+renderMenu :: Menu -> Pane -> Widget Name
+renderMenu m = hBox . (renderClipboard (clipboard m) :) . renderButtons (menuType m)
+
+renderButtons :: MenuType -> 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
+
+renderButton :: (Widget Name, Maybe String, Name) -> Widget Name
+renderButton (bContent, bLabel, bName) = clickable bName $ case bLabel of
+ Just txt -> borderWithLabel (str txt) bContent
+ Nothing -> border bContent
+
+mainButtons :: [(Widget Name, Maybe String, Name)]
+mainButtons = [
+ (str "se" <+> keybindStr "l" <+> str "ection menu", Nothing, Button {keyBind = KChar 'l', withCtrl = False}),
+ (str "t" <+> keybindStr "a" <+> str "b menu", Nothing, Button {keyBind = KChar 'a', withCtrl = False}),
+ (keybindStr "p" <+> str "ane menu", Nothing, Button {keyBind = KChar 'p', withCtrl = False}),
+ (keybindStr "q" <+> str "uit", Nothing, Button {keyBind = KChar 'q', withCtrl = False})
+ ]
+
+selectionButtons :: Maybe 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})]
+ _ -> []
+
+anySelectionButtons :: [(Widget Name, Maybe String, Name)]
+anySelectionButtons = [
+ (str "cut", ctrlText 'x', Button {keyBind = KChar 'x', withCtrl = True}),
+ (str "copy", ctrlText 'c', Button {keyBind = KChar 'c', withCtrl = True}),
+ (keybindStr "r" <+> str "ename", ctrlText 'r', Button {keyBind = KChar 'r', withCtrl = True}),
+ (keybindStr "d" <+> str "elete", ctrlText 'd', Button {keyBind = KChar 'd', withCtrl = True}),
+ (keybindStr "s" <+> str "how info", Nothing, Button {keyBind = KChar 's', withCtrl = False})
+ ]
+
+tabButtons :: Tab -> [(Widget Name, Maybe String, Name)]
+tabButtons tab = case tab of
+ DirTab {entryOrder = order} -> dirTabButtons ++ entryTabButtons order ++ anyTabButtons
+ SearchTab {entryOrder = order} -> entryTabButtons order ++ anyTabButtons
+ _ -> anyTabButtons
+
+dirTabButtons :: [(Widget Name, Maybe String, Name)]
+dirTabButtons = [
+ (str "paste", ctrlText 'v', Button {keyBind = KChar 'v', withCtrl = True}),
+ (keybindStr "s" <+> str "earch", ctrlText 's', Button {keyBind = KChar 's', withCtrl = True}),
+ (keybindStr "m" <+> str "ake dir", Nothing, Button {keyBind = KChar 'm', withCtrl = False}),
+ (keybindStr "t" <+> str "ouch file", Nothing, Button {keyBind = KChar 't', withCtrl = False})
+ ]
+
+entryTabButtons :: 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 "i" <+> str "nvert order", Nothing, Button {keyBind = KChar 'i', withCtrl = False})
+ ]
+
+anyTabButtons :: [(Widget Name, Maybe String, Name)]
+anyTabButtons = [
+ (keybindStr "g" <+> str "o to", Nothing, Button {keyBind = KChar 'g', withCtrl = False}),
+ (keybindStr "e" <+> str "mpty tab", Nothing, Button {keyBind = KChar 'e', withCtrl = False}),
+ (keybindStr "k" <+> str "ill tab", Nothing, Button {keyBind = KChar 'k', withCtrl = False})
+ ]
+
+paneButtons :: [(Widget Name, Maybe String, Name)]
+paneButtons = [
+ (keybindStr "e" <+> str "mpty pane", ctrlText 'e', Button {keyBind = KChar 'e', withCtrl = True}),
+ (keybindStr "k" <+> str "ill pane", ctrlText 'k', Button {keyBind = KChar 'k', withCtrl = True})
+ ]
+
+ctrlText :: Char -> Maybe String
+ctrlText c = Just $ "C-" ++ [toUpper c]
+
+backButton :: (Widget Name, Maybe String, Name)
+backButton = (str "<_", Nothing, Button {keyBind = KBS, withCtrl = False})
+
+renderClipboard :: Clipboard -> Widget Name
+renderClipboard = hLimit 24 . borderWithLabel (str "clipboard") . str . show
+
+-- state changing functions
+changeMenu :: MenuType -> Menu -> Menu
+changeMenu tp menu = menu {menuType = tp}
+
+changeClipboard :: Clipboard -> Menu -> Menu
+changeClipboard cb menu = menu {clipboard = cb}
diff --git a/src/Widgets/Pane.hs b/src/Widgets/Pane.hs
new file mode 100644
index 0000000..51ea357
--- /dev/null
+++ b/src/Widgets/Pane.hs
@@ -0,0 +1,107 @@
+module Widgets.Pane where
+import Types
+import Widgets.Tab
+
+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.Circular (next, previous)
+
+data Pane = Pane {paneName :: PaneName, tabZipper :: TabZipper}
+type TabZipper = PointedList Tab
+
+instance Eq Pane where
+ Pane {paneName = p1} == Pane {paneName = p2} = p1 == p2
+
+-- creation functions
+makePane :: PaneName -> FilePath -> IO Pane
+makePane pName path = Pane pName . singleton <$> makeDirTab pName path
+
+makeEmptyPane :: PaneName -> Pane
+makeEmptyPane pName = Pane pName . singleton $ makeEmptyTab
+
+-- 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
+
+renderLabels :: PaneName -> TabZipper -> Widget Name
+renderLabels pName zipper = hBox . map (clickableLabel pName) $ zip labels [0..]
+ where labels = map 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
+ EvKey (KChar 'k') [] -> updateTabZipper removeTab
+ EvKey (KChar 'e') [] -> updateTabZipper (insert makeEmptyTab)
+ EvKey (KChar 'r') [] -> reloadCurrentTab
+ EvKey (KChar '\t') [] -> updateTabZipper next
+ EvKey KBackTab [] -> updateTabZipper previous
+ EvKey KLeft [MCtrl] -> updateTabZipper swapWithPrevious
+ EvKey KRight [MCtrl] -> updateTabZipper swapWithNext
+ _ -> updateCurrentTab event
+
+-- state-changing functions
+updateTabZipper :: (TabZipper -> TabZipper) -> Pane -> EventM Name Pane
+updateTabZipper func pane = return $ pane {tabZipper = func $ tabZipper pane}
+
+reloadCurrentTab :: Pane -> EventM Name Pane
+reloadCurrentTab pane = do
+ reloaded <- liftIO . reload (paneName pane) $ currentTab pane
+ updateTabZipper (replace reloaded) pane
+
+updateCurrentTab :: Event -> Pane -> EventM Name Pane
+updateCurrentTab event pane = do
+ updated <- handleTabEvent 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
+ _ -> return pane
+
+-- tab and tabZipper utility functions
+moveTabToRow :: Int -> Pane -> EventM Name Pane
+moveTabToRow row pane = updateTabZipper (replace (moveToRow row $ currentTab pane)) pane
+
+currentTab :: Pane -> Tab
+currentTab = _focus . tabZipper
+
+removeTab :: TabZipper -> TabZipper
+removeTab zipper = case delete zipper of
+ Just newZipper -> newZipper
+ _ -> singleton makeEmptyTab
+
+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
+ | 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
+ | atStart zipper && atEnd zipper = zipper
+ | atEnd zipper = insertLeft (_focus zipper) . next $ removeTab zipper
+ | otherwise = insert (_focus zipper) $ removeTab zipper
diff --git a/src/Widgets/Prompt.hs b/src/Widgets/Prompt.hs
new file mode 100644
index 0000000..7561946
--- /dev/null
+++ b/src/Widgets/Prompt.hs
@@ -0,0 +1,286 @@
+module Widgets.Prompt where
+import Types
+import Widgets.Tab
+import Widgets.Menu
+
+import Data.Monoid ((<>))
+import Data.Functor (($>))
+import Control.Monad(when,forM_)
+import Control.Monad.IO.Class (liftIO)
+import Control.Concurrent (forkFinally, ThreadId, killThread)
+import Control.Exception (try, throw, displayException, SomeException, fromException)
+import Control.Exception.Base (AsyncException(ThreadKilled))
+import Control.Applicative ((*>), (<$>))
+import Brick.Widgets.Core ((<+>), str, strWrap, vBox, hLimit, padLeftRight, padTopBottom, withDefAttr)
+import Brick.Widgets.Border (borderWithLabel, hBorder)
+import Brick.Types (Widget, EventM, BrickEvent(..))
+import Brick.Widgets.Center (centerLayer, hCenter)
+import Brick.Widgets.Edit (Editor, editor, renderEditor, getEditContents, handleEditorEvent)
+import Brick.BChan (BChan, writeBChan)
+import Graphics.Vty (Event(EvKey), Key(..))
+import Data.Time.Format (formatTime, defaultTimeLocale)
+import System.FilePath (isValid, takeDirectory, (</>), takeFileName)
+import System.Directory (doesFileExist, doesDirectoryExist, createDirectory, renameFile,
+ copyFileWithMetadata, renameFile, removeFile, removeDirectoryRecursive, getDirectoryContents,
+ readable, writable, executable, searchable)
+
+data Prompt = Prompt {originTab :: Tab, originPane :: PaneName, action :: PromptAction} deriving Show
+type PathEditor = Editor FilePath Name
+data PromptAction = Copy Entry FilePath | Cut Entry FilePath | Rename PathEditor Entry |
+ Delete Entry | Mkdir PathEditor FilePath | Touch PathEditor FilePath |
+ GoTo PathEditor | Search PathEditor FilePath | DisplayInfo EntryInfo |
+ DisplayError String | Performing String ThreadId
+
+instance Show PromptAction where
+ show (Copy _ _) = " Copy "
+ show (Cut _ _) = " Cut "
+ show (Rename _ _) = " Rename "
+ show (Delete _) = " Delete "
+ show (Mkdir _ _) = " Make Directory "
+ show (Touch _ _) = " Touch File "
+ show (GoTo _) = " Go To "
+ show (DisplayInfo _) = " Entry Info "
+ show (Search _ _) = " Search "
+ show (Performing name _) = " Performing" ++ name
+ show _ = " Error "
+
+-- creation functions
+emptyPathEditor :: PathEditor
+emptyPathEditor = makePathEditor []
+
+makePathEditor :: FilePath -> PathEditor
+makePathEditor = editor PromptEditor (Just 1)
+
+makePastePrompt :: Clipboard -> Tab -> PaneName -> Prompt
+makePastePrompt c tab pName = Prompt tab pName $ case (c, tab) of
+ (EmptyBoard, _) -> DisplayError "The clipboard is empty"
+ (_, EmptyTab) -> DisplayError "You cannot paste into an empty tab"
+ (_, SearchTab {}) -> DisplayError "You cannot paste into a search tab"
+ (CopyBoard {fromEntry = entry}, DirTab{tabPath = path}) -> Copy entry path
+ (CutBoard {fromEntry = entry}, DirTab{tabPath = path}) -> Cut entry path
+
+makeGoToPrompt :: Tab -> PaneName -> Prompt
+makeGoToPrompt tab pName = Prompt tab pName $ GoTo emptyPathEditor
+
+makeRenamePrompt :: Tab -> PaneName -> Prompt
+makeRenamePrompt = withSelectedEntry (\en -> Rename (editorFromEntry en) en)
+ where editorFromEntry = makePathEditor . takeFileName . entryPath
+
+makeDeletePrompt :: Tab -> PaneName -> Prompt
+makeDeletePrompt = withSelectedEntry Delete
+
+makeMkdirPrompt :: Tab -> PaneName -> Prompt
+makeMkdirPrompt = withDirTabPath (Mkdir emptyPathEditor)
+
+makeTouchPrompt :: Tab -> PaneName -> Prompt
+makeTouchPrompt = withDirTabPath (Touch emptyPathEditor)
+
+makeDisplayInfoPrompt :: Tab -> PaneName -> Prompt
+makeDisplayInfoPrompt = withSelectedEntry (DisplayInfo . entryInfo)
+
+makeSearchPrompt :: Tab -> PaneName -> Prompt
+makeSearchPrompt = withDirTabPath (Search emptyPathEditor)
+
+withSelectedEntry :: (Entry -> PromptAction) -> Tab -> PaneName -> Prompt
+withSelectedEntry func tab pName = Prompt tab pName $ case selectedEntry tab of
+ Just entry -> func entry
+ _ -> DisplayError "This tab does not have a selected entry"
+
+withDirTabPath :: (FilePath -> PromptAction) -> Tab -> PaneName -> Prompt
+withDirTabPath func tab pName = Prompt tab pName $ case tab of
+ DirTab {tabPath = path} -> func path
+ _ -> DisplayError "This tab does not represent a directory"
+
+-- rendering functions
+renderPrompt :: Prompt -> Widget Name
+renderPrompt prompt = centerLayer . box $ vBox [body, hBorder, footer]
+ where
+ box = withDefAttr promptAttr . borderWithLabel (str . show $ action prompt) . hLimit 70
+ body = padLeftRight 2 . padTopBottom 1 $ renderBody prompt
+ footer = hCenter . renderFooter $ action prompt
+
+renderBody :: Prompt -> Widget Name
+renderBody pr = vBox $ case action pr of
+ Copy en path -> disclaimer : map strWrap [tellEntry en <> " will be copied from:", takeDirectory $ entryPath en, "to: ", path]
+ Cut en path -> disclaimer : map strWrap [tellEntry en <> " will be moved from:", takeDirectory $ entryPath en, "to: ", path]
+ Rename edit en -> disclaimer : strWrap (tellEntry en <> " will be renamed to:") : renderValidatedEditor edit
+ Delete en -> [disclaimer, strWrap $ tellEntry en <> " will be permanently deleted"]
+ Mkdir edit _ -> str "Directory name:" : renderValidatedEditor edit
+ Touch edit _ -> str "File name:" : renderValidatedEditor edit
+ GoTo edit -> str "Directory to open:" : renderValidatedEditor edit
+ Search edit _ -> str "Search for:" : renderValidatedEditor edit
+ DisplayInfo info -> map strWrap . (displaySize info :) $ displayPerms info ++ displayTimes info
+ DisplayError msg -> [str "Whoops, this went wrong:", withDefAttr errorAttr $ strWrap msg]
+ Performing name _ -> [str $ "Performing" ++ name, str "Please wait"]
+
+displaySize :: EntryInfo -> String
+displaySize info = "Size: " ++ show (entrySize info) ++ " Bytes (" ++ shortEntrySize info ++ ")"
+
+displayPerms :: EntryInfo -> [String]
+displayPerms info = case entryPerms info of
+ Nothing -> [" ", "Permissions unknown", "(could not read them)"]
+ Just p -> [
+ " ",
+ "Is readable: " <> (if readable p then "yes" else "no"),
+ "Is writable: " <> (if writable p then "yes" else "no"),
+ "Is executable: " <> (if executable p then "yes" else "no"),
+ "Is searchable: " <> (if searchable p then "yes" else "no")
+ ]
+
+displayTimes :: EntryInfo -> [String]
+displayTimes info = case entryTimes info of
+ Nothing -> [" ", "Last access and modification times unknown", "(could not read them)"]
+ Just (acTm, mdTm) -> [" ", "Last access time:" <> format acTm, "Last modification time:" <> format mdTm]
+ where format = formatTime defaultTimeLocale " %T %B %-d %Y"
+
+tellEntry :: Entry -> String
+tellEntry e = case e of
+ DirEntry {entryName = name} -> "The directory " <> name <> " (and all it's content)"
+ FileEntry {entryName = name} -> "The file " <> name
+
+disclaimer :: Widget Name
+disclaimer = withDefAttr disclaimerAttr $ strWrap "NOTE: this will operate on \
+ \your file system and may be irreversible, double check it! Also please note \
+ \that the operation can be stopped, but will not revert what was already done."
+
+renderValidatedEditor :: PathEditor -> [Widget Name]
+renderValidatedEditor e = [renderEditor (str . unlines) True e, validLine]
+ where
+ validLine = if isValid $ getEditLine e
+ then str " "
+ else withDefAttr errorAttr $ str " ^ invalid filepath!"
+
+renderFooter :: PromptAction -> Widget Name
+renderFooter act = case act of
+ Performing _ _ -> kb "Esc" <+> str " to Cancel. NOTE: will not revert what was already done."
+ _ -> kb "Enter" <+> str txt <+> kb "Esc" <+> str " to close and go back"
+ where
+ kb = withDefAttr keybindAttr . str
+ txt = case act of
+ Copy _ _ -> " to copy, "
+ Cut _ _ -> " to move, "
+ Rename _ _ -> " to rename, "
+ Delete _ -> " to delete, "
+ Mkdir _ _ -> " to make the directory, "
+ Touch _ _ -> " to touch the file, "
+ GoTo _ -> " to change directory, "
+ Search _ _ -> " to search, "
+ _ -> " or "
+
+-- event-handling functions
+handlePromptEvent :: BrickEvent Name (ThreadEvent Tab) -> Prompt -> BChan (ThreadEvent Tab) -> EventM Name (Either Prompt Tab)
+handlePromptEvent (AppEvent ev) pr _ = case ev of
+ ThreadError err -> return $ Left pr {action = DisplayError err}
+ ThreadSuccess tab -> return $ Right tab
+ ThreadClosed -> return . Right $ originTab pr
+handlePromptEvent (VtyEvent ev) pr eChan = case ev of
+ EvKey KEsc [] -> liftIO $ exitPrompt pr
+ EvKey KEnter [] -> liftIO $ performAction pr eChan
+ _ -> Left . Prompt (originTab pr) (originPane pr) <$> handleActionEditor ev (action pr)
+handlePromptEvent _ pr _ = return $ Left pr
+
+exitPrompt :: Prompt -> IO (Either Prompt Tab)
+exitPrompt pr = case action pr of
+ Performing name tId -> killThread tId $> Left pr -- returns the same prompt because the actual exiting will happen because of the exception that killThread raises
+ _ -> return . Right $ originTab pr
+
+-- gets to decide if the action will be processed in a different thread or not
+performAction :: Prompt -> BChan (ThreadEvent Tab) -> IO (Either Prompt Tab) --
+performAction pr eChan = case action pr of
+ Copy _ _ -> Left <$> processThreaded pr eChan
+ Cut _ _ -> Left <$> processThreaded pr eChan
+ Rename _ _ -> Left <$> processThreaded pr eChan
+ Delete _ -> Left <$> processThreaded pr eChan
+ Search _ _ -> Left <$> processThreaded pr eChan
+ Performing _ _ -> return $ Left pr -- doesn't really make sense
+ _ -> tryProcessAction pr
+
+processThreaded :: Prompt -> BChan (ThreadEvent Tab) -> IO Prompt
+processThreaded pr eChan = do
+ tId <- forkFinally (processAction pr) (reportResult eChan)
+ return $ pr {action = Performing (show $ action pr) tId}
+
+reportResult :: BChan (ThreadEvent Tab) -> Either SomeException Tab -> IO ()
+reportResult eChan res = writeBChan eChan $ case res of
+ Left e -> endingEvent e
+ Right tabRes -> ThreadSuccess tabRes
+
+endingEvent :: SomeException -> ThreadEvent Tab
+endingEvent e = case (fromException e :: Maybe AsyncException) of
+ Just ThreadKilled -> ThreadClosed
+ _ -> ThreadError $ displayException e
+
+tryProcessAction :: Prompt -> IO (Either Prompt Tab)
+tryProcessAction pr = do
+ result <- (try $ processAction pr) :: IO (Either SomeException Tab)
+ return $ case result of
+ Left e -> Left $ pr {action = DisplayError $ displayException e}
+ Right tabRes -> Right tabRes
+
+processAction :: Prompt -> IO Tab
+processAction Prompt {originTab = tab, originPane = pName, action = act} = case act of
+ Copy FileEntry {entryPath = ePath} path -> copyFileWithMetadata ePath (path </> takeFileName ePath) *> reload pName tab
+ Copy DirEntry {entryPath = ePath} path -> copyDirectoryRecursive ePath (path </> takeFileName ePath) *> reload pName tab
+ Cut FileEntry {entryPath = ePath} path -> moveFileWithMetadata ePath (path </> takeFileName ePath) *> reload pName tab
+ Cut DirEntry {entryPath = ePath} path -> moveDirectoryRecursive ePath (path </> takeFileName ePath) *> reload pName tab
+ Rename edit FileEntry {entryPath = ePath} -> renameFile ePath (takeDirectory ePath </> getEditLine edit) *> reload pName tab
+ Rename edit DirEntry {entryPath = ePath} -> moveDirectoryRecursive ePath (takeDirectory ePath </> getEditLine edit) *> reload pName tab
+ Delete FileEntry {entryPath = ePath} -> removeFile ePath *> reload pName tab
+ Delete DirEntry {entryPath = ePath} -> removeDirectoryRecursive ePath *> reload pName tab
+ Mkdir edit path -> createDirectory (path </> getEditLine edit) *> reload pName tab
+ Touch edit path -> writeFile (path </> getEditLine edit) "" *> reload pName tab
+ GoTo edit -> processGoTo pName $ getEditLine edit
+ Search edit path -> makeSearchTab pName path $ getEditLine edit
+ _ -> return tab
+
+processGoTo :: PaneName -> FilePath -> IO Tab
+processGoTo pName path = do
+ isFile <- doesFileExist path
+ isDir <- doesDirectoryExist path
+ if isFile || not isDir
+ then throw . userError $ path <> " does not exist or is not a directory"
+ else makeDirTab pName path
+
+handleActionEditor :: Event -> PromptAction -> EventM Name PromptAction
+handleActionEditor ev act = case act of
+ Rename edit en -> (`Rename` en) <$> handleEditorEvent ev edit
+ Mkdir edit path -> (`Mkdir` path) <$> handleEditorEvent ev edit
+ Touch edit path -> (`Touch` path) <$> handleEditorEvent ev edit
+ GoTo edit -> GoTo <$> handleEditorEvent ev edit
+ Search edit path -> (`Search` path) <$> handleEditorEvent ev edit
+ _ -> return act
+
+-- utility functions
+getEditLine :: PathEditor -> String
+getEditLine = head . getEditContents
+
+-- files functions not covered by System.Directory nor System.FilePath
+moveFileWithMetadata :: FilePath -> FilePath -> IO ()
+moveFileWithMetadata o d = do
+ copyFileWithMetadata o d
+ removeFile o
+
+moveDirectoryRecursive :: FilePath -> FilePath -> IO ()
+moveDirectoryRecursive o d = do
+ copyDirectoryRecursive o d
+ removeDirectoryRecursive o
+
+-- taken from https://stackoverflow.com/questions/6807025/what-is-the-haskell-way-to-copy-a-directory
+copyDirectoryRecursive :: FilePath -> FilePath -> IO ()
+copyDirectoryRecursive src dst = do
+ whenM (not <$> doesDirectoryExist src) $ throw (userError "source does not exist")
+ whenM (doesFileOrDirectoryExist dst) $ throw (userError "destination already exists")
+ createDirectory dst
+ content <- getDirectoryContents src
+ let xs = filter (`notElem` [".", ".."]) content
+ forM_ xs $ \name -> do
+ let srcPath = src </> name
+ let dstPath = dst </> name
+ isDirectory <- doesDirectoryExist srcPath
+ if isDirectory
+ then copyDirectoryRecursive srcPath dstPath
+ else copyFileWithMetadata srcPath dstPath
+ where
+ doesFileOrDirectoryExist x = orM [doesDirectoryExist x, doesFileExist x]
+ orM xs = or <$> sequence xs
+ whenM s r = s >>= flip when r
diff --git a/src/Widgets/Tab.hs b/src/Widgets/Tab.hs
new file mode 100644
index 0000000..63478b9
--- /dev/null
+++ b/src/Widgets/Tab.hs
@@ -0,0 +1,298 @@
+module Widgets.Tab where
+import Types
+
+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 Brick.Types (Widget, EventM)
+import Brick.Widgets.Core (hLimit, vLimit, hBox, vBox, (<+>), str, strWrap, fill, withBorderStyle, visible)
+import Brick.Widgets.List (List, list, renderList, handleListEvent, listMoveTo,
+ listSelectedElement, listInsert, listRemove, listReverse, 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 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
+
+instance Show EntryOrder where
+ show order = show (orderType order) ++ (if inverted order then " \x2193 " else " \x2191 ")
+
+instance Show OrderType where
+ show FileName = "name"
+ show FileSize = "size"
+ show AccessTime = "access"
+ show ModificationTime = "modified"
+
+-- creation functions
+makeEmptyTab :: Tab
+makeEmptyTab = EmptyTab
+
+makeDirTab :: PaneName -> FilePath -> IO Tab
+makeDirTab pName path = do
+ isFile <- doesFileExist path
+ isDir <- doesDirectoryExist path
+ if isDir && not isFile then do
+ let fName = takeFileName path
+ order = EntryOrder FileName False
+ entryLst <- makeDirEntryList pName order path
+ return $ DirTab (if null fName then "-root-" else fName) path entryLst order
+ else return makeEmptyTab
+
+makeDirEntryList :: PaneName -> EntryOrder -> FilePath -> IO (List Name 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
+
+makeSearchTab :: PaneName -> FilePath -> String -> IO Tab
+makeSearchTab pName path query = do
+ isFile <- doesFileExist path
+ isDir <- doesDirectoryExist path
+ 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
+
+getEntryTimes :: FilePath -> IO (UTCTime, UTCTime)
+getEntryTimes path = do
+ accessTime <- getAccessTime path
+ modifTime <- getModificationTime path
+ return (accessTime, modifTime)
+
+-- rendering functions
+renderLabel :: (Tab, Bool) -> Widget Name
+renderLabel (tab, hasFoc) = modifs . hLimit (wdt + 2) $ vBox [top, middle]
+ where
+ modifs = if hasFoc then withBorderStyle unicodeBold . visible
+ else withBorderStyle unicodeRounded
+ txt = show tab
+ wdt = min 14 $ length txt
+ 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]
+
+renderEntryOrder :: Tab -> Widget Name
+renderEntryOrder tab = str $ case tab of
+ EmptyTab -> ""
+ _ -> " 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
+
+renderContent :: Bool -> Tab -> Widget Name
+renderContent _ EmptyTab = 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, \
+ \but you can perform every action with your keyboard.\n \nInside each tab \
+ \you can move to a different entry using the up and down arrow keys \
+ \(Home/End to jump to top or bottom) and Enter to move into a selected \
+ \directory.\n \nYou can move to a different tab using... the Tab and the \
+ \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"
+
+-- event handling and state-changing functions
+handleTabEvent :: Event -> Tab -> EventM Name Tab
+handleTabEvent _ EmptyTab = return EmptyTab
+handleTabEvent 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}
+
+changeOrder :: Tab -> Tab
+changeOrder EmptyTab = EmptyTab
+changeOrder tab = tab {entryOrder = newOrder, entryList = newEntryList}
+ 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
+
+invertOrder :: Tab -> Tab
+invertOrder EmptyTab = EmptyTab
+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
+
+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
+
+keepSelection :: Tab -> List Name 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
+
+moveToRow :: Int -> Tab -> Tab
+moveToRow _ EmptyTab = EmptyTab
+moveToRow row tab = tab {entryList = listMoveTo row $ entryList tab}
+
+-- utility functions
+selectedEntry :: Tab -> Maybe Entry
+selectedEntry EmptyTab = Nothing
+selectedEntry tab = case listSelectedElement $ entryList tab of
+ Just (_, entry) -> Just entry
+ _ -> Nothing
+
+selectedIndex :: List Name 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
+ | otherwise = succ order
+
+sortEntries :: EntryOrder -> [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)
+
+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
+
+listRecursive :: [FilePath] -> IO [FilePath]
+listRecursive [] = return []
+listRecursive (path:paths) = do
+ isDir <- doesDirectoryExist path
+ isFile <- doesFileExist path
+ if isFile then (path :) <$> listRecursive paths
+ 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