{-# 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 :: Field [Action]
preSaveHooks = (PreSaveHooks -> f PreSaveHooks) -> Config -> f Config
forall a. YiConfigVariable a => Field a
Field PreSaveHooks
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 :: forall a. 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 a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left Text
m -> 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 a. a -> BufferM a
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 a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just FilePath
fp -> do
      now <- IO UTCTime -> YiM UTCTime
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO UTCTime
getCurrentTime
      rf <- liftBase $ R.readFile fp >>= \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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe YiString -> IO (Maybe YiString)
forall a. a -> IO a
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 a. a -> IO a
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 rf of
       Maybe YiString
Nothing -> () -> YiM ()
forall a. a -> YiM a
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 a b. YiM a -> (a -> YiM b) -> YiM b
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
      bufInfo <- BufferM BufferFileInfo -> YiM BufferFileInfo
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM BufferFileInfo
bufInfoB
      let s   = BufferFileInfo -> FilePath
bufInfoFileName BufferFileInfo
bufInfo
      succeed <- fwriteE
      let 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")
      when succeed $ printMsg 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
  bufInfo <- BufferM BufferFileInfo -> YiM BufferFileInfo
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM BufferFileInfo
bufInfoB
  let s   = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ BufferFileInfo -> FilePath
bufInfoFileName BufferFileInfo
bufInfo
  succeed <- fwriteToE f
  let 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"
  when succeed $ printMsg 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
  existsF <- IO Bool -> YiM Bool
forall α. IO α -> YiM α
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 existsF
    then errorEditor $ f <> ": File exists (add '!' to override)"
    else viWriteTo 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
  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
    fl <- (FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file
    st <- streamB Forward 0
    return (fl, st)

  case 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 a b. YiM a -> (a -> YiM b) -> YiM b
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 a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> YiM Bool
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Bool
False -> do
        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
        mapM_ runAction hooks
        mayErr <- liftBase $ R.writeFile f contents
        io getCurrentTime >>= withGivenBuffer bufferKey . markSavedB
        return 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 a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> YiM Bool
forall a. a -> YiM a
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
  b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
  setFileName b (T.unpack f)
  fwriteBufferE b

-- | Write all open buffers
fwriteAllY :: YiM Bool
fwriteAllY :: YiM Bool
fwriteAllY = do
    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
    and <$> mapM fwriteBufferE (fmap bkey 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
  cfn <- IO FilePath -> YiM FilePath
forall α. IO α -> YiM α
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
  withGivenBuffer b $ (.=) identA $ FileBuffer 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 a. a -> YiM a
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
Lens' FBuffer BufferId
identA of
  MemBuffer Text
_ -> Bool -> YiM Bool
forall a. a -> YiM a
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 α. IO α -> YiM α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (FilePath -> IO Bool
doesDirectoryExist FilePath
fn)