{-# 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.Reader     (asks, foldM, unless, void, when)
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)
import           System.PosixCompat.User  (GroupEntry, GroupEntry (..),
                                           UserEntry (..), getAllGroupEntries,
                                           getAllUserEntries,
                                           getGroupEntryForID,
                                           getUserEntryForID, groupID, userID)
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 -> String
(Int -> DiredOpState -> ShowS)
-> (DiredOpState -> String)
-> ([DiredOpState] -> ShowS)
-> Show DiredOpState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredOpState] -> ShowS
$cshowList :: [DiredOpState] -> ShowS
show :: DiredOpState -> String
$cshow :: DiredOpState -> String
showsPrec :: Int -> DiredOpState -> ShowS
$cshowsPrec :: Int -> DiredOpState -> ShowS
Show, DiredOpState -> DiredOpState -> Bool
(DiredOpState -> DiredOpState -> Bool)
-> (DiredOpState -> DiredOpState -> Bool) -> Eq DiredOpState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredOpState -> DiredOpState -> Bool
$c/= :: DiredOpState -> DiredOpState -> Bool
== :: DiredOpState -> DiredOpState -> Bool
$c== :: 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
$cto :: forall x. Rep DiredOpState x -> DiredOpState
$cfrom :: forall x. DiredOpState -> Rep DiredOpState x
Generic)

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

instance Binary DiredOpState

instance YiVariable DiredOpState

makeLenses ''DiredOpState

data DiredFileInfo = DiredFileInfo
    { DiredFileInfo -> YiString
permString             :: R.YiString
    , DiredFileInfo -> Integer
numLinks               :: Integer
    , DiredFileInfo -> YiString
owner                  :: R.YiString
    , DiredFileInfo -> YiString
grp                    :: R.YiString
    , DiredFileInfo -> Integer
sizeInBytes            :: Integer
    , DiredFileInfo -> YiString
modificationTimeString :: R.YiString
    } deriving (Int -> DiredFileInfo -> ShowS
[DiredFileInfo] -> ShowS
DiredFileInfo -> String
(Int -> DiredFileInfo -> ShowS)
-> (DiredFileInfo -> String)
-> ([DiredFileInfo] -> ShowS)
-> Show DiredFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredFileInfo] -> ShowS
$cshowList :: [DiredFileInfo] -> ShowS
show :: DiredFileInfo -> String
$cshow :: DiredFileInfo -> String
showsPrec :: Int -> DiredFileInfo -> ShowS
$cshowsPrec :: Int -> DiredFileInfo -> ShowS
Show, DiredFileInfo -> DiredFileInfo -> Bool
(DiredFileInfo -> DiredFileInfo -> Bool)
-> (DiredFileInfo -> DiredFileInfo -> Bool) -> Eq DiredFileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredFileInfo -> DiredFileInfo -> Bool
$c/= :: DiredFileInfo -> DiredFileInfo -> Bool
== :: DiredFileInfo -> DiredFileInfo -> Bool
$c== :: 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
$cto :: forall x. Rep DiredFileInfo x -> DiredFileInfo
$cfrom :: forall x. DiredFileInfo -> Rep DiredFileInfo x
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 -> String
(Int -> DiredEntry -> ShowS)
-> (DiredEntry -> String)
-> ([DiredEntry] -> ShowS)
-> Show DiredEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredEntry] -> ShowS
$cshowList :: [DiredEntry] -> ShowS
show :: DiredEntry -> String
$cshow :: DiredEntry -> String
showsPrec :: Int -> DiredEntry -> ShowS
$cshowsPrec :: Int -> DiredEntry -> ShowS
Show, DiredEntry -> DiredEntry -> Bool
(DiredEntry -> DiredEntry -> Bool)
-> (DiredEntry -> DiredEntry -> Bool) -> Eq DiredEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredEntry -> DiredEntry -> Bool
$c/= :: DiredEntry -> DiredEntry -> Bool
== :: DiredEntry -> DiredEntry -> Bool
$c== :: 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
$cto :: forall x. Rep DiredEntry x -> DiredEntry
$cfrom :: forall x. DiredEntry -> Rep DiredEntry x
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 -> String
diredPath        :: FilePath -- ^ The full path to the directory being viewed
     -- FIXME Choose better data structure for Marks...
    , DiredState -> Map String 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, String)]
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 -> String
diredCurrFile   :: FilePath
      -- ^ keep the position of pointer (for refreshing dired buffer)
    } deriving (Int -> DiredState -> ShowS
[DiredState] -> ShowS
DiredState -> String
(Int -> DiredState -> ShowS)
-> (DiredState -> String)
-> ([DiredState] -> ShowS)
-> Show DiredState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredState] -> ShowS
$cshowList :: [DiredState] -> ShowS
show :: DiredState -> String
$cshow :: DiredState -> String
showsPrec :: Int -> DiredState -> ShowS
$cshowsPrec :: Int -> DiredState -> ShowS
Show, DiredState -> DiredState -> Bool
(DiredState -> DiredState -> Bool)
-> (DiredState -> DiredState -> Bool) -> Eq DiredState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredState -> DiredState -> Bool
$c/= :: DiredState -> DiredState -> Bool
== :: DiredState -> DiredState -> Bool
$c== :: 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
$cto :: forall x. Rep DiredState x -> DiredState
$cfrom :: forall x. DiredState -> Rep DiredState x
Generic)

makeLensesWithSuffix "A" ''DiredState

instance Binary DiredState

instance Default DiredState where
    def :: DiredState
def = DiredState :: String
-> Map String Char
-> DiredEntries
-> [(Point, Point, String)]
-> Int
-> String
-> DiredState
DiredState { diredPath :: String
diredPath       = String
forall a. Monoid a => a
mempty
                     , diredMarks :: Map String Char
diredMarks      = Map String Char
forall a. Monoid a => a
mempty
                     , diredEntries :: DiredEntries
diredEntries    = DiredEntries
forall a. Monoid a => a
mempty
                     , diredFilePoints :: [(Point, Point, String)]
diredFilePoints = [(Point, Point, String)]
forall a. Monoid a => a
mempty
                     , diredNameCol :: Int
diredNameCol    = Int
0
                     , diredCurrFile :: String
diredCurrFile   = String
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 :: String -> YiM (Either Text BufferRef)
editFile String
filename = do
    String
f <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ String -> IO String
userToCanonPath String
filename

    [FBuffer]
dupBufs <- (FBuffer -> Bool) -> [FBuffer] -> [FBuffer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
equalFilePath String
f) (Maybe String -> Bool)
-> (FBuffer -> Maybe String) -> FBuffer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBuffer -> Maybe String
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
$ String -> IO Bool
doesDirectoryExist String
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
$ String -> IO Bool
doesFileExist String
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
<$> String -> YiM BufferRef
diredDirBuffer String
f
            else do
              Either Text BufferRef
nb <- if Bool
fileExists
                    then String -> YiM (Either Text BufferRef)
fileToNewBuffer String
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
<$> String -> YiM BufferRef
newEmptyBuffer String
f
              case Either Text BufferRef
nb of
                Left Text
m -> Either Text BufferRef -> YiM (Either Text BufferRef)
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
<$> String -> BufferRef -> YiM BufferRef
setupMode String
f BufferRef
buf

      (FBuffer
h:[FBuffer]
_) -> Either Text BufferRef -> YiM (Either Text BufferRef)
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 (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 (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (BufferRef -> EditorM ()
switchToBufferE BufferRef
bf EditorM () -> EditorM () -> EditorM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM ()
addJumpHereE) YiM ()
-> YiM (Either Text BufferRef) -> YiM (Either Text BufferRef)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text BufferRef -> YiM (Either Text BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return Either Text BufferRef
b
  where
    fileToNewBuffer :: FilePath -> YiM (Either T.Text BufferRef)
    fileToNewBuffer :: String -> YiM (Either Text BufferRef)
fileToNewBuffer String
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UTCTime
n -> IO (Either Text YiString) -> YiM (Either Text YiString)
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (String -> IO (Either Text YiString)
R.readFile String
f) YiM (Either Text YiString)
-> (Either Text YiString -> YiM (Either Text BufferRef))
-> YiM (Either Text BufferRef)
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 (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 YiString
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
$ String -> IO Permissions
getPermissions String
f

        BufferRef
b <- BufferId -> YiString -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (String -> BufferId
FileBuffer String
f) YiString
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
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 (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 :: String -> YiM BufferRef
newEmptyBuffer String
f =
      BufferId -> YiString -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (String -> BufferId
FileBuffer String
f) YiString
forall a. Monoid a => a
mempty

    setupMode :: FilePath -> BufferRef -> YiM BufferRef
    setupMode :: String -> BufferRef -> YiM BufferRef
setupMode String
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)
      YiString
content <- BufferRef -> BufferM YiString -> YiM YiString
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b BufferM YiString
elemsB

      let header :: YiString
header = Int -> YiString -> YiString
R.take Int
1024 YiString
content
          pc :: Parser Text Text
pc = Parser Text Text
"-*-" Parser Text Text -> Parser Text () -> Parser Text ()
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 (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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"-*-"
                    Parser Text Text -> Parser Text Text -> Parser Text Text
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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pc
          hmode :: Text
hmode = case Parser Text Text -> Text -> Either String Text
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser Text Text
pc (YiString -> Text
R.toText YiString
header) of
                    Left String
_ -> 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 (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 -> String -> YiString -> Bool
forall syntax. Mode syntax -> String -> YiString -> Bool
modeApplies Mode syntax
m String
f YiString
header) [AnyMode]
tbl Maybe AnyMode -> Maybe AnyMode -> Maybe AnyMode
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 (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b


bypassReadOnly :: BufferM a -> BufferM a
bypassReadOnly :: 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
readOnlyA
                      (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c 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
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 (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 (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)
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 (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 (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 (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 String
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException (String
"Remove file " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f) (String -> IO ()
removeLink String
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
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
f)
procDiredOp Bool
counting (DORemoveDir String
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException (String
"Remove directory " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f) (String -> IO ()
removeDirectoryRecursive String
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
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
f)
procDiredOp Bool
_counting (DORemoveBuffer String
_:[DiredOp]
_) = YiM ()
forall a. HasCallStack => a
undefined -- TODO
procDiredOp Bool
counting  (DOCopyFile String
o String
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException (String
"Copy file " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
o) (String -> String -> IO ()
copyFile String
o String
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
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
o)
            -- TODO: mark copied files with "C" if the target dir's
            -- dired buffer exists
procDiredOp Bool
counting (DOCopyDir String
o String
n:[DiredOp]
ops) = do
  [String]
contents <- IO [String] -> YiM [String]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [String] -> YiM [String]) -> IO [String] -> YiM [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String] -> IO [String]
forall a. String -> IO a -> IO a
printingException
              ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Copy directory ", String
o, String
" to ", String
n]) IO [String]
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
$ (String -> IO DiredOp) -> [String] -> IO [DiredOp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO DiredOp
builder ([String] -> IO [DiredOp]) -> [String] -> IO [DiredOp]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".", String
".."]) [String]
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
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
o)
          -- perform dir copy: create new dir and create other copy ops
          doCopy :: IO [FilePath]
          doCopy :: IO [String]
doCopy = do
            Bool
exists <- String -> IO Bool
doesDirectoryExist String
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
$ String -> IO ()
removeDirectoryRecursive String
n
            Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
n
            String -> IO [String]
getDirectoryContents String
o
          -- build actual copy operations
          builder :: FilePath -> IO DiredOp
          builder :: String -> IO DiredOp
builder String
name = do
            let npath :: String
npath = String
n String -> ShowS
</> String
name
            let opath :: String
opath = String
o String -> ShowS
</> String
name
            Bool
isDir <- String -> IO Bool
doesDirectoryExist String
opath
            DiredOp -> IO DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredOp -> IO DiredOp) -> DiredOp -> IO DiredOp
forall a b. (a -> b) -> a -> b
$ String -> DiredOp -> DiredOp
DOCkOverwrite String
npath (DiredOp -> DiredOp) -> DiredOp -> DiredOp
forall a b. (a -> b) -> a -> b
$ Bool -> String -> String -> DiredOp
getOp Bool
isDir String
opath String
npath
                where getOp :: Bool -> String -> String -> DiredOp
getOp Bool
isDir = if Bool
isDir then String -> String -> DiredOp
DOCopyDir else String -> String -> DiredOp
DOCopyFile


procDiredOp Bool
counting (DORename String
o String
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Rename ", String
o, String
" to ", String
n]) (String -> String -> IO ()
rename String
o String
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
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
o)
procDiredOp Bool
counting r :: [DiredOp]
r@(DOConfirm YiString
prompt [DiredOp]
eops [DiredOp]
enops:[DiredOp]
ops) =
  Text -> (Text -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
withMinibuffer (YiString -> Text
R.toText (YiString -> Text) -> YiString -> Text
forall a b. (a -> b) -> a -> b
$ YiString
prompt YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" (yes/no)") Text -> YiM [Text]
forall a. a -> YiM [a]
noHint (String -> YiM ()
act (String -> YiM ()) -> (Text -> String) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
  where act :: String -> YiM ()
act String
s = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
                  String
"yes" -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp]
eops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
                  String
"no"  -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp]
enops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
                  String
_     -> 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 String
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
$ String -> IO Bool
fileExist String
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 = YiString -> DiredOp -> DiredOp
DOChoice (YiString
"Overwrite " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString String
fp YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" ?") DiredOp
op
procDiredOp Bool
counting (DOInput YiString
prompt String -> [DiredOp]
opGen:[DiredOp]
ops) =
  Text -> (Text -> YiM ()) -> YiM ()
promptFile (YiString -> Text
R.toText YiString
prompt) (String -> YiM ()
act (String -> YiM ()) -> (Text -> String) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
    where act :: String -> YiM ()
act String
s = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp] -> YiM ()) -> [DiredOp] -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> [DiredOp]
opGen String
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredOpState -> YiM ()
f YiM () -> YiM () -> YiM ()
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 YiString
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 (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 (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap)
    where msg :: Text
msg = YiString -> Text
R.toText (YiString -> Text) -> YiString -> Text
forall a b. (a -> b) -> a -> b
$ YiString
prompt YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" (y/n/!/q/h)"
          askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n' Event -> YiM () -> I Event Action ()
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 () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
yesAction
                             , Char -> Event
char Char
'!' Event -> YiM () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
proceedNo
          yesAction :: YiM ()
yesAction = YiM ()
cleanUp YiM () -> YiM () -> YiM ()
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 (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 (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 (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
-- directry, but only the top level one
--
-- 3. Show the number of successful deletions at the end of the excution
--
-- 4. TODO: ask confirmation for wether to remove the associated
-- buffers when a file is removed
askDelFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askDelFiles :: String -> [(String, DiredEntry)] -> YiM ()
askDelFiles String
dir [(String, DiredEntry)]
fs =
  case [(String, DiredEntry)]
fs of
    ((String, DiredEntry)
_x:[(String, 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)
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 [YiString -> [DiredOp] -> [DiredOp] -> DiredOp
DOConfirm YiString
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 :: YiString
prompt = [YiString] -> YiString
R.concat [ YiString
"Delete "
                        , String -> YiString
R.fromString (String -> YiString) -> (Int -> String) -> Int -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> YiString) -> Int -> YiString
forall a b. (a -> b) -> a -> b
$ [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, DiredEntry)]
fs
                        , YiString
" file(s)?"
                        ]
      ops :: [IO DiredOp]
ops = ((String, DiredEntry) -> IO DiredOp)
-> [(String, DiredEntry)] -> [IO DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (String, DiredEntry) -> IO DiredOp
opGenerator [(String, 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 = [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, DiredEntry)]
fs
      opGenerator :: (FilePath, DiredEntry) -> IO DiredOp
      opGenerator :: (String, DiredEntry) -> IO DiredOp
opGenerator (String
fn, DiredEntry
de) = do
                   Bool
exists <- String -> IO Bool
fileExist String
path
                   if Bool
exists then case DiredEntry
de of
                     (DiredDir DiredFileInfo
_dfi) -> do
                       Bool
isNull <- ([String] -> Bool) -> IO [String] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Bool
nullDir (IO [String] -> IO Bool) -> IO [String] -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
path
                       DiredOp -> IO DiredOp
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 YiString -> [DiredOp] -> [DiredOp] -> DiredOp
DOConfirm YiString
recDelPrompt
                                               [String -> DiredOp
DORemoveDir String
path] [DiredOp
DONoOp]
                                else String -> DiredOp
DORemoveDir String
path
                     DiredEntry
_               -> DiredOp -> IO DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DiredOp
DORemoveFile String
path)
                     else DiredOp -> IO DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return DiredOp
DONoOp
          where path :: String
path = String
dir String -> ShowS
</> String
fn
                recDelPrompt :: YiString
recDelPrompt = YiString
"Recursive delete of " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString String
fn YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
"?"
                -- Test the emptyness of a folder
                nullDir :: [FilePath] -> Bool
                nullDir :: [String] -> Bool
nullDir = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem [String
".", String
".."])

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

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

diredKeymap :: Keymap -> Keymap
diredKeymap :: KeymapEndo
diredKeymap = I Event Action () -> KeymapEndo
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
important (I Event Action () -> KeymapEndo)
-> I Event Action () -> KeymapEndo
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> I Event Action ()) -> I Event Action ()
withArg Maybe Int -> I Event Action ()
mainMap
  where
    -- produces a copy of the map allowing for C-u
    withArg :: (Maybe Int -> Keymap) -> Keymap
    withArg :: (Maybe Int -> I Event Action ()) -> I Event Action ()
withArg Maybe Int -> I Event Action ()
k = [I Event Action ()] -> I Event Action ()
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 -> I Event Action ()
k (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) , Maybe Int -> I Event Action ()
k Maybe Int
forall a. Maybe a
Nothing ]

    mainMap :: Maybe Int -> Keymap
    mainMap :: Maybe Int -> I Event Action ()
mainMap Maybe Int
univArg = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
      [ Char -> Event
char Char
'p'                   Event -> BufferM () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredMark
      , Char -> Event
char Char
'^'                   Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredUpDir
      , Char -> Event
char Char
'+'                   Event -> YiM () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 -> I Event Action ()
multiMarks Maybe Int
univArg
      ]

    multiMarks :: Maybe Int -> Keymap
    multiMarks :: Maybe Int -> I Event Action ()
multiMarks Maybe Int
univArg = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
      [ Char -> Event
char Char
'!' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredUnmarkAll
      , Char -> Event
char Char
'@' Event -> BufferM () -> I Event Action ()
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 () -> I Event Action ()
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 () -> I Event Action ()
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 String
maybepath <- BufferM (Maybe String) -> YiM (Maybe String)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe String) -> YiM (Maybe String))
-> BufferM (Maybe String) -> YiM (Maybe String)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe String) -> BufferM (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe String
file
    String
dir <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ Maybe String -> IO String
getFolder Maybe String
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
$ String -> YiM (Either Text BufferRef)
editFile String
dir

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

diredDirBuffer :: FilePath -> YiM BufferRef
diredDirBuffer :: String -> YiM BufferRef
diredDirBuffer String
d = do
    -- Emacs doesn't follow symlinks, probably Yi shouldn't do too
    String
dir <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
d
    BufferRef
b <- BufferId -> YiString -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (String -> BufferId
FileBuffer String
dir) YiString
forall a. Monoid a => a
mempty
    EditorM () -> YiM ()
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
& (String -> Identity String) -> DiredState -> Identity DiredState
Lens' DiredState String
diredPathA ((String -> Identity String) -> DiredState -> Identity DiredState)
-> String -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
dir)
      (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c 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 (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 :: String
dir = DiredState -> String
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
$ String -> IO DiredEntries
diredScanDir String
dir
    String
currFile <- if [(Point, Point, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DiredState -> [(Point, Point, String)]
diredFilePoints DiredState
dState)
                then String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                else do Maybe (String, DiredEntry)
maybefile <- BufferM (Maybe (String, DiredEntry))
-> YiM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, DiredEntry))
fileFromPoint
                        case Maybe (String, DiredEntry)
maybefile of
                          Just (String
fp, DiredEntry
_) -> String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fp
                          Maybe (String, DiredEntry)
Nothing      -> String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    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
$ (String -> Identity String) -> DiredState -> Identity DiredState
Lens' DiredState String
diredCurrFileA ((String -> Identity String) -> DiredState -> Identity DiredState)
-> String -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
currFile (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ DiredState
dState
    -- Compute results
    let dlines :: [([DRStrings], StyleName, YiString)]
dlines = DiredState -> [([DRStrings], StyleName, YiString)]
linesToDisplay DiredState
ds
        ([[DRStrings]]
strss, [StyleName]
stys, [YiString]
strs) = [([DRStrings], StyleName, YiString)]
-> ([[DRStrings]], [StyleName], [YiString])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([DRStrings], StyleName, YiString)]
dlines
        strss' :: [[YiString]]
strss' = [[YiString]] -> [[YiString]]
forall a. [[a]] -> [[a]]
transpose ([[YiString]] -> [[YiString]]) -> [[YiString]] -> [[YiString]]
forall a b. (a -> b) -> a -> b
$ ([DRStrings] -> [YiString]) -> [[DRStrings]] -> [[YiString]]
forall a b. (a -> b) -> [a] -> [b]
map [DRStrings] -> [YiString]
doPadding ([[DRStrings]] -> [[YiString]]) -> [[DRStrings]] -> [[YiString]]
forall a b. (a -> b) -> a -> b
$ [[DRStrings]] -> [[DRStrings]]
forall a. [[a]] -> [[a]]
transpose [[DRStrings]]
strss
        namecol :: Int
namecol = if [[YiString]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[YiString]]
strss' then Int
0 else
                  let l1details :: [YiString]
l1details = [YiString] -> [YiString]
forall a. [a] -> [a]
init ([YiString] -> [YiString]) -> [YiString] -> [YiString]
forall a b. (a -> b) -> a -> b
$ [[YiString]] -> [YiString]
forall a. [a] -> a
head [[YiString]]
strss'
                  in [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Data.List.sum ((YiString -> Int) -> [YiString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map YiString -> Int
R.length [YiString]
l1details) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [YiString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [YiString]
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
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
      YiString -> BufferM ()
insertN (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ String -> YiString
R.fromString String
dir YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
":\n"
      Point
p <- BufferM Point
pointB
      -- paint header
      Overlay -> BufferM ()
addOverlayB (Overlay -> BufferM ()) -> Overlay -> BufferM ()
forall a b. (a -> b) -> a -> b
$ YiString -> Region -> StyleName -> YiString -> Overlay
mkOverlay YiString
"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 YiString
""
      [(Point, Point, String)]
ptsList <- (([YiString], StyleName, YiString)
 -> BufferM (Point, Point, String))
-> [([YiString], StyleName, YiString)]
-> BufferM [(Point, Point, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([YiString], StyleName, YiString) -> BufferM (Point, Point, String)
insertDiredLine ([([YiString], StyleName, YiString)]
 -> BufferM [(Point, Point, String)])
-> [([YiString], StyleName, YiString)]
-> BufferM [(Point, Point, String)]
forall a b. (a -> b) -> a -> b
$ [[YiString]]
-> [StyleName] -> [YiString] -> [([YiString], StyleName, YiString)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[YiString]]
strss' [StyleName]
stys [YiString]
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, String)] -> Identity [(Point, Point, String)])
-> DiredState -> Identity DiredState
Lens' DiredState [(Point, Point, String)]
diredFilePointsA (([(Point, Point, String)] -> Identity [(Point, Point, String)])
 -> DiredState -> Identity DiredState)
-> [(Point, Point, String)] -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Point, Point, String)]
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. Lens' (Mode syntax) (KeymapSet -> KeymapSet)
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
.~  (I Event Action () -> Identity (I Event Action ()))
-> KeymapSet -> Identity KeymapSet
Lens' KeymapSet (I Event Action ())
topKeymapA ((I Event Action () -> Identity (I Event Action ()))
 -> 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. Lens' (Mode syntax) Text
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
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 (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
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 String -> [(Point, Point, String)] -> Maybe Point
forall a b b. Eq a => a -> [(b, b, a)] -> Maybe b
getRow String
currFile [(Point, Point, String)]
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] -> [YiString]
doPadding [DRStrings]
drs = (DRStrings -> YiString) -> [DRStrings] -> [YiString]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> DRStrings -> YiString
pad (([Int] -> Int
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 -> YiString
pad Int
_n (DRPerms YiString
s)  = YiString
s
    pad Int
n  (DRLinks YiString
s)  = Int -> YiString -> YiString
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
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s
    pad Int
n  (DROwners YiString
s) = YiString
s YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> Int -> YiString -> YiString
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
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" "
    pad Int
n  (DRGroups YiString
s) = YiString
s YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> Int -> YiString -> YiString
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
- YiString -> Int
R.length YiString
s)) YiString
" "
    pad Int
n  (DRSizes YiString
s)  = Int -> YiString -> YiString
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
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s
    pad Int
n  (DRDates YiString
s)  = Int -> YiString -> YiString
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
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s
    pad Int
_n (DRFiles YiString
s)  = YiString
s       -- Don't right-justify the filename

    drlength :: DRStrings -> Int
drlength = YiString -> Int
R.length (YiString -> Int) -> (DRStrings -> YiString) -> DRStrings -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRStrings -> YiString
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 :: ([YiString], StyleName, YiString) -> BufferM (Point, Point, String)
insertDiredLine ([YiString]
fields, StyleName
sty, YiString
filenm) = BufferM (Point, Point, String) -> BufferM (Point, Point, String)
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM (Point, Point, String) -> BufferM (Point, Point, String))
-> BufferM (Point, Point, String) -> BufferM (Point, Point, String)
forall a b. (a -> b) -> a -> b
$ do
  YiString -> BufferM ()
insertN (YiString -> BufferM ())
-> ([YiString] -> YiString) -> [YiString] -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YiString] -> YiString
R.unwords ([YiString] -> BufferM ()) -> [YiString] -> BufferM ()
forall a b. (a -> b) -> a -> b
$ [YiString] -> [YiString]
forall a. [a] -> [a]
init [YiString]
fields
  Point
p1 <- BufferM Point
pointB
  YiString -> BufferM ()
insertN  (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> YiString -> YiString
`R.cons` [YiString] -> YiString
forall a. [a] -> a
last [YiString]
fields
  Point
p2 <- BufferM Point
pointB
  BufferM ()
newlineB
  Overlay -> BufferM ()
addOverlayB (YiString -> Region -> StyleName -> YiString -> Overlay
mkOverlay YiString
"dired" (Point -> Point -> Region
mkRegion Point
p1 Point
p2) StyleName
sty YiString
"")
  (Point, Point, String) -> BufferM (Point, Point, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
p1, Point
p2, YiString -> String
R.toString YiString
filenm)

data DRStrings = DRPerms {DRStrings -> YiString
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, YiString)]
linesToDisplay DiredState
dState = ((YiString, DiredEntry) -> ([DRStrings], StyleName, YiString))
-> [(YiString, DiredEntry)] -> [([DRStrings], StyleName, YiString)]
forall a b. (a -> b) -> [a] -> [b]
map ((YiString -> DiredEntry -> ([DRStrings], StyleName, YiString))
-> (YiString, DiredEntry) -> ([DRStrings], StyleName, YiString)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry YiString -> DiredEntry -> ([DRStrings], StyleName, YiString)
lineToDisplay) (DiredEntries -> [(YiString, DiredEntry)]
forall k a. Map k a -> [(k, a)]
M.assocs DiredEntries
entries)
  where
    entries :: DiredEntries
entries = DiredState -> DiredEntries
diredEntries DiredState
dState

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

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

-- | Return dired entries for the contents of the supplied directory
diredScanDir :: FilePath -> IO DiredEntries
diredScanDir :: String -> IO DiredEntries
diredScanDir String
dir = do
    [String]
files <- String -> IO [String]
getDirectoryContents String
dir
    (DiredEntries -> String -> IO DiredEntries)
-> DiredEntries -> [String] -> IO DiredEntries
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (String -> DiredEntries -> String -> IO DiredEntries
lineForFile String
dir) DiredEntries
forall k a. Map k a
M.empty [String]
files
    where
    lineForFile :: FilePath
                -> DiredEntries
                -> FilePath
                -> IO DiredEntries
    lineForFile :: String -> DiredEntries -> String -> IO DiredEntries
lineForFile String
d DiredEntries
m String
f = do
      let fp :: String
fp = String
d String -> ShowS
</> String
f
      FileStatus
fileStatus <- String -> IO FileStatus
getSymbolicLinkStatus String
fp
      DiredFileInfo
dfi <- String -> FileStatus -> IO DiredFileInfo
lineForFilePath String
fp FileStatus
fileStatus
      let islink :: Bool
islink = FileStatus -> Bool
isSymbolicLink FileStatus
fileStatus
      String
linkTarget <- if Bool
islink then String -> IO String
readSymbolicLink String
fp else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
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 -> YiString -> DiredEntry
DiredSymLink DiredFileInfo
dfi (String -> YiString
R.fromString String
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 (m :: * -> *) a. Monad m => a -> m a
return (DiredEntries -> IO DiredEntries)
-> DiredEntries -> IO DiredEntries
forall a b. (a -> b) -> a -> b
$ YiString -> DiredEntry -> DiredEntries -> DiredEntries
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> YiString
R.fromString String
f) DiredEntry
de DiredEntries
m

    lineForFilePath :: FilePath -> FileStatus -> IO DiredFileInfo
    lineForFilePath :: String -> FileStatus -> IO DiredFileInfo
lineForFilePath String
fp FileStatus
fileStatus = do
      let modTimeStr :: YiString
modTimeStr = String -> YiString
R.fromString (String -> YiString)
-> (EpochTime -> String) -> EpochTime -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
shortCalendarTimeToString
                       (UTCTime -> String)
-> (EpochTime -> UTCTime) -> EpochTime -> String
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 -> YiString) -> EpochTime -> YiString
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 :: String
fn = ShowS
takeFileName String
fp
      String
_filenm <- if FileStatus -> Bool
isSymbolicLink FileStatus
fileStatus
                 then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> ShowS -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
fn String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" -> ") String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
readSymbolicLink String
fp
                 else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroupID -> [GroupEntry] -> GroupEntry
scanForGid GroupID
gid) IO [GroupEntry]
getAllGroupEntries)
      let fmodeStr :: YiString
fmodeStr = (FileMode -> YiString
modeString (FileMode -> YiString)
-> (FileStatus -> FileMode) -> FileStatus -> YiString
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 :: YiString
ownerStr   = String -> YiString
R.fromString (String -> YiString) -> String -> YiString
forall a b. (a -> b) -> a -> b
$ UserEntry -> String
userName UserEntry
ownerEntry
          groupStr :: YiString
groupStr   = String -> YiString
R.fromString (String -> YiString) -> String -> YiString
forall a b. (a -> b) -> a -> b
$ GroupEntry -> String
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 (m :: * -> *) a. Monad m => a -> m a
return DiredFileInfo :: YiString
-> Integer
-> YiString
-> YiString
-> Integer
-> YiString
-> DiredFileInfo
DiredFileInfo { permString :: YiString
permString = YiString
fmodeStr
                           , numLinks :: Integer
numLinks = Integer
numOfLinks
                           , owner :: YiString
owner = YiString
ownerStr
                           , grp :: YiString
grp = YiString
groupStr
                           , sizeInBytes :: Integer
sizeInBytes = Integer
sz
                           , modificationTimeString :: YiString
modificationTimeString = YiString
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 = String
-> String
-> UserID
-> GroupID
-> String
-> String
-> String
-> UserEntry
UserEntry String
"?" String
forall a. Monoid a => a
mempty UserID
uid GroupID
0 String
forall a. Monoid a => a
mempty String
forall a. Monoid a => a
mempty String
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 = String -> String -> GroupID -> [String] -> GroupEntry
GroupEntry String
"?" String
forall a. Monoid a => a
mempty GroupID
gid [String]
forall a. Monoid a => a
mempty


modeString :: FileMode -> R.YiString
modeString :: FileMode -> YiString
modeString FileMode
fm = YiString
""
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"r" FileMode
ownerReadMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"w" FileMode
ownerWriteMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"x" FileMode
ownerExecuteMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"r" FileMode
groupReadMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"w" FileMode
groupWriteMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"x" FileMode
groupExecuteMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"r" FileMode
otherReadMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"w" FileMode
otherWriteMode
                YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"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 -> String
shortCalendarTimeToString = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%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 -> (YiString -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m YiString -> 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 :: [(YiString, DiredEntry)]
es = DiredEntries -> [(YiString, DiredEntry)]
forall k a. Map k a -> [(k, a)]
M.assocs (DiredEntries -> [(YiString, DiredEntry)])
-> DiredEntries -> [(YiString, DiredEntry)]
forall a b. (a -> b) -> a -> b
$ DiredState -> DiredEntries
diredEntries DiredState
dState
      ms :: Map String Char
ms = [(String, Char)] -> Map String Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (YiString -> String
R.toString YiString
fp, Char
c) | (YiString
fp, DiredEntry
e) <- [(YiString, DiredEntry)]
es, YiString -> DiredEntry -> Bool
p YiString
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 String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
 -> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map String Char -> Map String Char -> Map String Char
run Map String Char
ms)
  BufferM ()
diredRefreshMark
  where
    run :: M.Map FilePath Char -> M.Map FilePath Char -> M.Map FilePath Char
    run :: Map String Char -> Map String Char -> Map String Char
run Map String Char
ms Map String Char
cms = case Maybe Int
m of
      Maybe Int
Nothing -> Map String Char -> Map String Char -> Map String Char
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map String Char
ms Map String Char
cms
      Just Int
_ -> Map String Char -> [String] -> Map String Char
forall k v. Ord k => Map k v -> [k] -> Map k v
deleteKeys Map String Char
cms (Map String Char -> [String]
forall k a. Map k a -> [k]
M.keys Map String Char
ms)

diredMarkSymlinks :: Maybe Int -> BufferM ()
diredMarkSymlinks :: Maybe Int -> BufferM ()
diredMarkSymlinks Maybe Int
m = Maybe Int -> (YiString -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m YiString -> 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 -> (YiString -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m YiString -> 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 String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
 -> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DiredEntries -> Map String Char -> Map String 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 String Char -> Map String Char
tm DiredEntries
de Map String Char
ms = let unmarked :: Map String DiredEntry
unmarked = Map String DiredEntry -> [String] -> Map String DiredEntry
forall k v. Ord k => Map k v -> [k] -> Map k v
deleteKeys ((YiString -> String) -> DiredEntries -> Map String DiredEntry
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys YiString -> String
R.toString DiredEntries
de) (Map String Char -> [String]
forall k a. Map k a -> [k]
M.keys Map String Char
ms)
               in (DiredEntry -> Char) -> Map String DiredEntry -> Map String 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 String DiredEntry
unmarked

-- | Delete all the keys from the map.
deleteKeys :: Ord k => M.Map k v -> [k] -> M.Map k v
deleteKeys :: Map k v -> [k] -> Map k v
deleteKeys = (Map k v -> k -> Map k v) -> Map k v -> [k] -> Map k v
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 (String, DiredEntry))
fileFromPoint BufferM (Maybe (String, DiredEntry))
-> (Maybe (String, DiredEntry) -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (String
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 String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
 -> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> Char -> Map String Char -> Map String Char
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
fn Char
c)
      BufferM () -> BufferM ()
filenameColOf BufferM ()
mv
      BufferM ()
diredRefreshMark
    Maybe (String, 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, String)]
posDict = DiredState -> [(Point, Point, String)]
diredFilePoints DiredState
dState
      markMap :: Map String Char
markMap = DiredState -> Map String Char
diredMarks DiredState
dState
      draw :: (Point, b, String) -> BufferM ()
draw (Point
pos, b
_, String
fn) = case String -> Map String Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
fn Map String Char
markMap of
        Just Char
mark -> do
          Point -> BufferM ()
moveTo Point
pos BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> BufferM ()
insertB Char
mark BufferM () -> BufferM () -> BufferM ()
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
$
            YiString -> Region -> StyleName -> YiString -> Overlay
mkOverlay YiString
"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) YiString
""
        Maybe Char
Nothing ->
          -- for deleted marks
          Point -> BufferM ()
moveTo Point
pos BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiString -> BufferM ()
insertN YiString
" " BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
deleteN Int
1
  ((Point, Point, String) -> BufferM ())
-> [(Point, Point, String)] -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Point, Point, String) -> BufferM ()
forall b. (Point, b, String) -> BufferM ()
draw [(Point, Point, String)]
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 (String, DiredEntry))
fileFromPoint BufferM (Maybe (String, DiredEntry))
-> (Maybe (String, DiredEntry) -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (String
fn, DiredEntry
_de) -> do
      String -> BufferM ()
diredUnmarkPath String
fn
      BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDir
      BufferM ()
diredRefreshMark
    Maybe (String, DiredEntry)
Nothing        -> BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDir


diredUnmarkPath :: FilePath -> BufferM()
diredUnmarkPath :: String -> BufferM ()
diredUnmarkPath String
fn = BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredState -> (DiredState -> BufferM ()) -> BufferM ()
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 String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
 -> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> Map String Char -> Map String Char
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
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 (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 String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
 -> DiredState -> Identity DiredState)
-> Map String Char -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map String 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 (m :: * -> *) a. Monad m => a -> m a
return ()
                   BufferM ()
diredRefreshMark

currentDir :: YiM FilePath
currentDir :: YiM String
currentDir = DiredState -> String
diredPath (DiredState -> String) -> YiM DiredState -> YiM String
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 :: String -> [(String, DiredEntry)] -> YiM ()
askRenameFiles String
dir [(String, DiredEntry)]
fs = case [(String, DiredEntry)]
fs of
  [(String, DiredEntry)
_x] -> do YiM ()
resetDiredOpState
             Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [DiredOp]
sOpIsDir]
  (String, DiredEntry)
_x:[(String, DiredEntry)]
_ -> do YiM ()
resetDiredOpState
             Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [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 (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 :: YiString
prompt = YiString
"Move " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString (Int -> String
forall a. Show a => a -> String
show Int
total) YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" item(s) to:"
    mOpIsDirAndExists :: String -> [DiredOp]
mOpIsDirAndExists String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
negOps]
      where
        posOps :: [DiredOp]
posOps = ((String, DiredEntry) -> DiredOp)
-> [(String, DiredEntry)] -> [DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (String, DiredEntry) -> DiredOp
forall b. (String, b) -> DiredOp
builder [(String, 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
$ String -> Text
T.pack String
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not directory!"
        builder :: (String, b) -> DiredOp
builder (String
fn, b
_de) = let old :: String
old = String
dir String -> ShowS
</> String
fn
                                new :: String
new = String
t String -> ShowS
</> String
fn
                            in String -> DiredOp -> DiredOp
DOCkOverwrite String
new (String -> String -> DiredOp
DORename String
old String
new)
    sOpIsDir :: String -> [DiredOp]
sOpIsDir String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
sOpDirRename]
        where (String
fn, DiredEntry
_) = [(String, DiredEntry)] -> (String, DiredEntry)
forall a. [a] -> a
head [(String, DiredEntry)]
fs -- the only item
              posOps :: [DiredOp]
posOps = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (String -> String -> DiredOp
DORename String
old String
new),
                        (DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
                  where new :: String
new = String
t String -> ShowS
</> String
fn
                        old :: String
old = String
dir String -> ShowS
</> String
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' = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (String -> String -> DiredOp
DORename String
old String
new)]
                        p :: Text
p = Text
"Cannot move " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
old
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
new
                        negOps :: [DiredOp]
negOps = Text -> [DiredOp]
forall (m :: * -> *). Monad m => Text -> m DiredOp
mkErr Text
p
                        new :: String
new = String
t
                        old :: String
old = String
dir String -> ShowS
</> String
fn
                        ps :: String
ps = ShowS
dropTrailingPathSeparator String
t
                        ckParentDir :: IO Bool
ckParentDir = String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
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 = [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, 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 :: String -> [(String, DiredEntry)] -> YiM ()
askCopyFiles String
dir [(String, DiredEntry)]
fs =
  case [(String, DiredEntry)]
fs of
    [(String, DiredEntry)
_x] -> do YiM ()
resetDiredOpState
               Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [DiredOp]
sOpIsDir]
    (String, DiredEntry)
_x:[(String, DiredEntry)]
_ -> do YiM ()
resetDiredOpState
               Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [DiredOp]
mOpIsDirAndExists]
    []   ->    Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall (m :: * -> *) p. MonadEditor m => p -> m ()
showNothing]
  where
    prompt :: YiString
prompt = YiString
"Copy " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString (Int -> String
forall a. Show a => a -> String
show Int
total) YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" item(s) to:"
    mOpIsDirAndExists :: String -> [DiredOp]
mOpIsDirAndExists String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
negOps]
      where
        posOps :: [DiredOp]
posOps = ((String, DiredEntry) -> DiredOp)
-> [(String, DiredEntry)] -> [DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (String, DiredEntry) -> DiredOp
builder [(String, 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 (String -> Text
T.pack String
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not directory!")]
        builder :: (String, DiredEntry) -> DiredOp
builder (String
fn, DiredEntry
de) = let old :: String
old = String
dir String -> ShowS
</> String
fn
                               new :: String
new = String
t String -> ShowS
</> String
fn
                           in String -> DiredOp -> DiredOp
DOCkOverwrite String
new (DiredEntry -> String -> String -> DiredOp
op4Type DiredEntry
de String
old String
new)
    sOpIsDir :: String -> [DiredOp]
sOpIsDir String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
sOpDirCopy]
      where (String
fn, DiredEntry
de) = [(String, DiredEntry)] -> (String, DiredEntry)
forall a. [a] -> a
head [(String, DiredEntry)]
fs -- the only item
            posOps :: [DiredOp]
posOps = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (DiredEntry -> String -> String -> DiredOp
op4Type DiredEntry
de String
old String
new),
                      (DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
                where new :: String
new = String
t String -> ShowS
</> String
fn
                      old :: String
old = String
dir String -> ShowS
</> String
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' = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (DiredEntry -> String -> String -> DiredOp
op4Type DiredEntry
de String
old String
new)]
                      p :: Text
p = Text
"Cannot copy " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
old Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
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 :: String
new = String
t
                      old :: String
old = String
dir String -> ShowS
</> String
fn
                      ckParentDir :: IO Bool
ckParentDir = String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$
                                    ShowS
takeDirectory (ShowS
dropTrailingPathSeparator String
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 = [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, DiredEntry)]
fs
    op4Type :: DiredEntry -> FilePath -> FilePath -> DiredOp
    op4Type :: DiredEntry -> String -> String -> DiredOp
op4Type (DiredDir DiredFileInfo
_) = String -> String -> DiredOp
DOCopyDir
    op4Type DiredEntry
_            = String -> String -> DiredOp
DOCopyFile

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

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

diredLoad :: YiM ()
diredLoad :: YiM ()
diredLoad = do
  String
dir <- YiM String
currentDir
  BufferM (Maybe (String, DiredEntry))
-> YiM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, DiredEntry))
fileFromPoint YiM (Maybe (String, DiredEntry))
-> (Maybe (String, DiredEntry) -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (String
fn, DiredEntry
de) -> do
      let sel :: String
sel = String
dir String -> ShowS
</> String
fn
          sel' :: Text
sel' = String -> Text
T.pack String
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
$ String -> IO Bool
doesFileExist String
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
$ String -> YiM (Either Text BufferRef)
editFile String
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
$ String -> IO Bool
doesDirectoryExist String
sel
          if Bool
exists
            then String -> YiM ()
diredDir String
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 YiString
dest') -> do
          let dest :: String
dest = YiString -> String
R.toString YiString
dest'
              target :: String
target = if String -> Bool
isAbsolute String
dest then String
dest else String
dir String -> ShowS
</> String
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
$ String -> IO Bool
doesFileExist String
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
$ String -> IO Bool
doesDirectoryExist String
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
<> String -> Text
T.pack String
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
$ String -> YiM (Either Text BufferRef)
editFile String
target else
            if Bool
existsDir then String -> YiM ()
diredDir String
target else
              Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
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
$ String -> IO Bool
doesFileExist String
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
$ String -> IO Bool
doesFileExist String
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
$ String -> IO Bool
doesFileExist String
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
$ String -> IO Bool
doesFileExist String
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 (String, 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 (String, 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, String)]
candidates = ((Point, Point, String) -> Bool)
-> [(Point, Point, String)] -> [(Point, Point, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Point
_,Point
p2,String
_)->Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
p2) (DiredState -> [(Point, Point, String)]
diredFilePoints DiredState
dState)
        finddef :: String -> DiredEntries -> DiredEntry
finddef String
f = DiredEntry -> YiString -> DiredEntries -> DiredEntry
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault DiredEntry
DiredNoInfo (String -> YiString
R.fromString String
f)
    Maybe (String, DiredEntry) -> BufferM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, DiredEntry)
 -> BufferM (Maybe (String, DiredEntry)))
-> Maybe (String, DiredEntry)
-> BufferM (Maybe (String, DiredEntry))
forall a b. (a -> b) -> a -> b
$ case [(Point, Point, String)]
candidates of
      ((Point
_, Point
_, String
f):[(Point, Point, String)]
_) -> (String, DiredEntry) -> Maybe (String, DiredEntry)
forall a. a -> Maybe a
Just (String
f, String -> DiredEntries -> DiredEntry
finddef String
f (DiredEntries -> DiredEntry) -> DiredEntries -> DiredEntry
forall a b. (a -> b) -> a -> b
$ DiredState -> DiredEntries
diredEntries DiredState
dState)
      [(Point, Point, String)]
_             -> Maybe (String, DiredEntry)
forall a. Maybe a
Nothing

markedFiles :: (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles :: (Char -> Bool) -> YiM [(String, 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 :: [String]
fs = ([String], String) -> [String]
forall a b. (a, b) -> a
fst (([String], String) -> [String])
-> ([(String, Char)] -> ([String], String))
-> [(String, Char)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Char)] -> ([String], String)
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, Char)] -> [String]) -> [(String, Char)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Char) -> Bool) -> [(String, Char)] -> [(String, Char)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Bool
cond (Char -> Bool)
-> ((String, Char) -> Char) -> (String, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Char) -> Char
forall a b. (a, b) -> b
snd) (Map String Char -> [(String, Char)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map String Char -> [(String, Char)])
-> Map String Char -> [(String, Char)]
forall a b. (a -> b) -> a -> b
$ DiredState -> Map String Char
diredMarks DiredState
dState)
  [(String, DiredEntry)] -> YiM [(String, DiredEntry)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, DiredEntry)] -> YiM [(String, DiredEntry)])
-> [(String, DiredEntry)] -> YiM [(String, DiredEntry)]
forall a b. (a -> b) -> a -> b
$ (String -> (String, DiredEntry))
-> [String] -> [(String, DiredEntry)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
f -> (String
f, DiredState -> DiredEntries
diredEntries DiredState
dState DiredEntries -> YiString -> DiredEntry
forall k a. Ord k => Map k a -> k -> a
M.! String -> YiString
R.fromString String
f)) [String]
fs

diredUpDir :: YiM ()
diredUpDir :: YiM ()
diredUpDir = do
    String
dir <- YiM String
currentDir
    String -> YiM ()
diredDir (String -> YiM ()) -> String -> YiM ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
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
    String
dir <- YiM String
currentDir
    let newdir :: String
newdir = String
dir String -> ShowS
</> Text -> String
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
<> String -> Text
T.pack String
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 -> String -> IO ()
createDirectoryIfMissing Bool
True String
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 excute 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