{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.File (
editFile,
openingNewFile,
openNewFile,
viWrite, viWriteTo, viSafeWriteTo,
fwriteE,
fwriteBufferE,
fwriteAllY,
fwriteToE,
backupE,
revertE,
setFileName,
deservesSave,
preSaveHooks
) where
import Lens.Micro.Platform ((.=), makeLenses, use, view, (^.))
import Control.Monad (filterM, void, when)
import Control.Monad.Base (liftBase)
import Data.Default (Default, def)
import Data.Monoid ((<>))
import qualified Data.Text as T (Text, append, cons, pack, unpack)
import Data.Time (getCurrentTime)
import Data.Typeable (Typeable)
import System.Directory (doesDirectoryExist, doesFileExist)
import System.FriendlyPath (userToCanonPath)
import Yi.Buffer
import Yi.Config.Simple.Types (Field, customVariable)
import Yi.Core (errorEditor, runAction)
import Yi.Dired (editFile)
import Yi.Editor
import Yi.Keymap ()
import Yi.Monad (gets)
import qualified Yi.Rope as R (readFile, writeFile)
import Yi.String (showT)
import Yi.Types
import Yi.Utils (io)
newtype PreSaveHooks = PreSaveHooks { PreSaveHooks -> [Action]
_unPreSaveHooks :: [Action] }
deriving Typeable
instance Default PreSaveHooks where
def :: PreSaveHooks
def = [Action] -> PreSaveHooks
PreSaveHooks []
instance YiConfigVariable PreSaveHooks
makeLenses ''PreSaveHooks
preSaveHooks :: Field [Action]
preSaveHooks :: ([Action] -> f [Action]) -> Config -> f Config
preSaveHooks = (PreSaveHooks -> f PreSaveHooks) -> Config -> f Config
forall a. YiConfigVariable a => Field a
customVariable ((PreSaveHooks -> f PreSaveHooks) -> Config -> f Config)
-> (([Action] -> f [Action]) -> PreSaveHooks -> f PreSaveHooks)
-> ([Action] -> f [Action])
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Action] -> f [Action]) -> PreSaveHooks -> f PreSaveHooks
Lens' PreSaveHooks [Action]
unPreSaveHooks
openingNewFile :: FilePath -> BufferM a -> YiM ()
openingNewFile :: FilePath -> BufferM a -> YiM ()
openingNewFile FilePath
fp BufferM a
act = FilePath -> YiM (Either Text BufferRef)
editFile FilePath
fp YiM (Either Text BufferRef)
-> (Either Text BufferRef -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
m -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
m
Right BufferRef
ref -> YiM a -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM a -> YiM ()) -> YiM a -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> BufferM a -> YiM a
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
ref BufferM a
act
openNewFile :: FilePath -> YiM ()
openNewFile :: FilePath -> YiM ()
openNewFile = (FilePath -> BufferM () -> YiM ())
-> BufferM () -> FilePath -> YiM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> BufferM () -> YiM ()
forall a. FilePath -> BufferM a -> YiM ()
openingNewFile (BufferM () -> FilePath -> YiM ())
-> BufferM () -> FilePath -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
revertE :: YiM ()
revertE :: YiM ()
revertE =
BufferM (Maybe FilePath) -> YiM (Maybe FilePath)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer ((FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file) YiM (Maybe FilePath) -> (Maybe FilePath -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
fp -> do
UTCTime
now <- IO UTCTime -> YiM UTCTime
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO UTCTime
getCurrentTime
Maybe YiString
rf <- IO (Maybe YiString) -> YiM (Maybe YiString)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Maybe YiString) -> YiM (Maybe YiString))
-> IO (Maybe YiString) -> YiM (Maybe YiString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either Text YiString)
R.readFile FilePath
fp IO (Either Text YiString)
-> (Either Text YiString -> IO (Maybe YiString))
-> IO (Maybe YiString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
m -> Text -> IO ()
forall a. Show a => a -> IO ()
print (Text
"Can't revert: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m) IO () -> IO (Maybe YiString) -> IO (Maybe YiString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe YiString -> IO (Maybe YiString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe YiString
forall a. Maybe a
Nothing
Right YiString
c -> Maybe YiString -> IO (Maybe YiString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe YiString -> IO (Maybe YiString))
-> Maybe YiString -> IO (Maybe YiString)
forall a b. (a -> b) -> a -> b
$ YiString -> Maybe YiString
forall a. a -> Maybe a
Just YiString
c
case Maybe YiString
rf of
Maybe YiString
Nothing -> () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just YiString
s -> do
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ YiString -> UTCTime -> BufferM ()
revertB YiString
s UTCTime
now
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text
"Reverted from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. Show a => a -> Text
showT FilePath
fp)
Maybe FilePath
Nothing -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Can't revert, no file associated with buffer."
viWrite :: YiM ()
viWrite :: YiM ()
viWrite =
BufferM (Maybe FilePath) -> YiM (Maybe FilePath)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer ((FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file) YiM (Maybe FilePath) -> (Maybe FilePath -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> Text -> YiM ()
errorEditor Text
"no file name associated with buffer"
Just FilePath
f -> do
BufferFileInfo
bufInfo <- BufferM BufferFileInfo -> YiM BufferFileInfo
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM BufferFileInfo
bufInfoB
let s :: FilePath
s = BufferFileInfo -> FilePath
bufInfoFileName BufferFileInfo
bufInfo
Bool
succeed <- YiM Bool
fwriteE
let message :: Text
message = (FilePath -> Text
forall a. Show a => a -> Text
showT FilePath
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (if FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
s
then Text
" written"
else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. Show a => a -> Text
showT FilePath
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" written")
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
succeed (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
message
viWriteTo :: T.Text -> YiM ()
viWriteTo :: Text -> YiM ()
viWriteTo Text
f = do
BufferFileInfo
bufInfo <- BufferM BufferFileInfo -> YiM BufferFileInfo
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM BufferFileInfo
bufInfoB
let s :: Text
s = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ BufferFileInfo -> FilePath
bufInfoFileName BufferFileInfo
bufInfo
Bool
succeed <- Text -> YiM Bool
fwriteToE Text
f
let message :: Text
message = Text
f Text -> Text -> Text
`T.append` if Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s
then Text
" written"
else Char
' ' Char -> Text -> Text
`T.cons` Text
s Text -> Text -> Text
`T.append` Text
" written"
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
succeed (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
message
viSafeWriteTo :: T.Text -> YiM ()
viSafeWriteTo :: Text -> YiM ()
viSafeWriteTo Text
f = do
Bool
existsF <- IO Bool -> YiM Bool
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (Text -> FilePath
T.unpack Text
f)
if Bool
existsF
then Text -> YiM ()
errorEditor (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": File exists (add '!' to override)"
else Text -> YiM ()
viWriteTo Text
f
fwriteE :: YiM Bool
fwriteE :: YiM Bool
fwriteE = BufferRef -> YiM Bool
fwriteBufferE (BufferRef -> YiM Bool) -> YiM BufferRef -> YiM Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
fwriteBufferE :: BufferRef -> YiM Bool
fwriteBufferE :: BufferRef -> YiM Bool
fwriteBufferE BufferRef
bufferKey = do
(Maybe FilePath, YiString)
nameContents <- BufferRef
-> BufferM (Maybe FilePath, YiString)
-> YiM (Maybe FilePath, YiString)
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
bufferKey (BufferM (Maybe FilePath, YiString)
-> YiM (Maybe FilePath, YiString))
-> BufferM (Maybe FilePath, YiString)
-> YiM (Maybe FilePath, YiString)
forall a b. (a -> b) -> a -> b
$ do
Maybe FilePath
fl <- (FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file
YiString
st <- Direction -> Point -> BufferM YiString
streamB Direction
Forward Point
0
(Maybe FilePath, YiString) -> BufferM (Maybe FilePath, YiString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
fl, YiString
st)
case (Maybe FilePath, YiString)
nameContents of
(Just FilePath
f, YiString
contents) -> IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (FilePath -> IO Bool
doesDirectoryExist FilePath
f) YiM Bool -> (Bool -> YiM Bool) -> YiM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Can't save over a directory, doing nothing." YiM () -> YiM Bool -> YiM Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> YiM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Bool
False -> do
[Action]
hooks <- Getting [Action] Config [Action] -> Config -> [Action]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Action] Config [Action]
Field [Action]
preSaveHooks (Config -> [Action]) -> YiM Config -> YiM [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> YiM Config
forall (m :: * -> *). MonadEditor m => m Config
askCfg
(Action -> YiM ()) -> [Action] -> YiM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Action -> YiM ()
runAction [Action]
hooks
()
mayErr <- IO () -> YiM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> YiString -> IO ()
R.writeFile FilePath
f YiString
contents
IO UTCTime -> YiM UTCTime
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO UTCTime
getCurrentTime YiM UTCTime -> (UTCTime -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
bufferKey (BufferM () -> YiM ())
-> (UTCTime -> BufferM ()) -> UTCTime -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> BufferM ()
markSavedB
Bool -> YiM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
(Maybe FilePath
Nothing, YiString
_) -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Buffer not associated with a file" YiM () -> YiM Bool -> YiM Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> YiM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
fwriteToE :: T.Text -> YiM Bool
fwriteToE :: Text -> YiM Bool
fwriteToE Text
f = do
BufferRef
b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
BufferRef -> FilePath -> YiM ()
setFileName BufferRef
b (Text -> FilePath
T.unpack Text
f)
BufferRef -> YiM Bool
fwriteBufferE BufferRef
b
fwriteAllY :: YiM Bool
fwriteAllY :: YiM Bool
fwriteAllY = do
[FBuffer]
modifiedBuffers <- (FBuffer -> YiM Bool) -> [FBuffer] -> YiM [FBuffer]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FBuffer -> YiM Bool
deservesSave ([FBuffer] -> YiM [FBuffer]) -> YiM [FBuffer] -> YiM [FBuffer]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Editor -> [FBuffer]) -> YiM [FBuffer]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> [FBuffer]
bufferSet
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> YiM [Bool] -> YiM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BufferRef -> YiM Bool) -> [BufferRef] -> YiM [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BufferRef -> YiM Bool
fwriteBufferE ((FBuffer -> BufferRef) -> [FBuffer] -> [BufferRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FBuffer -> BufferRef
bkey [FBuffer]
modifiedBuffers)
backupE :: FilePath -> YiM ()
backupE :: FilePath -> YiM ()
backupE = FilePath -> FilePath -> YiM ()
forall a. HasCallStack => FilePath -> a
error FilePath
"backupE not implemented"
setFileName :: BufferRef -> FilePath -> YiM ()
setFileName :: BufferRef -> FilePath -> YiM ()
setFileName BufferRef
b FilePath
filename = do
FilePath
cfn <- IO FilePath -> YiM FilePath
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO FilePath -> YiM FilePath) -> IO FilePath -> YiM FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
userToCanonPath FilePath
filename
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
$ ASetter FBuffer FBuffer BufferId BufferId -> BufferId -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
(.=) ASetter FBuffer FBuffer BufferId BufferId
forall c. HasAttributes c => Lens' c BufferId
identA (BufferId -> BufferM ()) -> BufferId -> BufferM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> BufferId
FileBuffer FilePath
cfn
deservesSave :: FBuffer -> YiM Bool
deservesSave :: FBuffer -> YiM Bool
deservesSave FBuffer
b
| FBuffer -> Bool
isUnchangedBuffer FBuffer
b = Bool -> YiM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise = FBuffer -> YiM Bool
isFileBuffer FBuffer
b
isFileBuffer :: FBuffer -> YiM Bool
isFileBuffer :: FBuffer -> YiM Bool
isFileBuffer FBuffer
b = case FBuffer
b FBuffer -> Getting BufferId FBuffer BufferId -> BufferId
forall s a. s -> Getting a s a -> a
^. Getting BufferId FBuffer BufferId
forall c. HasAttributes c => Lens' c BufferId
identA of
MemBuffer Text
_ -> Bool -> YiM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
FileBuffer FilePath
fn -> Bool -> Bool
not (Bool -> Bool) -> YiM Bool -> YiM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool -> YiM Bool
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (FilePath -> IO Bool
doesDirectoryExist FilePath
fn)