{-# LANGUAGE MultiWayIf #-}
{-# 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 entries of interest. For a complete working demonstration of
-- this module, see @programs/FileBrowserDemo.hs@.
--
-- To use this module:
--
-- * Embed a 'FileBrowser' in your application state.
-- * Dispatch events to it in your event handler with
--   'handleFileBrowserEvent'.
-- * Get the entry under the browser's cursor with 'fileBrowserCursor'
--   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
--   handler.
--
-- File browsers have a built-in user-configurable function to limit the
-- entries displayed that defaults to showing all files. For example,
-- an application might want to limit the browser to just directories
-- and XML files. That is accomplished by setting the filter with
-- 'setFileBrowserEntryFilter' and some examples are provided in this
-- module: 'fileTypeMatch' and 'fileExtensionMatch'.
--
-- File browsers are styled using the provided collection of attribute
-- names, so add those to your attribute map to get the appearance you
-- want. File browsers also make use of a 'List' internally, so the
-- 'List' attributes will affect how the list appears.
--
-- File browsers catch 'IOException's when changing directories. If a
-- call to 'setWorkingDirectory' triggers an 'IOException' while reading
-- the working directory, the resulting 'IOException' is stored in the
-- file browser and is accessible with 'fileBrowserException'. The
-- 'setWorkingDirectory' function clears the exception field if the
-- working directory is read successfully. The caller is responsible for
-- deciding when and whether to display the exception to the user. In
-- the event that an 'IOException' is raised as described here, the file
-- browser will always present @..@ as a navigation option to allow the
-- user to continue navigating up the directory tree. It does this even
-- if the current or parent directory does not exist or cannot be read,
-- so it is always safe to present a file browser for any working
-- directory. Bear in mind that the @..@ entry is always subjected to
-- filtering and searching.
module Brick.Widgets.FileBrowser
  ( -- * Types
    FileBrowser
  , FileInfo(..)
  , FileStatus(..)
  , FileType(..)

  -- * Making a new file browser
  , newFileBrowser
  , selectNonDirectories
  , selectDirectories

  -- * Manipulating a file browser's state
  , setWorkingDirectory
  , getWorkingDirectory
  , updateFileBrowserSearch
  , setFileBrowserEntryFilter

  -- * Handling events
  , handleFileBrowserEvent
  , maybeSelectCurrentEntry

  -- * Rendering
  , renderFileBrowser

  -- * Getting information
  , fileBrowserCursor
  , fileBrowserIsSearching
  , fileBrowserSelection
  , fileBrowserException
  , fileBrowserSelectable
  , fileInfoFileType

  -- * Attributes
  , fileBrowserAttr
  , fileBrowserCurrentDirectoryAttr
  , fileBrowserSelectionInfoAttr
  , fileBrowserSelectedAttr
  , fileBrowserDirectoryAttr
  , fileBrowserBlockDeviceAttr
  , fileBrowserRegularFileAttr
  , fileBrowserCharacterDeviceAttr
  , fileBrowserNamedPipeAttr
  , fileBrowserSymbolicLinkAttr
  , fileBrowserUnixSocketAttr

  -- * Example browser entry filters
  , fileTypeMatch
  , fileExtensionMatch

  -- * Lenses
  , fileBrowserEntryFilterL
  , fileBrowserSelectableL
  , fileInfoFilenameL
  , fileInfoSanitizedFilenameL
  , fileInfoFilePathL
  , fileInfoFileStatusL
  , fileInfoLinkTargetTypeL
  , fileStatusSizeL
  , fileStatusFileTypeL

  -- * Miscellaneous
  , prettyFileSize

  -- * Utilities
  , entriesForDirectory
  , getFileInfo
  )
where

import qualified Control.Exception as E
import Control.Monad (forM)
import Control.Monad.IO.Class (liftIO)
import Data.Char (toLower, isPrint)
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
import qualified System.Directory as D
import qualified System.Posix.Files as U
import qualified System.Posix.Types as U
import qualified System.FilePath as FP
import Text.Printf (printf)

import Brick.Types
import Brick.AttrMap (AttrName)
import Brick.Widgets.Core
import Brick.Widgets.List

-- | A file browser's state. Embed this in your application state and
-- transform it with 'handleFileBrowserEvent' and the functions included
-- in this module.
data FileBrowser n =
    FileBrowser { FileBrowser n -> FilePath
fileBrowserWorkingDirectory :: FilePath
                , FileBrowser n -> List n FileInfo
fileBrowserEntries :: List n FileInfo
                , FileBrowser n -> [FileInfo]
fileBrowserLatestResults :: [FileInfo]
                , FileBrowser n -> Set FilePath
fileBrowserSelectedFiles :: Set.Set String
                , FileBrowser n -> n
fileBrowserName :: n
                , FileBrowser n -> Maybe (FileInfo -> Bool)
fileBrowserEntryFilter :: Maybe (FileInfo -> Bool)
                , FileBrowser n -> Maybe Text
fileBrowserSearchString :: Maybe T.Text
                , FileBrowser n -> Maybe IOException
fileBrowserException :: Maybe E.IOException
                -- ^ The exception status of the latest directory
                -- change. If 'Nothing', the latest directory change
                -- was successful and all entries were read. Otherwise,
                -- this contains the exception raised by the latest
                -- directory change in case the calling application
                -- needs to inspect or present the error to the user.
                , FileBrowser n -> FileInfo -> Bool
fileBrowserSelectable :: FileInfo -> Bool
                -- ^ The function that determines what kinds of entries
                -- 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.
                --
                -- Note that this is a record field so it can be used to
                -- change the selection function.
                }

-- | File status information.
data FileStatus =
    FileStatus { FileStatus -> Int64
fileStatusSize :: Int64
               -- ^ The size, in bytes, of this entry's file.
               , FileStatus -> Maybe FileType
fileStatusFileType :: Maybe FileType
               -- ^ The type of this entry's file, if it could be
               -- determined.
               }
               deriving (Int -> FileStatus -> ShowS
[FileStatus] -> ShowS
FileStatus -> FilePath
(Int -> FileStatus -> ShowS)
-> (FileStatus -> FilePath)
-> ([FileStatus] -> ShowS)
-> Show FileStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileStatus] -> ShowS
$cshowList :: [FileStatus] -> ShowS
show :: FileStatus -> FilePath
$cshow :: FileStatus -> FilePath
showsPrec :: Int -> FileStatus -> ShowS
$cshowsPrec :: Int -> FileStatus -> ShowS
Show, FileStatus -> FileStatus -> Bool
(FileStatus -> FileStatus -> Bool)
-> (FileStatus -> FileStatus -> Bool) -> Eq FileStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileStatus -> FileStatus -> Bool
$c/= :: FileStatus -> FileStatus -> Bool
== :: FileStatus -> FileStatus -> Bool
$c== :: FileStatus -> FileStatus -> Bool
Eq)

-- | Information about a file entry in the browser.
data FileInfo =
    FileInfo { FileInfo -> FilePath
fileInfoFilename :: String
             -- ^ The filename of this entry, without its path.
             -- This is not for display purposes; for that, use
             -- 'fileInfoSanitizedFilename'.
             , FileInfo -> FilePath
fileInfoSanitizedFilename :: String
             -- ^ The filename of this entry with out its path,
             -- sanitized of non-printable characters (replaced with
             -- '?'). This is for display purposes only.
             , FileInfo -> FilePath
fileInfoFilePath :: FilePath
             -- ^ The full path to this entry's file.
             , FileInfo -> Either IOException FileStatus
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.
             , FileInfo -> Maybe FileType
fileInfoLinkTargetType :: Maybe FileType
             -- ^ If this entry is a symlink, this indicates the type of
             -- file the symlink points to, if it could be obtained.
             }
             deriving (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> FilePath
(Int -> FileInfo -> ShowS)
-> (FileInfo -> FilePath) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> FilePath
$cshow :: FileInfo -> FilePath
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> FileInfo -> ShowS
Show, FileInfo -> FileInfo -> Bool
(FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool) -> Eq FileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c== :: FileInfo -> FileInfo -> Bool
Eq)

-- | The type of file entries in the browser.
data FileType =
    RegularFile
    -- ^ A regular disk file.
    | BlockDevice
    -- ^ A block device.
    | CharacterDevice
    -- ^ A character device.
    | NamedPipe
    -- ^ A named pipe.
    | Directory
    -- ^ A directory.
    | SymbolicLink
    -- ^ A symbolic link.
    | UnixSocket
    -- ^ A Unix socket.
    deriving (ReadPrec [FileType]
ReadPrec FileType
Int -> ReadS FileType
ReadS [FileType]
(Int -> ReadS FileType)
-> ReadS [FileType]
-> ReadPrec FileType
-> ReadPrec [FileType]
-> Read FileType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileType]
$creadListPrec :: ReadPrec [FileType]
readPrec :: ReadPrec FileType
$creadPrec :: ReadPrec FileType
readList :: ReadS [FileType]
$creadList :: ReadS [FileType]
readsPrec :: Int -> ReadS FileType
$creadsPrec :: Int -> ReadS FileType
Read, Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> FilePath
(Int -> FileType -> ShowS)
-> (FileType -> FilePath) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> FilePath
$cshow :: FileType -> FilePath
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq)

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.
--
-- By default, the browser will show all files and directories
-- in its working directory. To change that behavior, see
-- 'setFileBrowserEntryFilter'.
newFileBrowser :: (FileInfo -> Bool)
               -- ^ The function used to determine what kinds of entries
               -- 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.
               -> Maybe FilePath
               -- ^ The initial working directory that the browser
               -- displays. If not provided, this defaults to the
               -- executable's current working directory.
               -> IO (FileBrowser n)
newFileBrowser :: (FileInfo -> Bool) -> n -> Maybe FilePath -> IO (FileBrowser n)
newFileBrowser FileInfo -> Bool
selPredicate n
name Maybe FilePath
mCwd = do
    FilePath
initialCwd <- case Maybe FilePath
mCwd of
        Just FilePath
path -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
        Maybe FilePath
Nothing -> IO FilePath
D.getCurrentDirectory

    let b :: FileBrowser n
b = FileBrowser :: forall n.
FilePath
-> List n FileInfo
-> [FileInfo]
-> Set FilePath
-> n
-> Maybe (FileInfo -> Bool)
-> Maybe Text
-> Maybe IOException
-> (FileInfo -> Bool)
-> FileBrowser n
FileBrowser { fileBrowserWorkingDirectory :: FilePath
fileBrowserWorkingDirectory = FilePath
initialCwd
                        , fileBrowserEntries :: List n FileInfo
fileBrowserEntries = n -> Vector FileInfo -> Int -> List n FileInfo
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list n
name Vector FileInfo
forall a. Monoid a => a
mempty Int
1
                        , fileBrowserLatestResults :: [FileInfo]
fileBrowserLatestResults = [FileInfo]
forall a. Monoid a => a
mempty
                        , fileBrowserSelectedFiles :: Set FilePath
fileBrowserSelectedFiles = Set FilePath
forall a. Monoid a => a
mempty
                        , fileBrowserName :: n
fileBrowserName = n
name
                        , fileBrowserEntryFilter :: Maybe (FileInfo -> Bool)
fileBrowserEntryFilter = Maybe (FileInfo -> Bool)
forall a. Maybe a
Nothing
                        , fileBrowserSearchString :: Maybe Text
fileBrowserSearchString = Maybe Text
forall a. Maybe a
Nothing
                        , fileBrowserException :: Maybe IOException
fileBrowserException = Maybe IOException
forall a. Maybe a
Nothing
                        , fileBrowserSelectable :: FileInfo -> Bool
fileBrowserSelectable = FileInfo -> Bool
selPredicate
                        }

    FilePath -> FileBrowser n -> IO (FileBrowser n)
forall n. FilePath -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory FilePath
initialCwd FileBrowser n
b

-- | A file entry selector that permits selection of all file entries
-- except directories. Use this if you want users to be able to navigate
-- directories in the browser. If you want users to be able to select
-- only directories, use 'selectDirectories'.
selectNonDirectories :: FileInfo -> Bool
selectNonDirectories :: FileInfo -> Bool
selectNonDirectories FileInfo
i =
    case FileInfo -> Maybe FileType
fileInfoFileType FileInfo
i of
        Just FileType
Directory -> Bool
False
        Just FileType
SymbolicLink ->
            case FileInfo -> Maybe FileType
fileInfoLinkTargetType FileInfo
i of
                Just FileType
Directory -> Bool
False
                Maybe FileType
_ -> Bool
True
        Maybe FileType
_ -> Bool
True

-- | A file entry selector that permits selection of directories
-- only. This prevents directory navigation and only supports directory
-- selection.
selectDirectories :: FileInfo -> Bool
selectDirectories :: FileInfo -> Bool
selectDirectories FileInfo
i =
    case FileInfo -> Maybe FileType
fileInfoFileType FileInfo
i of
        Just FileType
Directory -> Bool
True
        Just FileType
SymbolicLink ->
            case FileInfo -> Maybe FileType
fileInfoLinkTargetType FileInfo
i of
                Just FileType
Directory -> Bool
True
                Maybe FileType
_ -> Bool
False
        Maybe FileType
_ -> Bool
False

-- | Set the filtering function used to determine which entries in
-- the browser's current directory appear in the browser. 'Nothing'
-- indicates no filtering, meaning all entries will be shown. 'Just'
-- indicates a function that should return 'True' for entries that
-- should be permitted to appear.
setFileBrowserEntryFilter :: Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
setFileBrowserEntryFilter :: Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
setFileBrowserEntryFilter Maybe (FileInfo -> Bool)
f FileBrowser n
b =
    FileBrowser n -> FileBrowser n
forall n. FileBrowser n -> FileBrowser n
applyFilterAndSearch (FileBrowser n -> FileBrowser n) -> FileBrowser n -> FileBrowser n
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (Maybe (FileInfo -> Bool) -> Identity (Maybe (FileInfo -> Bool)))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (Maybe (FileInfo -> Bool))
fileBrowserEntryFilterL ((Maybe (FileInfo -> Bool) -> Identity (Maybe (FileInfo -> Bool)))
 -> FileBrowser n -> Identity (FileBrowser n))
-> Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (FileInfo -> Bool)
f

-- | Set the working directory of the file browser. This scans the new
-- directory and repopulates the browser while maintaining any active
-- search string and/or entry filtering.
--
-- If the directory scan raises an 'IOException', the exception is
-- stored in the browser and is accessible with 'fileBrowserException'. If
-- no exception is raised, the exception field is cleared. Regardless of
-- whether an exception is raised, @..@ is always presented as a valid
-- option in the browser.
setWorkingDirectory :: FilePath -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory :: FilePath -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory FilePath
path FileBrowser n
b = do
    Either IOException [FileInfo]
entriesResult <- IO [FileInfo] -> IO (Either IOException [FileInfo])
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO [FileInfo] -> IO (Either IOException [FileInfo]))
-> IO [FileInfo] -> IO (Either IOException [FileInfo])
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FileInfo]
entriesForDirectory FilePath
path

    let ([FileInfo]
entries, Maybe IOException
exc) = case Either IOException [FileInfo]
entriesResult of
            Left (e::E.IOException) -> ([], IOException -> Maybe IOException
forall a. a -> Maybe a
Just IOException
e)
            Right [FileInfo]
es -> ([FileInfo]
es, Maybe IOException
forall a. Maybe a
Nothing)

    [FileInfo]
allEntries <- if FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"/" then [FileInfo] -> IO [FileInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [FileInfo]
entries else do
        Either IOException FileInfo
parentResult <- IO FileInfo -> IO (Either IOException FileInfo)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO FileInfo -> IO (Either IOException FileInfo))
-> IO FileInfo -> IO (Either IOException FileInfo)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileInfo
parentOf FilePath
path
        [FileInfo] -> IO [FileInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileInfo] -> IO [FileInfo]) -> [FileInfo] -> IO [FileInfo]
forall a b. (a -> b) -> a -> b
$ case Either IOException FileInfo
parentResult of
            Left (IOException
_::E.IOException) -> [FileInfo]
entries
            Right FileInfo
parent -> FileInfo
parent FileInfo -> [FileInfo] -> [FileInfo]
forall a. a -> [a] -> [a]
: [FileInfo]
entries

    let b' :: FileBrowser n
b' = [FileInfo] -> FileBrowser n -> FileBrowser n
forall n. [FileInfo] -> FileBrowser n -> FileBrowser n
setEntries [FileInfo]
allEntries FileBrowser n
b
    FileBrowser n -> IO (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> IO (FileBrowser n))
-> FileBrowser n -> IO (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b' FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (FilePath -> Identity FilePath)
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) FilePath
fileBrowserWorkingDirectoryL ((FilePath -> Identity FilePath)
 -> FileBrowser n -> Identity (FileBrowser n))
-> FilePath -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath
path
                FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (Maybe IOException -> Identity (Maybe IOException))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (Maybe IOException)
fileBrowserExceptionL ((Maybe IOException -> Identity (Maybe IOException))
 -> FileBrowser n -> Identity (FileBrowser n))
-> Maybe IOException -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe IOException
exc
                FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (Set FilePath -> Identity (Set FilePath))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (Set FilePath)
fileBrowserSelectedFilesL ((Set FilePath -> Identity (Set FilePath))
 -> FileBrowser n -> Identity (FileBrowser n))
-> Set FilePath -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set FilePath
forall a. Monoid a => a
mempty

parentOf :: FilePath -> IO FileInfo
parentOf :: FilePath -> IO FileInfo
parentOf FilePath
path = FilePath -> FilePath -> IO FileInfo
getFileInfo FilePath
".." (FilePath -> IO FileInfo) -> FilePath -> IO FileInfo
forall a b. (a -> b) -> a -> b
$ ShowS
FP.takeDirectory FilePath
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 :: FilePath -> FilePath -> IO FileInfo
getFileInfo FilePath
name = [FilePath] -> FilePath -> IO FileInfo
go []
    where
        go :: [FilePath] -> FilePath -> IO FileInfo
go [FilePath]
history FilePath
fullPath = do
            FilePath
filePath <- FilePath -> IO FilePath
D.makeAbsolute FilePath
fullPath
            Either IOException FileStatus
statusResult <- IO FileStatus -> IO (Either IOException FileStatus)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO FileStatus -> IO (Either IOException FileStatus))
-> IO FileStatus -> IO (Either IOException FileStatus)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
U.getSymbolicLinkStatus FilePath
filePath

            let stat :: Either IOException FileStatus
stat = do
                  FileStatus
status <- Either IOException FileStatus
statusResult
                  let U.COff Int64
sz = FileStatus -> COff
U.fileSize FileStatus
status
                  FileStatus -> Either IOException FileStatus
forall (m :: * -> *) a. Monad m => a -> m a
return FileStatus :: Int64 -> Maybe FileType -> FileStatus
FileStatus { fileStatusFileType :: Maybe FileType
fileStatusFileType = FileStatus -> Maybe FileType
fileTypeFromStatus FileStatus
status
                                    , fileStatusSize :: Int64
fileStatusSize = Int64
sz
                                    }

            Maybe FileType
targetTy <- case FileStatus -> Maybe FileType
fileStatusFileType (FileStatus -> Maybe FileType)
-> Either IOException FileStatus
-> Either IOException (Maybe FileType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either IOException FileStatus
stat of
                Right (Just FileType
SymbolicLink) -> do
                    Either SomeException FilePath
targetPathResult <- IO FilePath -> IO (Either SomeException FilePath)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO FilePath -> IO (Either SomeException FilePath))
-> IO FilePath -> IO (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
U.readSymbolicLink FilePath
filePath
                    case Either SomeException FilePath
targetPathResult of
                        Left (SomeException
_::E.SomeException) -> Maybe FileType -> IO (Maybe FileType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileType
forall a. Maybe a
Nothing
                        Right FilePath
targetPath ->
                            -- Watch out for recursive symlink chains:
                            -- if history starts repeating, abort the
                            -- symlink following process.
                            --
                            -- Examples:
                            --   $ ln -s foo foo
                            --
                            --   $ ln -s foo bar
                            --   $ ln -s bar foo
                            if FilePath
targetPath FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
history
                            then Maybe FileType -> IO (Maybe FileType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileType
forall a. Maybe a
Nothing
                            else do
                                FileInfo
targetInfo <- IO FileInfo -> IO FileInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> IO FileInfo) -> IO FileInfo -> IO FileInfo
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> IO FileInfo
go (FilePath
fullPath FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
history) FilePath
targetPath
                                case FileInfo -> Either IOException FileStatus
fileInfoFileStatus FileInfo
targetInfo of
                                    Right (FileStatus Int64
_ Maybe FileType
targetTy) -> Maybe FileType -> IO (Maybe FileType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileType
targetTy
                                    Either IOException FileStatus
_ -> Maybe FileType -> IO (Maybe FileType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileType
forall a. Maybe a
Nothing
                Either IOException (Maybe FileType)
_ -> Maybe FileType -> IO (Maybe FileType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileType
forall a. Maybe a
Nothing

            FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo :: FilePath
-> FilePath
-> FilePath
-> Either IOException FileStatus
-> Maybe FileType
-> FileInfo
FileInfo { fileInfoFilename :: FilePath
fileInfoFilename = FilePath
name
                            , fileInfoFilePath :: FilePath
fileInfoFilePath = FilePath
filePath
                            , fileInfoSanitizedFilename :: FilePath
fileInfoSanitizedFilename = ShowS
sanitizeFilename FilePath
name
                            , fileInfoFileStatus :: Either IOException FileStatus
fileInfoFileStatus = Either IOException FileStatus
stat
                            , fileInfoLinkTargetType :: Maybe FileType
fileInfoLinkTargetType = Maybe FileType
targetTy
                            }

-- | 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 :: FileInfo -> Maybe FileType
fileInfoFileType FileInfo
i =
    case FileInfo -> Either IOException FileStatus
fileInfoFileStatus FileInfo
i of
        Left IOException
_ -> Maybe FileType
forall a. Maybe a
Nothing
        Right FileStatus
stat -> FileStatus -> Maybe FileType
fileStatusFileType FileStatus
stat

-- | Get the working directory of the file browser.
getWorkingDirectory :: FileBrowser n -> FilePath
getWorkingDirectory :: FileBrowser n -> FilePath
getWorkingDirectory = FileBrowser n -> FilePath
forall n. FileBrowser n -> FilePath
fileBrowserWorkingDirectory

setEntries :: [FileInfo] -> FileBrowser n -> FileBrowser n
setEntries :: [FileInfo] -> FileBrowser n -> FileBrowser n
setEntries [FileInfo]
es FileBrowser n
b =
    FileBrowser n -> FileBrowser n
forall n. FileBrowser n -> FileBrowser n
applyFilterAndSearch (FileBrowser n -> FileBrowser n) -> FileBrowser n -> FileBrowser n
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& ([FileInfo] -> Identity [FileInfo])
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) [FileInfo]
fileBrowserLatestResultsL (([FileInfo] -> Identity [FileInfo])
 -> FileBrowser n -> Identity (FileBrowser n))
-> [FileInfo] -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FileInfo]
es

-- | Returns whether the file browser is in search mode, i.e., the mode
-- in which user input affects the browser's active search string and
-- displayed entries. This is used to aid in event dispatching in the
-- calling program.
fileBrowserIsSearching :: FileBrowser n -> Bool
fileBrowserIsSearching :: FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser n
b = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ FileBrowser n
bFileBrowser n
-> Getting (Maybe Text) (FileBrowser n) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) (FileBrowser n) (Maybe Text)
forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL

-- | 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 :: FileBrowser n -> [FileInfo]
fileBrowserSelection FileBrowser n
b =
    let getEntry :: FilePath -> FileInfo
getEntry FilePath
filename = Maybe FileInfo -> FileInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FileInfo -> FileInfo) -> Maybe FileInfo -> FileInfo
forall a b. (a -> b) -> a -> b
$ (FileInfo -> Bool) -> [FileInfo] -> Maybe FileInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
filename) (FilePath -> Bool) -> (FileInfo -> FilePath) -> FileInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> FilePath
fileInfoFilename) ([FileInfo] -> Maybe FileInfo) -> [FileInfo] -> Maybe FileInfo
forall a b. (a -> b) -> a -> b
$ FileBrowser n
bFileBrowser n
-> Getting [FileInfo] (FileBrowser n) [FileInfo] -> [FileInfo]
forall s a. s -> Getting a s a -> a
^.Getting [FileInfo] (FileBrowser n) [FileInfo]
forall n. Lens' (FileBrowser n) [FileInfo]
fileBrowserLatestResultsL
    in (FilePath -> FileInfo) -> [FilePath] -> [FileInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FileInfo
getEntry ([FilePath] -> [FileInfo]) -> [FilePath] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ Set FilePath -> [FilePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Set FilePath -> [FilePath]) -> Set FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FileBrowser n
bFileBrowser n
-> Getting (Set FilePath) (FileBrowser n) (Set FilePath)
-> Set FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Set FilePath) (FileBrowser n) (Set FilePath)
forall n. Lens' (FileBrowser n) (Set FilePath)
fileBrowserSelectedFilesL

-- | Modify the file browser's active search string. This causes the
-- browser's displayed entries to change to those in its current
-- directory that match the search string, if any. If a search string
-- is provided, it is matched case-insensitively anywhere in file or
-- directory names.
updateFileBrowserSearch :: (Maybe T.Text -> Maybe T.Text)
                        -- ^ The search transformation. 'Nothing'
                        -- indicates that search mode should be off;
                        -- 'Just' indicates that it should be on and
                        -- that the provided search string should be
                        -- used.
                        -> FileBrowser n
                        -- ^ The browser to modify.
                        -> FileBrowser n
updateFileBrowserSearch :: (Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch Maybe Text -> Maybe Text
f FileBrowser n
b =
    let old :: Maybe Text
old = FileBrowser n
bFileBrowser n
-> Getting (Maybe Text) (FileBrowser n) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) (FileBrowser n) (Maybe Text)
forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL
        new :: Maybe Text
new = Maybe Text -> Maybe Text
f (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FileBrowser n
bFileBrowser n
-> Getting (Maybe Text) (FileBrowser n) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) (FileBrowser n) (Maybe Text)
forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL
        oldLen :: Int
oldLen = Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
T.length Maybe Text
old
        newLen :: Int
newLen = Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
T.length Maybe Text
new
    in if Maybe Text
old Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
new
       then FileBrowser n
b
       else if Int
oldLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
newLen
            -- This case avoids a list rebuild and cursor position reset
            -- when the search state isn't *really* changing.
            then FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL ((Maybe Text -> Identity (Maybe Text))
 -> FileBrowser n -> Identity (FileBrowser n))
-> Maybe Text -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
new
            else FileBrowser n -> FileBrowser n
forall n. FileBrowser n -> FileBrowser n
applyFilterAndSearch (FileBrowser n -> FileBrowser n) -> FileBrowser n -> FileBrowser n
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL ((Maybe Text -> Identity (Maybe Text))
 -> FileBrowser n -> Identity (FileBrowser n))
-> Maybe Text -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
new

applyFilterAndSearch :: FileBrowser n -> FileBrowser n
applyFilterAndSearch :: FileBrowser n -> FileBrowser n
applyFilterAndSearch FileBrowser n
b =
    let filterMatch :: FileInfo -> Bool
filterMatch = (FileInfo -> Bool) -> Maybe (FileInfo -> Bool) -> FileInfo -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Bool -> FileInfo -> Bool
forall a b. a -> b -> a
const Bool
True) (FileBrowser n
bFileBrowser n
-> Getting
     (Maybe (FileInfo -> Bool))
     (FileBrowser n)
     (Maybe (FileInfo -> Bool))
-> Maybe (FileInfo -> Bool)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (FileInfo -> Bool))
  (FileBrowser n)
  (Maybe (FileInfo -> Bool))
forall n. Lens' (FileBrowser n) (Maybe (FileInfo -> Bool))
fileBrowserEntryFilterL)
        searchMatch :: FileInfo -> Bool
searchMatch = (FileInfo -> Bool)
-> (Text -> FileInfo -> Bool) -> Maybe Text -> FileInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> FileInfo -> Bool
forall a b. a -> b -> a
const Bool
True)
                            (\Text
search FileInfo
i -> (Text -> Text
T.toLower Text
search Text -> Text -> Bool
`T.isInfixOf` (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> FilePath
fileInfoSanitizedFilename FileInfo
i)))
                            (FileBrowser n
bFileBrowser n
-> Getting (Maybe Text) (FileBrowser n) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) (FileBrowser n) (Maybe Text)
forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL)
        match :: FileInfo -> Bool
match FileInfo
i = FileInfo -> Bool
filterMatch FileInfo
i Bool -> Bool -> Bool
&& FileInfo -> Bool
searchMatch FileInfo
i
        matching :: [FileInfo]
matching = (FileInfo -> Bool) -> [FileInfo] -> [FileInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter FileInfo -> Bool
match ([FileInfo] -> [FileInfo]) -> [FileInfo] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ FileBrowser n
bFileBrowser n
-> Getting [FileInfo] (FileBrowser n) [FileInfo] -> [FileInfo]
forall s a. s -> Getting a s a -> a
^.Getting [FileInfo] (FileBrowser n) [FileInfo]
forall n. Lens' (FileBrowser n) [FileInfo]
fileBrowserLatestResultsL
    in FileBrowser n
b { fileBrowserEntries :: List n FileInfo
fileBrowserEntries = n -> Vector FileInfo -> Int -> List n FileInfo
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (FileBrowser n
bFileBrowser n -> Getting n (FileBrowser n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (FileBrowser n) n
forall n. Lens' (FileBrowser n) n
fileBrowserNameL) ([FileInfo] -> Vector FileInfo
forall a. [a] -> Vector a
V.fromList [FileInfo]
matching) Int
1 }

-- | Generate a textual abbreviation of a file size, e.g. "10.2M" or "12
-- bytes".
prettyFileSize :: Int64
               -- ^ A file size in bytes.
               -> T.Text
prettyFileSize :: Int64 -> Text
prettyFileSize Int64
i
    | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2 Int64 -> Int64 -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
40::Int64) = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Double -> FilePath
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
40)) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"T"
    | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2 Int64 -> Int64 -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
30::Int64) = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Double -> FilePath
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
30)) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"G"
    | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2 Int64 -> Int64 -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
20::Int64) = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Double -> FilePath
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
20)) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"M"
    | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2 Int64 -> Int64 -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
10::Int64) = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Double -> FilePath
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
10)) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"K"
    | Bool
otherwise    = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> FilePath
forall a. Show a => a -> FilePath
show Int64
i FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" bytes"
    where
        format :: Double -> FilePath
format = FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%0.1f"
        divBy :: Int64 -> Double -> Double
        divBy :: Int64 -> Double -> Double
divBy Int64
a Double
b = ((Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a) :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
b

-- | Build a list of file info entries for the specified directory. This
-- 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
-- are sorted in case-insensitive lexicographic order.
--
-- This function is exported for those who want to implement their own
-- file browser using the types in this module.
entriesForDirectory :: FilePath -> IO [FileInfo]
entriesForDirectory :: FilePath -> IO [FileInfo]
entriesForDirectory FilePath
rawPath = do
    FilePath
path <- FilePath -> IO FilePath
D.makeAbsolute FilePath
rawPath

    -- Get all entries except "." and "..", then sort them
    [FilePath]
dirContents <- FilePath -> IO [FilePath]
D.listDirectory FilePath
path

    [FileInfo]
infos <- [FilePath] -> (FilePath -> IO FileInfo) -> IO [FileInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
dirContents ((FilePath -> IO FileInfo) -> IO [FileInfo])
-> (FilePath -> IO FileInfo) -> IO [FileInfo]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
        FilePath -> FilePath -> IO FileInfo
getFileInfo FilePath
f (FilePath
path FilePath -> ShowS
FP.</> FilePath
f)

    let dirsFirst :: FileInfo -> FileInfo -> Ordering
dirsFirst FileInfo
a FileInfo
b = if FileInfo -> Maybe FileType
fileInfoFileType FileInfo
a Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory Bool -> Bool -> Bool
&&
                           FileInfo -> Maybe FileType
fileInfoFileType FileInfo
b Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory
                        then FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> FilePath
fileInfoFilename FileInfo
a)
                                     (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> FilePath
fileInfoFilename FileInfo
b)
                        else if FileInfo -> Maybe FileType
fileInfoFileType FileInfo
a Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory Bool -> Bool -> Bool
&&
                                FileInfo -> Maybe FileType
fileInfoFileType FileInfo
b Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
/= FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory
                             then Ordering
LT
                             else if FileInfo -> Maybe FileType
fileInfoFileType FileInfo
b Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory Bool -> Bool -> Bool
&&
                                     FileInfo -> Maybe FileType
fileInfoFileType FileInfo
a Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
/= FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory
                                  then Ordering
GT
                                  else FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> FilePath
fileInfoFilename FileInfo
a)
                                               (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> FilePath
fileInfoFilename FileInfo
b)

        allEntries :: [FileInfo]
allEntries = (FileInfo -> FileInfo -> Ordering) -> [FileInfo] -> [FileInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy FileInfo -> FileInfo -> Ordering
dirsFirst [FileInfo]
infos

    [FileInfo] -> IO [FileInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [FileInfo]
allEntries

fileTypeFromStatus :: U.FileStatus -> Maybe FileType
fileTypeFromStatus :: FileStatus -> Maybe FileType
fileTypeFromStatus FileStatus
s =
    if | FileStatus -> Bool
U.isBlockDevice FileStatus
s     -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
BlockDevice
       | FileStatus -> Bool
U.isCharacterDevice FileStatus
s -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
CharacterDevice
       | FileStatus -> Bool
U.isNamedPipe FileStatus
s       -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
NamedPipe
       | FileStatus -> Bool
U.isRegularFile FileStatus
s     -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
RegularFile
       | FileStatus -> Bool
U.isDirectory FileStatus
s       -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory
       | FileStatus -> Bool
U.isSocket FileStatus
s          -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
UnixSocket
       | FileStatus -> Bool
U.isSymbolicLink FileStatus
s    -> FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
SymbolicLink
       | Bool
otherwise             -> Maybe FileType
forall a. Maybe a
Nothing

-- | Get the file information for the file under the cursor, if any.
fileBrowserCursor :: FileBrowser n -> Maybe FileInfo
fileBrowserCursor :: FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b = (Int, FileInfo) -> FileInfo
forall a b. (a, b) -> b
snd ((Int, FileInfo) -> FileInfo)
-> Maybe (Int, FileInfo) -> Maybe FileInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericList n Vector FileInfo -> Maybe (Int, FileInfo)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (FileBrowser n
bFileBrowser n
-> Getting
     (GenericList n Vector FileInfo)
     (FileBrowser n)
     (GenericList n Vector FileInfo)
-> GenericList n Vector FileInfo
forall s a. s -> Getting a s a -> a
^.Getting
  (GenericList n Vector FileInfo)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL)

-- | Handle a Vty input event. Note that event handling can
-- cause a directory change so the caller should be aware that
-- 'fileBrowserException' may need to be checked after handling an
-- event in case an exception was triggered while scanning the working
-- directory.
--
-- Events handled regardless of mode:
--
-- * @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
-- * @Ctrl-p@: select the previous entry
-- * 'List' navigation keys
--
-- Events handled only in normal mode:
--
-- * @/@: enter search mode
--
-- Events handled only in search mode:
--
-- * @Esc@, @Ctrl-C@: cancel search mode
-- * Text input: update search string
handleFileBrowserEvent :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEvent :: Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEvent Event
e FileBrowser n
b =
    if FileBrowser n -> Bool
forall n. FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser n
b
    then Event -> FileBrowser n -> EventM n (FileBrowser n)
forall n.
Ord n =>
Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventSearching Event
e FileBrowser n
b
    else Event -> FileBrowser n -> EventM n (FileBrowser n)
forall n.
Ord n =>
Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventNormal Event
e FileBrowser n
b

safeInit :: T.Text -> T.Text
safeInit :: Text -> Text
safeInit Text
t | Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
t
           | Bool
otherwise = Text -> Text
T.init Text
t

handleFileBrowserEventSearching :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventSearching :: Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventSearching Event
e FileBrowser n
b =
    case Event
e of
        Vty.EvKey (Vty.KChar Char
'c') [Modifier
Vty.MCtrl] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch (Maybe Text -> Maybe Text -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) FileBrowser n
b
        Vty.EvKey Key
Vty.KEsc [] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch (Maybe Text -> Maybe Text -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) FileBrowser n
b
        Vty.EvKey Key
Vty.KBS [] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
safeInit) FileBrowser n
b
        Vty.EvKey Key
Vty.KEnter [] ->
            (Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch (Maybe Text -> Maybe Text -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) (FileBrowser n -> FileBrowser n)
-> EventM n (FileBrowser n) -> EventM n (FileBrowser n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                FileBrowser n -> EventM n (FileBrowser n)
forall n. FileBrowser n -> EventM n (FileBrowser n)
maybeSelectCurrentEntry FileBrowser n
b
        Vty.EvKey (Vty.KChar Char
c) [] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
c)) FileBrowser n
b
        Event
_ ->
            Event -> FileBrowser n -> EventM n (FileBrowser n)
forall n.
Ord n =>
Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventCommon Event
e FileBrowser n
b

handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventNormal :: Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventNormal Event
e FileBrowser n
b =
    case Event
e of
        Vty.EvKey (Vty.KChar Char
'/') [] ->
            -- Begin file search
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch (Maybe Text -> Maybe Text -> Maybe Text
forall a b. a -> b -> a
const (Maybe Text -> Maybe Text -> Maybe Text)
-> Maybe Text -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") FileBrowser n
b
        Vty.EvKey Key
Vty.KEnter [] ->
            -- Select file or enter directory
            FileBrowser n -> EventM n (FileBrowser n)
forall n. FileBrowser n -> EventM n (FileBrowser n)
maybeSelectCurrentEntry FileBrowser n
b
        Vty.EvKey (Vty.KChar Char
' ') [] ->
            -- Select entry
            FileBrowser n -> EventM n (FileBrowser n)
forall n. FileBrowser n -> EventM n (FileBrowser n)
selectCurrentEntry FileBrowser n
b
        Event
_ ->
            Event -> FileBrowser n -> EventM n (FileBrowser n)
forall n.
Ord n =>
Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventCommon Event
e FileBrowser n
b

handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventCommon :: Event -> FileBrowser n -> EventM n (FileBrowser n)
handleFileBrowserEventCommon Event
e FileBrowser n
b =
    case Event
e of
        Vty.EvKey (Vty.KChar Char
'b') [Modifier
Vty.MCtrl] -> do
            let old :: List n FileInfo
old = FileBrowser n
b FileBrowser n
-> Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
-> List n FileInfo
forall s a. s -> Getting a s a -> a
^. Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL
            List n FileInfo
new <- List n FileInfo -> EventM n (List n FileInfo)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
GenericList n t e -> EventM n (GenericList n t e)
listMovePageUp List n FileInfo
old
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> List n FileInfo -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ List n FileInfo
new
        Vty.EvKey (Vty.KChar Char
'f') [Modifier
Vty.MCtrl] -> do
            let old :: List n FileInfo
old = FileBrowser n
b FileBrowser n
-> Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
-> List n FileInfo
forall s a. s -> Getting a s a -> a
^. Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL
            List n FileInfo
new <- List n FileInfo -> EventM n (List n FileInfo)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
GenericList n t e -> EventM n (GenericList n t e)
listMovePageDown List n FileInfo
old
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> List n FileInfo -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ List n FileInfo
new
        Vty.EvKey (Vty.KChar Char
'd') [Modifier
Vty.MCtrl] -> do
            let old :: List n FileInfo
old = FileBrowser n
b FileBrowser n
-> Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
-> List n FileInfo
forall s a. s -> Getting a s a -> a
^. Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL
            List n FileInfo
new <- Double -> List n FileInfo -> EventM n (List n FileInfo)
forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> GenericList n t e -> EventM n (GenericList n t e)
listMoveByPages (Double
0.5::Double) List n FileInfo
old
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> List n FileInfo -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ List n FileInfo
new
        Vty.EvKey (Vty.KChar Char
'u') [Modifier
Vty.MCtrl] -> do
            let old :: List n FileInfo
old = FileBrowser n
b FileBrowser n
-> Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
-> List n FileInfo
forall s a. s -> Getting a s a -> a
^. Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL
            List n FileInfo
new <- Double -> List n FileInfo -> EventM n (List n FileInfo)
forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> GenericList n t e -> EventM n (GenericList n t e)
listMoveByPages (-Double
0.5::Double) List n FileInfo
old
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> List n FileInfo -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ List n FileInfo
new
        Vty.EvKey (Vty.KChar Char
'g') [] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> FileBrowser n
-> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> List n FileInfo -> List n FileInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
0
        Vty.EvKey (Vty.KChar Char
'G') [] -> do
            let sz :: Int
sz = Vector FileInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (List n FileInfo -> Vector FileInfo
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (List n FileInfo -> Vector FileInfo)
-> List n FileInfo -> Vector FileInfo
forall a b. (a -> b) -> a -> b
$ FileBrowser n
bFileBrowser n
-> Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
-> List n FileInfo
forall s a. s -> Getting a s a -> a
^.Getting (List n FileInfo) (FileBrowser n) (List n FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL)
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> FileBrowser n
-> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> List n FileInfo -> List n FileInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Vty.EvKey (Vty.KChar Char
'j') [] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> FileBrowser n
-> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> List n FileInfo -> List n FileInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
1
        Vty.EvKey (Vty.KChar Char
'k') [] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> FileBrowser n
-> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> List n FileInfo -> List n FileInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy (-Int
1)
        Vty.EvKey (Vty.KChar Char
'n') [Modifier
Vty.MCtrl] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> FileBrowser n
-> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> List n FileInfo -> List n FileInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
1
        Vty.EvKey (Vty.KChar Char
'p') [Modifier
Vty.MCtrl] ->
            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> FileBrowser n
-> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> List n FileInfo -> List n FileInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy (-Int
1)
        Event
_ ->
            FileBrowser n
-> Lens' (FileBrowser n) (List n FileInfo)
-> (Event -> List n FileInfo -> EventM n (List n FileInfo))
-> Event
-> EventM n (FileBrowser n)
forall a b e n.
a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed FileBrowser n
b forall n. Lens' (FileBrowser n) (List n FileInfo)
Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL Event -> List n FileInfo -> EventM n (List n FileInfo)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent Event
e

-- | If the browser's current entry is selectable according to
-- @fileBrowserSelectable@, add it to the selection set and return.
-- If not, and if the entry is a directory or a symlink targeting a
-- directory, set the browser's current path to the selected directory.
--
-- Otherwise, return the browser state unchanged.
maybeSelectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)
maybeSelectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)
maybeSelectCurrentEntry FileBrowser n
b =
    case FileBrowser n -> Maybe FileInfo
forall n. FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b of
        Maybe FileInfo
Nothing -> FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return FileBrowser n
b
        Just FileInfo
entry ->
            if FileBrowser n -> FileInfo -> Bool
forall n. FileBrowser n -> FileInfo -> Bool
fileBrowserSelectable FileBrowser n
b FileInfo
entry
            then FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (Set FilePath -> Identity (Set FilePath))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (Set FilePath)
fileBrowserSelectedFilesL ((Set FilePath -> Identity (Set FilePath))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (Set FilePath -> Set FilePath) -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => a -> Set a -> Set a
Set.insert (FileInfo -> FilePath
fileInfoFilename FileInfo
entry)
            else case FileInfo -> Maybe FileType
fileInfoFileType FileInfo
entry of
                Just FileType
Directory ->
                    IO (FileBrowser n) -> EventM n (FileBrowser n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FileBrowser n) -> EventM n (FileBrowser n))
-> IO (FileBrowser n) -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FilePath -> FileBrowser n -> IO (FileBrowser n)
forall n. FilePath -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory (FileInfo -> FilePath
fileInfoFilePath FileInfo
entry) FileBrowser n
b
                Just FileType
SymbolicLink ->
                    case FileInfo -> Maybe FileType
fileInfoLinkTargetType FileInfo
entry of
                        Just FileType
Directory -> do
                            IO (FileBrowser n) -> EventM n (FileBrowser n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FileBrowser n) -> EventM n (FileBrowser n))
-> IO (FileBrowser n) -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FilePath -> FileBrowser n -> IO (FileBrowser n)
forall n. FilePath -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory (FileInfo -> FilePath
fileInfoFilePath FileInfo
entry) FileBrowser n
b
                        Maybe FileType
_ ->
                            FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return FileBrowser n
b
                Maybe FileType
_ ->
                    FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return FileBrowser n
b

selectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)
selectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)
selectCurrentEntry FileBrowser n
b =
    case FileBrowser n -> Maybe FileInfo
forall n. FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b of
        Maybe FileInfo
Nothing -> FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return FileBrowser n
b
        Just FileInfo
e -> FileBrowser n -> EventM n (FileBrowser n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser n -> EventM n (FileBrowser n))
-> FileBrowser n -> EventM n (FileBrowser n)
forall a b. (a -> b) -> a -> b
$ FileBrowser n
b FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (Set FilePath -> Identity (Set FilePath))
-> FileBrowser n -> Identity (FileBrowser n)
forall n. Lens' (FileBrowser n) (Set FilePath)
fileBrowserSelectedFilesL ((Set FilePath -> Identity (Set FilePath))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (Set FilePath -> Set FilePath) -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FilePath -> Set FilePath -> Set FilePath
forall a. Ord a => a -> Set a -> Set a
Set.insert (FileInfo -> FilePath
fileInfoFilename FileInfo
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
-- information about the selected entry.
--
-- Note that if the most recent file browser operation produced an
-- exception in 'fileBrowserException', that exception is not rendered
-- by this function. That exception needs to be rendered (if at all) by
-- the calling application.
--
-- The file browser is greedy in both dimensions.
renderFileBrowser :: (Show n, Ord n)
                  => Bool
                  -- ^ Whether the file browser has input focus.
                  -> FileBrowser n
                  -- ^ The browser to render.
                  -> Widget n
renderFileBrowser :: Bool -> FileBrowser n -> Widget n
renderFileBrowser Bool
foc FileBrowser n
b =
    let maxFilenameLength :: Int
maxFilenameLength = GenericList n Vector Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (GenericList n Vector Int -> Int)
-> GenericList n Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> (FileInfo -> FilePath) -> FileInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> FilePath
fileInfoFilename) (FileInfo -> Int)
-> GenericList n Vector FileInfo -> GenericList n Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileBrowser n
bFileBrowser n
-> Getting
     (GenericList n Vector FileInfo)
     (FileBrowser n)
     (GenericList n Vector FileInfo)
-> GenericList n Vector FileInfo
forall s a. s -> Getting a s a -> a
^.Getting
  (GenericList n Vector FileInfo)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL)
        cwdHeader :: Widget n
cwdHeader = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                    FilePath -> Widget n
forall n. FilePath -> Widget n
str (FilePath -> Widget n) -> FilePath -> Widget n
forall a b. (a -> b) -> a -> b
$ ShowS
sanitizeFilename ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FileBrowser n -> FilePath
forall n. FileBrowser n -> FilePath
fileBrowserWorkingDirectory FileBrowser n
b
        selInfo :: Widget n
selInfo = case GenericList n Vector FileInfo -> Maybe (Int, FileInfo)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (FileBrowser n
bFileBrowser n
-> Getting
     (GenericList n Vector FileInfo)
     (FileBrowser n)
     (GenericList n Vector FileInfo)
-> GenericList n Vector FileInfo
forall s a. s -> Getting a s a -> a
^.Getting
  (GenericList n Vector FileInfo)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL) of
            Maybe (Int, FileInfo)
Nothing -> Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
forall n. Char -> Widget n
fill Char
' '
            Just (Int
_, FileInfo
i) -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ FileInfo -> Widget n
forall n. FileInfo -> Widget n
selInfoFor FileInfo
i
        fileTypeLabel :: Maybe FileType -> p
fileTypeLabel Maybe FileType
Nothing = p
"unknown"
        fileTypeLabel (Just FileType
t) =
            case FileType
t of
                FileType
RegularFile -> p
"file"
                FileType
BlockDevice -> p
"block device"
                FileType
CharacterDevice -> p
"character device"
                FileType
NamedPipe -> p
"pipe"
                FileType
Directory -> p
"directory"
                FileType
SymbolicLink -> p
"symbolic link"
                FileType
UnixSocket -> p
"socket"
        selInfoFor :: FileInfo -> Widget n
selInfoFor FileInfo
i =
            let label :: Text
label = case FileInfo -> Either IOException FileStatus
fileInfoFileStatus FileInfo
i of
                    Left IOException
_ -> Text
"unknown"
                    Right FileStatus
stat ->
                        let maybeSize :: Text
maybeSize = if FileStatus -> Maybe FileType
fileStatusFileType FileStatus
stat Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
RegularFile
                                        then Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
prettyFileSize (FileStatus -> Int64
fileStatusSize FileStatus
stat)
                                        else Text
""
                        in Maybe FileType -> Text
forall p. IsString p => Maybe FileType -> p
fileTypeLabel (FileStatus -> Maybe FileType
fileStatusFileType FileStatus
stat) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
maybeSize
            in Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FileInfo -> FilePath
fileInfoSanitizedFilename FileInfo
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label

        maybeSearchInfo :: Widget n
maybeSearchInfo = case FileBrowser n
bFileBrowser n
-> Getting (Maybe Text) (FileBrowser n) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) (FileBrowser n) (Maybe Text)
forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL of
            Maybe Text
Nothing -> Widget n
forall n. Widget n
emptyWidget
            Just Text
s -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                      Text -> Widget n
forall n. Text -> Widget n
txt Text
"Search: " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
                      n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
showCursor (FileBrowser n
bFileBrowser n -> Getting n (FileBrowser n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (FileBrowser n) n
forall n. Lens' (FileBrowser n) n
fileBrowserNameL) ((Int, Int) -> Location
Location (Text -> Int
T.length Text
s, Int
0)) (Text -> Widget n
forall n. Text -> Widget n
txt Text
s)

    in AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
fileBrowserAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
fileBrowserCurrentDirectoryAttr Widget n
forall n. Widget n
cwdHeader
            , (Bool -> FileInfo -> Widget n)
-> Bool -> GenericList n Vector FileInfo -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList (Bool -> Int -> Set FilePath -> Bool -> FileInfo -> Widget n
forall n.
Bool -> Int -> Set FilePath -> Bool -> FileInfo -> Widget n
renderFileInfo Bool
foc Int
maxFilenameLength (FileBrowser n
bFileBrowser n
-> Getting (Set FilePath) (FileBrowser n) (Set FilePath)
-> Set FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Set FilePath) (FileBrowser n) (Set FilePath)
forall n. Lens' (FileBrowser n) (Set FilePath)
fileBrowserSelectedFilesL))
                         Bool
foc (FileBrowser n
bFileBrowser n
-> Getting
     (GenericList n Vector FileInfo)
     (FileBrowser n)
     (GenericList n Vector FileInfo)
-> GenericList n Vector FileInfo
forall s a. s -> Getting a s a -> a
^.Getting
  (GenericList n Vector FileInfo)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL)
            , Widget n
maybeSearchInfo
            , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
fileBrowserSelectionInfoAttr Widget n
forall n. Widget n
selInfo
            ]

renderFileInfo :: Bool -> Int -> Set.Set String -> Bool -> FileInfo -> Widget n
renderFileInfo :: Bool -> Int -> Set FilePath -> Bool -> FileInfo -> Widget n
renderFileInfo Bool
foc Int
maxLen Set FilePath
selFiles Bool
listSel FileInfo
info =
    (if Bool
foc
     then (if Bool
listSel then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
listSelectedFocusedAttr
               else if Bool
sel then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
fileBrowserSelectedAttr else Widget n -> Widget n
forall a. a -> a
id)
     else (if Bool
listSel then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
listSelectedAttr
               else if Bool
sel then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
fileBrowserSelectedAttr else Widget n -> Widget n
forall a. a -> a
id)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max Widget n
forall n. Widget n
body
    where
        sel :: Bool
sel = FileInfo -> FilePath
fileInfoFilename FileInfo
info FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
selFiles
        addAttr :: Widget n -> Widget n
addAttr = (Widget n -> Widget n)
-> (FileType -> Widget n -> Widget n)
-> Maybe FileType
-> Widget n
-> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget n -> Widget n
forall a. a -> a
id (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr (AttrName -> Widget n -> Widget n)
-> (FileType -> AttrName) -> FileType -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileType -> AttrName
attrForFileType) (FileInfo -> Maybe FileType
fileInfoFileType FileInfo
info)
        body :: Widget n
body = Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (Int
maxLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               FilePath -> Widget n
forall n. FilePath -> Widget n
str (FilePath -> Widget n) -> FilePath -> Widget n
forall a b. (a -> b) -> a -> b
$ FileInfo -> FilePath
fileInfoSanitizedFilename FileInfo
info FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
suffix)
        suffix :: FilePath
suffix = (if FileInfo -> Maybe FileType
fileInfoFileType FileInfo
info Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory then FilePath
"/" else FilePath
"") FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                 (if Bool
sel then FilePath
"*" else FilePath
"")

-- | Sanitize a filename for terminal display, replacing non-printable
-- characters with '?'.
sanitizeFilename :: String -> String
sanitizeFilename :: ShowS
sanitizeFilename = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toPrint
    where
        toPrint :: Char -> Char
toPrint Char
c | Char -> Bool
isPrint Char
c = Char
c
                  | Bool
otherwise = Char
'?'

attrForFileType :: FileType -> AttrName
attrForFileType :: FileType -> AttrName
attrForFileType FileType
RegularFile = AttrName
fileBrowserRegularFileAttr
attrForFileType FileType
BlockDevice = AttrName
fileBrowserBlockDeviceAttr
attrForFileType FileType
CharacterDevice = AttrName
fileBrowserCharacterDeviceAttr
attrForFileType FileType
NamedPipe = AttrName
fileBrowserNamedPipeAttr
attrForFileType FileType
Directory = AttrName
fileBrowserDirectoryAttr
attrForFileType FileType
SymbolicLink = AttrName
fileBrowserSymbolicLinkAttr
attrForFileType FileType
UnixSocket = AttrName
fileBrowserUnixSocketAttr

-- | The base attribute for all file browser attributes.
fileBrowserAttr :: AttrName
fileBrowserAttr :: AttrName
fileBrowserAttr = AttrName
"fileBrowser"

-- | The attribute used for the current directory displayed at the top
-- of the browser.
fileBrowserCurrentDirectoryAttr :: AttrName
fileBrowserCurrentDirectoryAttr :: AttrName
fileBrowserCurrentDirectoryAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"currentDirectory"

-- | The attribute used for the entry information displayed at the
-- bottom of the browser.
fileBrowserSelectionInfoAttr :: AttrName
fileBrowserSelectionInfoAttr :: AttrName
fileBrowserSelectionInfoAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"selectionInfo"

-- | The attribute used to render directory entries.
fileBrowserDirectoryAttr :: AttrName
fileBrowserDirectoryAttr :: AttrName
fileBrowserDirectoryAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"directory"

-- | The attribute used to render block device entries.
fileBrowserBlockDeviceAttr :: AttrName
fileBrowserBlockDeviceAttr :: AttrName
fileBrowserBlockDeviceAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"block"

-- | The attribute used to render regular file entries.
fileBrowserRegularFileAttr :: AttrName
fileBrowserRegularFileAttr :: AttrName
fileBrowserRegularFileAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"regular"

-- | The attribute used to render character device entries.
fileBrowserCharacterDeviceAttr :: AttrName
fileBrowserCharacterDeviceAttr :: AttrName
fileBrowserCharacterDeviceAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"char"

-- | The attribute used to render named pipe entries.
fileBrowserNamedPipeAttr :: AttrName
fileBrowserNamedPipeAttr :: AttrName
fileBrowserNamedPipeAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"pipe"

-- | The attribute used to render symbolic link entries.
fileBrowserSymbolicLinkAttr :: AttrName
fileBrowserSymbolicLinkAttr :: AttrName
fileBrowserSymbolicLinkAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"symlink"

-- | The attribute used to render Unix socket entries.
fileBrowserUnixSocketAttr :: AttrName
fileBrowserUnixSocketAttr :: AttrName
fileBrowserUnixSocketAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"unixSocket"

-- | The attribute used for selected entries in the file browser.
fileBrowserSelectedAttr :: AttrName
fileBrowserSelectedAttr :: AttrName
fileBrowserSelectedAttr = AttrName
fileBrowserAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"selected"

-- | A file type filter for use with 'setFileBrowserEntryFilter'. This
-- filter permits entries whose file types are in the specified list.
fileTypeMatch :: [FileType] -> FileInfo -> Bool
fileTypeMatch :: [FileType] -> FileInfo -> Bool
fileTypeMatch [FileType]
tys FileInfo
i = Bool -> (FileType -> Bool) -> Maybe FileType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (FileType -> [FileType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FileType]
tys) (Maybe FileType -> Bool) -> Maybe FileType -> Bool
forall a b. (a -> b) -> a -> b
$ FileInfo -> Maybe FileType
fileInfoFileType FileInfo
i

-- | A filter that matches any directory regardless of name, or any
-- regular file with the specified extension. For example, an extension
-- argument of @"xml"@ would match regular files @test.xml@ and
-- @TEST.XML@ and it will match directories regardless of name.
--
-- This matcher also matches symlinks if and only if their targets are
-- directories. This is intended to make it possible to use this matcher
-- to find files with certain extensions, but also support directory
-- traversal via symlinks.
fileExtensionMatch :: String -> FileInfo -> Bool
fileExtensionMatch :: FilePath -> FileInfo -> Bool
fileExtensionMatch FilePath
ext FileInfo
i = case FileInfo -> Maybe FileType
fileInfoFileType FileInfo
i of
    Just FileType
Directory -> Bool
True
    Just FileType
RegularFile -> (Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
ext)) FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> FilePath
fileInfoFilename FileInfo
i)
    Just FileType
SymbolicLink -> case FileInfo -> Maybe FileType
fileInfoLinkTargetType FileInfo
i of
        Just FileType
Directory -> Bool
True
        Maybe FileType
_ -> Bool
False
    Maybe FileType
_ -> Bool
False