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

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

module Yi.File (
  -- * File-based actions
  editFile,
  openingNewFile,
  openNewFile,

  viWrite, viWriteTo, viSafeWriteTo,
  fwriteE,
  fwriteBufferE,
  fwriteAllY,
  fwriteToE,
  backupE,
  revertE,

  -- * Helper functions
  setFileName,
  deservesSave,

  -- * Configuration
  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

-- | Tries to open a new buffer with 'editFile' and runs the given
-- action on the buffer handle if it succeeds.
--
-- If the 'editFile' fails, just the failure message is printed.
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

-- | Same as @openingNewFile@ with no action to run after.
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 ()

-- | Revert to the contents of the file on disk
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."


-- | Try to write a file in the manner of vi/vim
-- Need to catch any exception to avoid losing bindings
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

-- | Try to write to a named file in the manner of vi/vim
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

-- | Try to write to a named file if it doesn't exist. Error out if it does.
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

-- | Write current buffer to disk, if this buffer is associated with a file
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

-- | Write a given buffer to disk if it is associated with a file.
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

-- | Write current buffer to disk as @f@. The file is also set to @f@.
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

-- | Write all open buffers
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)

-- | Make a backup copy of file
backupE :: FilePath -> YiM ()
backupE :: FilePath -> YiM ()
backupE = FilePath -> FilePath -> YiM ()
forall a. HasCallStack => FilePath -> a
error FilePath
"backupE not implemented"


-- | Associate buffer with file; canonicalize the given path name.
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

-- | Checks if the given buffer deserves a save: whether it's a file
-- buffer and whether it's pointing at a file rather than a directory.
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

-- | Is there a proper file associated with the buffer?
-- In other words, does it make sense to offer to save it?
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)