{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Haskell2010                #-}
{-# LANGUAGE NoMonomorphismRestriction  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}

-- | This module implements persistence across different Yi runs.
--   It includes minibuffer command history, marks etc.
--   Warning: Current version will _not_ check whether two or more instances
--   of Yi are run at the same time.

module Yi.PersistentState(loadPersistentState,
                          savePersistentState,
                          maxHistoryEntries,
                          persistentSearch)
where

import GHC.Generics (Generic)

import           Control.Exc            (ignoringException)
import           Lens.Micro.Platform    ((.=), makeLenses, use)
import           Control.Monad          (when)
import           Data.Binary            (Binary, decodeFile, encodeFile)
import           Data.Default           (Default, def)
import qualified Data.Map               as M (map)
import           Data.Typeable          (Typeable)
import           System.Directory       (doesFileExist)
import           Yi.Config.Simple.Types (Field, customVariable)
import           Yi.Editor
import           Yi.History             (Histories (..), History (..))
import           Yi.Keymap              (YiM)
import           Yi.KillRing            (Killring (..))
import           Yi.Paths               (getPersistentStateFilename)
import           Yi.Regex               (SearchExp (..))
import           Yi.Search.Internal     (getRegexE, setRegexE)
import           Yi.Types               (YiConfigVariable)
import           Yi.Utils               (io)

data PersistentState = PersistentState
    { PersistentState -> Histories
histories     :: !Histories
    , PersistentState -> Killring
aKillring     :: !Killring
    , PersistentState -> Maybe SearchExp
aCurrentRegex :: Maybe SearchExp
    } deriving ((forall x. PersistentState -> Rep PersistentState x)
-> (forall x. Rep PersistentState x -> PersistentState)
-> Generic PersistentState
forall x. Rep PersistentState x -> PersistentState
forall x. PersistentState -> Rep PersistentState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PersistentState x -> PersistentState
$cfrom :: forall x. PersistentState -> Rep PersistentState x
Generic)

instance Binary PersistentState

newtype MaxHistoryEntries = MaxHistoryEntries { MaxHistoryEntries -> Int
_unMaxHistoryEntries :: Int }
  deriving(Typeable, Get MaxHistoryEntries
[MaxHistoryEntries] -> Put
MaxHistoryEntries -> Put
(MaxHistoryEntries -> Put)
-> Get MaxHistoryEntries
-> ([MaxHistoryEntries] -> Put)
-> Binary MaxHistoryEntries
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [MaxHistoryEntries] -> Put
$cputList :: [MaxHistoryEntries] -> Put
get :: Get MaxHistoryEntries
$cget :: Get MaxHistoryEntries
put :: MaxHistoryEntries -> Put
$cput :: MaxHistoryEntries -> Put
Binary)

instance Default MaxHistoryEntries where
  def :: MaxHistoryEntries
def = Int -> MaxHistoryEntries
MaxHistoryEntries Int
1000

instance YiConfigVariable MaxHistoryEntries

makeLenses ''MaxHistoryEntries

maxHistoryEntries :: Field Int
maxHistoryEntries :: (Int -> f Int) -> Config -> f Config
maxHistoryEntries = (MaxHistoryEntries -> f MaxHistoryEntries) -> Config -> f Config
forall a. YiConfigVariable a => Field a
customVariable ((MaxHistoryEntries -> f MaxHistoryEntries) -> Config -> f Config)
-> ((Int -> f Int) -> MaxHistoryEntries -> f MaxHistoryEntries)
-> (Int -> f Int)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> MaxHistoryEntries -> f MaxHistoryEntries
Lens' MaxHistoryEntries Int
unMaxHistoryEntries

newtype PersistentSearch = PersistentSearch { PersistentSearch -> Bool
_unPersistentSearch :: Bool }
  deriving(Typeable, Get PersistentSearch
[PersistentSearch] -> Put
PersistentSearch -> Put
(PersistentSearch -> Put)
-> Get PersistentSearch
-> ([PersistentSearch] -> Put)
-> Binary PersistentSearch
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [PersistentSearch] -> Put
$cputList :: [PersistentSearch] -> Put
get :: Get PersistentSearch
$cget :: Get PersistentSearch
put :: PersistentSearch -> Put
$cput :: PersistentSearch -> Put
Binary)

instance Default PersistentSearch where
  def :: PersistentSearch
def = Bool -> PersistentSearch
PersistentSearch Bool
True

instance YiConfigVariable PersistentSearch

makeLenses ''PersistentSearch

persistentSearch :: Field Bool
persistentSearch :: (Bool -> f Bool) -> Config -> f Config
persistentSearch = (PersistentSearch -> f PersistentSearch) -> Config -> f Config
forall a. YiConfigVariable a => Field a
customVariable ((PersistentSearch -> f PersistentSearch) -> Config -> f Config)
-> ((Bool -> f Bool) -> PersistentSearch -> f PersistentSearch)
-> (Bool -> f Bool)
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> PersistentSearch -> f PersistentSearch
Lens' PersistentSearch Bool
unPersistentSearch

-- | Trims per-command histories to contain at most N completions each.
trimHistories :: Int -> Histories -> Histories
trimHistories :: Int -> Histories -> Histories
trimHistories Int
maxHistory (Histories Map Text History
m) = Map Text History -> Histories
Histories (Map Text History -> Histories) -> Map Text History -> Histories
forall a b. (a -> b) -> a -> b
$ (History -> History) -> Map Text History -> Map Text History
forall a b k. (a -> b) -> Map k a -> Map k b
M.map History -> History
trimH Map Text History
m
  where
    trimH :: History -> History
trimH (History Int
cur [Text]
content Text
prefix) = Int -> [Text] -> Text -> History
History Int
cur ([Text] -> [Text]
forall a. [a] -> [a]
trim [Text]
content) Text
prefix
    trim :: [a] -> [a]
trim [a]
content = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
content Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxHistory)) [a]
content

-- | Here is a persistent history saving part.
--   We assume each command is a single line.
--   To add new components, one has to:
--
--   * add new field in @PersistentState@ structure,
--   * add write and read parts in @loadPersistentState@/@savePersistentState@,
--   * add a trimming code in @savePersistentState@ to prevent blowing up
--     of save file.
savePersistentState :: YiM ()
savePersistentState :: YiM ()
savePersistentState = do
    MaxHistoryEntries Int
histLimit <- EditorM MaxHistoryEntries -> YiM MaxHistoryEntries
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM MaxHistoryEntries
forall b (m :: * -> *). (YiConfigVariable b, MonadEditor m) => m b
askConfigVariableA
    FilePath
pStateFilename      <- YiM FilePath
forall (m :: * -> *). MonadBase IO m => m FilePath
getPersistentStateFilename
    (Histories
hist :: Histories) <- EditorM Histories -> YiM Histories
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor   EditorM Histories
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
    Killring
kr                  <- EditorM Killring -> YiM Killring
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM Killring -> YiM Killring)
-> EditorM Killring -> YiM Killring
forall a b. (a -> b) -> a -> b
$ Getting Killring Editor Killring -> EditorM Killring
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Killring Editor Killring
Lens' Editor Killring
killringA
    Maybe SearchExp
curRe               <- EditorM (Maybe SearchExp) -> YiM (Maybe SearchExp)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor   EditorM (Maybe SearchExp)
getRegexE
    let pState :: PersistentState
pState = PersistentState :: Histories -> Killring -> Maybe SearchExp -> PersistentState
PersistentState {
                   histories :: Histories
histories     = Int -> Histories -> Histories
trimHistories Int
histLimit Histories
hist
                 , aKillring :: Killring
aKillring     = Killring
kr    -- trimmed during normal operation
                 , aCurrentRegex :: Maybe SearchExp
aCurrentRegex = Maybe SearchExp
curRe -- just a single value -> no need to trim
                 }
    IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> PersistentState -> IO ()
forall a. Binary a => FilePath -> a -> IO ()
encodeFile FilePath
pStateFilename PersistentState
pState

-- | Reads and decodes a persistent state in both strict, and exception robust
--   way.
readPersistentState :: YiM (Maybe PersistentState)
readPersistentState :: YiM (Maybe PersistentState)
readPersistentState = do FilePath
pStateFilename <- YiM FilePath
forall (m :: * -> *). MonadBase IO m => m FilePath
getPersistentStateFilename
                         Bool
pStateExists <- IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool) -> IO Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
pStateFilename
                         if Bool -> Bool
not Bool
pStateExists
                           then Maybe PersistentState -> YiM (Maybe PersistentState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PersistentState
forall a. Maybe a
Nothing
                           else IO (Maybe PersistentState) -> YiM (Maybe PersistentState)
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO (Maybe PersistentState) -> YiM (Maybe PersistentState))
-> IO (Maybe PersistentState) -> YiM (Maybe PersistentState)
forall a b. (a -> b) -> a -> b
$ IO (Maybe PersistentState) -> IO (Maybe PersistentState)
forall a. IO (Maybe a) -> IO (Maybe a)
ignoringException (IO (Maybe PersistentState) -> IO (Maybe PersistentState))
-> IO (Maybe PersistentState) -> IO (Maybe PersistentState)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe PersistentState)
strictDecoder FilePath
pStateFilename
  where
    strictDecoder :: FilePath -> IO (Maybe PersistentState)
strictDecoder FilePath
filename = do (PersistentState
state :: PersistentState) <- FilePath -> IO PersistentState
forall a. Binary a => FilePath -> IO a
decodeFile FilePath
filename
                                PersistentState
state PersistentState
-> IO (Maybe PersistentState) -> IO (Maybe PersistentState)
`seq` Maybe PersistentState -> IO (Maybe PersistentState)
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistentState -> Maybe PersistentState
forall a. a -> Maybe a
Just PersistentState
state)

-- | Loads a persistent state, and sets Yi state variables accordingly.
loadPersistentState :: YiM ()
loadPersistentState :: YiM ()
loadPersistentState = do
    Maybe PersistentState
maybePState <- YiM (Maybe PersistentState)
readPersistentState
    case Maybe PersistentState
maybePState of
      Maybe PersistentState
Nothing     -> () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just PersistentState
pState -> do Histories -> YiM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn                (Histories -> YiM ()) -> Histories -> YiM ()
forall a b. (a -> b) -> a -> b
$ PersistentState -> Histories
histories     PersistentState
pState
                        ASetter Editor Editor Killring Killring -> Killring -> YiM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
(.=) ASetter Editor Editor Killring Killring
Lens' Editor Killring
killringA            (Killring -> YiM ()) -> Killring -> YiM ()
forall a b. (a -> b) -> a -> b
$ PersistentState -> Killring
aKillring     PersistentState
pState
                        PersistentSearch Bool
keepSearch <- YiM PersistentSearch
forall b (m :: * -> *). (YiConfigVariable b, MonadEditor m) => m b
askConfigVariableA
                        Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
keepSearch (YiM () -> YiM ())
-> (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$
                            EditorM ()
-> (SearchExp -> EditorM ()) -> Maybe SearchExp -> EditorM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) SearchExp -> EditorM ()
setRegexE (Maybe SearchExp -> EditorM ()) -> Maybe SearchExp -> EditorM ()
forall a b. (a -> b) -> a -> b
$ PersistentState -> Maybe SearchExp
aCurrentRegex PersistentState
pState