{-# 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
$cfrom :: forall x. PersistentState -> Rep PersistentState x
from :: forall x. PersistentState -> Rep PersistentState x
$cto :: forall x. Rep PersistentState x -> PersistentState
to :: forall x. Rep PersistentState x -> PersistentState
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
$cput :: MaxHistoryEntries -> Put
put :: MaxHistoryEntries -> Put
$cget :: Get MaxHistoryEntries
get :: Get MaxHistoryEntries
$cputList :: [MaxHistoryEntries] -> Put
putList :: [MaxHistoryEntries] -> Put
Binary)

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

instance YiConfigVariable MaxHistoryEntries

makeLenses ''MaxHistoryEntries

maxHistoryEntries :: Field Int
maxHistoryEntries :: Field Int
maxHistoryEntries = (MaxHistoryEntries -> f MaxHistoryEntries) -> Config -> f Config
forall a. YiConfigVariable a => Field a
Field MaxHistoryEntries
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
$cput :: PersistentSearch -> Put
put :: PersistentSearch -> Put
$cget :: Get PersistentSearch
get :: Get PersistentSearch
$cputList :: [PersistentSearch] -> Put
putList :: [PersistentSearch] -> Put
Binary)

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

instance YiConfigVariable PersistentSearch

makeLenses ''PersistentSearch

persistentSearch :: Field Bool
persistentSearch :: Field Bool
persistentSearch = (PersistentSearch -> f PersistentSearch) -> Config -> f Config
forall a. YiConfigVariable a => Field a
Field PersistentSearch
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 a. [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 histLimit <- EditorM MaxHistoryEntries -> YiM MaxHistoryEntries
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM MaxHistoryEntries
forall b (m :: * -> *). (YiConfigVariable b, MonadEditor m) => m b
askConfigVariableA
    pStateFilename      <- getPersistentStateFilename
    (hist :: Histories) <- withEditor   getEditorDyn
    kr                  <- withEditor $ use killringA
    curRe               <- withEditor   getRegexE
    let pState = 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 $ encodeFile pStateFilename pState

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

-- | Loads a persistent state, and sets Yi state variables accordingly.
loadPersistentState :: YiM ()
loadPersistentState :: YiM ()
loadPersistentState = do
    maybePState <- YiM (Maybe PersistentState)
readPersistentState
    case maybePState of
      Maybe PersistentState
Nothing     -> () -> YiM ()
forall a. a -> YiM a
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 keepSearch <- YiM PersistentSearch
forall b (m :: * -> *). (YiConfigVariable b, MonadEditor m) => m b
askConfigVariableA
                        when keepSearch . withEditor $
                            maybe (return ()) setRegexE $ aCurrentRegex pState