    {-# 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)