{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- | This module provides 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

  -- * Actions
  , actionFileBrowserBeginSearch
  , actionFileBrowserSelectEnter
  , actionFileBrowserSelectCurrent
  , actionFileBrowserListPageUp
  , actionFileBrowserListPageDown
  , actionFileBrowserListHalfPageUp
  , actionFileBrowserListHalfPageDown
  , actionFileBrowserListTop
  , actionFileBrowserListBottom
  , actionFileBrowserListNext
  , actionFileBrowserListPrev

  -- * 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
  , fileBrowserSelectableL
  , fileInfoFilenameL
  , fileInfoSanitizedFilenameL
  , fileInfoFilePathL
  , fileInfoFileStatusL
  , fileInfoLinkTargetTypeL
  , fileStatusSizeL
  , fileStatusFileTypeL

  -- * Getters
  , fileBrowserEntryFilterG
  , fileBrowserWorkingDirectoryG
  , fileBrowserEntriesG
  , fileBrowserLatestResultsG
  , fileBrowserSelectedFilesG
  , fileBrowserNameG
  , fileBrowserSearchStringG
  , fileBrowserExceptionG
  , fileBrowserSelectableG

  -- * 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 Lens.Micro.Mtl ((%=))
import Lens.Micro.TH (lensRules, generateUpdateableOptics)
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, 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 { forall n. FileBrowser n -> String
fileBrowserWorkingDirectory :: FilePath
                , forall n. FileBrowser n -> List n FileInfo
fileBrowserEntries :: List n FileInfo
                , forall n. FileBrowser n -> [FileInfo]
fileBrowserLatestResults :: [FileInfo]
                , forall n. FileBrowser n -> Set String
fileBrowserSelectedFiles :: Set.Set String
                , forall n. FileBrowser n -> n
fileBrowserName :: n
                , forall n. FileBrowser n -> Maybe (FileInfo -> Bool)
fileBrowserEntryFilter :: Maybe (FileInfo -> Bool)
                , forall n. FileBrowser n -> Maybe Text
fileBrowserSearchString :: Maybe T.Text
                , forall n. 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.
                , forall n. 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.
                }

instance Named (FileBrowser n) n where
    getName :: FileBrowser n -> n
getName = forall a n. Named a n => a -> n
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. FileBrowser n -> List n FileInfo
fileBrowserEntries

-- | 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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileStatus] -> ShowS
$cshowList :: [FileStatus] -> ShowS
show :: FileStatus -> String
$cshow :: FileStatus -> String
showsPrec :: Int -> FileStatus -> ShowS
$cshowsPrec :: Int -> FileStatus -> ShowS
Show, FileStatus -> FileStatus -> Bool
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 -> String
fileInfoFilename :: String
             -- ^ The filename of this entry, without its path.
             -- This is not for display purposes; for that, use
             -- 'fileInfoSanitizedFilename'.
             , FileInfo -> String
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 -> String
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> String
$cshow :: FileInfo -> String
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> FileInfo -> ShowS
Show, FileInfo -> FileInfo -> Bool
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]
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show, FileType -> FileType -> Bool
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
suffixLensesWith "G" (lensRules & generateUpdateableOptics .~ False) ''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 :: forall n.
(FileInfo -> Bool) -> n -> Maybe String -> IO (FileBrowser n)
newFileBrowser FileInfo -> Bool
selPredicate n
name Maybe String
mCwd = do
    String
initialCwd <- ShowS
FP.normalise forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe String
mCwd of
        Just String
path -> forall (m :: * -> *) a. Monad m => a -> m a
return String
path
        Maybe String
Nothing -> IO String
D.getCurrentDirectory

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

    forall n. String -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory String
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.
--
-- Note that this applies the filter after setting it by updating the
-- listed entries to reflect the result of the filter. That is unlike
-- setting the filter with the 'fileBrowserEntryFilterL' lens directly,
-- which just sets the filter but does not (and cannot) update the
-- listed entries.
setFileBrowserEntryFilter :: Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
setFileBrowserEntryFilter :: forall n.
Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
setFileBrowserEntryFilter Maybe (FileInfo -> Bool)
f FileBrowser n
b =
    forall n. FileBrowser n -> FileBrowser n
applyFilterAndSearch forall a b. (a -> b) -> a -> b
$ FileBrowser n
b forall a b. a -> (a -> b) -> b
& forall n. Lens' (FileBrowser n) (Maybe (FileInfo -> Bool))
fileBrowserEntryFilterL 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 :: forall n. String -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory String
path FileBrowser n
b = do
    Either IOException [FileInfo]
entriesResult <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ String -> IO [FileInfo]
entriesForDirectory String
path

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

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

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

parentOf :: FilePath -> IO FileInfo
parentOf :: String -> IO FileInfo
parentOf String
path = String -> String -> IO FileInfo
getFileInfo String
".." forall a b. (a -> b) -> a -> b
$ ShowS
FP.takeDirectory String
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 :: String -> String -> IO FileInfo
getFileInfo String
name = [String] -> String -> IO FileInfo
go []
    where
        go :: [String] -> String -> IO FileInfo
go [String]
history String
fullPath = do
            String
filePath <- String -> IO String
D.makeAbsolute String
fullPath
            Either IOException FileStatus
statusResult <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
U.getSymbolicLinkStatus String
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
                  forall (m :: * -> *) a. Monad m => a -> m a
return FileStatus { fileStatusFileType :: Maybe FileType
fileStatusFileType = FileStatus -> Maybe FileType
fileTypeFromStatus FileStatus
status
                                    , fileStatusSize :: Int64
fileStatusSize = Int64
sz
                                    }

            Maybe FileType
targetTy <- case FileStatus -> Maybe FileType
fileStatusFileType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either IOException FileStatus
stat of
                Right (Just FileType
SymbolicLink) -> do
                    Either SomeException String
targetPathResult <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ String -> IO String
U.readSymbolicLink String
filePath
                    case Either SomeException String
targetPathResult of
                        Left (SomeException
_::E.SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                        Right String
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 String
targetPath forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
history
                            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                            else do
                                FileInfo
targetInfo <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO FileInfo
go (String
fullPath forall a. a -> [a] -> [a]
: [String]
history) String
targetPath
                                case FileInfo -> Either IOException FileStatus
fileInfoFileStatus FileInfo
targetInfo of
                                    Right (FileStatus Int64
_ Maybe FileType
targetTy) -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileType
targetTy
                                    Either IOException FileStatus
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Either IOException (Maybe FileType)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

            forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo { fileInfoFilename :: String
fileInfoFilename = String
name
                            , fileInfoFilePath :: String
fileInfoFilePath = String
filePath
                            , fileInfoSanitizedFilename :: String
fileInfoSanitizedFilename = ShowS
sanitizeFilename String
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
_ -> 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 :: forall n. FileBrowser n -> String
getWorkingDirectory = forall n. FileBrowser n -> String
fileBrowserWorkingDirectory

setEntries :: [FileInfo] -> FileBrowser n -> FileBrowser n
setEntries :: forall n. [FileInfo] -> FileBrowser n -> FileBrowser n
setEntries [FileInfo]
es FileBrowser n
b =
    forall n. FileBrowser n -> FileBrowser n
applyFilterAndSearch forall a b. (a -> b) -> a -> b
$ FileBrowser n
b forall a b. a -> (a -> b) -> b
& forall n. Lens' (FileBrowser n) [FileInfo]
fileBrowserLatestResultsL 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 :: forall n. FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser n
b = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ FileBrowser n
bforall s a. s -> Getting a s a -> a
^.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 :: forall n. FileBrowser n -> [FileInfo]
fileBrowserSelection FileBrowser n
b =
    let getEntry :: String -> FileInfo
getEntry String
filename = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find ((forall a. Eq a => a -> a -> Bool
== String
filename) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> String
fileInfoFilename) forall a b. (a -> b) -> a -> b
$ FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) [FileInfo]
fileBrowserLatestResultsL
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> FileInfo
getEntry forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) (Set String)
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 :: forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch Maybe Text -> Maybe Text
f FileBrowser n
b =
    let old :: Maybe Text
old = FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL
        new :: Maybe Text
new = Maybe Text -> Maybe Text
f forall a b. (a -> b) -> a -> b
$ FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL
        oldLen :: Int
oldLen = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
T.length Maybe Text
old
        newLen :: Int
newLen = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
T.length Maybe Text
new
    in if Maybe Text
old forall a. Eq a => a -> a -> Bool
== Maybe Text
new
       then FileBrowser n
b
       else if Int
oldLen 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 forall a b. a -> (a -> b) -> b
& forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
new
            else forall n. FileBrowser n -> FileBrowser n
applyFilterAndSearch forall a b. (a -> b) -> a -> b
$ FileBrowser n
b forall a b. a -> (a -> b) -> b
& forall n. Lens' (FileBrowser n) (Maybe Text)
fileBrowserSearchStringL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
new

applyFilterAndSearch :: FileBrowser n -> FileBrowser n
applyFilterAndSearch :: forall n. FileBrowser n -> FileBrowser n
applyFilterAndSearch FileBrowser n
b =
    let filterMatch :: FileInfo -> Bool
filterMatch = forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const Bool
True) (FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) (Maybe (FileInfo -> Bool))
fileBrowserEntryFilterL)
        searchMatch :: FileInfo -> Bool
searchMatch = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
True)
                            (\Text
search FileInfo
i -> (Text -> Text
T.toLower Text
search Text -> Text -> Bool
`T.isInfixOf` (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> String
fileInfoSanitizedFilename FileInfo
i)))
                            (FileBrowser n
bforall s a. s -> Getting a s a -> a
^.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 = forall a. (a -> Bool) -> [a] -> [a]
filter FileInfo -> Bool
match forall a b. (a -> b) -> a -> b
$ FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) [FileInfo]
fileBrowserLatestResultsL
    in FileBrowser n
b { fileBrowserEntries :: List n FileInfo
fileBrowserEntries = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) n
fileBrowserNameL) (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 forall a. Ord a => a -> a -> Bool
>= Int64
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
40::Int64) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 forall a. Floating a => a -> a -> a
** Double
40)) forall a. Semigroup a => a -> a -> a
<> String
"T"
    | Int64
i forall a. Ord a => a -> a -> Bool
>= Int64
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
30::Int64) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 forall a. Floating a => a -> a -> a
** Double
30)) forall a. Semigroup a => a -> a -> a
<> String
"G"
    | Int64
i forall a. Ord a => a -> a -> Bool
>= Int64
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
20::Int64) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 forall a. Floating a => a -> a -> a
** Double
20)) forall a. Semigroup a => a -> a -> a
<> String
"M"
    | Int64
i forall a. Ord a => a -> a -> Bool
>= Int64
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int64
10::Int64) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 forall a. Floating a => a -> a -> a
** Double
10)) forall a. Semigroup a => a -> a -> a
<> String
"K"
    | Bool
otherwise    = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int64
i forall a. Semigroup a => a -> a -> a
<> String
" bytes"
    where
        format :: Double -> String
format = forall r. PrintfType r => String -> r
printf String
"%0.1f"
        divBy :: Int64 -> Double -> Double
        divBy :: Int64 -> Double -> Double
divBy Int64
a Double
b = ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a) :: 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 :: String -> IO [FileInfo]
entriesForDirectory String
rawPath = do
    String
path <- String -> IO String
D.makeAbsolute String
rawPath

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

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

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

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

    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     -> forall a. a -> Maybe a
Just FileType
BlockDevice
       | FileStatus -> Bool
U.isCharacterDevice FileStatus
s -> forall a. a -> Maybe a
Just FileType
CharacterDevice
       | FileStatus -> Bool
U.isNamedPipe FileStatus
s       -> forall a. a -> Maybe a
Just FileType
NamedPipe
       | FileStatus -> Bool
U.isRegularFile FileStatus
s     -> forall a. a -> Maybe a
Just FileType
RegularFile
       | FileStatus -> Bool
U.isDirectory FileStatus
s       -> forall a. a -> Maybe a
Just FileType
Directory
       | FileStatus -> Bool
U.isSocket FileStatus
s          -> forall a. a -> Maybe a
Just FileType
UnixSocket
       | FileStatus -> Bool
U.isSymbolicLink FileStatus
s    -> forall a. a -> Maybe a
Just FileType
SymbolicLink
       | Bool
otherwise             -> forall a. Maybe a
Nothing

-- | Get the file information for the file under the cursor, if any.
fileBrowserCursor :: FileBrowser n -> Maybe FileInfo
fileBrowserCursor :: forall n. FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (FileBrowser n
bforall s a. s -> Getting a s a -> a
^.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:
--
-- * @Ctrl-b@: 'actionFileBrowserListPageUp'
-- * @Ctrl-f@: 'actionFileBrowserListPageDown'
-- * @Ctrl-d@: 'actionFileBrowserListHalfPageDown'
-- * @Ctrl-u@: 'actionFileBrowserListHalfPageUp'
-- * @Ctrl-n@: 'actionFileBrowserListNext'
-- * @Ctrl-p@: 'actionFileBrowserListPrev'
--
-- Events handled only in normal mode:
--
-- * @/@: 'actionFileBrowserBeginSearch'
-- * @Enter@: 'actionFileBrowserSelectEnter'
-- * @Space@: 'actionFileBrowserSelectCurrent'
-- * @g@: 'actionFileBrowserListTop'
-- * @G@: 'actionFileBrowserListBottom'
-- * @j@: 'actionFileBrowserListNext'
-- * @k@: 'actionFileBrowserListPrev'
--
-- Events handled only in search mode:
--
-- * @Esc@, @Ctrl-C@: cancel search mode
-- * Text input: update search string

actionFileBrowserBeginSearch :: EventM n (FileBrowser n) ()
actionFileBrowserBeginSearch :: forall n. EventM n (FileBrowser n) ()
actionFileBrowserBeginSearch =
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall n.
(Maybe Text -> Maybe Text) -> FileBrowser n -> FileBrowser n
updateFileBrowserSearch (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"")

actionFileBrowserSelectEnter :: EventM n (FileBrowser n) ()
actionFileBrowserSelectEnter :: forall n. EventM n (FileBrowser n) ()
actionFileBrowserSelectEnter =
    forall n. EventM n (FileBrowser n) ()
maybeSelectCurrentEntry

actionFileBrowserSelectCurrent :: EventM n (FileBrowser n) ()
actionFileBrowserSelectCurrent :: forall n. EventM n (FileBrowser n) ()
actionFileBrowserSelectCurrent =
    forall n. EventM n (FileBrowser n) ()
selectCurrentEntry

actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageUp :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageUp =
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageUp

actionFileBrowserListPageDown :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageDown :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageDown =
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageDown

actionFileBrowserListHalfPageUp :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageUp :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageUp =
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL (forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> EventM n (GenericList n t e) ()
listMoveByPages (-Double
0.5::Double))

actionFileBrowserListHalfPageDown :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageDown :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageDown =
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL (forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> EventM n (GenericList n t e) ()
listMoveByPages (Double
0.5::Double))

actionFileBrowserListTop :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListTop :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListTop =
    forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
0

actionFileBrowserListBottom :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListBottom :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListBottom = do
    FileBrowser n
b <- forall s (m :: * -> *). MonadState s m => m s
get
    let sz :: Int
sz = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall n (t :: * -> *) e. GenericList n t e -> t e
listElements forall a b. (a -> b) -> a -> b
$ FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL)
    forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (Int
sz forall a. Num a => a -> a -> a
- Int
1)

actionFileBrowserListNext :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext =
    forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
1

actionFileBrowserListPrev :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev =
    forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy (-Int
1)

handleFileBrowserEvent :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()
handleFileBrowserEvent :: forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEvent Event
e = do
    FileBrowser n
b <- forall s (m :: * -> *). MonadState s m => m s
get
    if forall n. FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser n
b
        then forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventSearching Event
e
        else forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventNormal Event
e

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

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

handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventNormal :: forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventNormal Event
e =
    case Event
e of
        Vty.EvKey (Vty.KChar Char
'/') [] ->
            -- Begin file search
            forall n. EventM n (FileBrowser n) ()
actionFileBrowserBeginSearch
        Vty.EvKey Key
Vty.KEnter [] ->
            -- Select file or enter directory
            forall n. EventM n (FileBrowser n) ()
actionFileBrowserSelectEnter
        Vty.EvKey (Vty.KChar Char
' ') [] ->
            -- Select entry
            forall n. EventM n (FileBrowser n) ()
actionFileBrowserSelectCurrent
        Event
_ ->
            forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventCommon Event
e

handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventCommon :: forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventCommon Event
e =
    case Event
e of
        Vty.EvKey (Vty.KChar Char
'b') [Modifier
Vty.MCtrl] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageUp
        Vty.EvKey (Vty.KChar Char
'f') [Modifier
Vty.MCtrl] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageDown
        Vty.EvKey (Vty.KChar Char
'd') [Modifier
Vty.MCtrl] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageDown
        Vty.EvKey (Vty.KChar Char
'u') [Modifier
Vty.MCtrl] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageUp
        Vty.EvKey (Vty.KChar Char
'g') [] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListTop
        Vty.EvKey (Vty.KChar Char
'G') [] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListBottom
        Vty.EvKey (Vty.KChar Char
'j') [] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext
        Vty.EvKey (Vty.KChar Char
'k') [] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev
        Vty.EvKey (Vty.KChar Char
'n') [Modifier
Vty.MCtrl] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext
        Vty.EvKey (Vty.KChar Char
'p') [Modifier
Vty.MCtrl] ->
            forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev
        Event
_ ->
            forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> 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 :: EventM n (FileBrowser n) ()
maybeSelectCurrentEntry :: forall n. EventM n (FileBrowser n) ()
maybeSelectCurrentEntry = do
    FileBrowser n
b <- forall s (m :: * -> *). MonadState s m => m s
get
    case forall n. FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b of
        Maybe FileInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just FileInfo
entry ->
            if forall n. FileBrowser n -> FileInfo -> Bool
fileBrowserSelectable FileBrowser n
b FileInfo
entry
            then forall n. Lens' (FileBrowser n) (Set String)
fileBrowserSelectedFilesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
Set.insert (FileInfo -> String
fileInfoFilename FileInfo
entry)
            else case FileInfo -> Maybe FileType
fileInfoFileType FileInfo
entry of
                Just FileType
Directory ->
                    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall n. String -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory (FileInfo -> String
fileInfoFilePath FileInfo
entry) FileBrowser n
b)
                Just FileType
SymbolicLink ->
                    case FileInfo -> Maybe FileType
fileInfoLinkTargetType FileInfo
entry of
                        Just FileType
Directory ->
                            forall s (m :: * -> *). MonadState s m => s -> m ()
put forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall n. String -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory (FileInfo -> String
fileInfoFilePath FileInfo
entry) FileBrowser n
b)
                        Maybe FileType
_ ->
                            forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe FileType
_ ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return ()

selectCurrentEntry :: EventM n (FileBrowser n) ()
selectCurrentEntry :: forall n. EventM n (FileBrowser n) ()
selectCurrentEntry = do
    FileBrowser n
b <- forall s (m :: * -> *). MonadState s m => m s
get
    case forall n. FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b of
        Maybe FileInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just FileInfo
e -> forall n. Lens' (FileBrowser n) (Set String)
fileBrowserSelectedFilesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
Set.insert (FileInfo -> String
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 :: forall n. (Show n, Ord n) => Bool -> FileBrowser n -> Widget n
renderFileBrowser Bool
foc FileBrowser n
b =
    let maxFilenameLength :: Int
maxFilenameLength = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> String
fileInfoFilename) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL)
        cwdHeader :: Widget n
cwdHeader = forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$
                    forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ ShowS
sanitizeFilename forall a b. (a -> b) -> a -> b
$ forall n. FileBrowser n -> String
fileBrowserWorkingDirectory FileBrowser n
b
        selInfo :: Widget n
selInfo = case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (FileBrowser n
bforall s a. s -> Getting a s a -> a
^.forall n. Lens' (FileBrowser n) (List n FileInfo)
fileBrowserEntriesL) of
            Maybe (Int, FileInfo)
Nothing -> forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Char -> Widget n
fill Char
' '
            Just (Int
_, FileInfo
i) -> forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall {n}. FileInfo -> Widget n
selInfoFor FileInfo
i
        fileTypeLabel :: Maybe FileType -> a
fileTypeLabel Maybe FileType
Nothing = a
"unknown"
        fileTypeLabel (Just FileType
t) =
            case FileType
t of
                FileType
RegularFile -> a
"file"
                FileType
BlockDevice -> a
"block device"
                FileType
CharacterDevice -> a
"character device"
                FileType
NamedPipe -> a
"pipe"
                FileType
Directory -> a
"directory"
                FileType
SymbolicLink -> a
"symbolic link"
                FileType
UnixSocket -> a
"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 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just FileType
RegularFile
                                        then Text
", " forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
prettyFileSize (FileStatus -> Int64
fileStatusSize FileStatus
stat)
                                        else Text
""
                        in forall {a}. IsString a => Maybe FileType -> a
fileTypeLabel (FileStatus -> Maybe FileType
fileStatusFileType FileStatus
stat) forall a. Semigroup a => a -> a -> a
<> Text
maybeSize
            in forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FileInfo -> String
fileInfoSanitizedFilename FileInfo
i) forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
label

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

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

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

-- | Sanitize a filename for terminal display, replacing non-printable
-- characters with '?'.
sanitizeFilename :: String -> String
sanitizeFilename :: ShowS
sanitizeFilename = 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 = String -> AttrName
attrName String
"fileBrowser"

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

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

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

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

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

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

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

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

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

-- | The attribute used for selected entries in the file browser.
fileBrowserSelectedAttr :: AttrName
fileBrowserSelectedAttr :: AttrName
fileBrowserSelectedAttr = AttrName
fileBrowserAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FileType]
tys) 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 :: String -> FileInfo -> Bool
fileExtensionMatch String
ext FileInfo
i = case FileInfo -> Maybe FileType
fileInfoFileType FileInfo
i of
    Just FileType
Directory -> Bool
True
    Just FileType
RegularFile -> (Char
'.' forall a. a -> [a] -> [a]
: (Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
ext)) forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> String
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