module Yi.History where
import Control.Applicative
import Control.Lens
import Data.Binary
import Data.Default
import Data.List
import qualified Data.Map as M
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Typeable
import Yi.Buffer
import Yi.Editor
import qualified Yi.Rope as R
import Yi.Types (YiVariable)
newtype Histories = Histories (M.Map T.Text History)
deriving (Show, Eq, Typeable)
instance Binary Histories where
put (Histories m) = put $ M.mapKeys T.unpack m
get = Histories . M.mapKeys T.pack <$> get
instance Default Histories where
def = Histories def
data History = History { _historyCurrent :: Int
, _historyContents :: [T.Text]
, _historyPrefix :: T.Text
} deriving (Show, Eq, Typeable)
instance Default History where
def = History (1) [] mempty
instance Binary History where
put (History cu co pr) =
put cu >> put (map E.encodeUtf8 co) >> put (E.encodeUtf8 pr)
get = liftA3 History get (fmap E.decodeUtf8 <$> get) (E.decodeUtf8 <$> get)
instance YiVariable Histories
dynKeyA :: (Default v, Ord k) => k -> Lens' (M.Map k v) v
dynKeyA key = lens (M.findWithDefault def key) (flip (M.insert key))
miniBuffer :: T.Text
miniBuffer = "minibuffer"
historyUp :: EditorM ()
historyUp = historyMove miniBuffer 1
historyDown :: EditorM ()
historyDown = historyMove miniBuffer (1)
historyStart :: EditorM ()
historyStart = historyStartGen miniBuffer
historyStartGen :: T.Text -> EditorM ()
historyStartGen ident = do
Histories histories <- getEditorDyn
let (History _cur cont pref) = histories ^. dynKeyA ident
setHistory ident (History 0 (nub ("":cont)) pref) histories
historyFinish :: EditorM ()
historyFinish = historyFinishGen miniBuffer (R.toText <$> withCurrentBuffer elemsB)
historyFinishGen :: T.Text -> EditorM T.Text -> EditorM ()
historyFinishGen ident getCurValue = do
Histories histories <- getEditorDyn
let History _cur cont pref = histories ^. dynKeyA ident
curValue <- getCurValue
let cont' = dropWhile (curValue ==) . dropWhile T.null $ cont
curValue `seq`
cont' `seq`
setHistory ident (History (1) (curValue:cont') pref) histories
historyFind :: [T.Text] -> Int -> Int -> Int -> T.Text -> Int
historyFind cont len cur delta pref =
case (next < 0, next >= len) of
(True,_) -> next
(_,True) -> next
(_,_) -> if pref `T.isPrefixOf` (cont !! next)
then next
else historyFind cont len cur deltaLarger pref
where
next = cur + delta
deltaLarger = delta + signum delta
historyMove :: T.Text -> Int -> EditorM ()
historyMove ident delta = do
s <- historyMoveGen ident delta (R.toText <$> withCurrentBuffer elemsB)
withCurrentBuffer . replaceBufferContent . R.fromText $ s
historyMoveGen :: T.Text -> Int -> EditorM T.Text -> EditorM T.Text
historyMoveGen ident delta getCurValue = do
Histories histories <- getEditorDyn
let History cur cont pref = histories ^. dynKeyA ident
curValue <- getCurValue
let len = length cont
next = historyFind cont len cur delta pref
nextValue = cont !! next
case (next < 0, next >= len) of
(True, _) -> do
printMsg $ "end of " <> ident <> " history, no next item."
return curValue
(_, True) -> do
printMsg $ "beginning of " <> ident <> " history, no previous item."
return curValue
(_,_) -> do
let contents = take cur cont ++ [curValue] ++ drop (cur + 1) cont
setHistory ident (History next contents pref) histories
return nextValue
historyPrefixSet :: T.Text -> EditorM ()
historyPrefixSet = historyPrefixSet' miniBuffer
historyPrefixSet' :: T.Text -> T.Text -> EditorM ()
historyPrefixSet' ident pref = do
Histories histories <- getEditorDyn
let History cur cont _pref = histories ^. dynKeyA ident
setHistory ident (History cur cont pref) histories
setHistory :: (MonadEditor m, Functor m) => T.Text
-> History
-> M.Map T.Text History
-> m ()
setHistory i h = putEditorDyn . Histories . set (dynKeyA i) h