{-# 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, when)
import Control.Monad.IO.Class (liftIO)
import Data.Char (toLower, isPrint)
import Data.Foldable (for_)
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.PosixCompat.Files as U
import qualified System.PosixCompat.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 = List n FileInfo -> n
forall a n. Named a n => a -> n
getName (List n FileInfo -> n)
-> (FileBrowser n -> List n FileInfo) -> FileBrowser n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileBrowser n -> List n FileInfo
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
(Int -> FileStatus -> ShowS)
-> (FileStatus -> String)
-> ([FileStatus] -> ShowS)
-> Show FileStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileStatus -> ShowS
showsPrec :: Int -> FileStatus -> ShowS
$cshow :: FileStatus -> String
show :: FileStatus -> String
$cshowList :: [FileStatus] -> ShowS
showList :: [FileStatus] -> ShowS
Show, FileStatus -> FileStatus -> Bool
(FileStatus -> FileStatus -> Bool)
-> (FileStatus -> FileStatus -> Bool) -> Eq FileStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileStatus -> FileStatus -> Bool
== :: FileStatus -> FileStatus -> Bool
$c/= :: FileStatus -> FileStatus -> Bool
/= :: 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
(Int -> FileInfo -> ShowS)
-> (FileInfo -> String) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileInfo -> ShowS
showsPrec :: Int -> FileInfo -> ShowS
$cshow :: FileInfo -> String
show :: FileInfo -> String
$cshowList :: [FileInfo] -> ShowS
showList :: [FileInfo] -> ShowS
Show, FileInfo -> FileInfo -> Bool
(FileInfo -> FileInfo -> Bool)
-> (FileInfo -> FileInfo -> Bool) -> Eq FileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS FileType
readsPrec :: Int -> ReadS FileType
$creadList :: ReadS [FileType]
readList :: ReadS [FileType]
$creadPrec :: ReadPrec FileType
readPrec :: ReadPrec FileType
$creadListPrec :: ReadPrec [FileType]
readListPrec :: ReadPrec [FileType]
Read, Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileType -> ShowS
showsPrec :: Int -> FileType -> ShowS
$cshow :: FileType -> String
show :: FileType -> String
$cshowList :: [FileType] -> ShowS
showList :: [FileType] -> ShowS
Show, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
/= :: 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 ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe String
mCwd of
        Just String
path -> String -> IO String
forall a. a -> IO a
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 = 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 String
fileBrowserSelectedFiles = Set String
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
                        }

    String -> FileBrowser n -> IO (FileBrowser n)
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 -> FileInfo -> Maybe FileType
fileInfoLinkTargetType FileInfo
i Maybe FileType -> Maybe FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
Directory
        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 =
    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 (f :: * -> *).
Functor f =>
(Maybe (FileInfo -> Bool) -> f (Maybe (FileInfo -> Bool)))
-> FileBrowser n -> f (FileBrowser n)
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 :: forall n. String -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory String
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
$ String -> IO [FileInfo]
entriesForDirectory String
path

    let ([FileInfo]
entries, Maybe IOException
exc) = case Either IOException [FileInfo]
entriesResult of
            Left (IOException
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 String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"/" then [FileInfo] -> IO [FileInfo]
forall a. a -> IO a
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
$ String -> IO FileInfo
parentOf String
path
        [FileInfo] -> IO [FileInfo]
forall a. a -> IO a
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

    FileBrowser n -> IO (FileBrowser n)
forall a. a -> IO a
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
$ [FileInfo] -> FileBrowser n -> FileBrowser n
forall n. [FileInfo] -> FileBrowser n -> FileBrowser n
setEntries [FileInfo]
allEntries FileBrowser n
b
                 FileBrowser n -> (FileBrowser n -> FileBrowser n) -> FileBrowser n
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> FileBrowser n -> Identity (FileBrowser n)
forall n (f :: * -> *).
Functor f =>
(String -> f String) -> FileBrowser n -> f (FileBrowser n)
fileBrowserWorkingDirectoryL ((String -> Identity String)
 -> FileBrowser n -> Identity (FileBrowser n))
-> String -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
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 (f :: * -> *).
Functor f =>
(Maybe IOException -> f (Maybe IOException))
-> FileBrowser n -> f (FileBrowser n)
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 String -> Identity (Set String))
-> FileBrowser n -> Identity (FileBrowser n)
forall n (f :: * -> *).
Functor f =>
(Set String -> f (Set String))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserSelectedFilesL ((Set String -> Identity (Set String))
 -> FileBrowser n -> Identity (FileBrowser n))
-> Set String -> FileBrowser n -> FileBrowser n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set String
forall a. Monoid a => a
mempty

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

            FileInfo -> IO FileInfo
forall a. a -> IO a
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
_ -> 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 :: forall n. FileBrowser n -> String
getWorkingDirectory = FileBrowser n -> String
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 =
    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 (f :: * -> *).
Functor f =>
([FileInfo] -> f [FileInfo]) -> FileBrowser n -> f (FileBrowser n)
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 :: forall n. 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 (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> FileBrowser n -> f (FileBrowser n)
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 = 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 ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
filename) (String -> Bool) -> (FileInfo -> String) -> FileInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> String
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 (f :: * -> *).
Functor f =>
([FileInfo] -> f [FileInfo]) -> FileBrowser n -> f (FileBrowser n)
fileBrowserLatestResultsL
    in (String -> FileInfo) -> [String] -> [FileInfo]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> FileInfo
getEntry ([String] -> [FileInfo]) -> [String] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ Set String -> [String]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Set String -> [String]) -> Set String -> [String]
forall a b. (a -> b) -> a -> b
$ FileBrowser n
bFileBrowser n
-> Getting (Set String) (FileBrowser n) (Set String) -> Set String
forall s a. s -> Getting a s a -> a
^.Getting (Set String) (FileBrowser n) (Set String)
forall n (f :: * -> *).
Functor f =>
(Set String -> f (Set String))
-> FileBrowser n -> f (FileBrowser n)
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
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 (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> FileBrowser n -> f (FileBrowser n)
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 (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> FileBrowser n -> f (FileBrowser n)
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 (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> FileBrowser n -> f (FileBrowser n)
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 (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> FileBrowser n -> f (FileBrowser n)
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 :: forall n. 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 (f :: * -> *).
Functor f =>
(Maybe (FileInfo -> Bool) -> f (Maybe (FileInfo -> Bool)))
-> FileBrowser n -> f (FileBrowser n)
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` String -> Text
T.pack (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> String
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 (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> FileBrowser n -> f (FileBrowser n)
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 (f :: * -> *).
Functor f =>
([FileInfo] -> f [FileInfo]) -> FileBrowser n -> f (FileBrowser n)
fileBrowserLatestResultsL
    in FileBrowser n
b { fileBrowserEntries = list (b^.fileBrowserNameL) (V.fromList matching) 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) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
40)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"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) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
30)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"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) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
20)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"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) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
format (Int64
i Int64 -> Double -> Double
`divBy` (Double
2 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
10)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"K"
    | Bool
otherwise    = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes"
    where
        format :: Double -> String
format = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%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 :: 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 <- [String] -> (String -> IO FileInfo) -> IO [FileInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
dirContents ((String -> IO FileInfo) -> IO [FileInfo])
-> (String -> IO FileInfo) -> IO [FileInfo]
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 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 String -> String -> 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 -> String
fileInfoFilename FileInfo
a)
                                     (Char -> Char
toLower (Char -> Char) -> ShowS
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 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 String -> String -> 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 -> String
fileInfoFilename FileInfo
a)
                                               (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileInfo -> String
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 a. a -> IO a
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 :: forall n. 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 :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
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 (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
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 =
    (FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser 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
"")

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

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

actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageUp :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageUp =
    LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) ()
-> EventM n (FileBrowser n) ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) c)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) c
-> EventM n (FileBrowser n) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList n Vector FileInfo
 -> Focusing
      (StateT (EventState n) IO) () (GenericList n Vector FileInfo))
-> FileBrowser n
-> Focusing (StateT (EventState n) IO) () (FileBrowser n)
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL EventM n (GenericList n Vector FileInfo) ()
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 =
    LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) ()
-> EventM n (FileBrowser n) ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) c)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) c
-> EventM n (FileBrowser n) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList n Vector FileInfo
 -> Focusing
      (StateT (EventState n) IO) () (GenericList n Vector FileInfo))
-> FileBrowser n
-> Focusing (StateT (EventState n) IO) () (FileBrowser n)
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL EventM n (GenericList n Vector FileInfo) ()
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 =
    LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) ()
-> EventM n (FileBrowser n) ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) c)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) c
-> EventM n (FileBrowser n) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList n Vector FileInfo
 -> Focusing
      (StateT (EventState n) IO) () (GenericList n Vector FileInfo))
-> FileBrowser n
-> Focusing (StateT (EventState n) IO) () (FileBrowser n)
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL (Double -> EventM n (GenericList n Vector FileInfo) ()
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 =
    LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) ()
-> EventM n (FileBrowser n) ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) c)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) c
-> EventM n (FileBrowser n) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList n Vector FileInfo
 -> Focusing
      (StateT (EventState n) IO) () (GenericList n Vector FileInfo))
-> FileBrowser n
-> Focusing (StateT (EventState n) IO) () (FileBrowser n)
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL (Double -> EventM n (GenericList n Vector FileInfo) ()
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 =
    (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> EventM n (FileBrowser n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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

actionFileBrowserListBottom :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListBottom :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListBottom = do
    FileBrowser n
b <- EventM n (FileBrowser n) (FileBrowser n)
forall s (m :: * -> *). MonadState s m => m s
get
    let sz :: Int
sz = Vector FileInfo -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GenericList n Vector FileInfo -> Vector FileInfo
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (GenericList n Vector FileInfo -> Vector FileInfo)
-> GenericList n Vector FileInfo -> Vector FileInfo
forall a b. (a -> b) -> a -> 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 (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL)
    (GenericList n Vector FileInfo
 -> Identity (GenericList n Vector FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL ((GenericList n Vector FileInfo
  -> Identity (GenericList n Vector FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (GenericList n Vector FileInfo -> GenericList n Vector FileInfo)
-> EventM n (FileBrowser n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int
-> GenericList n Vector FileInfo -> GenericList n Vector 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)

actionFileBrowserListNext :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext =
    (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> EventM n (FileBrowser n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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

actionFileBrowserListPrev :: Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev :: forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev =
    (List n FileInfo -> Identity (List n FileInfo))
-> FileBrowser n -> Identity (FileBrowser n)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL ((List n FileInfo -> Identity (List n FileInfo))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (List n FileInfo -> List n FileInfo)
-> EventM n (FileBrowser n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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)

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 <- EventM n (FileBrowser n) (FileBrowser n)
forall s (m :: * -> *). MonadState s m => m s
get
    if FileBrowser n -> Bool
forall n. FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser n
b
        then Event -> EventM n (FileBrowser n) ()
forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEventSearching Event
e
        else Event -> EventM n (FileBrowser n) ()
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
t
           | Bool
otherwise = HasCallStack => Text -> Text
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] ->
            (FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser 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)
        Vty.EvKey Key
Vty.KEsc [] ->
            (FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser 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)
        Vty.EvKey Key
Vty.KBS [] ->
            (FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
safeInit)
        Vty.EvKey Key
Vty.KEnter [] -> do
            EventM n (FileBrowser n) ()
forall n. EventM n (FileBrowser n) ()
maybeSelectCurrentEntry
            (FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser 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)
        Vty.EvKey (Vty.KChar Char
c) [] ->
            (FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FileBrowser n -> FileBrowser n) -> EventM n (FileBrowser 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 a b. (a -> b) -> Maybe a -> Maybe b
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))
        Event
_ ->
            Event -> EventM n (FileBrowser n) ()
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
            EventM n (FileBrowser n) ()
forall n. EventM n (FileBrowser n) ()
actionFileBrowserBeginSearch
        Vty.EvKey Key
Vty.KEnter [] ->
            -- Select file or enter directory
            EventM n (FileBrowser n) ()
forall n. EventM n (FileBrowser n) ()
actionFileBrowserSelectEnter
        Vty.EvKey (Vty.KChar Char
' ') [] ->
            -- Select entry
            EventM n (FileBrowser n) ()
forall n. EventM n (FileBrowser n) ()
actionFileBrowserSelectCurrent
        Event
_ ->
            Event -> EventM n (FileBrowser n) ()
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] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageUp
        Vty.EvKey (Vty.KChar Char
'f') [Modifier
Vty.MCtrl] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPageDown
        Vty.EvKey (Vty.KChar Char
'd') [Modifier
Vty.MCtrl] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageDown
        Vty.EvKey (Vty.KChar Char
'u') [Modifier
Vty.MCtrl] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListHalfPageUp
        Vty.EvKey (Vty.KChar Char
'g') [] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListTop
        Vty.EvKey (Vty.KChar Char
'G') [] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListBottom
        Vty.EvKey (Vty.KChar Char
'j') [] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext
        Vty.EvKey (Vty.KChar Char
'k') [] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev
        Vty.EvKey (Vty.KChar Char
'n') [Modifier
Vty.MCtrl] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListNext
        Vty.EvKey (Vty.KChar Char
'p') [Modifier
Vty.MCtrl] ->
            EventM n (FileBrowser n) ()
forall n. Ord n => EventM n (FileBrowser n) ()
actionFileBrowserListPrev
        Event
_ ->
            LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) ()
-> EventM n (FileBrowser n) ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) c)
  (FileBrowser n)
  (GenericList n Vector FileInfo)
-> EventM n (GenericList n Vector FileInfo) c
-> EventM n (FileBrowser n) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList n Vector FileInfo
 -> Focusing
      (StateT (EventState n) IO) () (GenericList n Vector FileInfo))
-> FileBrowser n
-> Focusing (StateT (EventState n) IO) () (FileBrowser n)
LensLike'
  (Zoomed (EventM n (GenericList n Vector FileInfo)) ())
  (FileBrowser n)
  (GenericList n Vector FileInfo)
forall n (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserEntriesL (EventM n (GenericList n Vector FileInfo) ()
 -> EventM n (FileBrowser n) ())
-> EventM n (GenericList n Vector FileInfo) ()
-> EventM n (FileBrowser n) ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM n (GenericList n Vector FileInfo) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e

markSelected :: FileInfo -> EventM n (FileBrowser n) ()
markSelected :: forall n. FileInfo -> EventM n (FileBrowser n) ()
markSelected FileInfo
e = (Set String -> Identity (Set String))
-> FileBrowser n -> Identity (FileBrowser n)
forall n (f :: * -> *).
Functor f =>
(Set String -> f (Set String))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserSelectedFilesL ((Set String -> Identity (Set String))
 -> FileBrowser n -> Identity (FileBrowser n))
-> (Set String -> Set String) -> EventM n (FileBrowser n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert (FileInfo -> String
fileInfoFilename FileInfo
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 <- EventM n (FileBrowser n) (FileBrowser n)
forall s (m :: * -> *). MonadState s m => m s
get
    Maybe FileInfo
-> (FileInfo -> EventM n (FileBrowser n) ())
-> EventM n (FileBrowser n) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (FileBrowser n -> Maybe FileInfo
forall n. FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b) ((FileInfo -> EventM n (FileBrowser n) ())
 -> EventM n (FileBrowser n) ())
-> (FileInfo -> EventM n (FileBrowser n) ())
-> EventM n (FileBrowser n) ()
forall a b. (a -> b) -> a -> b
$ \FileInfo
entry ->
        if FileBrowser n -> FileInfo -> Bool
forall n. FileBrowser n -> FileInfo -> Bool
fileBrowserSelectable FileBrowser n
b FileInfo
entry
        then FileInfo -> EventM n (FileBrowser n) ()
forall n. FileInfo -> EventM n (FileBrowser n) ()
markSelected FileInfo
entry
        else Bool -> EventM n (FileBrowser n) () -> EventM n (FileBrowser n) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FileInfo -> Bool
selectDirectories FileInfo
entry) (EventM n (FileBrowser n) () -> EventM n (FileBrowser n) ())
-> EventM n (FileBrowser n) () -> EventM n (FileBrowser n) ()
forall a b. (a -> b) -> a -> b
$
            FileBrowser n -> EventM n (FileBrowser n) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FileBrowser n -> EventM n (FileBrowser n) ())
-> EventM n (FileBrowser n) (FileBrowser n)
-> EventM n (FileBrowser n) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (FileBrowser n) -> EventM n (FileBrowser n) (FileBrowser n)
forall a. IO a -> EventM n (FileBrowser n) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> FileBrowser n -> IO (FileBrowser n)
forall n. String -> FileBrowser n -> IO (FileBrowser n)
setWorkingDirectory (FileInfo -> String
fileInfoFilePath FileInfo
entry) FileBrowser n
b)

selectCurrentEntry :: EventM n (FileBrowser n) ()
selectCurrentEntry :: forall n. EventM n (FileBrowser n) ()
selectCurrentEntry = do
    FileBrowser n
b <- EventM n (FileBrowser n) (FileBrowser n)
forall s (m :: * -> *). MonadState s m => m s
get
    Maybe FileInfo
-> (FileInfo -> EventM n (FileBrowser n) ())
-> EventM n (FileBrowser n) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (FileBrowser n -> Maybe FileInfo
forall n. FileBrowser n -> Maybe FileInfo
fileBrowserCursor FileBrowser n
b) FileInfo -> EventM n (FileBrowser n) ()
forall n. FileInfo -> EventM n (FileBrowser n) ()
markSelected

-- | 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 = GenericList n Vector Int -> Int
forall a. Ord a => GenericList n Vector a -> a
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
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (FileInfo -> String) -> FileInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> String
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 (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
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
$
                    String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ ShowS
sanitizeFilename ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FileBrowser n -> String
forall n. FileBrowser n -> String
fileBrowserWorkingDirectory FileBrowser n
b
        selInfo :: Widget n
selInfo = case GenericList n Vector FileInfo -> Maybe (Int, FileInfo)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
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 (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
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 -> 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 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 {a}. IsString a => Maybe FileType -> a
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
$ String -> Text
T.pack (FileInfo -> String
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 (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> FileBrowser n -> f (FileBrowser n)
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 (f :: * -> *).
Functor f =>
(n -> f n) -> FileBrowser n -> f (FileBrowser 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 String -> n -> Bool -> FileInfo -> Widget n
forall n.
Bool -> Int -> Set String -> n -> Bool -> FileInfo -> Widget n
renderFileInfo Bool
foc Int
maxFilenameLength (FileBrowser n
bFileBrowser n
-> Getting (Set String) (FileBrowser n) (Set String) -> Set String
forall s a. s -> Getting a s a -> a
^.Getting (Set String) (FileBrowser n) (Set String)
forall n (f :: * -> *).
Functor f =>
(Set String -> f (Set String))
-> FileBrowser n -> f (FileBrowser n)
fileBrowserSelectedFilesL) (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 (f :: * -> *).
Functor f =>
(n -> f n) -> FileBrowser n -> f (FileBrowser n)
fileBrowserNameL))
                         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 (f :: * -> *).
Functor f =>
(List n FileInfo -> f (List n FileInfo))
-> FileBrowser n -> f (FileBrowser n)
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 -> 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 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
body
    where
        sel :: Bool
sel = FileInfo -> String
fileInfoFilename FileInfo
info String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
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
$
               (if Bool
foc Bool -> Bool -> Bool
&& Bool
listSel then n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
putCursor n
n ((Int, Int) -> Location
Location (Int
0,Int
0)) 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
$
               String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ FileInfo -> String
fileInfoSanitizedFilename FileInfo
info String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
suffix)
        suffix :: String
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 String
"/" else String
"") String -> ShowS
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 = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 AttrName -> AttrName -> AttrName
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 = Bool -> (FileType -> Bool) -> Maybe FileType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (FileType -> [FileType] -> Bool
forall a. Eq a => a -> [a] -> 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 :: 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
'.' 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
<$> String
ext)) String -> String -> 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 -> 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