{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
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
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
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
, aCurrentRegex :: Maybe SearchExp
aCurrentRegex = Maybe SearchExp
curRe
}
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
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)
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