{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Dired
( dired
, diredDir
, diredDirBuffer
, editFile
) where
import GHC.Generics (Generic)
import Control.Applicative ((<|>))
import Control.Category ((>>>))
import Control.Exc (orException, printingException)
import Lens.Micro.Platform (makeLenses, use, (%~), (&), (.=), (.~), (^.))
import Control.Monad.Reader (asks, foldM, unless, void, when)
import qualified Data.Attoparsec.Text as P
import Data.Binary (Binary)
import Data.Char (toLower)
import Data.Default (Default, def)
import Data.Foldable (find, foldl')
import Data.List (any, elem, sum, transpose)
import qualified Data.Map as M (Map, assocs, delete, empty,
findWithDefault, fromList,
insert, keys, lookup, map,
mapKeys, union, (!))
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text as T (Text, pack, unpack)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Typeable (Typeable)
import System.CanonicalizePath (canonicalizePath)
import System.Directory (copyFile, createDirectoryIfMissing,
doesDirectoryExist, doesFileExist,
getDirectoryContents, getPermissions,
removeDirectoryRecursive, writable)
import System.FilePath (dropTrailingPathSeparator,
equalFilePath, isAbsolute,
takeDirectory, takeFileName, (</>))
import System.FriendlyPath (userToCanonPath)
import System.PosixCompat.Files (FileStatus, fileExist, fileGroup,
fileMode, fileOwner, fileSize,
getSymbolicLinkStatus,
groupExecuteMode, groupReadMode,
groupWriteMode, isBlockDevice,
isCharacterDevice, isDirectory,
isNamedPipe, isRegularFile, isSocket,
isSymbolicLink, linkCount,
modificationTime, otherExecuteMode,
otherReadMode, otherWriteMode,
ownerExecuteMode, ownerReadMode,
ownerWriteMode, readSymbolicLink,
readSymbolicLink, removeLink, rename,
unionFileModes)
import System.PosixCompat.Types (FileMode, GroupID, UserID)
import System.PosixCompat.User (GroupEntry, GroupEntry (..),
UserEntry (..), getAllGroupEntries,
getAllUserEntries,
getGroupEntryForID,
getUserEntryForID, groupID, userID)
import Text.Printf (printf)
import Yi.Buffer
import Yi.Config (modeTable)
import Yi.Core (errorEditor)
import Yi.Editor
import Yi.Keymap (Keymap, YiM, topKeymapA)
import Yi.Keymap.Keys
import Yi.MiniBuffer (noHint, spawnMinibufferE, withMinibuffer, withMinibufferFree)
import Yi.Misc (getFolder, promptFile)
import Yi.Monad (gets)
import qualified Yi.Rope as R
import Yi.String (showT)
import Yi.Style
import Yi.Types (YiVariable, yiConfig)
import Yi.Utils (io, makeLensesWithSuffix)
#if __GLASGOW_HASKELL__ < 710
import System.Locale (defaultTimeLocale)
import Data.Time (UTCTime, formatTime, getCurrentTime)
#else
import Data.Time (UTCTime, formatTime, getCurrentTime, defaultTimeLocale)
#endif
data DiredOpState = DiredOpState
{ DiredOpState -> Int
_diredOpSucCnt :: !Int
, DiredOpState -> Bool
_diredOpForAll :: Bool
} deriving (Int -> DiredOpState -> ShowS
[DiredOpState] -> ShowS
DiredOpState -> String
(Int -> DiredOpState -> ShowS)
-> (DiredOpState -> String)
-> ([DiredOpState] -> ShowS)
-> Show DiredOpState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredOpState] -> ShowS
$cshowList :: [DiredOpState] -> ShowS
show :: DiredOpState -> String
$cshow :: DiredOpState -> String
showsPrec :: Int -> DiredOpState -> ShowS
$cshowsPrec :: Int -> DiredOpState -> ShowS
Show, DiredOpState -> DiredOpState -> Bool
(DiredOpState -> DiredOpState -> Bool)
-> (DiredOpState -> DiredOpState -> Bool) -> Eq DiredOpState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredOpState -> DiredOpState -> Bool
$c/= :: DiredOpState -> DiredOpState -> Bool
== :: DiredOpState -> DiredOpState -> Bool
$c== :: DiredOpState -> DiredOpState -> Bool
Eq, Typeable, (forall x. DiredOpState -> Rep DiredOpState x)
-> (forall x. Rep DiredOpState x -> DiredOpState)
-> Generic DiredOpState
forall x. Rep DiredOpState x -> DiredOpState
forall x. DiredOpState -> Rep DiredOpState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiredOpState x -> DiredOpState
$cfrom :: forall x. DiredOpState -> Rep DiredOpState x
Generic)
instance Default DiredOpState where
def :: DiredOpState
def = DiredOpState :: Int -> Bool -> DiredOpState
DiredOpState { _diredOpSucCnt :: Int
_diredOpSucCnt = Int
0, _diredOpForAll :: Bool
_diredOpForAll = Bool
False }
instance Binary DiredOpState
instance YiVariable DiredOpState
makeLenses ''DiredOpState
data DiredFileInfo = DiredFileInfo
{ DiredFileInfo -> YiString
permString :: R.YiString
, DiredFileInfo -> Integer
numLinks :: Integer
, DiredFileInfo -> YiString
owner :: R.YiString
, DiredFileInfo -> YiString
grp :: R.YiString
, DiredFileInfo -> Integer
sizeInBytes :: Integer
, DiredFileInfo -> YiString
modificationTimeString :: R.YiString
} deriving (Int -> DiredFileInfo -> ShowS
[DiredFileInfo] -> ShowS
DiredFileInfo -> String
(Int -> DiredFileInfo -> ShowS)
-> (DiredFileInfo -> String)
-> ([DiredFileInfo] -> ShowS)
-> Show DiredFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredFileInfo] -> ShowS
$cshowList :: [DiredFileInfo] -> ShowS
show :: DiredFileInfo -> String
$cshow :: DiredFileInfo -> String
showsPrec :: Int -> DiredFileInfo -> ShowS
$cshowsPrec :: Int -> DiredFileInfo -> ShowS
Show, DiredFileInfo -> DiredFileInfo -> Bool
(DiredFileInfo -> DiredFileInfo -> Bool)
-> (DiredFileInfo -> DiredFileInfo -> Bool) -> Eq DiredFileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredFileInfo -> DiredFileInfo -> Bool
$c/= :: DiredFileInfo -> DiredFileInfo -> Bool
== :: DiredFileInfo -> DiredFileInfo -> Bool
$c== :: DiredFileInfo -> DiredFileInfo -> Bool
Eq, Typeable, (forall x. DiredFileInfo -> Rep DiredFileInfo x)
-> (forall x. Rep DiredFileInfo x -> DiredFileInfo)
-> Generic DiredFileInfo
forall x. Rep DiredFileInfo x -> DiredFileInfo
forall x. DiredFileInfo -> Rep DiredFileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiredFileInfo x -> DiredFileInfo
$cfrom :: forall x. DiredFileInfo -> Rep DiredFileInfo x
Generic)
data DiredEntry
= DiredFile DiredFileInfo
| DiredDir DiredFileInfo
| DiredSymLink DiredFileInfo R.YiString
| DiredSocket DiredFileInfo
| DiredBlockDevice DiredFileInfo
| DiredCharacterDevice DiredFileInfo
| DiredNamedPipe DiredFileInfo
| DiredNoInfo
deriving (Int -> DiredEntry -> ShowS
[DiredEntry] -> ShowS
DiredEntry -> String
(Int -> DiredEntry -> ShowS)
-> (DiredEntry -> String)
-> ([DiredEntry] -> ShowS)
-> Show DiredEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredEntry] -> ShowS
$cshowList :: [DiredEntry] -> ShowS
show :: DiredEntry -> String
$cshow :: DiredEntry -> String
showsPrec :: Int -> DiredEntry -> ShowS
$cshowsPrec :: Int -> DiredEntry -> ShowS
Show, DiredEntry -> DiredEntry -> Bool
(DiredEntry -> DiredEntry -> Bool)
-> (DiredEntry -> DiredEntry -> Bool) -> Eq DiredEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredEntry -> DiredEntry -> Bool
$c/= :: DiredEntry -> DiredEntry -> Bool
== :: DiredEntry -> DiredEntry -> Bool
$c== :: DiredEntry -> DiredEntry -> Bool
Eq, Typeable, (forall x. DiredEntry -> Rep DiredEntry x)
-> (forall x. Rep DiredEntry x -> DiredEntry) -> Generic DiredEntry
forall x. Rep DiredEntry x -> DiredEntry
forall x. DiredEntry -> Rep DiredEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiredEntry x -> DiredEntry
$cfrom :: forall x. DiredEntry -> Rep DiredEntry x
Generic)
type DiredFilePath = R.YiString
type DiredEntries = M.Map DiredFilePath DiredEntry
data DiredState = DiredState
{ DiredState -> String
diredPath :: FilePath
, DiredState -> Map String Char
diredMarks :: M.Map FilePath Char
, DiredState -> DiredEntries
diredEntries :: DiredEntries
, DiredState -> [(Point, Point, String)]
diredFilePoints :: [(Point,Point,FilePath)]
, DiredState -> Int
diredNameCol :: Int
, DiredState -> String
diredCurrFile :: FilePath
} deriving (Int -> DiredState -> ShowS
[DiredState] -> ShowS
DiredState -> String
(Int -> DiredState -> ShowS)
-> (DiredState -> String)
-> ([DiredState] -> ShowS)
-> Show DiredState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiredState] -> ShowS
$cshowList :: [DiredState] -> ShowS
show :: DiredState -> String
$cshow :: DiredState -> String
showsPrec :: Int -> DiredState -> ShowS
$cshowsPrec :: Int -> DiredState -> ShowS
Show, DiredState -> DiredState -> Bool
(DiredState -> DiredState -> Bool)
-> (DiredState -> DiredState -> Bool) -> Eq DiredState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiredState -> DiredState -> Bool
$c/= :: DiredState -> DiredState -> Bool
== :: DiredState -> DiredState -> Bool
$c== :: DiredState -> DiredState -> Bool
Eq, Typeable, (forall x. DiredState -> Rep DiredState x)
-> (forall x. Rep DiredState x -> DiredState) -> Generic DiredState
forall x. Rep DiredState x -> DiredState
forall x. DiredState -> Rep DiredState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiredState x -> DiredState
$cfrom :: forall x. DiredState -> Rep DiredState x
Generic)
makeLensesWithSuffix "A" ''DiredState
instance Binary DiredState
instance Default DiredState where
def :: DiredState
def = DiredState :: String
-> Map String Char
-> DiredEntries
-> [(Point, Point, String)]
-> Int
-> String
-> DiredState
DiredState { diredPath :: String
diredPath = String
forall a. Monoid a => a
mempty
, diredMarks :: Map String Char
diredMarks = Map String Char
forall a. Monoid a => a
mempty
, diredEntries :: DiredEntries
diredEntries = DiredEntries
forall a. Monoid a => a
mempty
, diredFilePoints :: [(Point, Point, String)]
diredFilePoints = [(Point, Point, String)]
forall a. Monoid a => a
mempty
, diredNameCol :: Int
diredNameCol = Int
0
, diredCurrFile :: String
diredCurrFile = String
forall a. Monoid a => a
mempty
}
instance YiVariable DiredState
instance Binary DiredEntry
instance Binary DiredFileInfo
editFile :: FilePath -> YiM (Either T.Text BufferRef)
editFile :: String -> YiM (Either Text BufferRef)
editFile String
filename = do
String
f <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ String -> IO String
userToCanonPath String
filename
[FBuffer]
dupBufs <- (FBuffer -> Bool) -> [FBuffer] -> [FBuffer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
equalFilePath String
f) (Maybe String -> Bool)
-> (FBuffer -> Maybe String) -> FBuffer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBuffer -> Maybe String
file) ([FBuffer] -> [FBuffer]) -> YiM [FBuffer] -> YiM [FBuffer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Editor -> [FBuffer]) -> YiM [FBuffer]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> [FBuffer]
bufferSet
Bool
dirExists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
f
Bool
fileExists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
f
Either Text BufferRef
b <- case [FBuffer]
dupBufs of
[] -> if Bool
dirExists
then BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> Either Text BufferRef)
-> YiM BufferRef -> YiM (Either Text BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> YiM BufferRef
diredDirBuffer String
f
else do
Either Text BufferRef
nb <- if Bool
fileExists
then String -> YiM (Either Text BufferRef)
fileToNewBuffer String
f
else BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> Either Text BufferRef)
-> YiM BufferRef -> YiM (Either Text BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> YiM BufferRef
newEmptyBuffer String
f
case Either Text BufferRef
nb of
Left Text
m -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text BufferRef
forall a b. a -> Either a b
Left Text
m
Right BufferRef
buf -> BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> Either Text BufferRef)
-> YiM BufferRef -> YiM (Either Text BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> BufferRef -> YiM BufferRef
setupMode String
f BufferRef
buf
(FBuffer
h:[FBuffer]
_) -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> (BufferRef -> Either Text BufferRef)
-> BufferRef
-> YiM (Either Text BufferRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right (BufferRef -> YiM (Either Text BufferRef))
-> BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ FBuffer -> BufferRef
bkey FBuffer
h
case Either Text BufferRef
b of
Left Text
m -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text BufferRef
forall a b. a -> Either a b
Left Text
m
Right BufferRef
bf -> EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (BufferRef -> EditorM ()
switchToBufferE BufferRef
bf EditorM () -> EditorM () -> EditorM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM ()
addJumpHereE) YiM ()
-> YiM (Either Text BufferRef) -> YiM (Either Text BufferRef)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text BufferRef -> YiM (Either Text BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return Either Text BufferRef
b
where
fileToNewBuffer :: FilePath -> YiM (Either T.Text BufferRef)
fileToNewBuffer :: String -> YiM (Either Text BufferRef)
fileToNewBuffer String
f = IO UTCTime -> YiM UTCTime
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO UTCTime
getCurrentTime YiM UTCTime
-> (UTCTime -> YiM (Either Text BufferRef))
-> YiM (Either Text BufferRef)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UTCTime
n -> IO (Either Text YiString) -> YiM (Either Text YiString)
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (String -> IO (Either Text YiString)
R.readFile String
f) YiM (Either Text YiString)
-> (Either Text YiString -> YiM (Either Text BufferRef))
-> YiM (Either Text BufferRef)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
m -> Either Text BufferRef -> YiM (Either Text BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text BufferRef
forall a b. a -> Either a b
Left Text
m
Right YiString
contents -> do
Permissions
permissions <- IO Permissions -> YiM Permissions
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Permissions -> YiM Permissions)
-> IO Permissions -> YiM Permissions
forall a b. (a -> b) -> a -> b
$ String -> IO Permissions
getPermissions String
f
BufferRef
b <- BufferId -> YiString -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (String -> BufferId
FileBuffer String
f) YiString
contents
BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
UTCTime -> BufferM ()
markSavedB UTCTime
n
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
writable Permissions
permissions) ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True)
Either Text BufferRef -> YiM (Either Text BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text BufferRef -> YiM (Either Text BufferRef))
-> Either Text BufferRef -> YiM (Either Text BufferRef)
forall a b. (a -> b) -> a -> b
$ BufferRef -> Either Text BufferRef
forall a b. b -> Either a b
Right BufferRef
b
newEmptyBuffer :: FilePath -> YiM BufferRef
newEmptyBuffer :: String -> YiM BufferRef
newEmptyBuffer String
f =
BufferId -> YiString -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (String -> BufferId
FileBuffer String
f) YiString
forall a. Monoid a => a
mempty
setupMode :: FilePath -> BufferRef -> YiM BufferRef
setupMode :: String -> BufferRef -> YiM BufferRef
setupMode String
f BufferRef
b = do
[AnyMode]
tbl <- (Yi -> [AnyMode]) -> YiM [AnyMode]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Config -> [AnyMode]
modeTable (Config -> [AnyMode]) -> (Yi -> Config) -> Yi -> [AnyMode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yi -> Config
yiConfig)
YiString
content <- BufferRef -> BufferM YiString -> YiM YiString
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b BufferM YiString
elemsB
let header :: YiString
header = Int -> YiString -> YiString
R.take Int
1024 YiString
content
pc :: Parser Text Text
pc = Parser Text Text
"-*-" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
P.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Text ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"-*-"
Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text ()
P.skip (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pc
hmode :: Text
hmode = case Parser Text Text -> Text -> Either String Text
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser Text Text
pc (YiString -> Text
R.toText YiString
header) of
Left String
_ -> Text
""
Right Text
str -> Text
str
Just AnyMode
mode = (AnyMode -> Bool) -> [AnyMode] -> Maybe AnyMode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AnyMode Mode syntax
m) -> Mode syntax -> Text
forall syntax. Mode syntax -> Text
modeName Mode syntax
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
hmode) [AnyMode]
tbl Maybe AnyMode -> Maybe AnyMode -> Maybe AnyMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(AnyMode -> Bool) -> [AnyMode] -> Maybe AnyMode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AnyMode Mode syntax
m) -> Mode syntax -> String -> YiString -> Bool
forall syntax. Mode syntax -> String -> YiString -> Bool
modeApplies Mode syntax
m String
f YiString
header) [AnyMode]
tbl Maybe AnyMode -> Maybe AnyMode -> Maybe AnyMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
AnyMode -> Maybe AnyMode
forall a. a -> Maybe a
Just (Mode Any -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode Mode Any
forall syntax. Mode syntax
emptyMode)
case AnyMode
mode of
AnyMode Mode syntax
newMode -> BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Mode syntax -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode syntax
newMode
BufferRef -> YiM BufferRef
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b
bypassReadOnly :: BufferM a -> BufferM a
bypassReadOnly :: BufferM a -> BufferM a
bypassReadOnly BufferM a
f = do Bool
ro <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
readOnlyA
(Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
a
res <- BufferM a
f
(Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
ro
a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
filenameColOf :: BufferM () -> BufferM ()
filenameColOf :: BufferM () -> BufferM ()
filenameColOf BufferM ()
f = BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredState -> (DiredState -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASetter FBuffer FBuffer (Maybe Int) (Maybe Int)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
(.=) ASetter FBuffer FBuffer (Maybe Int) (Maybe Int)
forall c. HasAttributes c => Lens' c (Maybe Int)
preferColA (Maybe Int -> BufferM ())
-> (DiredState -> Maybe Int) -> DiredState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> (DiredState -> Int) -> DiredState -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiredState -> Int
diredNameCol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
f
resetDiredOpState :: YiM ()
resetDiredOpState :: YiM ()
resetDiredOpState = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ DiredOpState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredOpState
forall a. Default a => a
def :: DiredOpState)
incDiredOpSucCnt :: YiM ()
incDiredOpSucCnt :: YiM ()
incDiredOpSucCnt =
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM DiredOpState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredOpState -> (DiredOpState -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredOpState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredOpState -> BufferM ())
-> (DiredOpState -> DiredOpState) -> DiredOpState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Identity Int) -> DiredOpState -> Identity DiredOpState
Lens' DiredOpState Int
diredOpSucCnt ((Int -> Identity Int) -> DiredOpState -> Identity DiredOpState)
-> (Int -> Int) -> DiredOpState -> DiredOpState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int
forall a. Enum a => a -> a
succ)
getDiredOpState :: YiM DiredOpState
getDiredOpState :: YiM DiredOpState
getDiredOpState = BufferM DiredOpState -> YiM DiredOpState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredOpState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM ()
modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM ()
modDiredOpState DiredOpState -> DiredOpState
f = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM DiredOpState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredOpState -> (DiredOpState -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredOpState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredOpState -> BufferM ())
-> (DiredOpState -> DiredOpState) -> DiredOpState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiredOpState -> DiredOpState
f
procDiredOp :: Bool -> [DiredOp] -> YiM ()
procDiredOp :: Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (DORemoveFile String
f:[DiredOp]
ops) = do
IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException (String
"Remove file " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f) (String -> IO ()
removeLink String
f)
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
where postproc :: YiM ()
postproc = do YiM ()
incDiredOpSucCnt
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
f)
procDiredOp Bool
counting (DORemoveDir String
f:[DiredOp]
ops) = do
IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException (String
"Remove directory " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f) (String -> IO ()
removeDirectoryRecursive String
f)
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
where postproc :: YiM ()
postproc = do
YiM ()
incDiredOpSucCnt
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
f)
procDiredOp Bool
_counting (DORemoveBuffer String
_:[DiredOp]
_) = YiM ()
forall a. HasCallStack => a
undefined
procDiredOp Bool
counting (DOCopyFile String
o String
n:[DiredOp]
ops) = do
IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException (String
"Copy file " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
o) (String -> String -> IO ()
copyFile String
o String
n)
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
where postproc :: YiM ()
postproc = do
YiM ()
incDiredOpSucCnt
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
o)
procDiredOp Bool
counting (DOCopyDir String
o String
n:[DiredOp]
ops) = do
[String]
contents <- IO [String] -> YiM [String]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [String] -> YiM [String]) -> IO [String] -> YiM [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String] -> IO [String]
forall a. String -> IO a -> IO a
printingException
([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Copy directory ", String
o, String
" to ", String
n]) IO [String]
doCopy
[DiredOp]
subops <- IO [DiredOp] -> YiM [DiredOp]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [DiredOp] -> YiM [DiredOp]) -> IO [DiredOp] -> YiM [DiredOp]
forall a b. (a -> b) -> a -> b
$ (String -> IO DiredOp) -> [String] -> IO [DiredOp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO DiredOp
builder ([String] -> IO [DiredOp]) -> [String] -> IO [DiredOp]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".", String
".."]) [String]
contents
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
False [DiredOp]
subops
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
where postproc :: YiM ()
postproc = do
YiM ()
incDiredOpSucCnt
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
o)
doCopy :: IO [FilePath]
doCopy :: IO [String]
doCopy = do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
n
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
n
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
n
String -> IO [String]
getDirectoryContents String
o
builder :: FilePath -> IO DiredOp
builder :: String -> IO DiredOp
builder String
name = do
let npath :: String
npath = String
n String -> ShowS
</> String
name
let opath :: String
opath = String
o String -> ShowS
</> String
name
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
opath
DiredOp -> IO DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredOp -> IO DiredOp) -> DiredOp -> IO DiredOp
forall a b. (a -> b) -> a -> b
$ String -> DiredOp -> DiredOp
DOCkOverwrite String
npath (DiredOp -> DiredOp) -> DiredOp -> DiredOp
forall a b. (a -> b) -> a -> b
$ Bool -> String -> String -> DiredOp
getOp Bool
isDir String
opath String
npath
where getOp :: Bool -> String -> String -> DiredOp
getOp Bool
isDir = if Bool
isDir then String -> String -> DiredOp
DOCopyDir else String -> String -> DiredOp
DOCopyFile
procDiredOp Bool
counting (DORename String
o String
n:[DiredOp]
ops) = do
IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
printingException ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Rename ", String
o, String
" to ", String
n]) (String -> String -> IO ()
rename String
o String
n)
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
counting YiM ()
postproc
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
where postproc :: YiM ()
postproc = do
YiM ()
incDiredOpSucCnt
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> BufferM ()
diredUnmarkPath (ShowS
takeFileName String
o)
procDiredOp Bool
counting r :: [DiredOp]
r@(DOConfirm YiString
prompt [DiredOp]
eops [DiredOp]
enops:[DiredOp]
ops) =
Text -> (Text -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
withMinibuffer (YiString -> Text
R.toText (YiString -> Text) -> YiString -> Text
forall a b. (a -> b) -> a -> b
$ YiString
prompt YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" (yes/no)") Text -> YiM [Text]
forall a. a -> YiM [a]
noHint (String -> YiM ()
act (String -> YiM ()) -> (Text -> String) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
where act :: String -> YiM ()
act String
s = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
String
"yes" -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp]
eops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
String
"no" -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp]
enops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
String
_ -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
r
procDiredOp Bool
counting (DOCheck IO Bool
check [DiredOp]
eops [DiredOp]
enops:[DiredOp]
ops) = do
Bool
res <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO Bool
check
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (if Bool
res then [DiredOp]
eops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops else [DiredOp]
enops [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops)
procDiredOp Bool
counting (DOCkOverwrite String
fp DiredOp
op:[DiredOp]
ops) = do
Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
fileExist String
fp
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (if Bool
exists then DiredOp
newOpDiredOp -> [DiredOp] -> [DiredOp]
forall a. a -> [a] -> [a]
:[DiredOp]
ops else DiredOp
opDiredOp -> [DiredOp] -> [DiredOp]
forall a. a -> [a] -> [a]
:[DiredOp]
ops)
where newOp :: DiredOp
newOp = YiString -> DiredOp -> DiredOp
DOChoice (YiString
"Overwrite " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString String
fp YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" ?") DiredOp
op
procDiredOp Bool
counting (DOInput YiString
prompt String -> [DiredOp]
opGen:[DiredOp]
ops) =
Text -> (Text -> YiM ()) -> YiM ()
promptFile (YiString -> Text
R.toText YiString
prompt) (String -> YiM ()
act (String -> YiM ()) -> (Text -> String) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
where act :: String -> YiM ()
act String
s = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting ([DiredOp] -> YiM ()) -> [DiredOp] -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> [DiredOp]
opGen String
s [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [DiredOp]
ops
procDiredOp Bool
counting (DiredOp
DONoOp:[DiredOp]
ops) = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
procDiredOp Bool
counting (DOFeedback DiredOpState -> YiM ()
f:[DiredOp]
ops) =
YiM DiredOpState
getDiredOpState YiM DiredOpState -> (DiredOpState -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredOpState -> YiM ()
f YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
procDiredOp Bool
counting r :: [DiredOp]
r@(DOChoice YiString
prompt DiredOp
op:[DiredOp]
ops) = do
DiredOpState
st <- YiM DiredOpState
getDiredOpState
if DiredOpState
st DiredOpState -> Getting Bool DiredOpState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool DiredOpState Bool
Lens' DiredOpState Bool
diredOpForAll
then YiM ()
proceedYes
else EditorM BufferRef -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m ()
withEditor_ (EditorM BufferRef -> YiM ()) -> EditorM BufferRef -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
msg (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap)
where msg :: Text
msg = YiString -> Text
R.toText (YiString -> Text) -> YiString -> Text
forall a b. (a -> b) -> a -> b
$ YiString
prompt YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" (y/n/!/q/h)"
askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
noAction
, Char -> Event
char Char
'y' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
yesAction
, Char -> Event
char Char
'!' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
allAction
, Char -> Event
char Char
'q' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quit
, Char -> Event
char Char
'h' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
help
]
noAction :: YiM ()
noAction = YiM ()
cleanUp YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
proceedNo
yesAction :: YiM ()
yesAction = YiM ()
cleanUp YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
proceedYes
allAction :: YiM ()
allAction = do YiM ()
cleanUp
(DiredOpState -> DiredOpState) -> YiM ()
modDiredOpState ((Bool -> Identity Bool) -> DiredOpState -> Identity DiredOpState
Lens' DiredOpState Bool
diredOpForAll ((Bool -> Identity Bool) -> DiredOpState -> Identity DiredOpState)
-> Bool -> DiredOpState -> DiredOpState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
YiM ()
proceedYes
quit :: YiM ()
quit = YiM ()
cleanUp YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Quit"
help :: YiM ()
help = do
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg
Text
"y: yes, n: no, !: yes on all remaining items, q: quit, h: help"
YiM ()
cleanUp
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
r
cleanUp :: YiM ()
cleanUp = EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
proceedYes :: YiM ()
proceedYes = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting (DiredOp
opDiredOp -> [DiredOp] -> [DiredOp]
forall a. a -> [a] -> [a]
:[DiredOp]
ops)
proceedNo :: YiM ()
proceedNo = Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
counting [DiredOp]
ops
procDiredOp Bool
_ [DiredOp]
_ = () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
askDelFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askDelFiles :: String -> [(String, DiredEntry)] -> YiM ()
askDelFiles String
dir [(String, DiredEntry)]
fs =
case [(String, DiredEntry)]
fs of
((String, DiredEntry)
_x:[(String, DiredEntry)]
_) -> do
YiM ()
resetDiredOpState
[DiredOp]
opList <- IO [DiredOp] -> YiM [DiredOp]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [DiredOp] -> YiM [DiredOp]) -> IO [DiredOp] -> YiM [DiredOp]
forall a b. (a -> b) -> a -> b
$ [IO DiredOp] -> IO [DiredOp]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO DiredOp]
ops
let ops' :: [DiredOp]
ops' = [DiredOp]
opList [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> [DiredOp] -> [DiredOp] -> DiredOp
DOConfirm YiString
prompt [DiredOp]
ops' [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall (m :: * -> *) p. MonadEditor m => p -> m ()
showNothing]]
[] -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall (m :: * -> *) p. MonadEditor m => p -> m ()
showNothing]
where
prompt :: YiString
prompt = [YiString] -> YiString
R.concat [ YiString
"Delete "
, String -> YiString
R.fromString (String -> YiString) -> (Int -> String) -> Int -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> YiString) -> Int -> YiString
forall a b. (a -> b) -> a -> b
$ [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, DiredEntry)]
fs
, YiString
" file(s)?"
]
ops :: [IO DiredOp]
ops = ((String, DiredEntry) -> IO DiredOp)
-> [(String, DiredEntry)] -> [IO DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (String, DiredEntry) -> IO DiredOp
opGenerator [(String, DiredEntry)]
fs
showResult :: DiredOpState -> YiM ()
showResult DiredOpState
st = do
YiM ()
diredRefresh
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showT (DiredOpState
st DiredOpState -> Getting Int DiredOpState Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int DiredOpState Int
Lens' DiredOpState Int
diredOpSucCnt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" deletions done"
showNothing :: p -> m ()
showNothing p
_ = Text -> m ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"(No deletions requested)"
total :: Int
total = [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, DiredEntry)]
fs
opGenerator :: (FilePath, DiredEntry) -> IO DiredOp
opGenerator :: (String, DiredEntry) -> IO DiredOp
opGenerator (String
fn, DiredEntry
de) = do
Bool
exists <- String -> IO Bool
fileExist String
path
if Bool
exists then case DiredEntry
de of
(DiredDir DiredFileInfo
_dfi) -> do
Bool
isNull <- ([String] -> Bool) -> IO [String] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Bool
nullDir (IO [String] -> IO Bool) -> IO [String] -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
path
DiredOp -> IO DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredOp -> IO DiredOp) -> DiredOp -> IO DiredOp
forall a b. (a -> b) -> a -> b
$ if Bool
isNull then YiString -> [DiredOp] -> [DiredOp] -> DiredOp
DOConfirm YiString
recDelPrompt
[String -> DiredOp
DORemoveDir String
path] [DiredOp
DONoOp]
else String -> DiredOp
DORemoveDir String
path
DiredEntry
_ -> DiredOp -> IO DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DiredOp
DORemoveFile String
path)
else DiredOp -> IO DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return DiredOp
DONoOp
where path :: String
path = String
dir String -> ShowS
</> String
fn
recDelPrompt :: YiString
recDelPrompt = YiString
"Recursive delete of " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString String
fn YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
"?"
nullDir :: [FilePath] -> Bool
nullDir :: [String] -> Bool
nullDir = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem [String
".", String
".."])
diredDoDel :: YiM ()
diredDoDel :: YiM ()
diredDoDel = do
String
dir <- YiM String
currentDir
Maybe (String, DiredEntry)
maybefile <- BufferM (Maybe (String, DiredEntry))
-> YiM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, DiredEntry))
fileFromPoint
case Maybe (String, DiredEntry)
maybefile of
Just (String
fn, DiredEntry
de) -> String -> [(String, DiredEntry)] -> YiM ()
askDelFiles String
dir [(String
fn, DiredEntry
de)]
Maybe (String, DiredEntry)
Nothing -> YiM ()
noFileAtThisLine
diredDoMarkedDel :: YiM ()
diredDoMarkedDel :: YiM ()
diredDoMarkedDel = do
String
dir <- YiM String
currentDir
[(String, DiredEntry)]
fs <- (Char -> Bool) -> YiM [(String, DiredEntry)]
markedFiles (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D')
String -> [(String, DiredEntry)] -> YiM ()
askDelFiles String
dir [(String, DiredEntry)]
fs
diredKeymap :: Keymap -> Keymap
diredKeymap :: KeymapEndo
diredKeymap = I Event Action () -> KeymapEndo
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
important (I Event Action () -> KeymapEndo)
-> I Event Action () -> KeymapEndo
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> I Event Action ()) -> I Event Action ()
withArg Maybe Int -> I Event Action ()
mainMap
where
withArg :: (Maybe Int -> Keymap) -> Keymap
withArg :: (Maybe Int -> I Event Action ()) -> I Event Action ()
withArg Maybe Int -> I Event Action ()
k = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
ctrlCh Char
'u' Event -> KeymapEndo
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>> Maybe Int -> I Event Action ()
k (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) , Maybe Int -> I Event Action ()
k Maybe Int
forall a. Maybe a
Nothing ]
mainMap :: Maybe Int -> Keymap
mainMap :: Maybe Int -> I Event Action ()
mainMap Maybe Int
univArg = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
[ Char -> Event
char Char
'p' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM () -> BufferM ()
filenameColOf BufferM ()
lineUp
, [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char Char
'n', Char -> Event
char Char
' '] I Event Action Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDown
, Char -> Event
char Char
'd' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredMarkDel
, Char -> Event
char Char
'g' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredRefresh
, Char -> Event
char Char
'm' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredMark
, Char -> Event
char Char
'^' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredUpDir
, Char -> Event
char Char
'+' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredCreateDir
, Char -> Event
char Char
'q' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>!
((BufferRef -> EditorM ()
forall (m :: * -> *). MonadEditor m => BufferRef -> m ()
deleteBuffer (BufferRef -> EditorM ()) -> EditorM BufferRef -> EditorM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Editor -> BufferRef) -> EditorM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer) :: EditorM ())
, Char -> Event
char Char
'x' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredDoMarkedDel
, [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Event -> Event
ctrl (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Char -> Event
char Char
'm', Key -> Event
spec Key
KEnter, Char -> Event
char Char
'f', Char -> Event
char Char
'e'] I Event Action Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! YiM ()
diredLoad
, Char -> Event
char Char
'o' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow YiM ()
diredLoad
, Char -> Event
char Char
'u' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Direction -> BufferM ()
diredUnmark Direction
Forward
, Key -> Event
spec Key
KBS Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Direction -> BufferM ()
diredUnmark Direction
Backward
, Char -> Event
char Char
'D' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredDoDel
, Char -> Event
char Char
'U' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredUnmarkAll
, Char -> Event
char Char
'R' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredRename
, Char -> Event
char Char
'C' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
diredCopy
, Char -> Event
char Char
'*' Event -> KeymapEndo
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>> Maybe Int -> I Event Action ()
multiMarks Maybe Int
univArg
]
multiMarks :: Maybe Int -> Keymap
multiMarks :: Maybe Int -> I Event Action ()
multiMarks Maybe Int
univArg = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
[ Char -> Event
char Char
'!' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredUnmarkAll
, Char -> Event
char Char
'@' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Maybe Int -> BufferM ()
diredMarkSymlinks Maybe Int
univArg
, Char -> Event
char Char
'/' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Maybe Int -> BufferM ()
diredMarkDirectories Maybe Int
univArg
, Char -> Event
char Char
't' Event -> BufferM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
diredToggleAllMarks
]
dired :: YiM ()
dired :: YiM ()
dired = do
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Dired..."
Maybe String
maybepath <- BufferM (Maybe String) -> YiM (Maybe String)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe String) -> YiM (Maybe String))
-> BufferM (Maybe String) -> YiM (Maybe String)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe String) -> BufferM (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe String
file
String
dir <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ Maybe String -> IO String
getFolder Maybe String
maybepath
YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> YiM (Either Text BufferRef) -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> YiM (Either Text BufferRef)
editFile String
dir
diredDir :: FilePath -> YiM ()
diredDir :: String -> YiM ()
diredDir String
dir = YiM BufferRef -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> YiM BufferRef
diredDirBuffer String
dir)
diredDirBuffer :: FilePath -> YiM BufferRef
diredDirBuffer :: String -> YiM BufferRef
diredDirBuffer String
d = do
String
dir <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
d
BufferRef
b <- BufferId -> YiString -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (String -> BufferId
FileBuffer String
dir) YiString
forall a. Monoid a => a
mempty
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> EditorM ()
switchToBufferE BufferRef
b
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
DiredState
state <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
state DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> DiredState -> Identity DiredState
Lens' DiredState String
diredPathA ((String -> Identity String) -> DiredState -> Identity DiredState)
-> String -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
dir)
(Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
directoryContentA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
YiM ()
diredRefresh
BufferRef -> YiM BufferRef
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b
diredRefresh :: YiM ()
diredRefresh :: YiM ()
diredRefresh = do
DiredState
dState <- BufferM DiredState -> YiM DiredState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
let dir :: String
dir = DiredState -> String
diredPath DiredState
dState
DiredEntries
di <- IO DiredEntries -> YiM DiredEntries
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO DiredEntries -> YiM DiredEntries)
-> IO DiredEntries -> YiM DiredEntries
forall a b. (a -> b) -> a -> b
$ String -> IO DiredEntries
diredScanDir String
dir
String
currFile <- if [(Point, Point, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DiredState -> [(Point, Point, String)]
diredFilePoints DiredState
dState)
then String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
else do Maybe (String, DiredEntry)
maybefile <- BufferM (Maybe (String, DiredEntry))
-> YiM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, DiredEntry))
fileFromPoint
case Maybe (String, DiredEntry)
maybefile of
Just (String
fp, DiredEntry
_) -> String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fp
Maybe (String, DiredEntry)
Nothing -> String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
let ds :: DiredState
ds = (DiredEntries -> Identity DiredEntries)
-> DiredState -> Identity DiredState
Lens' DiredState DiredEntries
diredEntriesA ((DiredEntries -> Identity DiredEntries)
-> DiredState -> Identity DiredState)
-> DiredEntries -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DiredEntries
di (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ (String -> Identity String) -> DiredState -> Identity DiredState
Lens' DiredState String
diredCurrFileA ((String -> Identity String) -> DiredState -> Identity DiredState)
-> String -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
currFile (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ DiredState
dState
let dlines :: [([DRStrings], StyleName, YiString)]
dlines = DiredState -> [([DRStrings], StyleName, YiString)]
linesToDisplay DiredState
ds
([[DRStrings]]
strss, [StyleName]
stys, [YiString]
strs) = [([DRStrings], StyleName, YiString)]
-> ([[DRStrings]], [StyleName], [YiString])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([DRStrings], StyleName, YiString)]
dlines
strss' :: [[YiString]]
strss' = [[YiString]] -> [[YiString]]
forall a. [[a]] -> [[a]]
transpose ([[YiString]] -> [[YiString]]) -> [[YiString]] -> [[YiString]]
forall a b. (a -> b) -> a -> b
$ ([DRStrings] -> [YiString]) -> [[DRStrings]] -> [[YiString]]
forall a b. (a -> b) -> [a] -> [b]
map [DRStrings] -> [YiString]
doPadding ([[DRStrings]] -> [[YiString]]) -> [[DRStrings]] -> [[YiString]]
forall a b. (a -> b) -> a -> b
$ [[DRStrings]] -> [[DRStrings]]
forall a. [[a]] -> [[a]]
transpose [[DRStrings]]
strss
namecol :: Int
namecol = if [[YiString]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[YiString]]
strss' then Int
0 else
let l1details :: [YiString]
l1details = [YiString] -> [YiString]
forall a. [a] -> [a]
init ([YiString] -> [YiString]) -> [YiString] -> [YiString]
forall a b. (a -> b) -> a -> b
$ [[YiString]] -> [YiString]
forall a. [a] -> a
head [[YiString]]
strss'
in [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Data.List.sum ((YiString -> Int) -> [YiString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map YiString -> Int
R.length [YiString]
l1details) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [YiString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [YiString]
l1details
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
(Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> BufferM Region
regionOfB TextUnit
Document
YiString -> BufferM ()
insertN (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ String -> YiString
R.fromString String
dir YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
":\n"
Point
p <- BufferM Point
pointB
Overlay -> BufferM ()
addOverlayB (Overlay -> BufferM ()) -> Overlay -> BufferM ()
forall a b. (a -> b) -> a -> b
$ YiString -> Region -> StyleName -> YiString -> Overlay
mkOverlay YiString
"dired" (Point -> Point -> Region
mkRegion Point
0 (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
2)) StyleName
forall b. b -> Style
headStyle YiString
""
[(Point, Point, String)]
ptsList <- (([YiString], StyleName, YiString)
-> BufferM (Point, Point, String))
-> [([YiString], StyleName, YiString)]
-> BufferM [(Point, Point, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([YiString], StyleName, YiString) -> BufferM (Point, Point, String)
insertDiredLine ([([YiString], StyleName, YiString)]
-> BufferM [(Point, Point, String)])
-> [([YiString], StyleName, YiString)]
-> BufferM [(Point, Point, String)]
forall a b. (a -> b) -> a -> b
$ [[YiString]]
-> [StyleName] -> [YiString] -> [([YiString], StyleName, YiString)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[YiString]]
strss' [StyleName]
stys [YiString]
strs
DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState -> BufferM ()) -> DiredState -> BufferM ()
forall a b. (a -> b) -> a -> b
$ ([(Point, Point, String)] -> Identity [(Point, Point, String)])
-> DiredState -> Identity DiredState
Lens' DiredState [(Point, Point, String)]
diredFilePointsA (([(Point, Point, String)] -> Identity [(Point, Point, String)])
-> DiredState -> Identity DiredState)
-> [(Point, Point, String)] -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Point, Point, String)]
ptsList (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ (Int -> Identity Int) -> DiredState -> Identity DiredState
Lens' DiredState Int
diredNameColA ((Int -> Identity Int) -> DiredState -> Identity DiredState)
-> Int -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
namecol (DiredState -> DiredState) -> DiredState -> DiredState
forall a b. (a -> b) -> a -> b
$ DiredState
ds
(forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
modifyMode ((forall syntax. Mode syntax -> Mode syntax) -> BufferM ())
-> (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
forall a b. (a -> b) -> a -> b
$ ((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
-> Mode syntax -> Identity (Mode syntax)
forall syntax. Lens' (Mode syntax) (KeymapSet -> KeymapSet)
modeKeymapA (((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
-> Mode syntax -> Identity (Mode syntax))
-> (KeymapSet -> KeymapSet) -> Mode syntax -> Mode syntax
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (I Event Action () -> Identity (I Event Action ()))
-> KeymapSet -> Identity KeymapSet
Lens' KeymapSet (I Event Action ())
topKeymapA ((I Event Action () -> Identity (I Event Action ()))
-> KeymapSet -> Identity KeymapSet)
-> KeymapEndo -> KeymapSet -> KeymapSet
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeymapEndo
diredKeymap
(Mode syntax -> Mode syntax)
-> (Mode syntax -> Mode syntax) -> Mode syntax -> Mode syntax
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> Identity Text) -> Mode syntax -> Identity (Mode syntax)
forall syntax. Lens' (Mode syntax) Text
modeNameA ((Text -> Identity Text) -> Mode syntax -> Identity (Mode syntax))
-> Text -> Mode syntax -> Mode syntax
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"dired"
BufferM ()
diredRefreshMark
(Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
currFile) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
2)
case String -> [(Point, Point, String)] -> Maybe Point
forall a b b. Eq a => a -> [(b, b, a)] -> Maybe b
getRow String
currFile [(Point, Point, String)]
ptsList of
Just Point
rpos -> BufferM () -> BufferM ()
filenameColOf (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo Point
rpos
Maybe Point
Nothing -> BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDown
where
getRow :: a -> [(b, b, a)] -> Maybe b
getRow a
fp [(b, b, a)]
recList = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
fp (((b, b, a) -> (a, b)) -> [(b, b, a)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
a,b
_b,a
c)->(a
c,b
a)) [(b, b, a)]
recList)
headStyle :: b -> Style
headStyle = Style -> b -> Style
forall a b. a -> b -> a
const (Color -> Style
withFg Color
grey)
doPadding :: [DRStrings] -> [R.YiString]
doPadding :: [DRStrings] -> [YiString]
doPadding [DRStrings]
drs = (DRStrings -> YiString) -> [DRStrings] -> [YiString]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> DRStrings -> YiString
pad (([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([DRStrings] -> [Int]) -> [DRStrings] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRStrings -> Int) -> [DRStrings] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map DRStrings -> Int
drlength) [DRStrings]
drs)) [DRStrings]
drs
pad :: Int -> DRStrings -> YiString
pad Int
_n (DRPerms YiString
s) = YiString
s
pad Int
n (DRLinks YiString
s) = Int -> YiString -> YiString
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s
pad Int
n (DROwners YiString
s) = YiString
s YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> Int -> YiString -> YiString
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" "
pad Int
n (DRGroups YiString
s) = YiString
s YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> Int -> YiString -> YiString
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- YiString -> Int
R.length YiString
s)) YiString
" "
pad Int
n (DRSizes YiString
s) = Int -> YiString -> YiString
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s
pad Int
n (DRDates YiString
s) = Int -> YiString -> YiString
R.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- YiString -> Int
R.length YiString
s)) YiString
" " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s
pad Int
_n (DRFiles YiString
s) = YiString
s
drlength :: DRStrings -> Int
drlength = YiString -> Int
R.length (YiString -> Int) -> (DRStrings -> YiString) -> DRStrings -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRStrings -> YiString
undrs
insertDiredLine :: ([R.YiString], StyleName, R.YiString)
-> BufferM (Point, Point, FilePath)
insertDiredLine :: ([YiString], StyleName, YiString) -> BufferM (Point, Point, String)
insertDiredLine ([YiString]
fields, StyleName
sty, YiString
filenm) = BufferM (Point, Point, String) -> BufferM (Point, Point, String)
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM (Point, Point, String) -> BufferM (Point, Point, String))
-> BufferM (Point, Point, String) -> BufferM (Point, Point, String)
forall a b. (a -> b) -> a -> b
$ do
YiString -> BufferM ()
insertN (YiString -> BufferM ())
-> ([YiString] -> YiString) -> [YiString] -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YiString] -> YiString
R.unwords ([YiString] -> BufferM ()) -> [YiString] -> BufferM ()
forall a b. (a -> b) -> a -> b
$ [YiString] -> [YiString]
forall a. [a] -> [a]
init [YiString]
fields
Point
p1 <- BufferM Point
pointB
YiString -> BufferM ()
insertN (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> YiString -> YiString
`R.cons` [YiString] -> YiString
forall a. [a] -> a
last [YiString]
fields
Point
p2 <- BufferM Point
pointB
BufferM ()
newlineB
Overlay -> BufferM ()
addOverlayB (YiString -> Region -> StyleName -> YiString -> Overlay
mkOverlay YiString
"dired" (Point -> Point -> Region
mkRegion Point
p1 Point
p2) StyleName
sty YiString
"")
(Point, Point, String) -> BufferM (Point, Point, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
p1, Point
p2, YiString -> String
R.toString YiString
filenm)
data DRStrings = DRPerms {DRStrings -> YiString
undrs :: R.YiString}
| DRLinks {undrs :: R.YiString}
| DROwners {undrs :: R.YiString}
| DRGroups {undrs :: R.YiString}
| DRSizes {undrs :: R.YiString}
| DRDates {undrs :: R.YiString}
| DRFiles {undrs :: R.YiString}
linesToDisplay :: DiredState -> [([DRStrings], StyleName, R.YiString)]
linesToDisplay :: DiredState -> [([DRStrings], StyleName, YiString)]
linesToDisplay DiredState
dState = ((YiString, DiredEntry) -> ([DRStrings], StyleName, YiString))
-> [(YiString, DiredEntry)] -> [([DRStrings], StyleName, YiString)]
forall a b. (a -> b) -> [a] -> [b]
map ((YiString -> DiredEntry -> ([DRStrings], StyleName, YiString))
-> (YiString, DiredEntry) -> ([DRStrings], StyleName, YiString)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry YiString -> DiredEntry -> ([DRStrings], StyleName, YiString)
lineToDisplay) (DiredEntries -> [(YiString, DiredEntry)]
forall k a. Map k a -> [(k, a)]
M.assocs DiredEntries
entries)
where
entries :: DiredEntries
entries = DiredState -> DiredEntries
diredEntries DiredState
dState
lineToDisplay :: YiString -> DiredEntry -> ([DRStrings], StyleName, YiString)
lineToDisplay YiString
k (DiredFile DiredFileInfo
v) =
(YiString -> DiredFileInfo -> [DRStrings]
l YiString
" -" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [YiString -> DRStrings
DRFiles YiString
k], StyleName
defaultStyle, YiString
k)
lineToDisplay YiString
k (DiredDir DiredFileInfo
v) =
(YiString -> DiredFileInfo -> [DRStrings]
l YiString
" d" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [YiString -> DRStrings
DRFiles YiString
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
blue), YiString
k)
lineToDisplay YiString
k (DiredSymLink DiredFileInfo
v YiString
s) =
(YiString -> DiredFileInfo -> [DRStrings]
l YiString
" l" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [YiString -> DRStrings
DRFiles (YiString -> DRStrings) -> YiString -> DRStrings
forall a b. (a -> b) -> a -> b
$ YiString
k YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" -> " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
s], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
cyan), YiString
k)
lineToDisplay YiString
k (DiredSocket DiredFileInfo
v) =
(YiString -> DiredFileInfo -> [DRStrings]
l YiString
" s" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [YiString -> DRStrings
DRFiles YiString
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
magenta), YiString
k)
lineToDisplay YiString
k (DiredCharacterDevice DiredFileInfo
v) =
(YiString -> DiredFileInfo -> [DRStrings]
l YiString
" c" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [YiString -> DRStrings
DRFiles YiString
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
yellow), YiString
k)
lineToDisplay YiString
k (DiredBlockDevice DiredFileInfo
v) =
(YiString -> DiredFileInfo -> [DRStrings]
l YiString
" b" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [YiString -> DRStrings
DRFiles YiString
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
yellow), YiString
k)
lineToDisplay YiString
k (DiredNamedPipe DiredFileInfo
v) =
(YiString -> DiredFileInfo -> [DRStrings]
l YiString
" p" DiredFileInfo
v [DRStrings] -> [DRStrings] -> [DRStrings]
forall a. Semigroup a => a -> a -> a
<> [YiString -> DRStrings
DRFiles YiString
k], Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
brown), YiString
k)
lineToDisplay YiString
k DiredEntry
DiredNoInfo =
([YiString -> DRStrings
DRFiles (YiString -> DRStrings) -> YiString -> DRStrings
forall a b. (a -> b) -> a -> b
$ YiString
k YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" : Not a file/dir/symlink"], StyleName
defaultStyle, YiString
k)
l :: YiString -> DiredFileInfo -> [DRStrings]
l YiString
pre DiredFileInfo
v = [YiString -> DRStrings
DRPerms (YiString -> DRStrings) -> YiString -> DRStrings
forall a b. (a -> b) -> a -> b
$ YiString
pre YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> DiredFileInfo -> YiString
permString DiredFileInfo
v,
YiString -> DRStrings
DRLinks (YiString -> DRStrings)
-> (String -> YiString) -> String -> DRStrings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> YiString
R.fromString (String -> DRStrings) -> String -> DRStrings
forall a b. (a -> b) -> a -> b
$ String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%4d" (DiredFileInfo -> Integer
numLinks DiredFileInfo
v),
YiString -> DRStrings
DROwners (YiString -> DRStrings) -> YiString -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFileInfo -> YiString
owner DiredFileInfo
v,
YiString -> DRStrings
DRGroups (YiString -> DRStrings) -> YiString -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFileInfo -> YiString
grp DiredFileInfo
v,
YiString -> DRStrings
DRSizes (YiString -> DRStrings)
-> (String -> YiString) -> String -> DRStrings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> YiString
R.fromString (String -> DRStrings) -> String -> DRStrings
forall a b. (a -> b) -> a -> b
$ String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%8d" (DiredFileInfo -> Integer
sizeInBytes DiredFileInfo
v),
YiString -> DRStrings
DRDates (YiString -> DRStrings) -> YiString -> DRStrings
forall a b. (a -> b) -> a -> b
$ DiredFileInfo -> YiString
modificationTimeString DiredFileInfo
v]
diredScanDir :: FilePath -> IO DiredEntries
diredScanDir :: String -> IO DiredEntries
diredScanDir String
dir = do
[String]
files <- String -> IO [String]
getDirectoryContents String
dir
(DiredEntries -> String -> IO DiredEntries)
-> DiredEntries -> [String] -> IO DiredEntries
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (String -> DiredEntries -> String -> IO DiredEntries
lineForFile String
dir) DiredEntries
forall k a. Map k a
M.empty [String]
files
where
lineForFile :: FilePath
-> DiredEntries
-> FilePath
-> IO DiredEntries
lineForFile :: String -> DiredEntries -> String -> IO DiredEntries
lineForFile String
d DiredEntries
m String
f = do
let fp :: String
fp = String
d String -> ShowS
</> String
f
FileStatus
fileStatus <- String -> IO FileStatus
getSymbolicLinkStatus String
fp
DiredFileInfo
dfi <- String -> FileStatus -> IO DiredFileInfo
lineForFilePath String
fp FileStatus
fileStatus
let islink :: Bool
islink = FileStatus -> Bool
isSymbolicLink FileStatus
fileStatus
String
linkTarget <- if Bool
islink then String -> IO String
readSymbolicLink String
fp else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
forall a. Monoid a => a
mempty
let de :: DiredEntry
de
| FileStatus -> Bool
isDirectory FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredDir DiredFileInfo
dfi
| FileStatus -> Bool
isRegularFile FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredFile DiredFileInfo
dfi
| Bool
islink = DiredFileInfo -> YiString -> DiredEntry
DiredSymLink DiredFileInfo
dfi (String -> YiString
R.fromString String
linkTarget)
| FileStatus -> Bool
isSocket FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredSocket DiredFileInfo
dfi
| FileStatus -> Bool
isCharacterDevice FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredCharacterDevice DiredFileInfo
dfi
| FileStatus -> Bool
isBlockDevice FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredBlockDevice DiredFileInfo
dfi
| FileStatus -> Bool
isNamedPipe FileStatus
fileStatus = DiredFileInfo -> DiredEntry
DiredNamedPipe DiredFileInfo
dfi
| Bool
otherwise = DiredEntry
DiredNoInfo
DiredEntries -> IO DiredEntries
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredEntries -> IO DiredEntries)
-> DiredEntries -> IO DiredEntries
forall a b. (a -> b) -> a -> b
$ YiString -> DiredEntry -> DiredEntries -> DiredEntries
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> YiString
R.fromString String
f) DiredEntry
de DiredEntries
m
lineForFilePath :: FilePath -> FileStatus -> IO DiredFileInfo
lineForFilePath :: String -> FileStatus -> IO DiredFileInfo
lineForFilePath String
fp FileStatus
fileStatus = do
let modTimeStr :: YiString
modTimeStr = String -> YiString
R.fromString (String -> YiString)
-> (EpochTime -> String) -> EpochTime -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
shortCalendarTimeToString
(UTCTime -> String)
-> (EpochTime -> UTCTime) -> EpochTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (EpochTime -> POSIXTime) -> EpochTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
(EpochTime -> YiString) -> EpochTime -> YiString
forall a b. (a -> b) -> a -> b
$ FileStatus -> EpochTime
modificationTime FileStatus
fileStatus
let uid :: UserID
uid = FileStatus -> UserID
fileOwner FileStatus
fileStatus
gid :: GroupID
gid = FileStatus -> GroupID
fileGroup FileStatus
fileStatus
fn :: String
fn = ShowS
takeFileName String
fp
String
_filenm <- if FileStatus -> Bool
isSymbolicLink FileStatus
fileStatus
then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> ShowS -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
fn String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" -> ") String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
readSymbolicLink String
fp
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fn
UserEntry
ownerEntry <- IO UserEntry -> IO UserEntry -> IO UserEntry
forall a. IO a -> IO a -> IO a
orException (UserID -> IO UserEntry
getUserEntryForID UserID
uid)
(([UserEntry] -> UserEntry) -> IO [UserEntry] -> IO UserEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UserID -> [UserEntry] -> UserEntry
scanForUid UserID
uid) IO [UserEntry]
getAllUserEntries)
GroupEntry
groupEntry <- IO GroupEntry -> IO GroupEntry -> IO GroupEntry
forall a. IO a -> IO a -> IO a
orException (GroupID -> IO GroupEntry
getGroupEntryForID GroupID
gid)
(([GroupEntry] -> GroupEntry) -> IO [GroupEntry] -> IO GroupEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroupID -> [GroupEntry] -> GroupEntry
scanForGid GroupID
gid) IO [GroupEntry]
getAllGroupEntries)
let fmodeStr :: YiString
fmodeStr = (FileMode -> YiString
modeString (FileMode -> YiString)
-> (FileStatus -> FileMode) -> FileStatus -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileMode
fileMode) FileStatus
fileStatus
sz :: Integer
sz = FileOffset -> Integer
forall a. Integral a => a -> Integer
toInteger (FileOffset -> Integer) -> FileOffset -> Integer
forall a b. (a -> b) -> a -> b
$ FileStatus -> FileOffset
fileSize FileStatus
fileStatus
ownerStr :: YiString
ownerStr = String -> YiString
R.fromString (String -> YiString) -> String -> YiString
forall a b. (a -> b) -> a -> b
$ UserEntry -> String
userName UserEntry
ownerEntry
groupStr :: YiString
groupStr = String -> YiString
R.fromString (String -> YiString) -> String -> YiString
forall a b. (a -> b) -> a -> b
$ GroupEntry -> String
groupName GroupEntry
groupEntry
numOfLinks :: Integer
numOfLinks = LinkCount -> Integer
forall a. Integral a => a -> Integer
toInteger (LinkCount -> Integer) -> LinkCount -> Integer
forall a b. (a -> b) -> a -> b
$ FileStatus -> LinkCount
linkCount FileStatus
fileStatus
DiredFileInfo -> IO DiredFileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DiredFileInfo :: YiString
-> Integer
-> YiString
-> YiString
-> Integer
-> YiString
-> DiredFileInfo
DiredFileInfo { permString :: YiString
permString = YiString
fmodeStr
, numLinks :: Integer
numLinks = Integer
numOfLinks
, owner :: YiString
owner = YiString
ownerStr
, grp :: YiString
grp = YiString
groupStr
, sizeInBytes :: Integer
sizeInBytes = Integer
sz
, modificationTimeString :: YiString
modificationTimeString = YiString
modTimeStr}
scanForUid :: UserID -> [UserEntry] -> UserEntry
scanForUid :: UserID -> [UserEntry] -> UserEntry
scanForUid UserID
uid [UserEntry]
entries = UserEntry -> Maybe UserEntry -> UserEntry
forall a. a -> Maybe a -> a
fromMaybe UserEntry
missingEntry (Maybe UserEntry -> UserEntry) -> Maybe UserEntry -> UserEntry
forall a b. (a -> b) -> a -> b
$
(UserEntry -> Bool) -> [UserEntry] -> Maybe UserEntry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((UserID
uid UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
==) (UserID -> Bool) -> (UserEntry -> UserID) -> UserEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserEntry -> UserID
userID) [UserEntry]
entries
where
missingEntry :: UserEntry
missingEntry = String
-> String
-> UserID
-> GroupID
-> String
-> String
-> String
-> UserEntry
UserEntry String
"?" String
forall a. Monoid a => a
mempty UserID
uid GroupID
0 String
forall a. Monoid a => a
mempty String
forall a. Monoid a => a
mempty String
forall a. Monoid a => a
mempty
scanForGid :: GroupID -> [GroupEntry] -> GroupEntry
scanForGid :: GroupID -> [GroupEntry] -> GroupEntry
scanForGid GroupID
gid [GroupEntry]
entries = GroupEntry -> Maybe GroupEntry -> GroupEntry
forall a. a -> Maybe a -> a
fromMaybe GroupEntry
missingEntry (Maybe GroupEntry -> GroupEntry) -> Maybe GroupEntry -> GroupEntry
forall a b. (a -> b) -> a -> b
$
(GroupEntry -> Bool) -> [GroupEntry] -> Maybe GroupEntry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((GroupID
gid GroupID -> GroupID -> Bool
forall a. Eq a => a -> a -> Bool
==) (GroupID -> Bool) -> (GroupEntry -> GroupID) -> GroupEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupEntry -> GroupID
groupID) [GroupEntry]
entries
where
missingEntry :: GroupEntry
missingEntry = String -> String -> GroupID -> [String] -> GroupEntry
GroupEntry String
"?" String
forall a. Monoid a => a
mempty GroupID
gid [String]
forall a. Monoid a => a
mempty
modeString :: FileMode -> R.YiString
modeString :: FileMode -> YiString
modeString FileMode
fm = YiString
""
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"r" FileMode
ownerReadMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"w" FileMode
ownerWriteMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"x" FileMode
ownerExecuteMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"r" FileMode
groupReadMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"w" FileMode
groupWriteMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"x" FileMode
groupExecuteMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"r" FileMode
otherReadMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"w" FileMode
otherWriteMode
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> FileMode -> YiString
forall p. IsString p => p -> FileMode -> p
strIfSet YiString
"x" FileMode
otherExecuteMode
where
strIfSet :: p -> FileMode -> p
strIfSet p
s FileMode
mode = if FileMode
fm FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== (FileMode
fm FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
mode) then p
s else p
"-"
shortCalendarTimeToString :: UTCTime -> String
shortCalendarTimeToString :: UTCTime -> String
shortCalendarTimeToString = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%b %d %H:%M"
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
diredMarkKind :: Maybe Int
-> (DiredFilePath -> DiredEntry -> Bool)
-> Char
-> BufferM ()
diredMarkKind :: Maybe Int -> (YiString -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m YiString -> DiredEntry -> Bool
p Char
c = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
let es :: [(YiString, DiredEntry)]
es = DiredEntries -> [(YiString, DiredEntry)]
forall k a. Map k a -> [(k, a)]
M.assocs (DiredEntries -> [(YiString, DiredEntry)])
-> DiredEntries -> [(YiString, DiredEntry)]
forall a b. (a -> b) -> a -> b
$ DiredState -> DiredEntries
diredEntries DiredState
dState
ms :: Map String Char
ms = [(String, Char)] -> Map String Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (YiString -> String
R.toString YiString
fp, Char
c) | (YiString
fp, DiredEntry
e) <- [(YiString, DiredEntry)]
es, YiString -> DiredEntry -> Bool
p YiString
fp DiredEntry
e ]
DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
dState DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map String Char -> Map String Char -> Map String Char
run Map String Char
ms)
BufferM ()
diredRefreshMark
where
run :: M.Map FilePath Char -> M.Map FilePath Char -> M.Map FilePath Char
run :: Map String Char -> Map String Char -> Map String Char
run Map String Char
ms Map String Char
cms = case Maybe Int
m of
Maybe Int
Nothing -> Map String Char -> Map String Char -> Map String Char
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map String Char
ms Map String Char
cms
Just Int
_ -> Map String Char -> [String] -> Map String Char
forall k v. Ord k => Map k v -> [k] -> Map k v
deleteKeys Map String Char
cms (Map String Char -> [String]
forall k a. Map k a -> [k]
M.keys Map String Char
ms)
diredMarkSymlinks :: Maybe Int -> BufferM ()
diredMarkSymlinks :: Maybe Int -> BufferM ()
diredMarkSymlinks Maybe Int
m = Maybe Int -> (YiString -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m YiString -> DiredEntry -> Bool
forall p. p -> DiredEntry -> Bool
p Char
'*'
where
p :: p -> DiredEntry -> Bool
p p
_ DiredSymLink {} = Bool
True
p p
_ DiredEntry
_ = Bool
False
diredMarkDirectories :: Maybe Int -> BufferM ()
diredMarkDirectories :: Maybe Int -> BufferM ()
diredMarkDirectories Maybe Int
m = Maybe Int -> (YiString -> DiredEntry -> Bool) -> Char -> BufferM ()
diredMarkKind Maybe Int
m YiString -> DiredEntry -> Bool
forall a. (Eq a, IsString a) => a -> DiredEntry -> Bool
p Char
'*'
where
p :: a -> DiredEntry -> Bool
p a
"." DiredDir {} = Bool
False
p a
".." DiredDir {} = Bool
False
p a
_ DiredDir {} = Bool
True
p a
_ DiredEntry
_ = Bool
False
diredToggleAllMarks :: BufferM ()
diredToggleAllMarks :: BufferM ()
diredToggleAllMarks = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
let es :: DiredEntries
es = DiredState -> DiredEntries
diredEntries DiredState
dState
DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
dState DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DiredEntries -> Map String Char -> Map String Char
tm DiredEntries
es)
BufferM ()
diredRefreshMark
where
tm :: DiredEntries -> M.Map FilePath Char -> M.Map FilePath Char
tm :: DiredEntries -> Map String Char -> Map String Char
tm DiredEntries
de Map String Char
ms = let unmarked :: Map String DiredEntry
unmarked = Map String DiredEntry -> [String] -> Map String DiredEntry
forall k v. Ord k => Map k v -> [k] -> Map k v
deleteKeys ((YiString -> String) -> DiredEntries -> Map String DiredEntry
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys YiString -> String
R.toString DiredEntries
de) (Map String Char -> [String]
forall k a. Map k a -> [k]
M.keys Map String Char
ms)
in (DiredEntry -> Char) -> Map String DiredEntry -> Map String Char
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Char -> DiredEntry -> Char
forall a b. a -> b -> a
const Char
'*') Map String DiredEntry
unmarked
deleteKeys :: Ord k => M.Map k v -> [k] -> M.Map k v
deleteKeys :: Map k v -> [k] -> Map k v
deleteKeys = (Map k v -> k -> Map k v) -> Map k v -> [k] -> Map k v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((k -> Map k v -> Map k v) -> Map k v -> k -> Map k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> Map k v -> Map k v
forall k a. Ord k => k -> Map k a -> Map k a
M.delete)
diredMarkWithChar :: Char -> BufferM () -> BufferM ()
diredMarkWithChar :: Char -> BufferM () -> BufferM ()
diredMarkWithChar Char
c BufferM ()
mv = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
BufferM (Maybe (String, DiredEntry))
fileFromPoint BufferM (Maybe (String, DiredEntry))
-> (Maybe (String, DiredEntry) -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (String
fn, DiredEntry
_de) -> do
DiredState
state <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn (DiredState
state DiredState -> (DiredState -> DiredState) -> DiredState
forall a b. a -> (a -> b) -> b
& (Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> Char -> Map String Char -> Map String Char
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
fn Char
c)
BufferM () -> BufferM ()
filenameColOf BufferM ()
mv
BufferM ()
diredRefreshMark
Maybe (String, DiredEntry)
Nothing -> BufferM () -> BufferM ()
filenameColOf BufferM ()
mv
diredRefreshMark :: BufferM ()
diredRefreshMark :: BufferM ()
diredRefreshMark = do
Point
b <- BufferM Point
pointB
DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
let posDict :: [(Point, Point, String)]
posDict = DiredState -> [(Point, Point, String)]
diredFilePoints DiredState
dState
markMap :: Map String Char
markMap = DiredState -> Map String Char
diredMarks DiredState
dState
draw :: (Point, b, String) -> BufferM ()
draw (Point
pos, b
_, String
fn) = case String -> Map String Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
fn Map String Char
markMap of
Just Char
mark -> do
Point -> BufferM ()
moveTo Point
pos BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> BufferM ()
insertB Char
mark BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
deleteN Int
1
Point
e <- BufferM Point
pointB
Overlay -> BufferM ()
addOverlayB (Overlay -> BufferM ()) -> Overlay -> BufferM ()
forall a b. (a -> b) -> a -> b
$
YiString -> Region -> StyleName -> YiString -> Overlay
mkOverlay YiString
"dired" (Point -> Point -> Region
mkRegion (Point
e Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
1) Point
e) (Char -> StyleName
styleOfMark Char
mark) YiString
""
Maybe Char
Nothing ->
Point -> BufferM ()
moveTo Point
pos BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiString -> BufferM ()
insertN YiString
" " BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
deleteN Int
1
((Point, Point, String) -> BufferM ())
-> [(Point, Point, String)] -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Point, Point, String) -> BufferM ()
forall b. (Point, b, String) -> BufferM ()
draw [(Point, Point, String)]
posDict
Point -> BufferM ()
moveTo Point
b
where
styleOfMark :: Char -> StyleName
styleOfMark Char
'*' = Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
green)
styleOfMark Char
'D' = Style -> StyleName
forall a b. a -> b -> a
const (Color -> Style
withFg Color
red)
styleOfMark Char
_ = StyleName
defaultStyle
diredUnmark :: Direction
-> BufferM ()
diredUnmark :: Direction -> BufferM ()
diredUnmark Direction
d = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
let lineDir :: BufferM ()
lineDir = case Direction
d of { Direction
Forward -> BufferM ()
lineDown; Direction
Backward -> BufferM ()
lineUp; }
BufferM (Maybe (String, DiredEntry))
fileFromPoint BufferM (Maybe (String, DiredEntry))
-> (Maybe (String, DiredEntry) -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (String
fn, DiredEntry
_de) -> do
String -> BufferM ()
diredUnmarkPath String
fn
BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDir
BufferM ()
diredRefreshMark
Maybe (String, DiredEntry)
Nothing -> BufferM () -> BufferM ()
filenameColOf BufferM ()
lineDir
diredUnmarkPath :: FilePath -> BufferM()
diredUnmarkPath :: String -> BufferM ()
diredUnmarkPath String
fn = BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredState -> (DiredState -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn(DiredState -> BufferM ())
-> (DiredState -> DiredState) -> DiredState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState)
-> (Map String Char -> Map String Char) -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> Map String Char -> Map String Char
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
fn)
diredUnmarkAll :: BufferM ()
diredUnmarkAll :: BufferM ()
diredUnmarkAll = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
bypassReadOnly (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn BufferM DiredState -> (DiredState -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DiredState -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn(DiredState -> BufferM ())
-> (DiredState -> DiredState) -> DiredState -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState
Lens' DiredState (Map String Char)
diredMarksA ((Map String Char -> Identity (Map String Char))
-> DiredState -> Identity DiredState)
-> Map String Char -> DiredState -> DiredState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map String Char
forall k a. Map k a
M.empty)
BufferM () -> BufferM ()
filenameColOf (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
BufferM ()
diredRefreshMark
currentDir :: YiM FilePath
currentDir :: YiM String
currentDir = DiredState -> String
diredPath (DiredState -> String) -> YiM DiredState -> YiM String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM DiredState -> YiM DiredState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
askRenameFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askRenameFiles :: String -> [(String, DiredEntry)] -> YiM ()
askRenameFiles String
dir [(String, DiredEntry)]
fs = case [(String, DiredEntry)]
fs of
[(String, DiredEntry)
_x] -> do YiM ()
resetDiredOpState
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [DiredOp]
sOpIsDir]
(String, DiredEntry)
_x:[(String, DiredEntry)]
_ -> do YiM ()
resetDiredOpState
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [DiredOp]
mOpIsDirAndExists]
[] -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall (m :: * -> *) p. MonadEditor m => p -> m ()
showNothing]
where
mkErr :: Text -> m DiredOp
mkErr Text
t = DiredOp -> m DiredOp
forall (m :: * -> *) a. Monad m => a -> m a
return (DiredOp -> m DiredOp)
-> (YiM () -> DiredOp) -> YiM () -> m DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiredOpState -> YiM ()) -> DiredOp
DOFeedback ((DiredOpState -> YiM ()) -> DiredOp)
-> (YiM () -> DiredOpState -> YiM ()) -> YiM () -> DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiM () -> DiredOpState -> YiM ()
forall a b. a -> b -> a
const (YiM () -> m DiredOp) -> YiM () -> m DiredOp
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
errorEditor Text
t
prompt :: YiString
prompt = YiString
"Move " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString (Int -> String
forall a. Show a => a -> String
show Int
total) YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" item(s) to:"
mOpIsDirAndExists :: String -> [DiredOp]
mOpIsDirAndExists String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
negOps]
where
posOps :: [DiredOp]
posOps = ((String, DiredEntry) -> DiredOp)
-> [(String, DiredEntry)] -> [DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (String, DiredEntry) -> DiredOp
forall b. (String, b) -> DiredOp
builder [(String, DiredEntry)]
fs [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
negOps :: [DiredOp]
negOps = Text -> [DiredOp]
forall (m :: * -> *). Monad m => Text -> m DiredOp
mkErr (Text -> [DiredOp]) -> Text -> [DiredOp]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not directory!"
builder :: (String, b) -> DiredOp
builder (String
fn, b
_de) = let old :: String
old = String
dir String -> ShowS
</> String
fn
new :: String
new = String
t String -> ShowS
</> String
fn
in String -> DiredOp -> DiredOp
DOCkOverwrite String
new (String -> String -> DiredOp
DORename String
old String
new)
sOpIsDir :: String -> [DiredOp]
sOpIsDir String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
sOpDirRename]
where (String
fn, DiredEntry
_) = [(String, DiredEntry)] -> (String, DiredEntry)
forall a. [a] -> a
head [(String, DiredEntry)]
fs
posOps :: [DiredOp]
posOps = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (String -> String -> DiredOp
DORename String
old String
new),
(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
where new :: String
new = String
t String -> ShowS
</> String
fn
old :: String
old = String
dir String -> ShowS
</> String
fn
sOpDirRename :: [DiredOp]
sOpDirRename = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck IO Bool
ckParentDir [DiredOp]
posOps' [DiredOp]
negOps,
(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
where posOps' :: [DiredOp]
posOps' = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (String -> String -> DiredOp
DORename String
old String
new)]
p :: Text
p = Text
"Cannot move " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
old
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
new
negOps :: [DiredOp]
negOps = Text -> [DiredOp]
forall (m :: * -> *). Monad m => Text -> m DiredOp
mkErr Text
p
new :: String
new = String
t
old :: String
old = String
dir String -> ShowS
</> String
fn
ps :: String
ps = ShowS
dropTrailingPathSeparator String
t
ckParentDir :: IO Bool
ckParentDir = String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
ps
showResult :: DiredOpState -> YiM ()
showResult DiredOpState
st = do
YiM ()
diredRefresh
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showT (DiredOpState
st DiredOpState -> Getting Int DiredOpState Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int DiredOpState Int
Lens' DiredOpState Int
diredOpSucCnt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" item(s) moved."
showNothing :: p -> m ()
showNothing p
_ = Text -> m ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Quit"
total :: Int
total = [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, DiredEntry)]
fs
askCopyFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askCopyFiles :: String -> [(String, DiredEntry)] -> YiM ()
askCopyFiles String
dir [(String, DiredEntry)]
fs =
case [(String, DiredEntry)]
fs of
[(String, DiredEntry)
_x] -> do YiM ()
resetDiredOpState
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [DiredOp]
sOpIsDir]
(String, DiredEntry)
_x:[(String, DiredEntry)]
_ -> do YiM ()
resetDiredOpState
Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [YiString -> (String -> [DiredOp]) -> DiredOp
DOInput YiString
prompt String -> [DiredOp]
mOpIsDirAndExists]
[] -> Bool -> [DiredOp] -> YiM ()
procDiredOp Bool
True [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
forall (m :: * -> *) p. MonadEditor m => p -> m ()
showNothing]
where
prompt :: YiString
prompt = YiString
"Copy " YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> String -> YiString
R.fromString (Int -> String
forall a. Show a => a -> String
show Int
total) YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
" item(s) to:"
mOpIsDirAndExists :: String -> [DiredOp]
mOpIsDirAndExists String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
negOps]
where
posOps :: [DiredOp]
posOps = ((String, DiredEntry) -> DiredOp)
-> [(String, DiredEntry)] -> [DiredOp]
forall a b. (a -> b) -> [a] -> [b]
map (String, DiredEntry) -> DiredOp
builder [(String, DiredEntry)]
fs [DiredOp] -> [DiredOp] -> [DiredOp]
forall a. Semigroup a => a -> a -> a
<> [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
negOps :: [DiredOp]
negOps = [(DiredOpState -> YiM ()) -> DiredOp
DOFeedback ((DiredOpState -> YiM ()) -> DiredOp)
-> (YiM () -> DiredOpState -> YiM ()) -> YiM () -> DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiM () -> DiredOpState -> YiM ()
forall a b. a -> b -> a
const (YiM () -> DiredOp) -> YiM () -> DiredOp
forall a b. (a -> b) -> a -> b
$
Text -> YiM ()
errorEditor (String -> Text
T.pack String
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not directory!")]
builder :: (String, DiredEntry) -> DiredOp
builder (String
fn, DiredEntry
de) = let old :: String
old = String
dir String -> ShowS
</> String
fn
new :: String
new = String
t String -> ShowS
</> String
fn
in String -> DiredOp -> DiredOp
DOCkOverwrite String
new (DiredEntry -> String -> String -> DiredOp
op4Type DiredEntry
de String
old String
new)
sOpIsDir :: String -> [DiredOp]
sOpIsDir String
t = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck (String -> IO Bool
doesDirectoryExist String
t) [DiredOp]
posOps [DiredOp]
sOpDirCopy]
where (String
fn, DiredEntry
de) = [(String, DiredEntry)] -> (String, DiredEntry)
forall a. [a] -> a
head [(String, DiredEntry)]
fs
posOps :: [DiredOp]
posOps = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (DiredEntry -> String -> String -> DiredOp
op4Type DiredEntry
de String
old String
new),
(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
where new :: String
new = String
t String -> ShowS
</> String
fn
old :: String
old = String
dir String -> ShowS
</> String
fn
sOpDirCopy :: [DiredOp]
sOpDirCopy = [IO Bool -> [DiredOp] -> [DiredOp] -> DiredOp
DOCheck IO Bool
ckParentDir [DiredOp]
posOps' [DiredOp]
negOps,
(DiredOpState -> YiM ()) -> DiredOp
DOFeedback DiredOpState -> YiM ()
showResult]
where posOps' :: [DiredOp]
posOps' = [String -> DiredOp -> DiredOp
DOCkOverwrite String
new (DiredEntry -> String -> String -> DiredOp
op4Type DiredEntry
de String
old String
new)]
p :: Text
p = Text
"Cannot copy " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
old Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
new
negOps :: [DiredOp]
negOps =
[(DiredOpState -> YiM ()) -> DiredOp
DOFeedback ((DiredOpState -> YiM ()) -> DiredOp)
-> (YiM () -> DiredOpState -> YiM ()) -> YiM () -> DiredOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiM () -> DiredOpState -> YiM ()
forall a b. a -> b -> a
const (YiM () -> DiredOp) -> YiM () -> DiredOp
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
errorEditor Text
p]
new :: String
new = String
t
old :: String
old = String
dir String -> ShowS
</> String
fn
ckParentDir :: IO Bool
ckParentDir = String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$
ShowS
takeDirectory (ShowS
dropTrailingPathSeparator String
t)
showResult :: DiredOpState -> YiM ()
showResult DiredOpState
st = do
YiM ()
diredRefresh
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showT (DiredOpState
st DiredOpState -> Getting Int DiredOpState Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int DiredOpState Int
Lens' DiredOpState Int
diredOpSucCnt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" item(s) copied."
showNothing :: p -> m ()
showNothing p
_ = Text -> m ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Quit"
total :: Int
total = [(String, DiredEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, DiredEntry)]
fs
op4Type :: DiredEntry -> FilePath -> FilePath -> DiredOp
op4Type :: DiredEntry -> String -> String -> DiredOp
op4Type (DiredDir DiredFileInfo
_) = String -> String -> DiredOp
DOCopyDir
op4Type DiredEntry
_ = String -> String -> DiredOp
DOCopyFile
diredRename :: YiM ()
diredRename :: YiM ()
diredRename = do
String
dir <- YiM String
currentDir
[(String, DiredEntry)]
fs <- (Char -> Bool) -> YiM [(String, DiredEntry)]
markedFiles (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')
if [(String, DiredEntry)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, DiredEntry)]
fs then do Maybe (String, DiredEntry)
maybefile <- BufferM (Maybe (String, DiredEntry))
-> YiM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, DiredEntry))
fileFromPoint
case Maybe (String, DiredEntry)
maybefile of
Just (String
fn, DiredEntry
de) -> String -> [(String, DiredEntry)] -> YiM ()
askRenameFiles String
dir [(String
fn, DiredEntry
de)]
Maybe (String, DiredEntry)
Nothing -> YiM ()
noFileAtThisLine
else String -> [(String, DiredEntry)] -> YiM ()
askRenameFiles String
dir [(String, DiredEntry)]
fs
diredCopy :: YiM ()
diredCopy :: YiM ()
diredCopy = do
String
dir <- YiM String
currentDir
[(String, DiredEntry)]
fs <- (Char -> Bool) -> YiM [(String, DiredEntry)]
markedFiles (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')
if [(String, DiredEntry)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, DiredEntry)]
fs then do Maybe (String, DiredEntry)
maybefile <- BufferM (Maybe (String, DiredEntry))
-> YiM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, DiredEntry))
fileFromPoint
case Maybe (String, DiredEntry)
maybefile of
Just (String
fn, DiredEntry
de) -> String -> [(String, DiredEntry)] -> YiM ()
askCopyFiles String
dir [(String
fn, DiredEntry
de)]
Maybe (String, DiredEntry)
Nothing -> YiM ()
noFileAtThisLine
else String -> [(String, DiredEntry)] -> YiM ()
askCopyFiles String
dir [(String, DiredEntry)]
fs
diredLoad :: YiM ()
diredLoad :: YiM ()
diredLoad = do
String
dir <- YiM String
currentDir
BufferM (Maybe (String, DiredEntry))
-> YiM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, DiredEntry))
fileFromPoint YiM (Maybe (String, DiredEntry))
-> (Maybe (String, DiredEntry) -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (String
fn, DiredEntry
de) -> do
let sel :: String
sel = String
dir String -> ShowS
</> String
fn
sel' :: Text
sel' = String -> Text
T.pack String
sel
case DiredEntry
de of
(DiredFile DiredFileInfo
_dfi) -> do
Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
sel
if Bool
exists
then YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> YiM (Either Text BufferRef) -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> YiM (Either Text BufferRef)
editFile String
sel
else Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists"
(DiredDir DiredFileInfo
_dfi) -> do
Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
sel
if Bool
exists
then String -> YiM ()
diredDir String
sel
else Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists"
(DiredSymLink DiredFileInfo
_dfi YiString
dest') -> do
let dest :: String
dest = YiString -> String
R.toString YiString
dest'
target :: String
target = if String -> Bool
isAbsolute String
dest then String
dest else String
dir String -> ShowS
</> String
dest
Bool
existsFile <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
target
Bool
existsDir <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
target
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"Following link:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
target
if Bool
existsFile then YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> YiM (Either Text BufferRef) -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> YiM (Either Text BufferRef)
editFile String
target else
if Bool
existsDir then String -> YiM ()
diredDir String
target else
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
target Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist"
(DiredSocket DiredFileInfo
_dfi) -> do
Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
sel
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
then Text
"Can't open Socket " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
(DiredBlockDevice DiredFileInfo
_dfi) -> do
Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
sel
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
then Text
"Can't open Block Device " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
(DiredCharacterDevice DiredFileInfo
_dfi) -> do
Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
sel
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
then Text
"Can't open Character Device " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
(DiredNamedPipe DiredFileInfo
_dfi) -> do
Bool
exists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
sel
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (if Bool
exists
then Text
"Can't open Pipe " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
else Text
sel' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" no longer exists")
DiredEntry
DiredNoInfo -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"No File Info for:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sel'
Maybe (String, DiredEntry)
Nothing -> YiM ()
noFileAtThisLine
noFileAtThisLine :: YiM ()
noFileAtThisLine :: YiM ()
noFileAtThisLine = Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"(No file at this line)"
fileFromPoint :: BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint :: BufferM (Maybe (String, DiredEntry))
fileFromPoint = do
Point
p <- BufferM Point
pointB
DiredState
dState <- BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
let candidates :: [(Point, Point, String)]
candidates = ((Point, Point, String) -> Bool)
-> [(Point, Point, String)] -> [(Point, Point, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Point
_,Point
p2,String
_)->Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
p2) (DiredState -> [(Point, Point, String)]
diredFilePoints DiredState
dState)
finddef :: String -> DiredEntries -> DiredEntry
finddef String
f = DiredEntry -> YiString -> DiredEntries -> DiredEntry
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault DiredEntry
DiredNoInfo (String -> YiString
R.fromString String
f)
Maybe (String, DiredEntry) -> BufferM (Maybe (String, DiredEntry))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, DiredEntry)
-> BufferM (Maybe (String, DiredEntry)))
-> Maybe (String, DiredEntry)
-> BufferM (Maybe (String, DiredEntry))
forall a b. (a -> b) -> a -> b
$ case [(Point, Point, String)]
candidates of
((Point
_, Point
_, String
f):[(Point, Point, String)]
_) -> (String, DiredEntry) -> Maybe (String, DiredEntry)
forall a. a -> Maybe a
Just (String
f, String -> DiredEntries -> DiredEntry
finddef String
f (DiredEntries -> DiredEntry) -> DiredEntries -> DiredEntry
forall a b. (a -> b) -> a -> b
$ DiredState -> DiredEntries
diredEntries DiredState
dState)
[(Point, Point, String)]
_ -> Maybe (String, DiredEntry)
forall a. Maybe a
Nothing
markedFiles :: (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles :: (Char -> Bool) -> YiM [(String, DiredEntry)]
markedFiles Char -> Bool
cond = do
DiredState
dState <- BufferM DiredState -> YiM DiredState
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM DiredState
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
let fs :: [String]
fs = ([String], String) -> [String]
forall a b. (a, b) -> a
fst (([String], String) -> [String])
-> ([(String, Char)] -> ([String], String))
-> [(String, Char)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Char)] -> ([String], String)
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, Char)] -> [String]) -> [(String, Char)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Char) -> Bool) -> [(String, Char)] -> [(String, Char)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Bool
cond (Char -> Bool)
-> ((String, Char) -> Char) -> (String, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Char) -> Char
forall a b. (a, b) -> b
snd) (Map String Char -> [(String, Char)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map String Char -> [(String, Char)])
-> Map String Char -> [(String, Char)]
forall a b. (a -> b) -> a -> b
$ DiredState -> Map String Char
diredMarks DiredState
dState)
[(String, DiredEntry)] -> YiM [(String, DiredEntry)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, DiredEntry)] -> YiM [(String, DiredEntry)])
-> [(String, DiredEntry)] -> YiM [(String, DiredEntry)]
forall a b. (a -> b) -> a -> b
$ (String -> (String, DiredEntry))
-> [String] -> [(String, DiredEntry)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
f -> (String
f, DiredState -> DiredEntries
diredEntries DiredState
dState DiredEntries -> YiString -> DiredEntry
forall k a. Ord k => Map k a -> k -> a
M.! String -> YiString
R.fromString String
f)) [String]
fs
diredUpDir :: YiM ()
diredUpDir :: YiM ()
diredUpDir = do
String
dir <- YiM String
currentDir
String -> YiM ()
diredDir (String -> YiM ()) -> String -> YiM ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
dir
diredCreateDir :: YiM ()
diredCreateDir :: YiM ()
diredCreateDir =
Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"Create Dir:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
nm -> do
String
dir <- YiM String
currentDir
let newdir :: String
newdir = String
dir String -> ShowS
</> Text -> String
T.unpack Text
nm
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"Creating " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
newdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
newdir
YiM ()
diredRefresh
data DiredOp = DORemoveFile FilePath
| DORemoveDir FilePath
| DOCopyFile FilePath FilePath
| DOCopyDir FilePath FilePath
| DORename FilePath FilePath
| DORemoveBuffer FilePath
| DOConfirm R.YiString [DiredOp] [DiredOp]
| DOCheck (IO Bool) [DiredOp] [DiredOp]
| DOCkOverwrite FilePath DiredOp
| DOInput R.YiString (String -> [DiredOp])
| DOChoice R.YiString DiredOp
| DOFeedback (DiredOpState -> YiM ())
| DONoOp