diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,30 @@ Brick changelog --------------- +0.43 +---- + +API changes: + * The FileBrowser module got the ability to select multiple files + (#204). This means that the `fileBrowserSelection` function now + returns a list of `FileInfo` rather than at most one via `Maybe`. + The module also now uses a new attribute, `fileBrowserSelectedAttr`, + to indicate entries that are currently selected (in addition to + displaying an asterisk after their filenames). Lastly, the file + size and type fields of `FileInfo` have been replaced with a + new type, `FileStatus`, and `FileInfo` now carries an `Either + IOException FileStatus`. As part of that safety improvement, + `setWorkingDirectory` now no longer clobbers the entire entry listing + if any of the listings fail to stat. In addition, the FileBrowser now + uses the correct file stat routines to deal with symbolic links. + +Package changes: + * Added lower bound on `directory` (thanks Fraser Tweedale) + +Test suite changes: + * Test suite now propagates success/failure to exit status (thanks + Fraser Tweedale) + 0.42.1 ------ diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 0.42.1 +version: 0.43 synopsis: A declarative terminal user interface library description: Write terminal applications painlessly with 'brick'! You write an @@ -91,7 +91,7 @@ vty >= 5.24, transformers, data-clist >= 0.1, - directory, + directory >= 1.2.5.0, dlist, filepath, containers, diff --git a/docs/guide.rst b/docs/guide.rst --- a/docs/guide.rst +++ b/docs/guide.rst @@ -333,7 +333,7 @@ .. code:: haskell myEvent :: s -> BrickEvent n CounterEvent -> EventM n (Next s) - myEvent s (AppEvent (CounterEvent i)) = ... + myEvent s (AppEvent (Counter i)) = ... The next step is to actually *generate* our custom events and inject them into the ``brick`` event stream so they make it to the diff --git a/programs/FileBrowserDemo.hs b/programs/FileBrowserDemo.hs --- a/programs/FileBrowserDemo.hs +++ b/programs/FileBrowserDemo.hs @@ -64,9 +64,12 @@ b' <- FB.handleFileBrowserEvent ev b -- If the browser has a selected file after handling the -- event (because the user pressed Enter), shut down. - case fileBrowserSelection b' of - Nothing -> M.continue b' - Just _ -> M.halt b' + case ev of + V.EvKey V.KEnter [] -> + case fileBrowserSelection b' of + [] -> M.continue b' + _ -> M.halt b' + _ -> M.continue b' appEvent b _ = M.continue b errorAttr :: AttrName @@ -83,6 +86,7 @@ , (FB.fileBrowserNamedPipeAttr, fg V.yellow) , (FB.fileBrowserSymbolicLinkAttr, fg V.cyan) , (FB.fileBrowserUnixSocketAttr, fg V.red) + , (FB.fileBrowserSelectedAttr, V.white `on` V.magenta) , (errorAttr, fg V.red) ] diff --git a/src/Brick/Widgets/FileBrowser.hs b/src/Brick/Widgets/FileBrowser.hs --- a/src/Brick/Widgets/FileBrowser.hs +++ b/src/Brick/Widgets/FileBrowser.hs @@ -2,9 +2,10 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} -- | This module provids a file browser widget that allows users to -- navigate directory trees, search for files and directories, and --- select a file of interest. For a complete working demonstration of +-- select entries of interest. For a complete working demonstration of -- this module, see @programs/FileBrowserDemo.hs@. -- -- To use this module: @@ -13,8 +14,8 @@ -- * Dispatch events to it in your event handler with -- 'handleFileBrowserEvent'. -- * Get the entry under the browser's cursor with 'fileBrowserCursor' --- and get the entry selected by the user with 'Enter' using --- 'fileBrowserSelection'. +-- and get the entries selected by the user with 'Enter' or 'Space' +-- using 'fileBrowserSelection'. -- * Inspect 'fileBrowserException' to determine whether the -- file browser encountered an error when reading a directory in -- 'setWorkingDirectory' or when changing directories in the event @@ -50,6 +51,7 @@ ( -- * Types FileBrowser , FileInfo(..) + , FileStatus(..) , FileType(..) -- * Making a new file browser , newFileBrowser @@ -74,11 +76,13 @@ , fileBrowserSelection , fileBrowserException , fileBrowserSelectable + , fileInfoFileType -- * Attributes , fileBrowserAttr , fileBrowserCurrentDirectoryAttr , fileBrowserSelectionInfoAttr + , fileBrowserSelectedAttr , fileBrowserDirectoryAttr , fileBrowserBlockDeviceAttr , fileBrowserRegularFileAttr @@ -95,16 +99,18 @@ , fileBrowserEntryFilterL , fileBrowserSelectableL , fileInfoFilenameL - , fileInfoFileSizeL , fileInfoSanitizedFilenameL , fileInfoFilePathL - , fileInfoFileTypeL + , fileInfoFileStatusL + , fileStatusSizeL + , fileStatusFileTypeL -- * Miscellaneous , prettyFileSize -- * Utilities , entriesForDirectory + , getFileInfo ) where @@ -112,13 +118,15 @@ import Control.Monad (forM) import Control.Monad.IO.Class (liftIO) import Data.Char (toLower, isPrint) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, fromJust) +import qualified Data.Foldable as F import qualified Data.Text as T #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import Data.Int (Int64) import Data.List (sortBy, isSuffixOf) +import qualified Data.Set as Set import qualified Data.Vector as V import Lens.Micro import qualified Graphics.Vty as Vty @@ -140,8 +148,8 @@ FileBrowser { fileBrowserWorkingDirectory :: FilePath , fileBrowserEntries :: List n FileInfo , fileBrowserLatestResults :: [FileInfo] + , fileBrowserSelectedFiles :: Set.Set String , fileBrowserName :: n - , fileBrowserSelectionState :: Maybe FileInfo , fileBrowserEntryFilter :: Maybe (FileInfo -> Bool) , fileBrowserSearchString :: Maybe T.Text , fileBrowserException :: Maybe E.IOException @@ -153,9 +161,9 @@ -- needs to inspect or present the error to the user. , fileBrowserSelectable :: FileInfo -> Bool -- ^ The function that determines what kinds of entries - -- are selectable with @Enter@ in the event handler. - -- Note that if this returns 'True' for an entry, an - -- @Enter@ keypress selects that entry rather than doing + -- are selectable with in the event handler. Note that + -- if this returns 'True' for an entry, an @Enter@ or + -- @Space@ keypress selects that entry rather than doing -- anything else; directory changes can only occur if -- this returns 'False' for directories. -- @@ -163,6 +171,16 @@ -- change the selection function. } +-- | File status information. +data FileStatus = + FileStatus { fileStatusSize :: Int64 + -- ^ The size, in bytes, of this entry's file. + , fileStatusFileType :: Maybe FileType + -- ^ The type of this entry's file, if it could be + -- determined. + } + deriving (Show, Eq) + -- | Information about a file entry in the browser. data FileInfo = FileInfo { fileInfoFilename :: String @@ -175,13 +193,12 @@ -- '?'). This is for display purposes only. , fileInfoFilePath :: FilePath -- ^ The full path to this entry's file. - , fileInfoFileType :: Maybe FileType - -- ^ The type of this entry's file, if it could be - -- determined. - , fileInfoFileSize :: Int64 - -- ^ The size, in bytes, of this entry's file. + , fileInfoFileStatus :: Either E.IOException FileStatus + -- ^ The file status if it could be obtained, or the + -- exception that was caught when attempting to read the + -- file's status. } - deriving (Show, Eq, Read) + deriving (Show, Eq) -- | The type of file entries in the browser. data FileType = @@ -203,6 +220,7 @@ suffixLenses ''FileBrowser suffixLenses ''FileInfo +suffixLenses ''FileStatus -- | Make a new file browser state. The provided resource name will be -- used to render the 'List' viewport of the browser. @@ -212,11 +230,10 @@ -- 'setFileBrowserEntryFilter'. newFileBrowser :: (FileInfo -> Bool) -- ^ The function used to determine what kinds of entries - -- can be selected with @Enter@ (see - -- 'handleFileBrowserEvent'). A good default is - -- 'selectNonDirectories'. This can be changed at - -- 'any time with 'fileBrowserSelectable' or its - -- 'corresponding lens. + -- can be selected (see 'handleFileBrowserEvent'). A + -- good default is 'selectNonDirectories'. This can be + -- changed at 'any time with 'fileBrowserSelectable' or + -- its 'corresponding lens. -> n -- ^ The resource name associated with the browser's -- entry listing. @@ -233,8 +250,8 @@ let b = FileBrowser { fileBrowserWorkingDirectory = initialCwd , fileBrowserEntries = list name mempty 1 , fileBrowserLatestResults = mempty + , fileBrowserSelectedFiles = mempty , fileBrowserName = name - , fileBrowserSelectionState = Nothing , fileBrowserEntryFilter = Nothing , fileBrowserSearchString = Nothing , fileBrowserException = Nothing @@ -253,7 +270,6 @@ Just Directory -> False _ -> True - -- | A file entry selector that permits selection of directories -- only. This prevents directory navigation and only supports directory -- selection. @@ -298,19 +314,52 @@ let b' = setEntries allEntries b return $ b' & fileBrowserWorkingDirectoryL .~ path & fileBrowserExceptionL .~ exc + & fileBrowserSelectedFilesL .~ mempty parentOf :: FilePath -> IO FileInfo -parentOf path = do - filePath <- D.canonicalizePath $ FP.takeDirectory path - status <- U.getFileStatus filePath - let U.COff sz = U.fileSize status - return FileInfo { fileInfoFilename = ".." +parentOf path = getFileInfo ".." $ FP.takeDirectory path + +-- | Build a 'FileInfo' for the specified file and path. If an +-- 'IOException' is raised while attempting to get the file information, +-- the 'fileInfoFileStatus' field is populated with the exception. +-- Otherwise it is populated with the 'FileStatus' for the file. +getFileInfo :: String + -- ^ The name of the file to inspect. This filename is only + -- used to set the 'fileInfoFilename' and sanitized filename + -- fields; the actual file to be inspected is referred + -- to by the second argument. This is decomposed so that + -- 'FileInfo's can be used to represent information about + -- entries like @..@, whose display names differ from their + -- physical paths. + -> FilePath + -- ^ The actual full path to the file or directory to + -- inspect. + -> IO FileInfo +getFileInfo name fullPath = do + filePath <- D.makeAbsolute fullPath + statusResult <- E.try $ U.getSymbolicLinkStatus filePath + + let stat = do + status <- statusResult + let U.COff sz = U.fileSize status + return FileStatus { fileStatusFileType = fileTypeFromStatus status + , fileStatusSize = sz + } + + return FileInfo { fileInfoFilename = name , fileInfoFilePath = filePath - , fileInfoSanitizedFilename = ".." - , fileInfoFileType = fileTypeFromStatus status - , fileInfoFileSize = sz + , fileInfoSanitizedFilename = sanitizeFilename name + , fileInfoFileStatus = stat } +-- | Get the file type for this file info entry. If the file type could +-- not be obtained due to an 'IOException', return 'Nothing'. +fileInfoFileType :: FileInfo -> Maybe FileType +fileInfoFileType i = + case fileInfoFileStatus i of + Left _ -> Nothing + Right stat -> fileStatusFileType stat + -- | Get the working directory of the file browser. getWorkingDirectory :: FileBrowser n -> FilePath getWorkingDirectory = fileBrowserWorkingDirectory @@ -326,11 +375,13 @@ fileBrowserIsSearching :: FileBrowser n -> Bool fileBrowserIsSearching b = isJust $ b^.fileBrowserSearchStringL --- | Get the entry chosen by the user, if any. The entry is chosen --- by an 'Enter' keypress; if you want the entry under the cursor, use --- 'fileBrowserCursor'. -fileBrowserSelection :: FileBrowser n -> Maybe FileInfo -fileBrowserSelection = fileBrowserSelectionState +-- | Get the entries chosen by the user, if any. Entries are chosen by +-- an 'Enter' or 'Space' keypress; if you want the entry under the +-- cursor, use 'fileBrowserCursor'. +fileBrowserSelection :: FileBrowser n -> [FileInfo] +fileBrowserSelection b = + let getEntry filename = fromJust $ F.find ((== filename) . fileInfoFilename) $ b^.fileBrowserLatestResultsL + in fmap getEntry $ F.toList $ b^.fileBrowserSelectedFilesL -- | Modify the file browser's active search string. This causes the -- browser's displayed entries to change to those in its current @@ -386,8 +437,11 @@ divBy a b = ((fromIntegral a) :: Double) / b -- | Build a list of file info entries for the specified directory. This --- does not catch any exceptions, so the caller is responsible for --- handling them. +-- function does not catch any exceptions raised by calling +-- 'makeAbsolute' or 'listDirectory', but it does catch exceptions on +-- a per-file basis. Any exceptions caught when inspecting individual +-- files are stored in the 'fileInfoFileStatus' field of each +-- 'FileInfo'. -- -- The entries returned are all entries in the specified directory -- except for @.@ and @..@. Directories are always given first. Entries @@ -403,15 +457,7 @@ dirContents <- D.listDirectory path infos <- forM dirContents $ \f -> do - filePath <- D.canonicalizePath $ path FP. f - status <- U.getFileStatus filePath - let U.COff sz = U.fileSize status - return FileInfo { fileInfoFilename = f - , fileInfoFilePath = filePath - , fileInfoSanitizedFilename = sanitizeFilename f - , fileInfoFileType = fileTypeFromStatus status - , fileInfoFileSize = sz - } + getFileInfo f (path FP. f) let dirsFirst a b = if fileInfoFileType a == Just Directory && fileInfoFileType b == Just Directory @@ -453,7 +499,7 @@ -- -- Events handled regardless of mode: -- --- * @Enter@: set the file browser's selected entry +-- * @Enter@, @Space@: set the file browser's selected entry -- ('fileBrowserSelection') for use by the calling application, -- subject to 'fileBrowserSelectable'. -- * @Ctrl-n@: select the next entry @@ -504,6 +550,9 @@ Vty.EvKey Vty.KEnter [] -> -- Select file or enter directory maybeSelectCurrentEntry b + Vty.EvKey (Vty.KChar ' ') [] -> + -- Select entry + selectCurrentEntry b _ -> handleFileBrowserEventCommon e b @@ -523,11 +572,17 @@ Nothing -> return b Just entry -> if fileBrowserSelectable b entry - then return $ b & fileBrowserSelectionStateL .~ Just entry + then return $ b & fileBrowserSelectedFilesL %~ Set.insert (fileInfoFilename entry) else case fileInfoFileType entry of Just Directory -> liftIO $ setWorkingDirectory (fileInfoFilePath entry) b _ -> return b +selectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n) +selectCurrentEntry b = + case fileBrowserCursor b of + Nothing -> return b + Just e -> return $ b & fileBrowserSelectedFilesL %~ Set.insert (fileInfoFilename e) + -- | Render a file browser. This renders a list of entries in the -- working directory, a cursor to select from among the entries, a -- header displaying the working directory, and a footer displaying @@ -563,11 +618,15 @@ SymbolicLink -> "symbolic link" UnixSocket -> "socket" selInfoFor i = - let maybeSize = if fileInfoFileType i == Just RegularFile - then ", " <> prettyFileSize (fileInfoFileSize i) - else "" - in txt $ (T.pack $ fileInfoSanitizedFilename i) <> ": " <> - fileTypeLabel (fileInfoFileType i) <> maybeSize + let label = case fileInfoFileStatus i of + Left _ -> "unknown" + Right stat -> + let maybeSize = if fileStatusFileType stat == Just RegularFile + then ", " <> prettyFileSize (fileStatusSize stat) + else "" + in fileTypeLabel (fileStatusFileType stat) <> maybeSize + in txt $ (T.pack $ fileInfoSanitizedFilename i) <> ": " <> label + maybeSearchInfo = case b^.fileBrowserSearchStringL of Nothing -> emptyWidget Just s -> padRight Max $ @@ -576,23 +635,28 @@ in withDefAttr fileBrowserAttr $ vBox [ withDefAttr fileBrowserCurrentDirectoryAttr cwdHeader - , renderList (renderFileInfo foc maxFilenameLength) foc (b^.fileBrowserEntriesL) + , renderList (renderFileInfo foc maxFilenameLength (b^.fileBrowserSelectedFilesL)) + foc (b^.fileBrowserEntriesL) , maybeSearchInfo , withDefAttr fileBrowserSelectionInfoAttr selInfo ] -renderFileInfo :: Bool -> Int -> Bool -> FileInfo -> Widget n -renderFileInfo foc maxLen sel info = +renderFileInfo :: Bool -> Int -> Set.Set String -> Bool -> FileInfo -> Widget n +renderFileInfo foc maxLen selFiles listSel info = (if foc - then (if sel then forceAttr listSelectedFocusedAttr else id) - else (if sel then forceAttr listSelectedAttr else id)) $ + then (if listSel then forceAttr listSelectedFocusedAttr + else if sel then forceAttr fileBrowserSelectedAttr else id) + else (if listSel then forceAttr listSelectedAttr + else if sel then forceAttr fileBrowserSelectedAttr else id)) $ padRight Max body where + sel = fileInfoFilename info `Set.member` selFiles addAttr = maybe id (withDefAttr . attrForFileType) (fileInfoFileType info) - body = addAttr (hLimit (maxLen + 1) $ padRight Max $ str $ fileInfoSanitizedFilename info <> suffix) - suffix = if fileInfoFileType info == Just Directory - then "/" - else "" + body = addAttr (hLimit (maxLen + 1) $ + padRight Max $ + str $ fileInfoSanitizedFilename info <> suffix) + suffix = (if fileInfoFileType info == Just Directory then "/" else "") <> + (if sel then "*" else "") -- | Sanitize a filename for terminal display, replacing non-printable -- characters with '?'. @@ -652,6 +716,10 @@ -- | The attribute used to render Unix socket entries. fileBrowserUnixSocketAttr :: AttrName fileBrowserUnixSocketAttr = fileBrowserAttr <> "unixSocket" + +-- | The attribute used for selected entries in the file browser. +fileBrowserSelectedAttr :: AttrName +fileBrowserSelectedAttr = fileBrowserAttr <> "selected" -- | A file type filter for use with 'setFileBrowserEntryFilter'. This -- filter permits entries whose file types are in the specified list. diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -2,6 +2,9 @@ {-# LANGUAGE TypeFamilies #-} import Control.Applicative +import Data.Bool (bool) +import System.Exit (exitFailure, exitSuccess) + import Data.IMap (IMap, Run(Run)) import Data.IntMap (IntMap) import Test.QuickCheck @@ -103,5 +106,5 @@ return [] -main :: IO Bool -main = $quickCheckAll +main :: IO () +main = $quickCheckAll >>= bool exitFailure exitSuccess