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

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

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

    = TODO

    * add more comments
    * Support symlinks
    * Mark operations

        * search

    * Improve the colouring to show

        * loaded buffers
        * .hs files
        * marked files

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

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

    import           GHC.Generics             (Generic)

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

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

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

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

    instance Binary DiredOpState

    instance YiVariable DiredOpState

    makeLenses ''DiredOpState

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

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

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

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

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

    makeLensesWithSuffix "A" ''DiredState

    instance Binary DiredState

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

    instance YiVariable DiredState

    instance Binary DiredEntry
    instance Binary DiredFileInfo

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

        dupBufs <- filter (maybe False (equalFilePath f) . file) <$> gets bufferSet

        dirExists  <- io $ doesDirectoryExist f
        fileExists <- io $ doesFileExist f

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

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

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

            b <- stringToNewBuffer (FileBuffer f) contents
            withGivenBuffer b $ do
              markSavedB n
              unless (writable permissions) (readOnlyA .= True)

            return $ Right b

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

        setupMode :: FilePath -> BufferRef -> YiM BufferRef
        setupMode :: FilePath -> BufferRef -> YiM BufferRef
    setupMode FilePath
    f BufferRef
    b = do
          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)
          content <- withGivenBuffer b elemsB

          let header = Int -> DiredFilePath -> DiredFilePath
    R.take Int
    1024 DiredFilePath
    content
              pc = Parser Text Text
    "-*-" Parser Text Text -> Parser Text () -> Parser Text ()
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Char -> Bool) -> Parser Text ()
    P.skipWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') Parser Text () -> Parser Text Text -> Parser Text Text
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Char -> Bool) -> Parser Text Text
    P.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ') Parser Text Text -> Parser Text () -> Parser Text Text
    forall a b. Parser Text a -> Parser Text b -> Parser Text a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* (Char -> Bool) -> Parser Text ()
    P.skipWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') Parser Text Text -> Parser Text Text -> Parser Text Text
    forall a b. Parser Text a -> Parser Text b -> Parser Text a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser Text Text
    "-*-"
                        Parser Text Text -> Parser Text Text -> Parser Text Text
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Char -> Bool) -> Parser Text ()
    P.skip (Bool -> Char -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Parser Text () -> Parser Text () -> Parser Text ()
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Char -> Bool) -> Parser Text ()
    P.skipWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '-') Parser Text () -> Parser Text Text -> Parser Text Text
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser Text Text
    pc
              hmode = case Parser Text Text -> Text -> Either FilePath Text
    forall a. Parser a -> Text -> Either FilePath a
    P.parseOnly Parser Text Text
    pc (DiredFilePath -> Text
    R.toText DiredFilePath
    header) of
                        Left FilePath
    _ -> Text
    ""
                        Right Text
    str -> Text
    str
              Just mode = 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) tbl <|>
                          find (\(AnyMode Mode syntax
    m) -> Mode syntax -> FilePath -> DiredFilePath -> Bool
    forall syntax. Mode syntax -> FilePath -> DiredFilePath -> Bool
    modeApplies Mode syntax
    m FilePath
    f DiredFilePath
    header) tbl <|>
                          Just (AnyMode emptyMode)
          case 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

          return b

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

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

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

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

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

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

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

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

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

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

    diredDoMarkedDel :: YiM ()
    diredDoMarkedDel :: YiM ()
    diredDoMarkedDel = do
      dir <- YiM FilePath
    currentDir
      fs <- markedFiles (== 'D')
      askDelFiles dir fs

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

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

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

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

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

    diredDirBuffer :: FilePath -> YiM BufferRef
    diredDirBuffer :: FilePath -> YiM BufferRef
    diredDirBuffer FilePath
    d = do
        -- Emacs doesn't follow symlinks, probably Yi shouldn't do too
        dir <- IO FilePath -> YiM FilePath
    forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
    io (IO FilePath -> YiM FilePath) -> IO FilePath -> YiM FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    canonicalizePath FilePath
    d
        b <- stringToNewBuffer (FileBuffer dir) mempty
        withEditor $ switchToBufferE b
        withCurrentBuffer $ do
          state <- getBufferDyn
          putBufferDyn (state & diredPathA .~ dir)
          directoryContentA .= True
        diredRefresh
        return b

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

        -- Set buffer contents
        withCurrentBuffer $ do -- Clear buffer
          readOnlyA .= False
          ---- modifications begin here
          deleteRegionB =<< regionOfB Document
          -- Write Header
          insertN $ R.fromString dir <> ":\n"
          p <- pointB
          -- paint header
          addOverlayB $ mkOverlay "dired" (mkRegion 0 (p-2)) headStyle ""
          ptsList <- mapM insertDiredLine $ zip3 strss' stys strs
          putBufferDyn $ diredFilePointsA .~ ptsList $ diredNameColA .~ namecol $ ds

          -- Colours for Dired come from overlays not syntax highlighting
          modifyMode $ modeKeymapA .~  topKeymapA %~ diredKeymap
                       >>> modeNameA .~ "dired"
          diredRefreshMark
          ---- no modifications after this line
          readOnlyA .= True
          when (null currFile) $ moveTo (p-2)
          case getRow currFile ptsList of
            Just Point
    rpos -> BufferM () -> BufferM ()
    filenameColOf (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
    forall a b. (a -> b) -> a -> b
    $ Point -> BufferM ()
    moveTo Point
    rpos
            Maybe Point
    Nothing   -> BufferM () -> BufferM ()
    filenameColOf BufferM ()
    lineDown
        where
        getRow :: a -> [(b, b, a)] -> Maybe b
    getRow a
    fp [(b, b, a)]
    recList = a -> [(a, b)] -> Maybe b
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup a
    fp (((b, b, a) -> (a, b)) -> [(b, b, a)] -> [(a, b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(b
    a,b
    _b,a
    c)->(a
    c,b
    a)) [(b, b, a)]
    recList)
        headStyle :: b -> Style
    headStyle = Style -> b -> Style
    forall a b. a -> b -> a
    const (Color -> Style
    withFg Color
    grey)
        doPadding :: [DRStrings] -> [R.YiString]
        doPadding :: [DRStrings] -> [DiredFilePath]
    doPadding [DRStrings]
    drs = (DRStrings -> DiredFilePath) -> [DRStrings] -> [DiredFilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> DRStrings -> DiredFilePath
    pad (([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> ([DRStrings] -> [Int]) -> [DRStrings] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DRStrings -> Int) -> [DRStrings] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map DRStrings -> Int
    drlength) [DRStrings]
    drs)) [DRStrings]
    drs

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    diredRename :: YiM ()
    diredRename :: YiM ()
    diredRename = do
      dir <- YiM FilePath
    currentDir
      fs <- markedFiles (== '*')
      if null fs then do maybefile <- withCurrentBuffer fileFromPoint
                         case maybefile of
                           Just (FilePath
    fn, DiredEntry
    de) -> FilePath -> [(FilePath, DiredEntry)] -> YiM ()
    askRenameFiles FilePath
    dir [(FilePath
    fn, DiredEntry
    de)]
                           Maybe (FilePath, DiredEntry)
    Nothing       -> YiM ()
    noFileAtThisLine
                 else askRenameFiles dir fs

    diredCopy :: YiM ()
    diredCopy :: YiM ()
    diredCopy = do
      dir <- YiM FilePath
    currentDir
      fs <- markedFiles (== '*')
      if null fs then do maybefile <- withCurrentBuffer fileFromPoint
                         case maybefile of
                           Just (FilePath
    fn, DiredEntry
    de) -> FilePath -> [(FilePath, DiredEntry)] -> YiM ()
    askCopyFiles FilePath
    dir [(FilePath
    fn, DiredEntry
    de)]
                           Maybe (FilePath, DiredEntry)
    Nothing       -> YiM ()
    noFileAtThisLine
                 else askCopyFiles dir fs

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

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

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

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

    diredUpDir :: YiM ()
    diredUpDir :: YiM ()
    diredUpDir = do
        dir <- YiM FilePath
    currentDir
        diredDir $ takeDirectory 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
        dir <- YiM FilePath
    currentDir
        let newdir = FilePath
    dir FilePath -> ShowS
    </> Text -> FilePath
    T.unpack Text
    nm
        printMsg $ "Creating " <> T.pack newdir <> "..."
        io $ createDirectoryIfMissing True newdir
        diredRefresh

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