module Yi.File (
editFile,
openingNewFile,
openNewFile,
viWrite, viWriteTo, viSafeWriteTo,
fwriteE,
fwriteBufferE,
fwriteAllY,
fwriteToE,
backupE,
revertE,
setFileName,
deservesSave,
preSaveHooks
) where
import Control.Applicative ((<$>))
import Control.Lens (assign, 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, writeFileUsingText)
import Yi.String (showT)
import Yi.Types
import Yi.Utils (io)
newtype PreSaveHooks = PreSaveHooks { _unPreSaveHooks :: [Action] }
deriving Typeable
instance Default PreSaveHooks where
def = PreSaveHooks []
instance YiConfigVariable PreSaveHooks
makeLenses ''PreSaveHooks
preSaveHooks :: Field [Action]
preSaveHooks = customVariable . unPreSaveHooks
openingNewFile :: FilePath -> BufferM a -> YiM ()
openingNewFile fp act = editFile fp >>= \case
Left m -> printMsg m
Right ref -> void $ withGivenBuffer ref act
openNewFile :: FilePath -> YiM ()
openNewFile = flip openingNewFile $ return ()
revertE :: YiM ()
revertE =
withCurrentBuffer (gets file) >>= \case
Just fp -> do
now <- io getCurrentTime
rf <- liftBase $ R.readFile fp >>= \case
Left m -> print ("Can't revert: " <> m) >> return Nothing
Right (c, cv) -> return $ Just (c, Just cv)
case rf of
Nothing -> return ()
Just (s, conv) -> do
withCurrentBuffer $ revertB s conv now
printMsg ("Reverted from " <> showT fp)
Nothing -> printMsg "Can't revert, no file associated with buffer."
viWrite :: YiM ()
viWrite =
withCurrentBuffer (gets file) >>= \case
Nothing -> errorEditor "no file name associated with buffer"
Just f -> do
bufInfo <- withCurrentBuffer bufInfoB
let s = bufInfoFileName bufInfo
succeed <- fwriteE
let message = (showT f <>) (if f == s
then " written"
else " " <> showT s <> " written")
when succeed $ printMsg message
viWriteTo :: T.Text -> YiM ()
viWriteTo f = do
bufInfo <- withCurrentBuffer bufInfoB
let s = T.pack $ bufInfoFileName bufInfo
succeed <- fwriteToE f
let message = f `T.append` if f == s
then " written"
else ' ' `T.cons` s `T.append` " written"
when succeed $ printMsg message
viSafeWriteTo :: T.Text -> YiM ()
viSafeWriteTo f = do
existsF <- liftBase $ doesFileExist (T.unpack f)
if existsF
then errorEditor $ f <> ": File exists (add '!' to override)"
else viWriteTo f
fwriteE :: YiM Bool
fwriteE = fwriteBufferE =<< gets currentBuffer
fwriteBufferE :: BufferRef -> YiM Bool
fwriteBufferE bufferKey = do
nameContents <- withGivenBuffer bufferKey $ do
fl <- gets file
st <- streamB Forward 0
conv <- use encodingConverterNameA
return (fl, st, conv)
case nameContents of
(Just f, contents, conv) -> io (doesDirectoryExist f) >>= \case
True -> printMsg "Can't save over a directory, doing nothing." >> return False
False -> do
hooks <- view preSaveHooks <$> askCfg
mapM_ runAction hooks
mayErr <- liftBase $ case conv of
Nothing -> R.writeFileUsingText f contents >> return Nothing
Just cn -> R.writeFile f contents cn
case mayErr of
Just err -> printMsg err >> return False
Nothing -> io getCurrentTime >>= withGivenBuffer bufferKey . markSavedB
>> return True
(Nothing, _, _) -> printMsg "Buffer not associated with a file" >> return False
fwriteToE :: T.Text -> YiM Bool
fwriteToE f = do
b <- gets currentBuffer
setFileName b (T.unpack f)
fwriteBufferE b
fwriteAllY :: YiM Bool
fwriteAllY = do
modifiedBuffers <- filterM deservesSave =<< gets bufferSet
and <$> mapM fwriteBufferE (fmap bkey modifiedBuffers)
backupE :: FilePath -> YiM ()
backupE = error "backupE not implemented"
setFileName :: BufferRef -> FilePath -> YiM ()
setFileName b filename = do
cfn <- liftBase $ userToCanonPath filename
withGivenBuffer b $ assign identA $ FileBuffer cfn
deservesSave :: FBuffer -> YiM Bool
deservesSave b
| isUnchangedBuffer b = return False
| otherwise = isFileBuffer b
isFileBuffer :: FBuffer -> YiM Bool
isFileBuffer b = case b ^. identA of
MemBuffer _ -> return False
FileBuffer fn -> not <$> liftBase (doesDirectoryExist fn)