{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# OPTIONS_HADDOCK show-extensions #-}

{-|
Module      :  Yi.Dired
License     :  GPL-2
Maintainer  :  yi-devel@googlegroups.com
Stability   :  experimental
Portability :  portable

A simple
<https://www.gnu.org/software/emacs/manual/html_node/emacs/Dired.html dired>
implementation for Yi.

= TODO

* add more comments
* Support symlinks
* Mark operations

    * search

* Improve the colouring to show

    * loaded buffers
    * .hs files
    * marked files

* Fix old mod dates (> 6months) to show year
* Fix the 'number of links' field to show actual values not just 1...
* Automatic support for browsing .zip, .gz files etc...
-}

module Yi.Dired
  ( dired
  , diredDir
  , diredDirBuffer
  , editFile
  ) where

import           GHC.Generics             (Generic)

import           Control.Applicative      ((<|>))
import           Control.Category         ((>>>))
import           Control.Exc              (orException, printingException)
import           Lens.Micro.Platform      (makeLenses, use, (%~), (&), (.=), (.~), (^.))
import           Control.Monad            (foldM, unless, void, when)
import           Control.Monad.Reader     (asks)
import qualified Data.Attoparsec.Text     as P
import           Data.Binary              (Binary)
import           Data.Char                (toLower)
import           Data.Default             (Default, def)
import           Data.Foldable            (find, foldl')
import           Data.List                (any, elem, sum, transpose)
import qualified Data.Map                 as M (Map, assocs, delete, empty,
                                                findWithDefault, fromList,
                                                insert, keys, lookup, map,
                                                mapKeys, union, (!))
import           Data.Maybe               (fromMaybe)
import           Data.Monoid              ((<>))
import qualified Data.Text                as T (Text, pack, unpack)
import           Data.Time.Clock.POSIX    (posixSecondsToUTCTime)
import           Data.Typeable            (Typeable)
import           System.CanonicalizePath  (canonicalizePath)
import           System.Directory         (copyFile, createDirectoryIfMissing,
                                           doesDirectoryExist, doesFileExist,
                                           getDirectoryContents, getPermissions,
                                           removeDirectoryRecursive, writable)
import           System.FilePath          (dropTrailingPathSeparator,
                                           equalFilePath, isAbsolute,
                                           takeDirectory, takeFileName, (</>))
import           System.FriendlyPath      (userToCanonPath)
import           System.PosixCompat.Files (FileStatus, fileExist, fileGroup,
                                           fileMode, fileOwner, fileSize,
                                           getSymbolicLinkStatus,
                                           groupExecuteMode, groupReadMode,
                                           groupWriteMode, isBlockDevice,
                                           isCharacterDevice, isDirectory,
                                           isNamedPipe, isRegularFile, isSocket,
                                           isSymbolicLink, linkCount,
                                           modificationTime, otherExecuteMode,
                                           otherReadMode, otherWriteMode,
                                           ownerExecuteMode, ownerReadMode,
                                           ownerWriteMode, readSymbolicLink,
                                           readSymbolicLink, removeLink, rename,
                                           unionFileModes)
import           System.PosixCompat.Types (FileMode, GroupID, UserID)
#ifndef mingw32_HOST_OS
#if MIN_VERSION_unix(2,8,0)
import           System.Posix.User.ByteString (GroupEntry(GroupEntry), UserEntry(UserEntry))
import           System.Posix.User        (getAllGroupEntries,
#else
import           System.Posix.User        (GroupEntry(..), UserEntry(..),getAllGroupEntries,
#endif
                                           getAllUserEntries,
                                           getGroupEntryForID,
                                           getUserEntryForID, groupID, userID, userName, groupName)
#endif
import           Text.Printf              (printf)
import           Yi.Buffer
import           Yi.Config                (modeTable)
import           Yi.Core                  (errorEditor)
import           Yi.Editor
import           Yi.Keymap                (Keymap, YiM, topKeymapA)
import           Yi.Keymap.Keys
import           Yi.MiniBuffer            (noHint, spawnMinibufferE, withMinibuffer, withMinibufferFree)
import           Yi.Misc                  (getFolder, promptFile)
import           Yi.Monad                 (gets)
import qualified Yi.Rope                  as R
import           Yi.String                (showT)
import           Yi.Style
import           Yi.Types                 (YiVariable, yiConfig)
import           Yi.Utils                 (io, makeLensesWithSuffix)


#if __GLASGOW_HASKELL__ < 710
import System.Locale (defaultTimeLocale)
import Data.Time     (UTCTime, formatTime, getCurrentTime)
#else
import Data.Time     (UTCTime, formatTime, getCurrentTime, defaultTimeLocale)
#endif

-- Have no idea how to keep track of this state better, so here it is ...
data DiredOpState = DiredOpState
    { DiredOpState -> Int
_diredOpSucCnt :: !Int -- ^ keep track of the num of successful operations
    , DiredOpState -> Bool
_diredOpForAll :: Bool -- ^ if True, DOChoice will be bypassed
    } deriving (Int -> DiredOpState -> ShowS
[DiredOpState] -> ShowS
DiredOpState -> FilePath
(Int -> DiredOpState -> ShowS)
-> (DiredOpState -> FilePath)
-> ([DiredOpState] -> ShowS)
-> Show DiredOpState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiredOpState -> ShowS
showsPrec :: Int -> DiredOpState -> ShowS
$cshow :: DiredOpState -> FilePath
show :: DiredOpState -> FilePath
$cshowList :: [DiredOpState] -> ShowS
showList :: [DiredOpState] -> ShowS
Show, DiredOpState -> DiredOpState -> Bool
(DiredOpState -> DiredOpState -> Bool)
-> (DiredOpState -> DiredOpState -> Bool) -> Eq DiredOpState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiredOpState -> DiredOpState -> Bool
== :: DiredOpState -> DiredOpState -> Bool
$c/= :: DiredOpState -> DiredOpState -> Bool
/= :: DiredOpState -> DiredOpState -> Bool
Eq, Typeable, (forall x. DiredOpState -> Rep DiredOpState x)
-> (forall x. Rep DiredOpState x -> DiredOpState)
-> Generic DiredOpState
forall x. Rep DiredOpState x -> DiredOpState
forall x. DiredOpState -> Rep DiredOpState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DiredOpState -> Rep DiredOpState x
from :: forall x. DiredOpState -> Rep DiredOpState x
$cto :: forall x. Rep DiredOpState x -> DiredOpState
to :: forall x. Rep DiredOpState x -> DiredOpState
Generic)

instance Default DiredOpState where
    def :: DiredOpState
def = DiredOpState { _diredOpSucCnt :: Int
_diredOpSucCnt = Int
0, _diredOpForAll :: Bool
_diredOpForAll = Bool
False }

instance Binary DiredOpState

instance YiVariable DiredOpState

makeLenses ''DiredOpState

data DiredFileInfo = DiredFileInfo
    { DiredFileInfo -> DiredFilePath
permString             :: R.YiString
    , DiredFileInfo -> Integer
numLinks               :: Integer
    , DiredFileInfo -> DiredFilePath
owner                  :: R.YiString
    , DiredFileInfo -> DiredFilePath
grp                    :: R.YiString
    , DiredFileInfo -> Integer
sizeInBytes            :: Integer
    , DiredFileInfo -> DiredFilePath
modificationTimeString :: R.YiString
    } deriving (Int -> DiredFileInfo -> ShowS
[DiredFileInfo] -> ShowS
DiredFileInfo -> FilePath
(Int -> DiredFileInfo -> ShowS)
-> (DiredFileInfo -> FilePath)
-> ([DiredFileInfo] -> ShowS)
-> Show DiredFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiredFileInfo -> ShowS
showsPrec :: Int -> DiredFileInfo -> ShowS
$cshow :: DiredFileInfo -> FilePath
show :: DiredFileInfo -> FilePath
$cshowList :: [DiredFileInfo] -> ShowS
showList :: [DiredFileInfo] -> ShowS
Show, DiredFileInfo -> DiredFileInfo -> Bool
(DiredFileInfo -> DiredFileInfo -> Bool)
-> (DiredFileInfo -> DiredFileInfo -> Bool) -> Eq DiredFileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiredFileInfo -> DiredFileInfo -> Bool
== :: DiredFileInfo -> DiredFileInfo -> Bool
$c/= :: DiredFileInfo -> DiredFileInfo -> Bool
/= :: DiredFileInfo -> DiredFileInfo -> Bool
Eq, Typeable, (forall x. DiredFileInfo -> Rep DiredFileInfo x)
-> (forall x. Rep DiredFileInfo x -> DiredFileInfo)
-> Generic DiredFileInfo
forall x. Rep DiredFileInfo x -> DiredFileInfo
forall x. DiredFileInfo -> Rep DiredFileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DiredFileInfo -> Rep DiredFileInfo x
from :: forall x. DiredFileInfo -> Rep DiredFileInfo x
$cto :: forall x. Rep DiredFileInfo x -> DiredFileInfo
to :: forall x. Rep DiredFileInfo x -> DiredFileInfo
Generic)

data DiredEntry
    = DiredFile DiredFileInfo
    | DiredDir DiredFileInfo
    | DiredSymLink DiredFileInfo R.YiString
    | DiredSocket DiredFileInfo
    | DiredBlockDevice DiredFileInfo
    | DiredCharacterDevice DiredFileInfo
    | DiredNamedPipe DiredFileInfo
    | DiredNoInfo
    deriving (Int -> DiredEntry -> ShowS
[DiredEntry] -> ShowS
DiredEntry -> FilePath
(Int -> DiredEntry -> ShowS)
-> (DiredEntry -> FilePath)
-> ([DiredEntry] -> ShowS)
-> Show DiredEntry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiredEntry -> ShowS
showsPrec :: Int -> DiredEntry -> ShowS
$cshow :: DiredEntry -> FilePath
show :: DiredEntry -> FilePath
$cshowList :: [DiredEntry] -> ShowS
showList :: [DiredEntry] -> ShowS
Show, DiredEntry -> DiredEntry -> Bool
(DiredEntry -> DiredEntry -> Bool)
-> (DiredEntry -> DiredEntry -> Bool) -> Eq DiredEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiredEntry -> DiredEntry -> Bool
== :: DiredEntry -> DiredEntry -> Bool
$c/= :: DiredEntry -> DiredEntry -> Bool
/= :: DiredEntry -> DiredEntry -> Bool
Eq, Typeable, (forall x. DiredEntry -> Rep DiredEntry x)
-> (forall x. Rep DiredEntry x -> DiredEntry) -> Generic DiredEntry
forall x. Rep DiredEntry x -> DiredEntry
forall x. DiredEntry -> Rep DiredEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DiredEntry -> Rep DiredEntry x
from :: forall x. DiredEntry -> Rep DiredEntry x
$cto :: forall x. Rep DiredEntry x -> DiredEntry
to :: forall x. Rep DiredEntry x -> DiredEntry
Generic)

-- | Alias serving as documentation of some arguments. We keep most
-- paths as 'R.YiString' for the sole reason that we'll have to render
-- them.
type DiredFilePath = R.YiString

-- | Handy alias for 'DiredEntry' map.
type DiredEntries = M.Map DiredFilePath DiredEntry

data DiredState = DiredState
    { DiredState -> FilePath
diredPath        :: FilePath -- ^ The full path to the directory being viewed
     -- FIXME Choose better data structure for Marks...
    , DiredState -> Map FilePath Char
diredMarks      :: M.Map FilePath Char
      -- ^ Map values are just leafnames, not full paths
    , DiredState -> DiredEntries
diredEntries    :: DiredEntries
      -- ^ keys are just leafnames, not full paths
    , DiredState -> [(Point, Point, FilePath)]
diredFilePoints :: [(Point,Point,FilePath)]
      -- ^ position in the buffer where filename is
    , DiredState -> Int
diredNameCol    :: Int
      -- ^ position on line where filename is (all pointA are this col)
    , DiredState -> FilePath
diredCurrFile   :: FilePath
      -- ^ keep the position of pointer (for refreshing dired buffer)
    } deriving (Int -> DiredState -> ShowS
[DiredState] -> ShowS
DiredState -> FilePath
(Int -> DiredState -> ShowS)
-> (DiredState -> FilePath)
-> ([DiredState] -> ShowS)
-> Show DiredState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiredState -> ShowS
showsPrec :: Int -> DiredState -> ShowS
$cshow :: DiredState -> FilePath
show :: DiredState -> FilePath
$cshowList :: [DiredState] -> ShowS
showList :: [DiredState] -> ShowS
Show, DiredState -> DiredState -> Bool
(DiredState -> DiredState -> Bool)
-> (DiredState -> DiredState -> Bool) -> Eq DiredState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiredState -> DiredState -> Bool
== :: DiredState -> DiredState -> Bool
$c/= :: DiredState -> DiredState -> Bool
/= :: DiredState -> DiredState -> Bool
Eq, Typeable, (forall x. DiredState -> Rep DiredState x)
-> (forall x. Rep DiredState x -> DiredState) -> Generic DiredState
forall x. Rep DiredState x -> DiredState
forall x. DiredState -> Rep DiredState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DiredState -> Rep DiredState x
from :: forall x. DiredState -> Rep DiredState x
$cto :: forall x. Rep DiredState x -> DiredState
to :: forall x. Rep DiredState x -> DiredState
Generic)

makeLensesWithSuffix "A" ''DiredState

instance Binary DiredState

instance Default DiredState where
    def :: DiredState
def = DiredState { diredPath :: FilePath
diredPath       = FilePath
forall a. Monoid a => a
mempty
                     , diredMarks :: Map FilePath Char
diredMarks      = Map FilePath Char
forall a. Monoid a => a
mempty
                     , diredEntries :: DiredEntries
diredEntries    = DiredEntries
forall a. Monoid a => a
mempty
                     , diredFilePoints :: [(Point, Point, FilePath)]
diredFilePoints = [(Point, Point, FilePath)]
forall a. Monoid a => a
mempty
                     , diredNameCol :: Int
diredNameCol    = Int
0
                     , diredCurrFile :: FilePath
diredCurrFile   = FilePath
forall a. Monoid a => a
mempty
                     }

instance YiVariable DiredState

instance Binary DiredEntry
instance Binary DiredFileInfo

-- | If file exists, read contents of file into a new buffer, otherwise
-- creating a new empty buffer. Replace the current window with a new
-- window onto the new buffer.
--
-- If the file is already open, just switch to the corresponding buffer.
--
-- Need to clean up semantics for when buffers exist, and how to attach
-- windows to buffers.
--
-- @Yi.File@ module re-exports this, you probably want to import that
-- instead.
--
-- In case of a decoding failure, failure message is returned instead
-- of the 'BufferRef'.
editFile :: FilePath -> YiM (Either T.Text BufferRef)
editFile :: FilePath -> YiM (Either Text BufferRef)
editFile FilePath
filename = do
    FilePath
f <- IO FilePath -> YiM FilePath
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO FilePath -> YiM FilePath) -> IO FilePath -> YiM FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
userToCanonPath FilePath
filename

    [FBuffer]
dupBufs <- (FBuffer -> Bool) -> [FBuffer] -> [FBuffer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> (FilePath -> Bool) -> Maybe FilePath -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (FilePath -> FilePath -> Bool
equalFilePath FilePath
f) (Maybe FilePath -> Bool)
-> (FBuffer -> Maybe FilePath) -> FBuffer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBuffer -> Maybe FilePath
file) ([FBuffer] -> [FBuffer]) -> YiM [FBuffer] -> YiM [FBuffer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Editor -> [FBuffer]) -> YiM [FBuffer]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> [FBuffer]
bufferSet

    Bool
dirExists  <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
f
    Bool
fileExists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
f

    Either Text BufferRef
b <- case [FBuffer]
dupBufs of
      [] -> if Bool
dirExists
            then BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> Either Text BufferRef)
-> YiM BufferRef -> YiM (Either Text BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> YiM BufferRef
diredDirBuffer FilePath
f
            else do
              Either Text BufferRef
nb <- if Bool
fileExists
                    then FilePath -> YiM (Either Text BufferRef)
fileToNewBuffer FilePath
f
                    else BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> Either Text BufferRef)
-> YiM BufferRef -> YiM (Either Text BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> YiM BufferRef
newEmptyBuffer FilePath
f
              case Either Text BufferRef
nb of
                Left Text
m -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text BufferRef
forall a b. a -> Either a b
Left Text
m
                Right BufferRef
buf -> BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> Either Text BufferRef)
-> YiM BufferRef -> YiM (Either Text BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> BufferRef -> YiM BufferRef
setupMode FilePath
f BufferRef
buf

      (FBuffer
h:[FBuffer]
_) -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> (BufferRef -> Either Text BufferRef)
-> BufferRef
-> YiM (Either Text BufferRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> YiM (Either Text BufferRef))
-> BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ FBuffer -> BufferRef
bkey FBuffer
h

    case Either Text BufferRef
b of
     Left Text
m -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text BufferRef
forall a b. a -> Either a b
Left Text
m
     Right BufferRef
bf -> EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (BufferRef -> EditorM ()
switchToBufferE BufferRef
bf EditorM () -> EditorM () -> EditorM ()
forall a b. EditorM a -> EditorM b -> EditorM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM ()
addJumpHereE) YiM ()
-> YiM (Either Text BufferRef) -> YiM (Either Text BufferRef)
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return Either Text BufferRef
b
  where
    fileToNewBuffer :: FilePath -> YiM (Either T.Text BufferRef)
    fileToNewBuffer :: FilePath -> YiM (Either Text BufferRef)
fileToNewBuffer FilePath
f = IO UTCTime -> YiM UTCTime
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO UTCTime
getCurrentTime YiM UTCTime
-> (UTCTime -> YiM (Either Text BufferRef))
-> YiM (Either Text BufferRef)
forall a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UTCTime
n -> IO (Either Text DiredFilePath) -> YiM (Either Text DiredFilePath)
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (FilePath -> IO (Either Text DiredFilePath)
R.readFile FilePath
f) YiM (Either Text DiredFilePath)
-> (Either Text DiredFilePath -> YiM (Either Text BufferRef))
-> YiM (Either Text BufferRef)
forall a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Text
m -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text BufferRef
forall a b. a -> Either a b
Left Text
m
      Right DiredFilePath
contents -> do
        Permissions
permissions <- IO Permissions -> YiM Permissions
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Permissions -> YiM Permissions)
-> IO Permissions -> YiM Permissions
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Permissions
getPermissions FilePath
f

        BufferRef
b <- BufferId -> DiredFilePath -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> DiredFilePath -> m BufferRef
stringToNewBuffer (FilePath -> BufferId
FileBuffer FilePath
f) DiredFilePath
contents
        BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
          UTCTime -> BufferM ()
markSavedB UTCTime
n
          Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
writable Permissions
permissions) ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
Lens' FBuffer Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True)

        Either Text BufferRef -> YiM (Either Text BufferRef)
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right BufferRef
b

    newEmptyBuffer :: FilePath -> YiM BufferRef
    newEmptyBuffer :: FilePath -> YiM BufferRef
newEmptyBuffer FilePath
f =
      BufferId -> DiredFilePath -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> DiredFilePath -> m BufferRef
stringToNewBuffer (FilePath -> BufferId
FileBuffer FilePath
f) DiredFilePath
forall a. Monoid a => a
mempty

    setupMode :: FilePath -> BufferRef -> YiM BufferRef
    setupMode :: FilePath -> BufferRef -> YiM BufferRef
setupMode FilePath
f BufferRef
b = do
      [AnyMode]
tbl <- (Yi -> [AnyMode]) -> YiM [AnyMode]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Config -> [AnyMode]
modeTable (Config -> [AnyMode]) -> (Yi -> Config) -> Yi -> [AnyMode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yi -> Config
yiConfig)
      DiredFilePath
content <- BufferRef -> BufferM DiredFilePath -> YiM DiredFilePath
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b BufferM DiredFilePath
elemsB

      let header :: DiredFilePath
header = Int -> DiredFilePath -> DiredFilePath
R.take Int
1024 DiredFilePath
content
          pc :: Parser Text Text
pc = Parser Text Text
"-*-" Parser Text Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser Text () -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
P.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser Text Text -> Parser Text () -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Text ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser Text Text -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"-*-"
                    Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text ()
P.skip (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) Parser Text () -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') Parser Text () -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pc
          hmode :: Text
hmode = case Parser Text Text -> Text -> Either FilePath Text
forall a. Parser a -> Text -> Either FilePath a
P.parseOnly Parser Text Text
pc (DiredFilePath -> Text
R.toText DiredFilePath
header) of
                    Left FilePath
_ -> Text
""
                    Right Text
str -> Text
str
          Just AnyMode
mode = (AnyMode -> Bool) -> [AnyMode] -> Maybe AnyMode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AnyMode Mode syntax
m) -> Mode syntax -> Text
forall syntax. Mode syntax -> Text
modeName Mode syntax
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
hmode) [AnyMode]
tbl Maybe AnyMode -> Maybe AnyMode -> Maybe AnyMode
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      (AnyMode -> Bool) -> [AnyMode] -> Maybe AnyMode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AnyMode Mode syntax
m) -> Mode syntax -> FilePath -> DiredFilePath -> Bool
forall syntax. Mode syntax -> FilePath -> DiredFilePath -> Bool
modeApplies Mode syntax
m FilePath
f DiredFilePath
header) [AnyMode]
tbl Maybe AnyMode -> Maybe AnyMode -> Maybe AnyMode
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      AnyMode -> Maybe AnyMode
forall a. a -> Maybe a
Just (Mode Any -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode Mode Any
forall syntax. Mode syntax
emptyMode)
      case AnyMode
mode of
          AnyMode Mode syntax
newMode -> BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Mode syntax -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode syntax
newMode

      BufferRef -> YiM BufferRef
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b


bypassReadOnly :: BufferM a -> BufferM a
bypassReadOnly :: forall a. BufferM a -> BufferM a
bypassReadOnly BufferM a
f = do Bool
ro <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
Lens' FBuffer Bool
readOnlyA
                      (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
Lens' FBuffer Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
                      a
res <- BufferM a
f
                      (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
Lens' FBuffer Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
ro
                      a -> BufferM a
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

filenameColOf :: BufferM () -> BufferM ()
filenameColOf :: BufferM () -> BufferM ()
filenameColOf BufferM ()
f = BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredState -> (DiredState -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASetter FBuffer FBuffer (Maybe Int) (Maybe Int)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
(.=) ASetter FBuffer FBuffer (Maybe Int) (Maybe Int)
forall c. HasAttributes c => Lens' c (Maybe Int)
Lens' FBuffer (Maybe Int)
preferColA (Maybe Int -> BufferM ())
-> (DiredState -> Maybe Int) -> DiredState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> (DiredState -> Int) -> DiredState -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiredState -> Int
diredNameCol BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
f

resetDiredOpState :: YiM ()
resetDiredOpState :: YiM ()
resetDiredOpState = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ DiredOpState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredOpState
forall a. Default a => a
def :: DiredOpState)

incDiredOpSucCnt :: YiM ()
incDiredOpSucCnt :: YiM ()
incDiredOpSucCnt =
  BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM DiredOpState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredOpState -> (DiredOpState -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredOpState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredOpState -> BufferM ())
-> (DiredOpState -> DiredOpState) -> DiredOpState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Identity Int) -> DiredOpState -> Identity DiredOpState
Lens' DiredOpState Int
diredOpSucCnt ((Int -> Identity Int) -> DiredOpState -> Identity DiredOpState)
-> (Int -> Int) -> DiredOpState -> DiredOpState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int
forall a. Enum a => a -> a
succ)

getDiredOpState :: YiM DiredOpState
getDiredOpState :: YiM DiredOpState
getDiredOpState = BufferM DiredOpState -> YiM DiredOpState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredOpState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn

modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM ()
modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM ()
modDiredOpState DiredOpState -> DiredOpState
f = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM DiredOpState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredOpState -> (DiredOpState -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredOpState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredOpState -> BufferM ())
-> (DiredOpState -> DiredOpState) -> DiredOpState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiredOpState -> DiredOpState
f

-- | Execute the operations
--
-- Pass the list of remaining operations down, insert new ops at the
-- head if needed
procDiredOp :: Bool -> [DiredOp] -> YiM ()
procDiredOp :: Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (DORemoveFile FilePath
f:[DiredOp]
ops) = do
  IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
printingException (FilePath
"Remove file " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
f) (FilePath -> IO ()
removeLink FilePath
f)
  Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
    where postproc :: YiM ()
postproc = do YiM ()
incDiredOpSucCnt
                        BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> BufferM ()
diredUnmarkPath (ShowS
takeFileName FilePath
f)
procDiredOp Bool
counting (DORemoveDir FilePath
f:[DiredOp]
ops) = do
  IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
printingException (FilePath
"Remove directory " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
f) (FilePath -> IO ()
removeDirectoryRecursive FilePath
f)
  -- document suggests removeDirectoryRecursive will follow
  -- symlinks in f, but it seems not the case, at least on OS X.
  Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
    where postproc :: YiM ()
postproc = do
            YiM ()
incDiredOpSucCnt
            BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> BufferM ()
diredUnmarkPath (ShowS
takeFileName FilePath
f)
procDiredOp Bool
_counting (DORemoveBuffer FilePath
_:[DiredOp]
_) = YiM ()
forall a. HasCallStack => a
undefined -- TODO
procDiredOp Bool
counting  (DOCopyFile FilePath
o FilePath
n:[DiredOp]
ops) = do
  IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
printingException (FilePath
"Copy file " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
o) (FilePath -> FilePath -> IO ()
copyFile FilePath
o FilePath
n)
  Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
    where postproc :: YiM ()
postproc = do
            YiM ()
incDiredOpSucCnt
            BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> BufferM ()
diredUnmarkPath (ShowS
takeFileName FilePath
o)
            -- TODO: mark copied files with "C" if the target dir's
            -- dired buffer exists
procDiredOp Bool
counting (DOCopyDir FilePath
o FilePath
n:[DiredOp]
ops) = do
  [FilePath]
contents <- IO [FilePath] -> YiM [FilePath]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [FilePath] -> YiM [FilePath])
-> IO [FilePath] -> YiM [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath] -> IO [FilePath]
forall a. FilePath -> IO a -> IO a
printingException
              ([FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
"Copy directory ", FilePath
o, FilePath
" to ", FilePath
n]) IO [FilePath]
doCopy
  [DiredOp]
subops <- IO [DiredOp] -> YiM [DiredOp]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [DiredOp] -> YiM [DiredOp]) -> IO [DiredOp] -> YiM [DiredOp]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO DiredOp) -> [FilePath] -> IO [DiredOp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO DiredOp
builder ([FilePath] -> IO [DiredOp]) -> [FilePath] -> IO [DiredOp]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".", FilePath
".."]) [FilePath]
contents
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
False [DiredOp]
subops
  Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
    where postproc :: YiM ()
postproc = do
            YiM ()
incDiredOpSucCnt
            BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> BufferM ()
diredUnmarkPath (ShowS
takeFileName FilePath
o)
          -- perform dir copy: create new dir and create other copy ops
          doCopy :: IO [FilePath]
          doCopy :: IO [FilePath]
doCopy = do
            Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
n
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
n
            Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
n
            FilePath -> IO [FilePath]
getDirectoryContents FilePath
o
          -- build actual copy operations
          builder :: FilePath -> IO DiredOp
          builder :: FilePath -> IO DiredOp
builder FilePath
name = do
            let npath :: FilePath
npath = FilePath
n FilePath -> ShowS
</> FilePath
name
            let opath :: FilePath
opath = FilePath
o FilePath -> ShowS
</> FilePath
name
            Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
opath
            DiredOp -> IO DiredOp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredOp -> IO DiredOp) -> DiredOp -> IO DiredOp
forall a b. (a -> b) -> a -> b
$ FilePath -> DiredOp -> DiredOp
DOCkOverwrite FilePath
npath (DiredOp -> DiredOp) -> DiredOp -> DiredOp
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> FilePath -> DiredOp
getOp Bool
isDir FilePath
opath FilePath
npath
                where getOp :: Bool -> FilePath -> FilePath -> DiredOp
getOp Bool
isDir = if Bool
isDir then FilePath -> FilePath -> DiredOp
DOCopyDir else FilePath -> FilePath -> DiredOp
DOCopyFile


procDiredOp Bool
counting (DORename FilePath
o FilePath
n:[DiredOp]
ops) = do
  IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
printingException ([FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
"Rename ", FilePath
o, FilePath
" to ", FilePath
n]) (FilePath -> FilePath -> IO ()
rename FilePath
o FilePath
n)
  Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
    where postproc :: YiM ()
postproc = do
            YiM ()
incDiredOpSucCnt
            BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> BufferM ()
diredUnmarkPath (ShowS
takeFileName FilePath
o)
procDiredOp Bool
counting r :: [DiredOp]
r@(DOConfirm DiredFilePath
prompt [DiredOp]
eops [DiredOp]
enops:[DiredOp]
ops) =
  Text -> (Text -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
withMinibuffer (DiredFilePath -> Text
R.toText (DiredFilePath -> Text) -> DiredFilePath -> Text
forall a b. (a -> b) -> a -> b
$ DiredFilePath
prompt DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" (yes/no)") Text -> YiM [Text]
forall a. a -> YiM [a]
noHint (FilePath -> YiM ()
act (FilePath -> YiM ()) -> (Text -> FilePath) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
  where act :: FilePath -> YiM ()
act FilePath
s = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
s of
                  FilePath
"yes" -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp]
eops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
                  FilePath
"no"  -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp]
enops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
                  FilePath
_     -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
r
                             -- TODO: show an error msg
procDiredOp Bool
counting (DOCheck IO Bool
check [DiredOp]
eops [DiredOp]
enops:[DiredOp]
ops) = do
  Bool
res <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO Bool
check
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (if Bool
res then [DiredOp]
eops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops else [DiredOp]
enops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
procDiredOp Bool
counting (DOCkOverwrite FilePath
fp DiredOp
op:[DiredOp]
ops) = do
  Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
fileExist FilePath
fp
  Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (if Bool
exists then DiredOp
newOpDiredOp -> [DiredOp] -> [DiredOp]
forall a. a -> [a] -> [a]
:[DiredOp]
ops else DiredOp
opDiredOp -> [DiredOp] -> [DiredOp]
forall a. a -> [a] -> [a]
:[DiredOp]
ops)
      where newOp :: DiredOp
newOp = DiredFilePath -> DiredOp -> DiredOp
DOChoice (DiredFilePath
"Overwrite " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> DiredFilePath
R.fromString FilePath
fp DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" ?") DiredOp
op
procDiredOp Bool
counting (DOInput DiredFilePath
prompt FilePath -> [DiredOp]
opGen:[DiredOp]
ops) =
  Text -> (Text -> YiM ()) -> YiM ()
promptFile (DiredFilePath -> Text
R.toText DiredFilePath
prompt) (FilePath -> YiM ()
act (FilePath -> YiM ()) -> (Text -> FilePath) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
    where act :: FilePath -> YiM ()
act FilePath
s = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp] -> YiM ()) -> [DiredOp] -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [DiredOp]
opGen FilePath
s [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops
procDiredOp Bool
counting (DiredOp
DONoOp:[DiredOp]
ops) = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
procDiredOp Bool
counting (DOFeedback DiredOpState -> YiM ()
f:[DiredOp]
ops) =
  YiM DiredOpState
getDiredOpState YiM DiredOpState -> (DiredOpState -> YiM ()) -> YiM ()
forall a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredOpState -> YiM ()
f YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
procDiredOp Bool
counting r :: [DiredOp]
r@(DOChoice DiredFilePath
prompt DiredOp
op:[DiredOp]
ops) = do
  DiredOpState
st <- YiM DiredOpState
getDiredOpState
  if DiredOpState
st DiredOpState -> Getting Bool DiredOpState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool DiredOpState Bool
Lens' DiredOpState Bool
diredOpForAll
    then YiM ()
proceedYes
    else EditorM BufferRef -> YiM ()
forall a. EditorM a -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m ()
withEditor_ (EditorM BufferRef -> YiM ()) -> EditorM BufferRef -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
msg (Keymap -> KeymapEndo
forall a b. a -> b -> a
const Keymap
askKeymap)
    where msg :: Text
msg = DiredFilePath -> Text
R.toText (DiredFilePath -> Text) -> DiredFilePath -> Text
forall a b. (a -> b) -> a -> b
$ DiredFilePath
prompt DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" (y/n/!/q/h)"
          askKeymap :: Keymap
askKeymap = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
noAction
                             , Char -> Event
char Char
'y' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
yesAction
                             , Char -> Event
char Char
'!' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
allAction
                             , Char -> Event
char Char
'q' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quit
                             , Char -> Event
char Char
'h' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
help
                             ]
          noAction :: YiM ()
noAction = YiM ()
cleanUp YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
proceedNo
          yesAction :: YiM ()
yesAction = YiM ()
cleanUp YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
proceedYes
          allAction :: YiM ()
allAction = do YiM ()
cleanUp
                         (DiredOpState -> DiredOpState) -> YiM ()
modDiredOpState ((Bool -> Identity Bool) -> DiredOpState -> Identity DiredOpState
Lens' DiredOpState Bool
diredOpForAll ((Bool -> Identity Bool) -> DiredOpState -> Identity DiredOpState)
-> Bool -> DiredOpState -> DiredOpState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
                         YiM ()
proceedYes
          quit :: YiM ()
quit = YiM ()
cleanUp YiM () -> YiM () -> YiM ()
forall a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Quit"
          help :: YiM ()
help = do
            Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg
              Text
"y: yes, n: no, !: yes on all remaining items, q: quit, h: help"
            YiM ()
cleanUp
            Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
r -- repeat
          -- use cleanUp to get back the original buffer
          cleanUp :: YiM ()
cleanUp = EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
          proceedYes :: YiM ()
proceedYes = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (DiredOp
opDiredOp -> [DiredOp] -> [DiredOp]
forall a. a -> [a] -> [a]
:[DiredOp]
ops)
          proceedNo :: YiM ()
proceedNo = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
procDiredOp Bool
_ [DiredOp]
_ = () -> YiM ()
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | Delete a list of file in the given directory
--
-- 1. Ask for confirmation, if yes, perform deletions, otherwise
-- showNothing
--
-- 2. Confirmation is required for recursive deletion of non-empty
-- directory, but only the top level one
--
-- 3. Show the number of successful deletions at the end of the execution
--
-- 4. TODO: ask confirmation for whether to remove the associated
-- buffers when a file is removed
askDelFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askDelFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askDelFiles FilePath
dir [(FilePath, DiredEntry)]
fs =
  case [(FilePath, DiredEntry)]
fs of
    ((FilePath, DiredEntry)
_x:[(FilePath, DiredEntry)]
_) -> do
            YiM ()
resetDiredOpState
            -- TODO: show the file name list in new tmp window
            [DiredOp]
opList <- IO [DiredOp] -> YiM [DiredOp]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [DiredOp] -> YiM [DiredOp]) -> IO [DiredOp] -> YiM [DiredOp]
forall a b. (a -> b) -> a -> b
$ [IO DiredOp] -> IO [DiredOp]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [IO DiredOp]
ops
            -- a deletion command is mapped to a list of deletions
            -- wrapped up by DOConfirm
            -- TODO: is `counting' necessary here?
            let ops' :: [DiredOp]
ops' = [DiredOp]
opList [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
            Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [DiredFilePath -> [DiredOp] -> [DiredOp] -> DiredOp
DOConfirm DiredFilePath
prompt [DiredOp]
ops' [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall {m :: * -> *} {p}. MonadEditor m => p -> m ()
showNothing]]
    -- no files listed
    []     -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall {m :: * -> *} {p}. MonadEditor m => p -> m ()
showNothing]
    where
      prompt :: DiredFilePath
prompt = [DiredFilePath] -> DiredFilePath
R.concat [ DiredFilePath
"Delete "
                        , FilePath -> DiredFilePath
R.fromString (FilePath -> DiredFilePath)
-> (Int -> FilePath) -> Int -> DiredFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> DiredFilePath) -> Int -> DiredFilePath
forall a b. (a -> b) -> a -> b
$ [(FilePath, DiredEntry)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, DiredEntry)]
fs
                        , DiredFilePath
" file(s)?"
                        ]
      ops :: [IO DiredOp]
ops = ((FilePath, DiredEntry) -> IO DiredOp)
-> [(FilePath, DiredEntry)] -> [IO DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, DiredEntry) -> IO DiredOp
opGenerator [(FilePath, DiredEntry)]
fs
      showResult :: DiredOpState -> YiM ()
showResult DiredOpState
st = do
        YiM ()
diredRefresh
        Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showT (DiredOpState
st DiredOpState -> Getting Int DiredOpState Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int DiredOpState Int
Lens' DiredOpState Int
diredOpSucCnt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" deletions done"
      showNothing :: p -> m ()
showNothing p
_ = Text -> m ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"(No deletions requested)"
      total :: Int
total = [(FilePath, DiredEntry)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, DiredEntry)]
fs
      opGenerator :: (FilePath, DiredEntry) -> IO DiredOp
      opGenerator :: (FilePath, DiredEntry) -> IO DiredOp
opGenerator (FilePath
fn, DiredEntry
de) = do
                   Bool
exists <- FilePath -> IO Bool
fileExist FilePath
path
                   if Bool
exists then case DiredEntry
de of
                     (DiredDir DiredFileInfo
_dfi) -> do
                       Bool
isNull <- ([FilePath] -> Bool) -> IO [FilePath] -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> Bool
nullDir (IO [FilePath] -> IO Bool) -> IO [FilePath] -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
                       DiredOp -> IO DiredOp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredOp -> IO DiredOp) -> DiredOp -> IO DiredOp
forall a b. (a -> b) -> a -> b
$ if Bool
isNull then DiredFilePath -> [DiredOp] -> [DiredOp] -> DiredOp
DOConfirm DiredFilePath
recDelPrompt
                                               [FilePath -> DiredOp
DORemoveDir FilePath
path] [DiredOp
DONoOp]
                                else FilePath -> DiredOp
DORemoveDir FilePath
path
                     DiredEntry
_               -> DiredOp -> IO DiredOp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> DiredOp
DORemoveFile FilePath
path)
                     else DiredOp -> IO DiredOp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiredOp
DONoOp
          where path :: FilePath
path = FilePath
dir FilePath -> ShowS
</> FilePath
fn
                recDelPrompt :: DiredFilePath
recDelPrompt = DiredFilePath
"Recursive delete of " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> DiredFilePath
R.fromString FilePath
fn DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
"?"
                -- Test the emptyness of a folder
                nullDir :: [FilePath] -> Bool
                nullDir :: [FilePath] -> Bool
nullDir = (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath] -> Bool) -> [FilePath] -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem [FilePath
".", FilePath
".."])

diredDoDel :: YiM ()
diredDoDel :: YiM ()
diredDoDel = do
  FilePath
dir <- YiM FilePath
currentDir
  Maybe (FilePath, DiredEntry)
maybefile <- BufferM (Maybe (FilePath, DiredEntry))
-> YiM (Maybe (FilePath, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint
  case Maybe (FilePath, DiredEntry)
maybefile of
    Just (FilePath
fn, DiredEntry
de) -> FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askDelFiles FilePath
dir [(FilePath
fn, DiredEntry
de)]
    Maybe (FilePath, DiredEntry)
Nothing       -> YiM ()
noFileAtThisLine

diredDoMarkedDel :: YiM ()
diredDoMarkedDel :: YiM ()
diredDoMarkedDel = do
  FilePath
dir <- YiM FilePath
currentDir
  [(FilePath, DiredEntry)]
fs <- (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D')
  FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askDelFiles FilePath
dir [(FilePath, DiredEntry)]
fs

diredKeymap :: Keymap -> Keymap
diredKeymap :: KeymapEndo
diredKeymap = Keymap -> KeymapEndo
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
important (Keymap -> KeymapEndo) -> Keymap -> KeymapEndo
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> Keymap) -> Keymap
withArg Maybe Int -> Keymap
mainMap
  where
    -- produces a copy of the map allowing for C-u
    withArg :: (Maybe Int -> Keymap) -> Keymap
    withArg :: (Maybe Int -> Keymap) -> Keymap
withArg Maybe Int -> Keymap
k = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
ctrlCh Char
'u' Event -> KeymapEndo
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>> Maybe Int -> Keymap
k (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) , Maybe Int -> Keymap
k Maybe Int
forall a. Maybe a
Nothing ]

    mainMap :: Maybe Int -> Keymap
    mainMap :: Maybe Int -> Keymap
mainMap Maybe Int
univArg = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
      [ Char -> Event
char Char
'p'                   Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM () -> BufferM ()
filenameColOf BufferM ()
lineUp
      , [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char Char
'n', Char -> Event
char Char
' ']  I Event Action Event -> BufferM () -> Keymap
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDown
      , Char -> Event
char Char
'd'                   Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredMarkDel
      , Char -> Event
char Char
'g'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredRefresh
      , Char -> Event
char Char
'm'                   Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredMark
      , Char -> Event
char Char
'^'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredUpDir
      , Char -> Event
char Char
'+'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredCreateDir
      , Char -> Event
char Char
'q'                   Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>!
          ((BufferRef -> EditorM ()
forall (m :: * -> *). MonadEditor m => BufferRef -> m ()
deleteBuffer (BufferRef -> EditorM ()) -> EditorM BufferRef -> EditorM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Editor -> BufferRef) -> EditorM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer) :: EditorM ())
      , Char -> Event
char Char
'x'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredDoMarkedDel
      , [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Event -> Event
ctrl (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Char -> Event
char Char
'm', Key -> Event
spec Key
KEnter, Char -> Event
char Char
'f', Char -> Event
char Char
'e'] I Event Action Event -> YiM () -> Keymap
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! YiM ()
diredLoad
        -- Currently ‘o’ misbehaves, seems this naive method loses
        -- track of buffers.
      , Char -> Event
char Char
'o'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow YiM ()
diredLoad
      , Char -> Event
char Char
'u'                   Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Direction -> BufferM ()
diredUnmark Direction
Forward
      , Key -> Event
spec Key
KBS                   Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Direction -> BufferM ()
diredUnmark Direction
Backward
      , Char -> Event
char Char
'D'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredDoDel
      , Char -> Event
char Char
'U'                   Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredUnmarkAll
      , Char -> Event
char Char
'R'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredRename
      , Char -> Event
char Char
'C'                   Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredCopy
      , Char -> Event
char Char
'*'                   Event -> KeymapEndo
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>>  Maybe Int -> Keymap
multiMarks Maybe Int
univArg
      ]

    multiMarks :: Maybe Int -> Keymap
    multiMarks :: Maybe Int -> Keymap
multiMarks Maybe Int
univArg = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
      [ Char -> Event
char Char
'!' Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredUnmarkAll
      , Char -> Event
char Char
'@' Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Maybe Int -> BufferM ()
diredMarkSymlinks Maybe Int
univArg
      , Char -> Event
char Char
'/' Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Maybe Int -> BufferM ()
diredMarkDirectories Maybe Int
univArg
      , Char -> Event
char Char
't' Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredToggleAllMarks
      ]

dired :: YiM ()
dired :: YiM ()
dired = do
    Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Dired..."
    Maybe FilePath
maybepath <- BufferM (Maybe FilePath) -> YiM (Maybe FilePath)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe FilePath) -> YiM (Maybe FilePath))
-> BufferM (Maybe FilePath) -> YiM (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file
    FilePath
dir <- IO FilePath -> YiM FilePath
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO FilePath -> YiM FilePath) -> IO FilePath -> YiM FilePath
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> IO FilePath
getFolder Maybe FilePath
maybepath
    YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> YiM (Either Text BufferRef) -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> YiM (Either Text BufferRef)
editFile FilePath
dir

diredDir :: FilePath -> YiM ()
diredDir :: FilePath -> YiM ()
diredDir FilePath
dir = YiM BufferRef -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FilePath -> YiM BufferRef
diredDirBuffer FilePath
dir)

diredDirBuffer :: FilePath -> YiM BufferRef
diredDirBuffer :: FilePath -> YiM BufferRef
diredDirBuffer FilePath
d = do
    -- Emacs doesn't follow symlinks, probably Yi shouldn't do too
    FilePath
dir <- IO FilePath -> YiM FilePath
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO FilePath -> YiM FilePath) -> IO FilePath -> YiM FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
d
    BufferRef
b <- BufferId -> DiredFilePath -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> DiredFilePath -> m BufferRef
stringToNewBuffer (FilePath -> BufferId
FileBuffer FilePath
dir) DiredFilePath
forall a. Monoid a => a
mempty
    EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> EditorM ()
switchToBufferE BufferRef
b
    BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
      DiredState
state <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
      DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
state DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (FilePath -> Identity FilePath)
-> DiredState -> Identity DiredState
Lens' DiredState FilePath
diredPathA ((FilePath -> Identity FilePath)
 -> DiredState -> Identity DiredState)
-> FilePath -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath
dir)
      (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
Lens' FBuffer Bool
directoryContentA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    YiM ()
diredRefresh
    BufferRef -> YiM BufferRef
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b

-- | Write the contents of the supplied directory into the current
-- buffer in dired format
diredRefresh :: YiM ()
diredRefresh :: YiM ()
diredRefresh = do
    DiredState
dState <- BufferM DiredState -> YiM DiredState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
    let dir :: FilePath
dir = DiredState -> FilePath
diredPath DiredState
dState
    -- Scan directory
    DiredEntries
di <- IO DiredEntries -> YiM DiredEntries
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO DiredEntries -> YiM DiredEntries)
-> IO DiredEntries -> YiM DiredEntries
forall a b. (a -> b) -> a -> b
$ FilePath -> IO DiredEntries
diredScanDir FilePath
dir
    FilePath
currFile <- if [(Point, Point, FilePath)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DiredState -> [(Point, Point, FilePath)]
diredFilePoints DiredState
dState)
                then FilePath -> YiM FilePath
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
                else do Maybe (FilePath, DiredEntry)
maybefile <- BufferM (Maybe (FilePath, DiredEntry))
-> YiM (Maybe (FilePath, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint
                        case Maybe (FilePath, DiredEntry)
maybefile of
                          Just (FilePath
fp, DiredEntry
_) -> FilePath -> YiM FilePath
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
                          Maybe (FilePath, DiredEntry)
Nothing      -> FilePath -> YiM FilePath
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
    let ds :: DiredState
ds = (DiredEntries -> Identity DiredEntries)
-> DiredState -> Identity DiredState
Lens' DiredState DiredEntries
diredEntriesA ((DiredEntries -> Identity DiredEntries)
 -> DiredState -> Identity DiredState)
-> DiredEntries -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DiredEntries
di (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ (FilePath -> Identity FilePath)
-> DiredState -> Identity DiredState
Lens' DiredState FilePath
diredCurrFileA ((FilePath -> Identity FilePath)
 -> DiredState -> Identity DiredState)
-> FilePath -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath
currFile (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ DiredState
dState
    -- Compute results
    let dlines :: [([DRStrings], StyleName, DiredFilePath)]
dlines = DiredState -> [([DRStrings], StyleName, DiredFilePath)]
linesToDisplay DiredState
ds
        ([[DRStrings]]
strss, [StyleName]
stys, [DiredFilePath]
strs) = [([DRStrings], StyleName, DiredFilePath)]
-> ([[DRStrings]], [StyleName], [DiredFilePath])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([DRStrings], StyleName, DiredFilePath)]
dlines
        strss' :: [[DiredFilePath]]
strss' = [[DiredFilePath]] -> [[DiredFilePath]]
forall a. [[a]] -> [[a]]
transpose ([[DiredFilePath]] -> [[DiredFilePath]])
-> [[DiredFilePath]] -> [[DiredFilePath]]
forall a b. (a -> b) -> a -> b
$ ([DRStrings] -> [DiredFilePath])
-> [[DRStrings]] -> [[DiredFilePath]]
forall a b. (a -> b) -> [a] -> [b]
map [DRStrings] -> [DiredFilePath]
doPadding ([[DRStrings]] -> [[DiredFilePath]])
-> [[DRStrings]] -> [[DiredFilePath]]
forall a b. (a -> b) -> a -> b
$ [[DRStrings]] -> [[DRStrings]]
forall a. [[a]] -> [[a]]
transpose [[DRStrings]]
strss
        namecol :: Int
namecol = if [[DiredFilePath]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DiredFilePath]]
strss' then Int
0 else
                  let l1details :: [DiredFilePath]
l1details = [DiredFilePath] -> [DiredFilePath]
forall a. HasCallStack => [a] -> [a]
init ([DiredFilePath] -> [DiredFilePath])
-> [DiredFilePath] -> [DiredFilePath]
forall a b. (a -> b) -> a -> b
$ [[DiredFilePath]] -> [DiredFilePath]
forall a. HasCallStack => [a] -> a
head [[DiredFilePath]]
strss'
                  in [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Data.List.sum ((DiredFilePath -> Int) -> [DiredFilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map DiredFilePath -> Int
R.length [DiredFilePath]
l1details) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [DiredFilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DiredFilePath]
l1details

    -- Set buffer contents
    BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do -- Clear buffer
      (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
Lens' FBuffer Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
      ---- modifications begin here
      Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> BufferM Region
regionOfB TextUnit
Document
      -- Write Header
      DiredFilePath -> BufferM ()
insertN (DiredFilePath -> BufferM ()) -> DiredFilePath -> BufferM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> DiredFilePath
R.fromString FilePath
dir DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
":\n"
      Point
p <- BufferM Point
pointB
      -- paint header
      Overlay -> BufferM ()
addOverlayB (Overlay -> BufferM ()) -> Overlay -> BufferM ()
forall a b. (a -> b) -> a -> b
$ DiredFilePath -> Region -> StyleName -> DiredFilePath -> Overlay
mkOverlay DiredFilePath
"dired" (Point -> Point -> Region
mkRegion Point
0 (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
2)) StyleName
forall {b}. b -> Style
headStyle DiredFilePath
""
      [(Point, Point, FilePath)]
ptsList <- (([DiredFilePath], StyleName, DiredFilePath)
 -> BufferM (Point, Point, FilePath))
-> [([DiredFilePath], StyleName, DiredFilePath)]
-> BufferM [(Point, Point, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([DiredFilePath], StyleName, DiredFilePath)
-> BufferM (Point, Point, FilePath)
insertDiredLine ([([DiredFilePath], StyleName, DiredFilePath)]
 -> BufferM [(Point, Point, FilePath)])
-> [([DiredFilePath], StyleName, DiredFilePath)]
-> BufferM [(Point, Point, FilePath)]
forall a b. (a -> b) -> a -> b
$ [[DiredFilePath]]
-> [StyleName]
-> [DiredFilePath]
-> [([DiredFilePath], StyleName, DiredFilePath)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[DiredFilePath]]
strss' [StyleName]
stys [DiredFilePath]
strs
      DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState -> BufferM ()) -> DiredState -> BufferM ()
forall a b. (a -> b) -> a -> b
$ ([(Point, Point, FilePath)] -> Identity [(Point, Point, FilePath)])
-> DiredState -> Identity DiredState
Lens' DiredState [(Point, Point, FilePath)]
diredFilePointsA (([(Point, Point, FilePath)]
  -> Identity [(Point, Point, FilePath)])
 -> DiredState -> Identity DiredState)
-> [(Point, Point, FilePath)] -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Point, Point, FilePath)]
ptsList (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ (Int -> Identity Int) -> DiredState -> Identity DiredState
Lens' DiredState Int
diredNameColA ((Int -> Identity Int) -> DiredState -> Identity DiredState)
-> Int -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
namecol (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ DiredState
ds

      -- Colours for Dired come from overlays not syntax highlighting
      (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
modifyMode ((forall syntax. Mode syntax -> Mode syntax) -> BufferM ())
-> (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
forall a b. (a -> b) -> a -> b
$ ((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
-> Mode syntax -> Identity (Mode syntax)
forall syntax (f :: * -> *).
Functor f =>
((KeymapSet -> KeymapSet) -> f (KeymapSet -> KeymapSet))
-> Mode syntax -> f (Mode syntax)
modeKeymapA (((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
 -> Mode syntax -> Identity (Mode syntax))
-> (KeymapSet -> KeymapSet) -> Mode syntax -> Mode syntax
forall s t a b. ASetter s t a b -> b -> s -> t
.~  (Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet
Lens' KeymapSet Keymap
topKeymapA ((Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet)
-> KeymapEndo -> KeymapSet -> KeymapSet
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeymapEndo
diredKeymap
                   (Mode syntax -> Mode syntax)
-> (Mode syntax -> Mode syntax) -> Mode syntax -> Mode syntax
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> Identity Text) -> Mode syntax -> Identity (Mode syntax)
forall syntax (f :: * -> *).
Functor f =>
(Text -> f Text) -> Mode syntax -> f (Mode syntax)
modeNameA ((Text -> Identity Text) -> Mode syntax -> Identity (Mode syntax))
-> Text -> Mode syntax -> Mode syntax
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"dired"
      BufferM ()
diredRefreshMark
      ---- no modifications after this line
      (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
Lens' FBuffer Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
currFile) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
2)
      case FilePath -> [(Point, Point, FilePath)] -> Maybe Point
forall {a} {b} {b}. Eq a => a -> [(b, b, a)] -> Maybe b
getRow FilePath
currFile [(Point, Point, FilePath)]
ptsList of
        Just Point
rpos -> BufferM () -> BufferM ()
filenameColOf (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo Point
rpos
        Maybe Point
Nothing   -> BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDown
    where
    getRow :: a -> [(b, b, a)] -> Maybe b
getRow a
fp [(b, b, a)]
recList = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
fp (((b, b, a) -> (a, b)) -> [(b, b, a)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
a,b
_b,a
c)->(a
c,b
a)) [(b, b, a)]
recList)
    headStyle :: b -> Style
headStyle = Style -> b -> Style
forall a b. a -> b -> a
const (Color -> Style
withFg Color
grey)
    doPadding :: [DRStrings] -> [R.YiString]
    doPadding :: [DRStrings] -> [DiredFilePath]
doPadding [DRStrings]
drs = (DRStrings -> DiredFilePath) -> [DRStrings] -> [DiredFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> DRStrings -> DiredFilePath
pad (([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([DRStrings] -> [Int]) -> [DRStrings] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRStrings -> Int) -> [DRStrings] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map DRStrings -> Int
drlength) [DRStrings]
drs)) [DRStrings]
drs

    pad :: Int -> DRStrings -> DiredFilePath
pad Int
_n (DRPerms DiredFilePath
s)  = DiredFilePath
s
    pad Int
n  (DRLinks DiredFilePath
s)  = Int -> DiredFilePath -> DiredFilePath
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- DiredFilePath -> Int
R.length DiredFilePath
s)) DiredFilePath
" " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
s
    pad Int
n  (DROwners DiredFilePath
s) = DiredFilePath
s DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> Int -> DiredFilePath -> DiredFilePath
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- DiredFilePath -> Int
R.length DiredFilePath
s)) DiredFilePath
" " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" "
    pad Int
n  (DRGroups DiredFilePath
s) = DiredFilePath
s DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> Int -> DiredFilePath -> DiredFilePath
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- DiredFilePath -> Int
R.length DiredFilePath
s)) DiredFilePath
" "
    pad Int
n  (DRSizes DiredFilePath
s)  = Int -> DiredFilePath -> DiredFilePath
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- DiredFilePath -> Int
R.length DiredFilePath
s)) DiredFilePath
" " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
s
    pad Int
n  (DRDates DiredFilePath
s)  = Int -> DiredFilePath -> DiredFilePath
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- DiredFilePath -> Int
R.length DiredFilePath
s)) DiredFilePath
" " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
s
    pad Int
_n (DRFiles DiredFilePath
s)  = DiredFilePath
s       -- Don't right-justify the filename

    drlength :: DRStrings -> Int
drlength = DiredFilePath -> Int
R.length (DiredFilePath -> Int)
-> (DRStrings -> DiredFilePath) -> DRStrings -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRStrings -> DiredFilePath
undrs

-- | Returns a tuple containing the textual region (the end of) which
-- is used for 'click' detection and the FilePath of the file
-- represented by that textual region
insertDiredLine :: ([R.YiString], StyleName, R.YiString)
                -> BufferM (Point, Point, FilePath)
insertDiredLine :: ([DiredFilePath], StyleName, DiredFilePath)
-> BufferM (Point, Point, FilePath)
insertDiredLine ([DiredFilePath]
fields, StyleName
sty, DiredFilePath
filenm) = BufferM (Point, Point, FilePath)
-> BufferM (Point, Point, FilePath)
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM (Point, Point, FilePath)
 -> BufferM (Point, Point, FilePath))
-> BufferM (Point, Point, FilePath)
-> BufferM (Point, Point, FilePath)
forall a b. (a -> b) -> a -> b
$ do
  DiredFilePath -> BufferM ()
insertN (DiredFilePath -> BufferM ())
-> ([DiredFilePath] -> DiredFilePath)
-> [DiredFilePath]
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DiredFilePath] -> DiredFilePath
R.unwords ([DiredFilePath] -> BufferM ()) -> [DiredFilePath] -> BufferM ()
forall a b. (a -> b) -> a -> b
$ [DiredFilePath] -> [DiredFilePath]
forall a. HasCallStack => [a] -> [a]
init [DiredFilePath]
fields
  Point
p1 <- BufferM Point
pointB
  DiredFilePath -> BufferM ()
insertN  (DiredFilePath -> BufferM ()) -> DiredFilePath -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> DiredFilePath -> DiredFilePath
`R.cons` [DiredFilePath] -> DiredFilePath
forall a. HasCallStack => [a] -> a
last [DiredFilePath]
fields
  Point
p2 <- BufferM Point
pointB
  BufferM ()
newlineB
  Overlay -> BufferM ()
addOverlayB (DiredFilePath -> Region -> StyleName -> DiredFilePath -> Overlay
mkOverlay DiredFilePath
"dired" (Point -> Point -> Region
mkRegion Point
p1 Point
p2) StyleName
sty DiredFilePath
"")
  (Point, Point, FilePath) -> BufferM (Point, Point, FilePath)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
p1, Point
p2, DiredFilePath -> FilePath
R.toString DiredFilePath
filenm)

data DRStrings = DRPerms {DRStrings -> DiredFilePath
undrs :: R.YiString}
               | DRLinks {undrs :: R.YiString}
               | DROwners {undrs :: R.YiString}
               | DRGroups {undrs :: R.YiString}
               | DRSizes {undrs :: R.YiString}
               | DRDates {undrs :: R.YiString}
               | DRFiles {undrs :: R.YiString}

-- | Return a List of (prefix,
-- fullDisplayNameIncludingSourceAndDestOfLink, style, filename)
linesToDisplay :: DiredState -> [([DRStrings], StyleName, R.YiString)]
linesToDisplay :: DiredState -> [([DRStrings], StyleName, DiredFilePath)]
linesToDisplay DiredState
dState = ((DiredFilePath, DiredEntry)
 -> ([DRStrings], StyleName, DiredFilePath))
-> [(DiredFilePath, DiredEntry)]
-> [([DRStrings], StyleName, DiredFilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((DiredFilePath
 -> DiredEntry -> ([DRStrings], StyleName, DiredFilePath))
-> (DiredFilePath, DiredEntry)
-> ([DRStrings], StyleName, DiredFilePath)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DiredFilePath
-> DiredEntry -> ([DRStrings], StyleName, DiredFilePath)
lineToDisplay) (DiredEntries -> [(DiredFilePath, DiredEntry)]
forall k a. Map k a -> [(k, a)]
M.assocs DiredEntries
entries)
  where
    entries :: DiredEntries
entries = DiredState -> DiredEntries
diredEntries DiredState
dState

    lineToDisplay :: DiredFilePath
-> DiredEntry -> ([DRStrings], StyleName, DiredFilePath)
lineToDisplay DiredFilePath
k (DiredFile DiredFileInfo
v)      =
      (DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
" -" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [DiredFilePath -> DRStrings
DRFiles DiredFilePath
k], StyleName
defaultStyle, DiredFilePath
k)
    lineToDisplay DiredFilePath
k (DiredDir DiredFileInfo
v)       =
      (DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
" d" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [DiredFilePath -> DRStrings
DRFiles DiredFilePath
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
blue), DiredFilePath
k)
    lineToDisplay DiredFilePath
k (DiredSymLink DiredFileInfo
v DiredFilePath
s) =
      (DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
" l" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [DiredFilePath -> DRStrings
DRFiles (DiredFilePath -> DRStrings) -> DiredFilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFilePath
k DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" -> " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
s], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
cyan), DiredFilePath
k)
    lineToDisplay DiredFilePath
k (DiredSocket DiredFileInfo
v) =
      (DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
" s" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [DiredFilePath -> DRStrings
DRFiles DiredFilePath
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
magenta), DiredFilePath
k)
    lineToDisplay DiredFilePath
k (DiredCharacterDevice DiredFileInfo
v) =
      (DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
" c" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [DiredFilePath -> DRStrings
DRFiles DiredFilePath
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
yellow), DiredFilePath
k)
    lineToDisplay DiredFilePath
k (DiredBlockDevice DiredFileInfo
v) =
      (DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
" b" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [DiredFilePath -> DRStrings
DRFiles DiredFilePath
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
yellow), DiredFilePath
k)
    lineToDisplay DiredFilePath
k (DiredNamedPipe DiredFileInfo
v) =
      (DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
" p" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [DiredFilePath -> DRStrings
DRFiles DiredFilePath
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
brown), DiredFilePath
k)
    lineToDisplay DiredFilePath
k DiredEntry
DiredNoInfo        =
      ([DiredFilePath -> DRStrings
DRFiles (DiredFilePath -> DRStrings) -> DiredFilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFilePath
k DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" : Not a file/dir/symlink"], StyleName
defaultStyle, DiredFilePath
k)

    l :: DiredFilePath -> DiredFileInfo -> [DRStrings]
l DiredFilePath
pre DiredFileInfo
v = [DiredFilePath -> DRStrings
DRPerms (DiredFilePath -> DRStrings) -> DiredFilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFilePath
pre DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFileInfo -> DiredFilePath
permString DiredFileInfo
v,
               DiredFilePath -> DRStrings
DRLinks (DiredFilePath -> DRStrings)
-> (FilePath -> DiredFilePath) -> FilePath -> DRStrings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DiredFilePath
R.fromString (FilePath -> DRStrings) -> FilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ FilePath -> Integer -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%4d" (DiredFileInfo -> Integer
numLinks DiredFileInfo
v),
               DiredFilePath -> DRStrings
DROwners (DiredFilePath -> DRStrings) -> DiredFilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFileInfo -> DiredFilePath
owner DiredFileInfo
v,
               DiredFilePath -> DRStrings
DRGroups (DiredFilePath -> DRStrings) -> DiredFilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFileInfo -> DiredFilePath
grp DiredFileInfo
v,
               DiredFilePath -> DRStrings
DRSizes (DiredFilePath -> DRStrings)
-> (FilePath -> DiredFilePath) -> FilePath -> DRStrings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DiredFilePath
R.fromString (FilePath -> DRStrings) -> FilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ FilePath -> Integer -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%8d" (DiredFileInfo -> Integer
sizeInBytes DiredFileInfo
v),
               DiredFilePath -> DRStrings
DRDates (DiredFilePath -> DRStrings) -> DiredFilePath -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFileInfo -> DiredFilePath
modificationTimeString DiredFileInfo
v]

-- | Return dired entries for the contents of the supplied directory
diredScanDir :: FilePath -> IO DiredEntries
diredScanDir :: FilePath -> IO DiredEntries
diredScanDir FilePath
dir = do
    [FilePath]
files <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
    (DiredEntries -> FilePath -> IO DiredEntries)
-> DiredEntries -> [FilePath] -> IO DiredEntries
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (FilePath -> DiredEntries -> FilePath -> IO DiredEntries
lineForFile FilePath
dir) DiredEntries
forall k a. Map k a
M.empty [FilePath]
files
    where
    lineForFile :: FilePath
                -> DiredEntries
                -> FilePath
                -> IO DiredEntries
#ifndef mingw32_HOST_OS
    lineForFile :: FilePath -> DiredEntries -> FilePath -> IO DiredEntries
lineForFile FilePath
d DiredEntries
m FilePath
f = do
      let fp :: FilePath
fp = FilePath
d FilePath -> ShowS
</> FilePath
f
      FileStatus
fileStatus <- FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
fp
      DiredFileInfo
dfi <- FilePath -> FileStatus -> IO DiredFileInfo
lineForFilePath FilePath
fp FileStatus
fileStatus
      let islink :: Bool
islink = FileStatus -> Bool
isSymbolicLink FileStatus
fileStatus
      FilePath
linkTarget <- if Bool
islink then FilePath -> IO FilePath
readSymbolicLink FilePath
fp else FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall a. Monoid a => a
mempty
      let de :: DiredEntry
de
            | FileStatus -> Bool
isDirectory FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredDir DiredFileInfo
dfi
            | FileStatus -> Bool
isRegularFile FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredFile DiredFileInfo
dfi
            | Bool
islink = DiredFileInfo -> DiredFilePath -> DiredEntry
DiredSymLink DiredFileInfo
dfi (FilePath -> DiredFilePath
R.fromString FilePath
linkTarget)
            | FileStatus -> Bool
isSocket FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredSocket DiredFileInfo
dfi
            | FileStatus -> Bool
isCharacterDevice FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredCharacterDevice DiredFileInfo
dfi
            | FileStatus -> Bool
isBlockDevice FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredBlockDevice DiredFileInfo
dfi
            | FileStatus -> Bool
isNamedPipe FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredNamedPipe DiredFileInfo
dfi
            | Bool
otherwise = DiredEntry
DiredNoInfo
      DiredEntries -> IO DiredEntries
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredEntries -> IO DiredEntries)
-> DiredEntries -> IO DiredEntries
forall a b. (a -> b) -> a -> b
$ DiredFilePath -> DiredEntry -> DiredEntries -> DiredEntries
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FilePath -> DiredFilePath
R.fromString FilePath
f) DiredEntry
de DiredEntries
m

    lineForFilePath :: FilePath -> FileStatus -> IO DiredFileInfo
    lineForFilePath :: FilePath -> FileStatus -> IO DiredFileInfo
lineForFilePath FilePath
fp FileStatus
fileStatus = do
      let modTimeStr :: DiredFilePath
modTimeStr = FilePath -> DiredFilePath
R.fromString (FilePath -> DiredFilePath)
-> (EpochTime -> FilePath) -> EpochTime -> DiredFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> FilePath
shortCalendarTimeToString
                       (UTCTime -> FilePath)
-> (EpochTime -> UTCTime) -> EpochTime -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (EpochTime -> POSIXTime) -> EpochTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
                       (EpochTime -> DiredFilePath) -> EpochTime -> DiredFilePath
forall a b. (a -> b) -> a -> b
$ FileStatus -> EpochTime
modificationTime FileStatus
fileStatus
      let uid :: UserID
uid = FileStatus -> UserID
fileOwner FileStatus
fileStatus
          gid :: GroupID
gid = FileStatus -> GroupID
fileGroup FileStatus
fileStatus
          fn :: FilePath
fn = ShowS
takeFileName FilePath
fp
      FilePath
_filenm <- if FileStatus -> Bool
isSymbolicLink FileStatus
fileStatus
                 then FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> ShowS -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
fn FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" -> ") FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO FilePath
readSymbolicLink FilePath
fp
                 else FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fn
      UserEntry
ownerEntry <- IO UserEntry -> IO UserEntry -> IO UserEntry
forall a. IO a -> IO a -> IO a
orException (UserID -> IO UserEntry
getUserEntryForID UserID
uid)
                    (([UserEntry] -> UserEntry) -> IO [UserEntry] -> IO UserEntry
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UserID -> [UserEntry] -> UserEntry
scanForUid UserID
uid) IO [UserEntry]
getAllUserEntries)
      GroupEntry
groupEntry <- IO GroupEntry -> IO GroupEntry -> IO GroupEntry
forall a. IO a -> IO a -> IO a
orException (GroupID -> IO GroupEntry
getGroupEntryForID GroupID
gid)
                    (([GroupEntry] -> GroupEntry) -> IO [GroupEntry] -> IO GroupEntry
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroupID -> [GroupEntry] -> GroupEntry
scanForGid GroupID
gid) IO [GroupEntry]
getAllGroupEntries)
      let fmodeStr :: DiredFilePath
fmodeStr = (FileMode -> DiredFilePath
modeString (FileMode -> DiredFilePath)
-> (FileStatus -> FileMode) -> FileStatus -> DiredFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileMode
fileMode) FileStatus
fileStatus
          sz :: Integer
sz = FileOffset -> Integer
forall a. Integral a => a -> Integer
toInteger (FileOffset -> Integer) -> FileOffset -> Integer
forall a b. (a -> b) -> a -> b
$ FileStatus -> FileOffset
fileSize FileStatus
fileStatus
          ownerStr :: DiredFilePath
ownerStr   = FilePath -> DiredFilePath
R.fromString (FilePath -> DiredFilePath) -> FilePath -> DiredFilePath
forall a b. (a -> b) -> a -> b
$ UserEntry -> FilePath
userName UserEntry
ownerEntry
          groupStr :: DiredFilePath
groupStr   = FilePath -> DiredFilePath
R.fromString (FilePath -> DiredFilePath) -> FilePath -> DiredFilePath
forall a b. (a -> b) -> a -> b
$ GroupEntry -> FilePath
groupName GroupEntry
groupEntry
          numOfLinks :: Integer
numOfLinks = LinkCount -> Integer
forall a. Integral a => a -> Integer
toInteger (LinkCount -> Integer) -> LinkCount -> Integer
forall a b. (a -> b) -> a -> b
$ FileStatus -> LinkCount
linkCount FileStatus
fileStatus
      DiredFileInfo -> IO DiredFileInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiredFileInfo { permString :: DiredFilePath
permString = DiredFilePath
fmodeStr
                           , numLinks :: Integer
numLinks = Integer
numOfLinks
                           , owner :: DiredFilePath
owner = DiredFilePath
ownerStr
                           , grp :: DiredFilePath
grp = DiredFilePath
groupStr
                           , sizeInBytes :: Integer
sizeInBytes = Integer
sz
                           , modificationTimeString :: DiredFilePath
modificationTimeString = DiredFilePath
modTimeStr}

-- | Needed on Mac OS X 10.4
scanForUid :: UserID -> [UserEntry] -> UserEntry
scanForUid :: UserID -> [UserEntry] -> UserEntry
scanForUid UserID
uid [UserEntry]
entries = UserEntry -> Maybe UserEntry -> UserEntry
forall a. a -> Maybe a -> a
fromMaybe UserEntry
missingEntry (Maybe UserEntry -> UserEntry) -> Maybe UserEntry -> UserEntry
forall a b. (a -> b) -> a -> b
$
                                   (UserEntry -> Bool) -> [UserEntry] -> Maybe UserEntry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((UserID
uid UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
==) (UserID -> Bool) -> (UserEntry -> UserID) -> UserEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserEntry -> UserID
userID) [UserEntry]
entries
  where
    missingEntry :: UserEntry
missingEntry = ByteString
-> ByteString
-> UserID
-> GroupID
-> ByteString
-> ByteString
-> ByteString
-> UserEntry
UserEntry ByteString
"?" ByteString
forall a. Monoid a => a
mempty UserID
uid GroupID
0 ByteString
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty

-- | Needed on Mac OS X 10.4
scanForGid :: GroupID -> [GroupEntry] -> GroupEntry
scanForGid :: GroupID -> [GroupEntry] -> GroupEntry
scanForGid GroupID
gid [GroupEntry]
entries = GroupEntry -> Maybe GroupEntry -> GroupEntry
forall a. a -> Maybe a -> a
fromMaybe GroupEntry
missingEntry (Maybe GroupEntry -> GroupEntry) -> Maybe GroupEntry -> GroupEntry
forall a b. (a -> b) -> a -> b
$
                                   (GroupEntry -> Bool) -> [GroupEntry] -> Maybe GroupEntry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((GroupID
gid GroupID -> GroupID -> Bool
forall a. Eq a => a -> a -> Bool
==) (GroupID -> Bool) -> (GroupEntry -> GroupID) -> GroupEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupEntry -> GroupID
groupID) [GroupEntry]
entries
  where
    missingEntry :: GroupEntry
missingEntry = ByteString -> ByteString -> GroupID -> [ByteString] -> GroupEntry
GroupEntry ByteString
"?" ByteString
forall a. Monoid a => a
mempty GroupID
gid [ByteString]
forall a. Monoid a => a
mempty

#else
    -- has been the default for Windows anyway, so just directly do it without unix-compat
    lineForFile _ m f = return $ M.insert (R.fromString f) DiredNoInfo m
#endif

modeString :: FileMode -> R.YiString
modeString :: FileMode -> DiredFilePath
modeString FileMode
fm = DiredFilePath
""
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"r" FileMode
ownerReadMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"w" FileMode
ownerWriteMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"x" FileMode
ownerExecuteMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"r" FileMode
groupReadMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"w" FileMode
groupWriteMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"x" FileMode
groupExecuteMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"r" FileMode
otherReadMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"w" FileMode
otherWriteMode
                DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath -> FileMode -> DiredFilePath
forall {p}. IsString p => p -> FileMode -> p
strIfSet DiredFilePath
"x" FileMode
otherExecuteMode
    where
    strIfSet :: p -> FileMode -> p
strIfSet p
s FileMode
mode = if FileMode
fm FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== (FileMode
fm FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
mode) then p
s else p
"-"


shortCalendarTimeToString :: UTCTime -> String
shortCalendarTimeToString :: UTCTime -> FilePath
shortCalendarTimeToString = TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%b %d %H:%M"

-- Default Filter: omit files ending in '~' or '#' and also '.' and '..'.
-- TODO: customizable filters?
--diredOmitFile :: String -> Bool
--diredOmitFile = undefined

diredMark :: BufferM ()
diredMark :: BufferM ()
diredMark = Char -> BufferM () -> BufferM ()
diredMarkWithChar Char
'*' BufferM ()
lineDown

diredMarkDel :: BufferM ()
diredMarkDel :: BufferM ()
diredMarkDel = Char -> BufferM () -> BufferM ()
diredMarkWithChar Char
'D' BufferM ()
lineDown

-- | Generic mark toggler.
diredMarkKind :: Maybe Int
                 -- ^ universal argument, usually indicating whether
                 -- to mark or unmark. Here ‘Just …’ is taken as
                 -- unmark.
              -> (DiredFilePath -> DiredEntry -> Bool)
                 -- ^ Picks which entries to consider
              -> Char
                 -- ^ Character used for marking. Pass garbage if
                 -- unmarking.
              -> BufferM ()
diredMarkKind :: Maybe Int
-> (DiredFilePath -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m DiredFilePath -> DiredEntry -> Bool
p Char
c = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
  DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
  let es :: [(DiredFilePath, DiredEntry)]
es = DiredEntries -> [(DiredFilePath, DiredEntry)]
forall k a. Map k a -> [(k, a)]
M.assocs (DiredEntries -> [(DiredFilePath, DiredEntry)])
-> DiredEntries -> [(DiredFilePath, DiredEntry)]
forall a b. (a -> b) -> a -> b
$ DiredState -> DiredEntries
diredEntries DiredState
dState
      ms :: Map FilePath Char
ms = [(FilePath, Char)] -> Map FilePath Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (DiredFilePath -> FilePath
R.toString DiredFilePath
fp, Char
c) | (DiredFilePath
fp, DiredEntry
e) <- [(DiredFilePath, DiredEntry)]
es, DiredFilePath -> DiredEntry -> Bool
p DiredFilePath
fp DiredEntry
e ]
  DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
dState DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (Map FilePath Char -> Identity (Map FilePath Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map FilePath Char)
diredMarksA ((Map FilePath Char -> Identity (Map FilePath Char))
 -> DiredState -> Identity DiredState)
-> (Map FilePath Char -> Map FilePath Char)
-> DiredState
-> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map FilePath Char -> Map FilePath Char -> Map FilePath Char
run Map FilePath Char
ms)
  BufferM ()
diredRefreshMark
  where
    run :: M.Map FilePath Char -> M.Map FilePath Char -> M.Map FilePath Char
    run :: Map FilePath Char -> Map FilePath Char -> Map FilePath Char
run Map FilePath Char
ms Map FilePath Char
cms = case Maybe Int
m of
      Maybe Int
Nothing -> Map FilePath Char -> Map FilePath Char -> Map FilePath Char
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map FilePath Char
ms Map FilePath Char
cms
      Just Int
_ -> Map FilePath Char -> [FilePath] -> Map FilePath Char
forall k v. Ord k => Map k v -> [k] -> Map k v
deleteKeys Map FilePath Char
cms (Map FilePath Char -> [FilePath]
forall k a. Map k a -> [k]
M.keys Map FilePath Char
ms)

diredMarkSymlinks :: Maybe Int -> BufferM ()
diredMarkSymlinks :: Maybe Int -> BufferM ()
diredMarkSymlinks Maybe Int
m = Maybe Int
-> (DiredFilePath -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m DiredFilePath -> DiredEntry -> Bool
forall {p}. p -> DiredEntry -> Bool
p Char
'*'
  where
    p :: p -> DiredEntry -> Bool
p p
_ DiredSymLink {} = Bool
True
    p p
_ DiredEntry
_ = Bool
False

diredMarkDirectories :: Maybe Int -> BufferM ()
diredMarkDirectories :: Maybe Int -> BufferM ()
diredMarkDirectories Maybe Int
m = Maybe Int
-> (DiredFilePath -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m DiredFilePath -> DiredEntry -> Bool
forall {a}. (Eq a, IsString a) => a -> DiredEntry -> Bool
p Char
'*'
  where
    p :: a -> DiredEntry -> Bool
p a
"." DiredDir {} = Bool
False
    p a
".." DiredDir {} = Bool
False
    p a
_ DiredDir {} = Bool
True
    p a
_ DiredEntry
_ = Bool
False

diredToggleAllMarks :: BufferM ()
diredToggleAllMarks :: BufferM ()
diredToggleAllMarks = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
  DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
  let es :: DiredEntries
es = DiredState -> DiredEntries
diredEntries DiredState
dState
  DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
dState DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (Map FilePath Char -> Identity (Map FilePath Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map FilePath Char)
diredMarksA ((Map FilePath Char -> Identity (Map FilePath Char))
 -> DiredState -> Identity DiredState)
-> (Map FilePath Char -> Map FilePath Char)
-> DiredState
-> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DiredEntries -> Map FilePath Char -> Map FilePath Char
tm DiredEntries
es)
  BufferM ()
diredRefreshMark
  where
    -- Get all entries, filter out the ones that are marked already,
    -- then mark everything that remains, in effect toggling the
    -- marks.
    tm :: DiredEntries -> M.Map FilePath Char -> M.Map FilePath Char
    tm :: DiredEntries -> Map FilePath Char -> Map FilePath Char
tm DiredEntries
de Map FilePath Char
ms = let unmarked :: Map FilePath DiredEntry
unmarked = Map FilePath DiredEntry -> [FilePath] -> Map FilePath DiredEntry
forall k v. Ord k => Map k v -> [k] -> Map k v
deleteKeys ((DiredFilePath -> FilePath)
-> DiredEntries -> Map FilePath DiredEntry
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys DiredFilePath -> FilePath
R.toString DiredEntries
de) (Map FilePath Char -> [FilePath]
forall k a. Map k a -> [k]
M.keys Map FilePath Char
ms)
               in (DiredEntry -> Char)
-> Map FilePath DiredEntry -> Map FilePath Char
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Char -> DiredEntry -> Char
forall a b. a -> b -> a
const Char
'*') Map FilePath DiredEntry
unmarked

-- | Delete all the keys from the map.
deleteKeys :: Ord k => M.Map k v -> [k] -> M.Map k v
deleteKeys :: forall k v. Ord k => Map k v -> [k] -> Map k v
deleteKeys = (Map k v -> k -> Map k v) -> Map k v -> [k] -> Map k v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((k -> Map k v -> Map k v) -> Map k v -> k -> Map k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> Map k v -> Map k v
forall k a. Ord k => k -> Map k a -> Map k a
M.delete)

diredMarkWithChar :: Char -> BufferM () -> BufferM ()
diredMarkWithChar :: Char -> BufferM () -> BufferM ()
diredMarkWithChar Char
c BufferM ()
mv = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
  BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint BufferM (Maybe (FilePath, DiredEntry))
-> (Maybe (FilePath, DiredEntry) -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (FilePath
fn, DiredEntry
_de) -> do
      DiredState
state <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
      DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
state DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (Map FilePath Char -> Identity (Map FilePath Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map FilePath Char)
diredMarksA ((Map FilePath Char -> Identity (Map FilePath Char))
 -> DiredState -> Identity DiredState)
-> (Map FilePath Char -> Map FilePath Char)
-> DiredState
-> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FilePath -> Char -> Map FilePath Char -> Map FilePath Char
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
fn Char
c)
      BufferM () -> BufferM ()
filenameColOf BufferM ()
mv
      BufferM ()
diredRefreshMark
    Maybe (FilePath, DiredEntry)
Nothing -> BufferM () -> BufferM ()
filenameColOf BufferM ()
mv

diredRefreshMark :: BufferM ()
diredRefreshMark :: BufferM ()
diredRefreshMark = do
  Point
b <- BufferM Point
pointB
  DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
  let posDict :: [(Point, Point, FilePath)]
posDict = DiredState -> [(Point, Point, FilePath)]
diredFilePoints DiredState
dState
      markMap :: Map FilePath Char
markMap = DiredState -> Map FilePath Char
diredMarks DiredState
dState
      draw :: (Point, b, FilePath) -> BufferM ()
draw (Point
pos, b
_, FilePath
fn) = case FilePath -> Map FilePath Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
fn Map FilePath Char
markMap of
        Just Char
mark -> do
          Point -> BufferM ()
moveTo Point
pos BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> BufferM ()
insertB Char
mark BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
deleteN Int
1
          Point
e <- BufferM Point
pointB
          Overlay -> BufferM ()
addOverlayB (Overlay -> BufferM ()) -> Overlay -> BufferM ()
forall a b. (a -> b) -> a -> b
$
            DiredFilePath -> Region -> StyleName -> DiredFilePath -> Overlay
mkOverlay DiredFilePath
"dired" (Point -> Point -> Region
mkRegion (Point
e Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
1) Point
e) (Char -> StyleName
styleOfMark Char
mark) DiredFilePath
""
        Maybe Char
Nothing ->
          -- for deleted marks
          Point -> BufferM ()
moveTo Point
pos BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiredFilePath -> BufferM ()
insertN DiredFilePath
" " BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
deleteN Int
1
  ((Point, Point, FilePath) -> BufferM ())
-> [(Point, Point, FilePath)] -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Point, Point, FilePath) -> BufferM ()
forall {b}. (Point, b, FilePath) -> BufferM ()
draw [(Point, Point, FilePath)]
posDict
  Point -> BufferM ()
moveTo Point
b
    where
      styleOfMark :: Char -> StyleName
styleOfMark Char
'*' = Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
green)
      styleOfMark Char
'D' = Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
red)
      styleOfMark  Char
_  = StyleName
defaultStyle

-- | Removes mark from current file (if any) and moves in the
-- specified direction.
diredUnmark :: Direction -- ^ Direction to move in after unmarking
            -> BufferM ()
diredUnmark :: Direction -> BufferM ()
diredUnmark Direction
d = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
  let lineDir :: BufferM ()
lineDir = case Direction
d of { Direction
Forward -> BufferM ()
lineDown; Direction
Backward -> BufferM ()
lineUp; }
  BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint BufferM (Maybe (FilePath, DiredEntry))
-> (Maybe (FilePath, DiredEntry) -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (FilePath
fn, DiredEntry
_de) -> do
      FilePath -> BufferM ()
diredUnmarkPath FilePath
fn
      BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDir
      BufferM ()
diredRefreshMark
    Maybe (FilePath, DiredEntry)
Nothing        -> BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDir


diredUnmarkPath :: FilePath -> BufferM()
diredUnmarkPath :: FilePath -> BufferM ()
diredUnmarkPath FilePath
fn = BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredState -> (DiredState -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn(DiredState -> BufferM ())
-> (DiredState -> DiredState) -> DiredState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Map FilePath Char -> Identity (Map FilePath Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map FilePath Char)
diredMarksA ((Map FilePath Char -> Identity (Map FilePath Char))
 -> DiredState -> Identity DiredState)
-> (Map FilePath Char -> Map FilePath Char)
-> DiredState
-> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FilePath -> Map FilePath Char -> Map FilePath Char
forall k a. Ord k => k -> Map k a -> Map k a
M.delete FilePath
fn)

diredUnmarkAll :: BufferM ()
diredUnmarkAll :: BufferM ()
diredUnmarkAll = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
                   BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredState -> (DiredState -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn(DiredState -> BufferM ())
-> (DiredState -> DiredState) -> DiredState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Map FilePath Char -> Identity (Map FilePath Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map FilePath Char)
diredMarksA ((Map FilePath Char -> Identity (Map FilePath Char))
 -> DiredState -> Identity DiredState)
-> Map FilePath Char -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map FilePath Char
forall k a. Map k a
M.empty)
                   BufferM () -> BufferM ()
filenameColOf (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   BufferM ()
diredRefreshMark

currentDir :: YiM FilePath
currentDir :: YiM FilePath
currentDir = DiredState -> FilePath
diredPath (DiredState -> FilePath) -> YiM DiredState -> YiM FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM DiredState -> YiM DiredState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn

-- | move selected files in a given directory to the target location given
-- by user input
--
-- if multiple source
-- then if target is not a existing dir
--      then error
--      else move source files into target dir
-- else if target is dir
--      then if target exist
--           then move source file into target dir
--           else if source is dir and parent of target exists
--                then move source to target
--                else error
--      else if parent of target exist
--           then move source to target
--           else error
askRenameFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askRenameFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askRenameFiles FilePath
dir [(FilePath, DiredEntry)]
fs = case [(FilePath, DiredEntry)]
fs of
  [(FilePath, DiredEntry)
_x] -> do YiM ()
resetDiredOpState
             Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [DiredFilePath -> (FilePath -> [DiredOp]) -> DiredOp
DOInput DiredFilePath
prompt FilePath -> [DiredOp]
sOpIsDir]
  (FilePath, DiredEntry)
_x:[(FilePath, DiredEntry)]
_ -> do YiM ()
resetDiredOpState
             Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [DiredFilePath -> (FilePath -> [DiredOp]) -> DiredOp
DOInput DiredFilePath
prompt FilePath -> [DiredOp]
mOpIsDirAndExists]
  []   ->    Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall {m :: * -> *} {p}. MonadEditor m => p -> m ()
showNothing]
  where
    mkErr :: Text -> m DiredOp
mkErr Text
t = DiredOp -> m DiredOp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredOp -> m DiredOp)
-> (YiM () -> DiredOp) -> YiM () -> m DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiredOpState -> YiM ()) -> DiredOp
DOFeedback ((DiredOpState -> YiM ()) -> DiredOp)
-> (YiM () -> DiredOpState -> YiM ()) -> YiM () -> DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiM () -> DiredOpState -> YiM ()
forall a b. a -> b -> a
const (YiM () -> m DiredOp) -> YiM () -> m DiredOp
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
errorEditor Text
t
    prompt :: DiredFilePath
prompt = DiredFilePath
"Move " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> DiredFilePath
R.fromString (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
total) DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" item(s) to:"
    mOpIsDirAndExists :: FilePath -> [DiredOp]
mOpIsDirAndExists FilePath
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (FilePath -> IO Bool
doesDirectoryExist FilePath
t) [DiredOp]
posOps [DiredOp]
negOps]
      where
        posOps :: [DiredOp]
posOps = ((FilePath, DiredEntry) -> DiredOp)
-> [(FilePath, DiredEntry)] -> [DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, DiredEntry) -> DiredOp
forall {b}. (FilePath, b) -> DiredOp
builder [(FilePath, DiredEntry)]
fs [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
        negOps :: [DiredOp]
negOps = Text -> [DiredOp]
forall {m :: * -> *}. Monad m => Text -> m DiredOp
mkErr (Text -> [DiredOp]) -> Text -> [DiredOp]
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not directory!"
        builder :: (FilePath, b) -> DiredOp
builder (FilePath
fn, b
_de) = let old :: FilePath
old = FilePath
dir FilePath -> ShowS
</> FilePath
fn
                                new :: FilePath
new = FilePath
t FilePath -> ShowS
</> FilePath
fn
                            in FilePath -> DiredOp -> DiredOp
DOCkOverwrite FilePath
new (FilePath -> FilePath -> DiredOp
DORename FilePath
old FilePath
new)
    sOpIsDir :: FilePath -> [DiredOp]
sOpIsDir FilePath
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (FilePath -> IO Bool
doesDirectoryExist FilePath
t) [DiredOp]
posOps [DiredOp]
sOpDirRename]
        where (FilePath
fn, DiredEntry
_) = [(FilePath, DiredEntry)] -> (FilePath, DiredEntry)
forall a. HasCallStack => [a] -> a
head [(FilePath, DiredEntry)]
fs -- the only item
              posOps :: [DiredOp]
posOps = [FilePath -> DiredOp -> DiredOp
DOCkOverwrite FilePath
new (FilePath -> FilePath -> DiredOp
DORename FilePath
old FilePath
new),
                        (DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
                  where new :: FilePath
new = FilePath
t FilePath -> ShowS
</> FilePath
fn
                        old :: FilePath
old = FilePath
dir FilePath -> ShowS
</> FilePath
fn
              sOpDirRename :: [DiredOp]
sOpDirRename = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck IO Bool
ckParentDir [DiredOp]
posOps' [DiredOp]
negOps,
                              (DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
                  where posOps' :: [DiredOp]
posOps' = [FilePath -> DiredOp -> DiredOp
DOCkOverwrite FilePath
new (FilePath -> FilePath -> DiredOp
DORename FilePath
old FilePath
new)]
                        p :: Text
p = Text
"Cannot move " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
old
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
new
                        negOps :: [DiredOp]
negOps = Text -> [DiredOp]
forall {m :: * -> *}. Monad m => Text -> m DiredOp
mkErr Text
p
                        new :: FilePath
new = FilePath
t
                        old :: FilePath
old = FilePath
dir FilePath -> ShowS
</> FilePath
fn
                        ps :: FilePath
ps = ShowS
dropTrailingPathSeparator FilePath
t
                        ckParentDir :: IO Bool
ckParentDir = FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory FilePath
ps
    showResult :: DiredOpState -> YiM ()
showResult DiredOpState
st = do
      YiM ()
diredRefresh
      Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showT (DiredOpState
st DiredOpState -> Getting Int DiredOpState Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int DiredOpState Int
Lens' DiredOpState Int
diredOpSucCnt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" item(s) moved."
    showNothing :: p -> m ()
showNothing p
_ = Text -> m ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Quit"
    total :: Int
total = [(FilePath, DiredEntry)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, DiredEntry)]
fs

-- | copy selected files in a given directory to the target location given
-- by user input
--
-- askCopyFiles follow the same logic as askRenameFiles,
-- except dir and file are done by different DiredOP
askCopyFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askCopyFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askCopyFiles FilePath
dir [(FilePath, DiredEntry)]
fs =
  case [(FilePath, DiredEntry)]
fs of
    [(FilePath, DiredEntry)
_x] -> do YiM ()
resetDiredOpState
               Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [DiredFilePath -> (FilePath -> [DiredOp]) -> DiredOp
DOInput DiredFilePath
prompt FilePath -> [DiredOp]
sOpIsDir]
    (FilePath, DiredEntry)
_x:[(FilePath, DiredEntry)]
_ -> do YiM ()
resetDiredOpState
               Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [DiredFilePath -> (FilePath -> [DiredOp]) -> DiredOp
DOInput DiredFilePath
prompt FilePath -> [DiredOp]
mOpIsDirAndExists]
    []   ->    Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall {m :: * -> *} {p}. MonadEditor m => p -> m ()
showNothing]
  where
    prompt :: DiredFilePath
prompt = DiredFilePath
"Copy " DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> DiredFilePath
R.fromString (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
total) DiredFilePath -> DiredFilePath -> DiredFilePath
forall a. Semigroup a => a -> a -> a
<> DiredFilePath
" item(s) to:"
    mOpIsDirAndExists :: FilePath -> [DiredOp]
mOpIsDirAndExists FilePath
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (FilePath -> IO Bool
doesDirectoryExist FilePath
t) [DiredOp]
posOps [DiredOp]
negOps]
      where
        posOps :: [DiredOp]
posOps = ((FilePath, DiredEntry) -> DiredOp)
-> [(FilePath, DiredEntry)] -> [DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, DiredEntry) -> DiredOp
builder [(FilePath, DiredEntry)]
fs [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
        negOps :: [DiredOp]
negOps = [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback ((DiredOpState -> YiM ()) -> DiredOp)
-> (YiM () -> DiredOpState -> YiM ()) -> YiM () -> DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiM () -> DiredOpState -> YiM ()
forall a b. a -> b -> a
const (YiM () -> DiredOp) -> YiM () -> DiredOp
forall a b. (a -> b) -> a -> b
$
                  Text -> YiM ()
errorEditor (FilePath -> Text
T.pack FilePath
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not directory!")]
        builder :: (FilePath, DiredEntry) -> DiredOp
builder (FilePath
fn, DiredEntry
de) = let old :: FilePath
old = FilePath
dir FilePath -> ShowS
</> FilePath
fn
                               new :: FilePath
new = FilePath
t FilePath -> ShowS
</> FilePath
fn
                           in FilePath -> DiredOp -> DiredOp
DOCkOverwrite FilePath
new (DiredEntry -> FilePath -> FilePath -> DiredOp
op4Type DiredEntry
de FilePath
old FilePath
new)
    sOpIsDir :: FilePath -> [DiredOp]
sOpIsDir FilePath
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (FilePath -> IO Bool
doesDirectoryExist FilePath
t) [DiredOp]
posOps [DiredOp]
sOpDirCopy]
      where (FilePath
fn, DiredEntry
de) = [(FilePath, DiredEntry)] -> (FilePath, DiredEntry)
forall a. HasCallStack => [a] -> a
head [(FilePath, DiredEntry)]
fs -- the only item
            posOps :: [DiredOp]
posOps = [FilePath -> DiredOp -> DiredOp
DOCkOverwrite FilePath
new (DiredEntry -> FilePath -> FilePath -> DiredOp
op4Type DiredEntry
de FilePath
old FilePath
new),
                      (DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
                where new :: FilePath
new = FilePath
t FilePath -> ShowS
</> FilePath
fn
                      old :: FilePath
old = FilePath
dir FilePath -> ShowS
</> FilePath
fn
            sOpDirCopy :: [DiredOp]
sOpDirCopy = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck IO Bool
ckParentDir [DiredOp]
posOps' [DiredOp]
negOps,
                          (DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
                where posOps' :: [DiredOp]
posOps' = [FilePath -> DiredOp -> DiredOp
DOCkOverwrite FilePath
new (DiredEntry -> FilePath -> FilePath -> DiredOp
op4Type DiredEntry
de FilePath
old FilePath
new)]
                      p :: Text
p = Text
"Cannot copy " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
old Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
new
                      negOps :: [DiredOp]
negOps =
                          [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback ((DiredOpState -> YiM ()) -> DiredOp)
-> (YiM () -> DiredOpState -> YiM ()) -> YiM () -> DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiM () -> DiredOpState -> YiM ()
forall a b. a -> b -> a
const (YiM () -> DiredOp) -> YiM () -> DiredOp
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
errorEditor Text
p]
                      new :: FilePath
new = FilePath
t
                      old :: FilePath
old = FilePath
dir FilePath -> ShowS
</> FilePath
fn
                      ckParentDir :: IO Bool
ckParentDir = FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$
                                    ShowS
takeDirectory (ShowS
dropTrailingPathSeparator FilePath
t)
    showResult :: DiredOpState -> YiM ()
showResult DiredOpState
st = do
      YiM ()
diredRefresh
      Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showT (DiredOpState
st DiredOpState -> Getting Int DiredOpState Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int DiredOpState Int
Lens' DiredOpState Int
diredOpSucCnt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" item(s) copied."
    showNothing :: p -> m ()
showNothing p
_ = Text -> m ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Quit"
    total :: Int
total = [(FilePath, DiredEntry)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, DiredEntry)]
fs
    op4Type :: DiredEntry -> FilePath -> FilePath -> DiredOp
    op4Type :: DiredEntry -> FilePath -> FilePath -> DiredOp
op4Type (DiredDir DiredFileInfo
_) = FilePath -> FilePath -> DiredOp
DOCopyDir
    op4Type DiredEntry
_            = FilePath -> FilePath -> DiredOp
DOCopyFile

diredRename :: YiM ()
diredRename :: YiM ()
diredRename = do
  FilePath
dir <- YiM FilePath
currentDir
  [(FilePath, DiredEntry)]
fs <- (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')
  if [(FilePath, DiredEntry)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, DiredEntry)]
fs then do Maybe (FilePath, DiredEntry)
maybefile <- BufferM (Maybe (FilePath, DiredEntry))
-> YiM (Maybe (FilePath, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint
                     case Maybe (FilePath, DiredEntry)
maybefile of
                       Just (FilePath
fn, DiredEntry
de) -> FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askRenameFiles FilePath
dir [(FilePath
fn, DiredEntry
de)]
                       Maybe (FilePath, DiredEntry)
Nothing       -> YiM ()
noFileAtThisLine
             else FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askRenameFiles FilePath
dir [(FilePath, DiredEntry)]
fs

diredCopy :: YiM ()
diredCopy :: YiM ()
diredCopy = do
  FilePath
dir <- YiM FilePath
currentDir
  [(FilePath, DiredEntry)]
fs <- (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')
  if [(FilePath, DiredEntry)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, DiredEntry)]
fs then do Maybe (FilePath, DiredEntry)
maybefile <- BufferM (Maybe (FilePath, DiredEntry))
-> YiM (Maybe (FilePath, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint
                     case Maybe (FilePath, DiredEntry)
maybefile of
                       Just (FilePath
fn, DiredEntry
de) -> FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askCopyFiles FilePath
dir [(FilePath
fn, DiredEntry
de)]
                       Maybe (FilePath, DiredEntry)
Nothing       -> YiM ()
noFileAtThisLine
             else FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askCopyFiles FilePath
dir [(FilePath, DiredEntry)]
fs

diredLoad :: YiM ()
diredLoad :: YiM ()
diredLoad = do
  FilePath
dir <- YiM FilePath
currentDir
  BufferM (Maybe (FilePath, DiredEntry))
-> YiM (Maybe (FilePath, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint YiM (Maybe (FilePath, DiredEntry))
-> (Maybe (FilePath, DiredEntry) -> YiM ()) -> YiM ()
forall a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (FilePath
fn, DiredEntry
de) -> do
      let sel :: FilePath
sel = FilePath
dir FilePath -> ShowS
</> FilePath
fn
          sel' :: Text
sel' = FilePath -> Text
T.pack FilePath
sel
      case DiredEntry
de of
        (DiredFile DiredFileInfo
_dfi) -> do
          Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
sel
          if Bool
exists
            then YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> YiM (Either Text BufferRef) -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> YiM (Either Text BufferRef)
editFile FilePath
sel
            else Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists"
        (DiredDir DiredFileInfo
_dfi)  -> do
          Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
sel
          if Bool
exists
            then FilePath -> YiM ()
diredDir FilePath
sel
            else Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists"
        (DiredSymLink DiredFileInfo
_dfi DiredFilePath
dest') -> do
          let dest :: FilePath
dest = DiredFilePath -> FilePath
R.toString DiredFilePath
dest'
              target :: FilePath
target = if FilePath -> Bool
isAbsolute FilePath
dest then FilePath
dest else FilePath
dir FilePath -> ShowS
</> FilePath
dest
          Bool
existsFile <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
target
          Bool
existsDir <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
target
          Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"Following link:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
target
          if Bool
existsFile then YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> YiM (Either Text BufferRef) -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> YiM (Either Text BufferRef)
editFile FilePath
target else
            if Bool
existsDir then FilePath -> YiM ()
diredDir FilePath
target else
              Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
target Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist"
        (DiredSocket DiredFileInfo
_dfi) -> do
          Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
sel
          Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
                    then Text
"Can't open Socket " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
                    else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
        (DiredBlockDevice DiredFileInfo
_dfi) -> do
          Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
sel
          Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
                    then Text
"Can't open Block Device " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
                    else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
        (DiredCharacterDevice DiredFileInfo
_dfi) -> do
          Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
sel
          Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
                    then Text
"Can't open Character Device " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
                    else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
        (DiredNamedPipe DiredFileInfo
_dfi) -> do
          Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
sel
          Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
                    then Text
"Can't open Pipe " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
                    else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
        DiredEntry
DiredNoInfo -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"No File Info for:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
    Maybe (FilePath, DiredEntry)
Nothing        -> YiM ()
noFileAtThisLine


noFileAtThisLine :: YiM ()
noFileAtThisLine :: YiM ()
noFileAtThisLine = Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"(No file at this line)"

-- | Extract the filename at point. NB this may fail if the buffer has
-- been edited. Maybe use Markers instead.
fileFromPoint :: BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint :: BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint = do
    Point
p <- BufferM Point
pointB
    DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
    let candidates :: [(Point, Point, FilePath)]
candidates = ((Point, Point, FilePath) -> Bool)
-> [(Point, Point, FilePath)] -> [(Point, Point, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Point
_,Point
p2,FilePath
_)->Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
p2) (DiredState -> [(Point, Point, FilePath)]
diredFilePoints DiredState
dState)
        finddef :: FilePath -> DiredEntries -> DiredEntry
finddef FilePath
f = DiredEntry -> DiredFilePath -> DiredEntries -> DiredEntry
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault DiredEntry
DiredNoInfo (FilePath -> DiredFilePath
R.fromString FilePath
f)
    Maybe (FilePath, DiredEntry)
-> BufferM (Maybe (FilePath, DiredEntry))
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FilePath, DiredEntry)
 -> BufferM (Maybe (FilePath, DiredEntry)))
-> Maybe (FilePath, DiredEntry)
-> BufferM (Maybe (FilePath, DiredEntry))
forall a b. (a -> b) -> a -> b
$ case [(Point, Point, FilePath)]
candidates of
      ((Point
_, Point
_, FilePath
f):[(Point, Point, FilePath)]
_) -> (FilePath, DiredEntry) -> Maybe (FilePath, DiredEntry)
forall a. a -> Maybe a
Just (FilePath
f, FilePath -> DiredEntries -> DiredEntry
finddef FilePath
f (DiredEntries -> DiredEntry) -> DiredEntries -> DiredEntry
forall a b. (a -> b) -> a -> b
$ DiredState -> DiredEntries
diredEntries DiredState
dState)
      [(Point, Point, FilePath)]
_             -> Maybe (FilePath, DiredEntry)
forall a. Maybe a
Nothing

markedFiles :: (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles :: (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles Char -> Bool
cond = do
  DiredState
dState <- BufferM DiredState -> YiM DiredState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
  let fs :: [FilePath]
fs = ([FilePath], FilePath) -> [FilePath]
forall a b. (a, b) -> a
fst (([FilePath], FilePath) -> [FilePath])
-> ([(FilePath, Char)] -> ([FilePath], FilePath))
-> [(FilePath, Char)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, Char)] -> ([FilePath], FilePath)
forall a b. [(a, b)] -> ([a], [b])
unzip ([(FilePath, Char)] -> [FilePath])
-> [(FilePath, Char)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, Char) -> Bool)
-> [(FilePath, Char)] -> [(FilePath, Char)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Bool
cond (Char -> Bool)
-> ((FilePath, Char) -> Char) -> (FilePath, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Char) -> Char
forall a b. (a, b) -> b
snd) (Map FilePath Char -> [(FilePath, Char)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map FilePath Char -> [(FilePath, Char)])
-> Map FilePath Char -> [(FilePath, Char)]
forall a b. (a -> b) -> a -> b
$ DiredState -> Map FilePath Char
diredMarks DiredState
dState)
  [(FilePath, DiredEntry)] -> YiM [(FilePath, DiredEntry)]
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, DiredEntry)] -> YiM [(FilePath, DiredEntry)])
-> [(FilePath, DiredEntry)] -> YiM [(FilePath, DiredEntry)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> (FilePath, DiredEntry))
-> [FilePath] -> [(FilePath, DiredEntry)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
f -> (FilePath
f, DiredState -> DiredEntries
diredEntries DiredState
dState DiredEntries -> DiredFilePath -> DiredEntry
forall k a. Ord k => Map k a -> k -> a
M.! FilePath -> DiredFilePath
R.fromString FilePath
f)) [FilePath]
fs

diredUpDir :: YiM ()
diredUpDir :: YiM ()
diredUpDir = do
    FilePath
dir <- YiM FilePath
currentDir
    FilePath -> YiM ()
diredDir (FilePath -> YiM ()) -> FilePath -> YiM ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory FilePath
dir

diredCreateDir :: YiM ()
diredCreateDir :: YiM ()
diredCreateDir =
  Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"Create Dir:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
nm -> do
    FilePath
dir <- YiM FilePath
currentDir
    let newdir :: FilePath
newdir = FilePath
dir FilePath -> ShowS
</> Text -> FilePath
T.unpack Text
nm
    Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"Creating " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
newdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
    IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
newdir
    YiM ()
diredRefresh


-- | Elementary operations for dired file operations
-- Map a dired mark operation (e.g. delete, rename, copy) command
-- into a list of DiredOps, and use procDiredOp to execute them.
-- Logic and implementation of each operation are packaged in procDiredOp
-- See askDelFiles for example.
-- If new elem op is added, just add corresponding procDiredOp to handle it.
data DiredOp = DORemoveFile FilePath
             | DORemoveDir FilePath
             | DOCopyFile FilePath FilePath
             | DOCopyDir FilePath FilePath
             | DORename FilePath FilePath
             | DORemoveBuffer FilePath
             -- ^ remove the buffers that associate with the file
             | DOConfirm R.YiString [DiredOp] [DiredOp]
             -- ^ prompt a "yes/no" question. If yes, execute the
             -- first list of embedded DiredOps otherwise execute the
             -- second list of embedded DiredOps
             | DOCheck (IO Bool) [DiredOp] [DiredOp]
             -- ^ similar to DOConfirm, but no user interaction. Could
             -- be used to check file existence
             | DOCkOverwrite FilePath DiredOp
             -- ^ this is a shortcut, it invokes DCChoice if file exists
             | DOInput R.YiString (String -> [DiredOp])
             -- ^ prompt a string and collect user input.
             -- the embedded list of DiredOps is generated based on input,
             -- Remember that the input should be checked with DOCheck
             | DOChoice R.YiString DiredOp
             -- ^ prompt a string, provide keybindings for 'y', 'n',
             -- '!', 'q' and optional 'h' (help) this is useful when
             -- overwriting of existing files is required to complete
             -- the op choice '!' will bypass following DOChoice
             -- prompts.
             | DOFeedback (DiredOpState -> YiM ())
             -- ^ to feedback, given the state. such as show the result.
             | DONoOp
             -- ^ no operation