Hello community, here is the log from the commit of package ghc-yi-core for openSUSE:Factory checked in at 2017-07-05 23:59:55 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yi-core (Old) and /work/SRC/openSUSE:Factory/.ghc-yi-core.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-yi-core" Wed Jul 5 23:59:55 2017 rev:2 rq:506856 version:0.13.7 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yi-core/ghc-yi-core.changes 2017-05-10 20:46:31.320674974 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-yi-core.new/ghc-yi-core.changes 2017-07-05 23:59:56.535521475 +0200 @@ -1,0 +2,5 @@ +Mon Jun 19 20:53:33 UTC 2017 - [email protected] + +- Update to version 0.13.7. + +------------------------------------------------------------------- Old: ---- yi-core-0.13.5.tar.gz New: ---- yi-core-0.13.7.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yi-core.spec ++++++ --- /var/tmp/diff_new_pack.QruHdN/_old 2017-07-05 23:59:57.199427949 +0200 +++ /var/tmp/diff_new_pack.QruHdN/_new 2017-07-05 23:59:57.199427949 +0200 @@ -19,7 +19,7 @@ %global pkg_name yi-core %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.13.5 +Version: 0.13.7 Release: 0 Summary: Yi editor core library License: GPL-2.0+ @@ -67,6 +67,7 @@ BuildRequires: ghc-yi-rope-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} +BuildRequires: ghc-quickcheck-text-devel BuildRequires: ghc-tasty-devel BuildRequires: ghc-tasty-hunit-devel BuildRequires: ghc-tasty-quickcheck-devel ++++++ yi-core-0.13.5.tar.gz -> yi-core-0.13.7.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/bench/Bench.hs new/yi-core-0.13.7/bench/Bench.hs --- old/yi-core-0.13.5/bench/Bench.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/yi-core-0.13.7/bench/Bench.hs 2017-06-14 18:26:30.000000000 +0200 @@ -0,0 +1,99 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Main where + +import Control.DeepSeq +import Control.Monad +import Criterion +import Criterion.Main hiding (defaultConfig) +import qualified Data.List as L +import System.Environment +import System.IO +import Text.Printf (printf) +import Yi.Buffer +import Yi.Config (Config) +import Yi.Config.Default (defaultConfig) +import Yi.Editor +import qualified Yi.Rope as R + +-- bogus instance +instance NFData Editor where + rnf !_ = () + +data EditorAction = forall a b. (NFData a, NFData b) => + EditorAction + { _ea_act :: b -> EditorM a + , _ea_report :: a -> IO () + , _ea_setup :: EditorM b + , _ea_name :: String + , _ea_config :: Config + } + +simpleAction :: String -> EditorM () -> EditorAction +simpleAction n act = EditorAction + { _ea_act = \() -> act + , _ea_report = \() -> return () + , _ea_name = n + , _ea_config = defaultConfig + , _ea_setup = return () + } + +insertN :: Int -> EditorAction +insertN !n = EditorAction + { _ea_act = \() -> do + runLoop + , _ea_report = \yis_l -> + putStrLn $ printf "Buffer has %d characters." yis_l + + , _ea_name = "insert" ++ show n + , _ea_config = defaultConfig + , _ea_setup = return () + } + where + spin n' | n' <= 0 = R.length <$> elemsB + | otherwise = do + insertB 'X' + spin $! n' - 1 + runLoop = withCurrentBuffer $ spin n + +acts :: [EditorAction] +acts = [ simpleAction "split20" $ replicateM_ 20 splitE + , simpleAction "newTab20" (replicateM_ 20 newTabE) + , Main.insertN 10 + , Main.insertN 100 + , Main.insertN 1000 + , Main.insertN 100000 + , Main.insertN 1000000 + ] + +benchEditor :: (NFData a, NFData b) + => String -- ^ Benchmark name + -> Config -- ^ Config + -> EditorM a -- ^ Setup + -> (a -> EditorM b) -- ^ Action + -> Benchmark +benchEditor bname c setup act = + env (return $! runEditor c setup emptyEditor) $ \ ~(setupEditor, a) -> do + bench bname $ nf (\a' -> snd $ runEditor c (act a') setupEditor) a + +main :: IO () +main = getArgs >>= \case + ["list_actions"] -> print $ map _ea_name acts + ["run_action", action_name] -> case L.find ((action_name ==) . _ea_name) acts of + Just EditorAction{..} -> + let !(!_, b) = runEditor _ea_config (_ea_setup >>= _ea_act) emptyEditor + in do + _ea_report b + putStrLn $ _ea_name ++ " finished." + _ -> do + hPutStrLn stderr $ "No such action: " ++ action_name + hPutStrLn stderr $ "Available actions: " ++ show (map _ea_name acts) + _ -> do + let benchmarks :: [Benchmark] + benchmarks = flip map acts $ \EditorAction{..} -> + benchEditor _ea_name _ea_config _ea_setup _ea_act + defaultMain benchmarks diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Parser/Incremental.hs new/yi-core-0.13.7/src/Parser/Incremental.hs --- old/yi-core-0.13.5/src/Parser/Incremental.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Parser/Incremental.hs 2017-06-14 18:26:30.000000000 +0200 @@ -2,6 +2,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DeriveFunctor #-} -- TODO: -- better interface @@ -52,14 +53,10 @@ Fail :: Steps s a -- profile !! s = number of Dislikes found to do s Shifts -data Profile = PSusp | PFail | PRes Int | !Int :> Profile - deriving Show +data ProfileF a = PSusp | PFail | PRes a | !a :> ProfileF a + deriving (Show, Functor) -mapSucc :: Profile -> Profile -mapSucc PSusp = PSusp -mapSucc PFail = PFail -mapSucc (PRes x) = PRes (succ x) -mapSucc (x :> xs) = succ x :> mapSucc xs +type Profile = ProfileF Int -- Map lookahead to maximum dislike difference we accept. When looking much further, -- we are more prone to discard smaller differences. It's essential that this drops below 0 when @@ -112,7 +109,7 @@ profile (Shift p) = 0 :> profile p profile (Done) = PRes 0 -- success with zero dislikes profile (Fail) = PFail -profile (Dislike p) = mapSucc (profile p) +profile (Dislike p) = fmap succ (profile p) profile (Log _ p) = profile p profile (Sus _ _) = PSusp profile (Best _ pr _ _) = pr @@ -199,15 +196,15 @@ toQ (Shif p) = \k h -> Sh' $ toQ p k h toP :: Parser s a -> forall r. Steps s r -> Steps s (a :< r) -toP (Look a f) = \fut -> Sus (toP a fut) (\s -> toP (f s) fut) -toP (Appl f x) = App . toP f . toP x -toP (Pure x) = Val x -toP Empt = const Fail -toP (Disj a b) = \fut -> iBest (toP a fut) (toP b fut) -toP (Bind p a2q) = \fut -> toQ p (\(_,a) -> toP (a2q a) fut) () -toP (Yuck p) = Dislike . toP p -toP (Enter err p) = Log err . toP p -toP (Shif p) = Sh' . toP p +toP (Look a f) = {-# SCC "toP_Look" #-} \fut -> Sus (toP a fut) (\s -> toP (f s) fut) +toP (Appl f x) = {-# SCC "toP_Appl" #-} App . toP f . toP x +toP (Pure x) = {-# SCC "toP_Pure" #-} Val x +toP Empt = {-# SCC "toP_Empt" #-} const Fail +toP (Disj a b) = {-# SCC "toP_Disj" #-} \fut -> iBest (toP a fut) (toP b fut) +toP (Bind p a2q) = {-# SCC "toP_Bind" #-} \fut -> toQ p (\(_,a) -> toP (a2q a) fut) () +toP (Yuck p) = {-# SCC "toP_Yuck" #-} Dislike . toP p +toP (Enter err p) = {-# SCC "toP_Enter" #-} Log err . toP p +toP (Shif p) = {-# SCC "toP_Shif" #-} Sh' . toP p -- | Intelligent, caching best. iBest :: Steps s a -> Steps s a -> Steps s a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Buffer/HighLevel.hs new/yi-core-0.13.7/src/Yi/Buffer/HighLevel.hs --- old/yi-core-0.13.5/src/Yi/Buffer/HighLevel.hs 2016-12-08 00:13:42.000000000 +0100 +++ new/yi-core-0.13.7/src/Yi/Buffer/HighLevel.hs 2017-06-14 18:26:30.000000000 +0200 @@ -129,6 +129,7 @@ import Data.List (intersperse, sort) import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Monoid ((<>)) +import qualified Data.Set as Set import qualified Data.Text as T (Text, toLower, toUpper, unpack) import Data.Time (UTCTime) import Data.Tuple (swap) @@ -599,8 +600,7 @@ void $ gotoLnFrom n (markPointA fr .=) =<< pointB w <- askWindow wkey - (%=) pointFollowsWindowA (\old w' -> ((w == w') || old w')) - + pointFollowsWindowA %= Set.insert w -- Scroll line above window to the bottom. scrollToLineAboveWindowB :: BufferM () @@ -617,9 +617,9 @@ -- | Move the point to inside the viewable region snapInsB :: BufferM () snapInsB = do - movePoint <- use pointFollowsWindowA w <- askWindow wkey - when (movePoint w) $ do + movePoint <- Set.member w <$> use pointFollowsWindowA + when movePoint $ do r <- winRegionB p <- pointB moveTo $ max (regionStart r) $ min (regionEnd r) p @@ -643,9 +643,9 @@ -- | Move the visible region to include the point snapScreenB :: Maybe ScrollStyle ->BufferM Bool snapScreenB style = do - movePoint <- use pointFollowsWindowA w <- askWindow wkey - if movePoint w then return False else do + movePoint <- Set.member w <$> use pointFollowsWindowA + if movePoint then return False else do inWin <- pointInWindowB =<< pointB if inWin then return False else do h <- askWindow actualLines diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Buffer/Implementation.hs new/yi-core-0.13.7/src/Yi/Buffer/Implementation.hs --- old/yi-core-0.13.5/src/Yi/Buffer/Implementation.hs 2016-12-08 00:13:46.000000000 +0100 +++ new/yi-core-0.13.7/src/Yi/Buffer/Implementation.hs 2017-06-14 18:26:30.000000000 +0200 @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} @@ -26,7 +27,7 @@ , Mark, MarkValue(..) , Size , Direction (..) - , BufferImpl + , BufferImpl(..) , Overlay (..) , mkOverlay , overlayUpdate @@ -62,7 +63,6 @@ , markPointAA , markGravityAA , mem - , BufferImpl ) where import GHC.Generics (Generic) @@ -71,7 +71,7 @@ import Data.Binary (Binary (..)) import Data.Function (on) import Data.List (groupBy) -import qualified Data.Map as M (Map, delete, empty, findMax, insert, lookup, map, maxViewWithKey) +import qualified Data.Map.Strict as M (Map, delete, empty, findMax, insert, lookup, map, maxViewWithKey) import Data.Maybe (fromMaybe) import qualified Data.Set as Set (Set, delete, empty, filter, insert, map, toList) import Data.Typeable (Typeable) @@ -98,11 +98,11 @@ data HLState syntax = forall cache. HLState !(Highlighter cache syntax) !cache data Overlay = Overlay - { overlayOwner :: R.YiString - , overlayBegin :: MarkValue - , overlayEnd :: MarkValue - , overlayStyle :: StyleName - , overlayAnnotation :: R.YiString + { overlayOwner :: !R.YiString + , overlayBegin :: !MarkValue + , overlayEnd :: !MarkValue + , overlayStyle :: !StyleName + , overlayAnnotation :: !R.YiString } instance Eq Overlay where @@ -118,6 +118,14 @@ , compare msg msg' ] +instance Show Overlay where + show (Overlay a b c _ msg) = concat + [ "Overlay { " + , "overlayOwner = ", show a, ", " + , "overlayBegin = ", show b, ", " + , "overlayEnd = ", show c, ", " + , "overlayAnnotation = ", show msg, "}"] + data BufferImpl syntax = FBufferData { mem :: !YiString -- ^ buffer text , marks :: !Marks -- ^ Marks for this buffer @@ -321,10 +329,10 @@ overlays = Set.map (mapOvlMarks shift) (overlays fb)} -- FIXME: this is inefficient; find a way to use mapMonotonic -- (problem is that marks can have different gravities) - where (p', amount) = case u of - Insert pnt _ cs -> (insertChars p cs pnt, sz) - Delete pnt _ _ -> (deleteChars p pnt sz, negate sz) - sz = updateSize u + where (!p', !amount) = case u of + Insert pnt _ cs -> (insertChars p cs pnt, sz) + Delete pnt _ _ -> (deleteChars p pnt sz, negate sz) + !sz = updateSize u shift = shiftMarkValue (updatePoint u) amount p = mem fb -- FIXME: remove collapsed overlays diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Buffer/Misc.hs new/yi-core-0.13.7/src/Yi/Buffer/Misc.hs --- old/yi-core-0.13.5/src/Yi/Buffer/Misc.hs 2016-12-03 12:48:04.000000000 +0100 +++ new/yi-core-0.13.7/src/Yi/Buffer/Misc.hs 2017-06-14 18:26:30.000000000 +0200 @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} @@ -193,29 +194,30 @@ , fontsizeVariationA , encodingConverterNameA , stickyEolA + , queryBuffer ) where import Prelude hiding (foldr, mapM, notElem) -import Lens.Micro.Platform (Lens', lens, (%~), (^.), use, (.=), (%=), view) -import Control.Monad.RWS.Strict (Endo (Endo, appEndo), - MonadReader (ask), MonadState, - MonadWriter (tell), - asks, gets, join, modify, - replicateM_, runRWS, void, - when, (<>)) +import Control.Applicative (liftA2) +import Control.Monad (when, void, replicateM_, join) +import Data.Monoid +import Control.Monad.Reader +import Control.Monad.State.Strict hiding (get, put) import Data.Binary (Binary (..), Get) import Data.Char (ord) import Data.Default (Default (def)) import Data.DynamicState.Serializable (getDyn, putDyn) import Data.Foldable (Foldable (foldr), forM_, notElem) -import qualified Data.Map as M (Map, empty, insert, lookup) +import qualified Data.Map.Strict as M (Map, empty, insert, lookup) import Data.Maybe (fromMaybe, isNothing) +import qualified Data.Sequence as S import qualified Data.Set as Set (Set) import qualified Data.Text as T (Text, concat, justifyRight, pack, snoc, unpack) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Time (UTCTime (UTCTime)) import Data.Traversable (Traversable (mapM), forM) +import Lens.Micro.Platform (Lens', lens, (&), (.~), (%~), (^.), use, (.=), (%=), view) import Numeric (showHex) import System.FilePath (joinPath, splitPath) import Yi.Buffer.Basic (BufferRef, Point (..), Size (Size), WindowRef) @@ -396,7 +398,7 @@ queryBuffer x = gets (queryRawbuf x) modifyBuffer :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> BufferM () -modifyBuffer x = modify (modifyRawbuf x) +modifyBuffer x = modify' (modifyRawbuf x) queryAndModify :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) -> BufferM x queryAndModify x = getsAndModify (queryAndModifyRawbuf x) @@ -404,7 +406,7 @@ -- | Adds an "overlay" to the buffer addOverlayB :: Overlay -> BufferM () addOverlayB ov = do - pendingUpdatesA %= (++ [overlayUpdate ov]) + pendingUpdatesA %= (S.|> overlayUpdate ov) modifyBuffer $ addOverlayBI ov getOverlaysOfOwnerB :: R.YiString -> BufferM (Set.Set Overlay) @@ -413,7 +415,7 @@ -- | Remove an existing "overlay" delOverlayB :: Overlay -> BufferM () delOverlayB ov = do - pendingUpdatesA %= (++ [overlayUpdate ov]) + pendingUpdatesA %= (S.|> overlayUpdate ov) modifyBuffer $ delOverlayBI ov delOverlaysOfOwnerB :: R.YiString -> BufferM () @@ -438,9 +440,13 @@ getMarksRaw :: Window -> FBuffer -> Maybe WinMarks getMarksRaw w b = M.lookup (wkey w) (b ^. winMarksA) -runBufferFull :: Window -> FBuffer -> BufferM a -> (a, [Update], FBuffer) +runBufferFull :: Window -> FBuffer -> BufferM a -> (a, S.Seq Update, FBuffer) runBufferFull w b f = - let (a, b', updates) = runRWS (fromBufferM f') w b + let (a, b') = runState (runReaderT (fromBufferM f') w) b + updates = b' ^. updateStreamA + -- We're done running BufferM, don't store updates in editor + -- state. + !newSt = b' & updateStreamA .~ mempty f' = do ms <- getMarks w when (isNothing ms) $ do @@ -452,13 +458,13 @@ selMark = MarkValue 0 Backward, -- sel fromMark = MarkValue 0 Backward } -- from else do - Just mrks <- uses winMarksA (M.lookup $ wkey (b ^. lastActiveWindowA)) + Just mrks <- uses winMarksA (M.lookup $ wkey (b ^. lastActiveWindowA)) forM mrks getMarkValueB newMrks <- forM newMarkValues newMarkB winMarksA %= M.insert (wkey w) newMrks lastActiveWindowA .= w f - in (a, updates, pendingUpdatesA %~ (++ fmap TextUpdate updates) $ b') + in (a, updates, pendingUpdatesA %~ (S.>< fmap TextUpdate updates) $ newSt) getMarkValueRaw :: Mark -> FBuffer -> MarkValue getMarkValueRaw m = fromMaybe (MarkValue 0 Forward) . queryRawbuf (getMarkValueBI m) @@ -506,14 +512,14 @@ else do updateTransactionInFlightA .= False transacAccum <- use updateTransactionAccumA - updateTransactionAccumA .= [] + updateTransactionAccumA .= mempty - undosA %= (appEndo . mconcat) (Endo . addChangeU . AtomicChange <$> transacAccum) + undosA %= (appEndo . foldr (<>) mempty) (Endo . addChangeU . AtomicChange <$> transacAccum) undosA %= addChangeU InteractivePoint undoRedo :: (forall syntax. Mark -> URList -> BufferImpl syntax - -> (BufferImpl syntax, (URList, [Update]))) + -> (BufferImpl syntax, (URList, S.Seq Update))) -> BufferM () undoRedo f = do isTransacPresent <- use updateTransactionInFlightA @@ -524,7 +530,7 @@ ur <- use undosA (ur', updates) <- queryAndModify (f m ur) undosA .= ur' - tell updates + updateStreamA %= (<> updates) undoB :: BufferM () undoB = undoRedo undoU @@ -597,7 +603,7 @@ , preferVisCol = Nothing , stickyEol = False , bufferDynamic = mempty - , pendingUpdates = [] + , pendingUpdates = mempty , selectionStyle = SelectionStyle False False , keymapProcess = I.End , winMarks = M.empty @@ -606,11 +612,12 @@ , readOnly = False , directoryContent = False , inserting = True - , pointFollowsWindow = const False + , pointFollowsWindow = mempty , updateTransactionInFlight = False - , updateTransactionAccum = [] + , updateTransactionAccum = mempty , fontsizeVariation = 0 , encodingConverterName = Nothing + , updateStream = mempty } } epoch :: UTCTime @@ -666,26 +673,26 @@ applyUpdate :: Update -> BufferM () applyUpdate update = do - ro <- checkRO - valid <- queryBuffer (isValidUpdate update) - when (not ro && valid) $ do + runp <- liftA2 (&&) (not <$> checkRO) (queryBuffer (isValidUpdate update)) + when runp $ do forgetPreferCol - let reversed = reverseUpdateI update modifyBuffer (applyUpdateI update) - isTransacPresent <- use updateTransactionInFlightA if isTransacPresent - then updateTransactionAccumA %= (reversed:) - else undosA %= addChangeU (AtomicChange reversed) + then updateTransactionAccumA %= (reverseUpdateI update S.<|) + else undosA %= addChangeU (AtomicChange $ reverseUpdateI update) + + updateStreamA %= (S.|> update) - tell [update] - -- otherwise, just ignore. -- | Revert all the pending updates; don't touch the point. revertPendingUpdatesB :: BufferM () revertPendingUpdatesB = do updates <- use pendingUpdatesA - modifyBuffer (flip (foldr (\u bi -> applyUpdateI (reverseUpdateI u) bi)) [u | TextUpdate u <- updates]) + modifyBuffer $ \stx -> + let applyTextUpdate (TextUpdate u) bi = applyUpdateI (reverseUpdateI u) bi + applyTextUpdate _ bi = bi + in foldr applyTextUpdate stx updates -- | Write an element into the buffer at the current point. writeB :: Char -> BufferM () @@ -874,8 +881,8 @@ askMarks :: BufferM WinMarks askMarks = do - Just ms <- getMarks =<< ask - return ms + Just !ms <- getMarks =<< ask + return ms getMarkB :: Maybe String -> BufferM Mark getMarkB m = do @@ -961,7 +968,11 @@ pointOfLineColB line col = savingPointB $ moveToLineColB line col >> pointB forgetPreferCol :: BufferM () -forgetPreferCol = preferColA .= Nothing >> preferVisColA .= Nothing +forgetPreferCol = do + preferColA .= Nothing + preferVisColA .= Nothing + !st <- gets id + return $! (st `seq` ()) savingPrefCol :: BufferM a -> BufferM a savingPrefCol f = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Buffer/Undo.hs new/yi-core-0.13.7/src/Yi/Buffer/Undo.hs --- old/yi-core-0.13.5/src/Yi/Buffer/Undo.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Buffer/Undo.hs 2017-06-14 18:26:30.000000000 +0200 @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} -- | An implementation of restricted, linear undo, as described in: -- @@ -55,9 +56,10 @@ , Change(AtomicChange, InteractivePoint) ) where -import GHC.Generics (Generic) - import Data.Binary (Binary (..)) +import Data.Monoid +import qualified Data.Sequence as S +import GHC.Generics (Generic) import Yi.Buffer.Implementation data Change = SavedFilePoint @@ -70,7 +72,7 @@ instance Binary Change -- | A URList consists of an undo and a redo list. -data URList = URList ![Change] ![Change] +data URList = URList !(S.Seq Change) !(S.Seq Change) deriving (Show, Generic) instance Binary URList @@ -78,14 +80,14 @@ -- Notice we must have a saved file point as this is when we assume we are -- opening the file so it is currently the same as the one on disk emptyU :: URList -emptyU = URList [SavedFilePoint] [] +emptyU = URList (S.singleton SavedFilePoint) S.empty -- | Add an action to the undo list. -- According to the restricted, linear undo model, if we add a command -- whilst the redo list is not empty, we will lose our redoable changes. addChangeU :: Change -> URList -> URList addChangeU InteractivePoint (URList us rs) = URList (addIP us) rs -addChangeU u (URList us _rs) = URList (u:us) [] +addChangeU u (URList us _) = URList (u S.<| us) S.empty -- | Add a saved file point so that we can tell that the buffer has not -- been modified since the previous saved file point. @@ -93,50 +95,55 @@ -- since they are now worthless. setSavedFilePointU :: URList -> URList setSavedFilePointU (URList undos redos) = - URList (SavedFilePoint : cleanUndos) cleanRedos + URList (SavedFilePoint S.<| cleanUndos) cleanRedos where - cleanUndos = filter isNotSavedFilePoint undos - cleanRedos = filter isNotSavedFilePoint redos + cleanUndos = S.filter isNotSavedFilePoint undos + + cleanRedos = S.filter isNotSavedFilePoint redos + isNotSavedFilePoint :: Change -> Bool isNotSavedFilePoint SavedFilePoint = False isNotSavedFilePoint _ = True -- | This undoes one interaction step. -undoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) -undoU m = undoUntilInteractive m [] . undoInteractive +undoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, S.Seq Update)) +undoU m = undoUntilInteractive m mempty . undoInteractive -- | This redoes one iteraction step. -redoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) +redoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, S.Seq Update)) redoU = asRedo . undoU -- | Prepare undo by moving one interaction point from undoes to redoes. undoInteractive :: URList -> URList undoInteractive (URList us rs) = URList (remIP us) (addIP rs) -remIP, addIP :: [Change] -> [Change] - -- | Remove an initial interactive point, if there is one -remIP (InteractivePoint:xs) = xs -remIP xs = xs +remIP :: S.Seq Change -> S.Seq Change +remIP xs = case S.viewl xs of + InteractivePoint S.:< xs' -> xs' + _ -> xs -- | Insert an initial interactive point, if there is none -addIP xs@(InteractivePoint:_) = xs -addIP xs = InteractivePoint:xs +addIP :: S.Seq Change -> S.Seq Change +addIP xs = case S.viewl xs of + InteractivePoint S.:< _ -> xs + _ -> InteractivePoint S.<| xs -- | Repeatedly undo actions, storing away the inverse operations in the -- redo list. -undoUntilInteractive :: Mark -> [Update] -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) -undoUntilInteractive pointMark xs ur@(URList cs rs) b = case cs of - [] -> (b, (ur, xs)) - [SavedFilePoint] -> (b, (ur, xs)) -- Why this special case? - (InteractivePoint:_) -> (b, (ur, xs)) - (SavedFilePoint:cs') -> - undoUntilInteractive pointMark xs (URList cs' (SavedFilePoint:rs)) b - (AtomicChange u:cs') -> - let ur' = URList cs' (AtomicChange (reverseUpdateI u):rs) - b' = applyUpdateWithMoveI u b - (b'', (ur'', xs'')) = undoUntilInteractive pointMark xs ur' b' - in (b'', (ur'', u:xs'')) +undoUntilInteractive :: Mark -> S.Seq Update -> URList -> BufferImpl syntax + -> (BufferImpl syntax, (URList, S.Seq Update)) +undoUntilInteractive pointMark xs ur@(URList cs rs) b = case S.viewl cs of + S.EmptyL -> (b, (ur, xs)) + SavedFilePoint S.:< (S.viewl -> S.EmptyL) -> (b, (ur, xs)) -- Why this special case? + InteractivePoint S.:< _ -> (b, (ur, xs)) + SavedFilePoint S.:< cs' -> + undoUntilInteractive pointMark xs (URList cs' (SavedFilePoint S.<| rs)) b + AtomicChange u S.:< cs' -> + let ur' = URList cs' (AtomicChange (reverseUpdateI u) S.<| rs) + b' = applyUpdateWithMoveI u b + (b'', (ur'', xs')) = undoUntilInteractive pointMark xs ur' b' + in (b'', (ur'', u S.<| xs')) where -- Apply a /valid/ update and also move point in buffer to update position applyUpdateWithMoveI :: Update -> BufferImpl syntax -> BufferImpl syntax @@ -148,8 +155,10 @@ -- | Run the undo-function @f@ on a swapped URList making it -- operate in a redo fashion instead of undo. -asRedo :: (URList -> t -> (t, (URList, [Update]))) -> URList -> t -> (t, (URList, [Update])) -asRedo f ur x = let (y,(ur',rs)) = f (swapUndoRedo ur) x in (y,(swapUndoRedo ur',rs)) +asRedo :: (URList -> t -> (t, (URList, S.Seq Update))) -> URList -> t + -> (t, (URList, S.Seq Update)) +asRedo f ur x = let (y,(ur',rs)) = f (swapUndoRedo ur) x + in (y,(swapUndoRedo ur',rs)) where swapUndoRedo :: URList -> URList swapUndoRedo (URList us rs) = URList rs us @@ -162,8 +171,8 @@ isAtSavedFilePointU :: URList -> Bool isAtSavedFilePointU (URList us _) = isUnchanged us where - isUnchanged cs = case cs of - [] -> False - (SavedFilePoint : _) -> True - (InteractivePoint : cs') -> isUnchanged cs' - _ -> False + isUnchanged cs = case S.viewl cs of + S.EmptyL -> False + SavedFilePoint S.:< _ -> True + InteractivePoint S.:< cs' -> isUnchanged cs' + _ -> False diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Completion.hs new/yi-core-0.13.7/src/Yi/Completion.hs --- old/yi-core-0.13.5/src/Yi/Completion.hs 2016-09-29 16:40:52.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Completion.hs 2017-06-14 18:26:30.000000000 +0200 @@ -49,6 +49,7 @@ -- | Text from the match up to the end, for use with 'completeInList' infixUptoEndMatch :: T.Text -> T.Text -> Maybe T.Text +infixUptoEndMatch "" haystack = Just haystack infixUptoEndMatch needle haystack = case T.breakOn needle haystack of (_, t) -> if T.null t then Nothing else Just t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Config/Default.hs new/yi-core-0.13.7/src/Yi/Config/Default.hs --- old/yi-core-0.13.5/src/Yi/Config/Default.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Config/Default.hs 2017-06-14 18:26:30.000000000 +0200 @@ -4,10 +4,8 @@ module Yi.Config.Default (defaultConfig) where -import Lens.Micro.Platform ((.~), (^.), use) -import Control.Monad +import Lens.Micro.Platform ((.~)) import qualified Data.HashMap.Strict as HM -import qualified Data.Map as M import Data.Monoid import Paths_yi_core import System.FilePath @@ -17,7 +15,6 @@ makeBuild, reloadProjectE, searchSources, shell) import Yi.Config -import Yi.Config.Misc import Yi.Core (errorEditor, quitEditor) import Yi.Editor import Yi.Eval (publishedActions) @@ -99,15 +96,15 @@ , configTheme = defaultTheme } , defaultKm = modelessKeymapSet nilKeymap - , startActions = [] - , initialActions = [] + , startActions = mempty + , initialActions = mempty , modeTable = [AnyMode fundamentalMode] , debugMode = False , configKillringAccumulate = False , configCheckExternalChangesObsessively = True , configRegionStyle = Exclusive , configInputPreprocess = I.idAutomaton - , bufferUpdateHandler = [] + , bufferUpdateHandler = mempty , layoutManagers = [hPairNStack 1, vPairNStack 1, tall, wide] , configVars = mempty } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Config/Simple.hs new/yi-core-0.13.7/src/Yi/Config/Simple.hs --- old/yi-core-0.13.5/src/Yi/Config/Simple.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Config/Simple.hs 2017-06-14 18:26:30.000000000 +0200 @@ -115,10 +115,10 @@ module Yi.Misc, ) where -import Lens.Micro.Platform (Lens', (.=), (%=), (%~), use, lens) +import Lens.Micro.Platform (Lens', (%=), (%~), use, lens) import Control.Monad.State hiding (modify, get) -import Data.Maybe(mapMaybe) import qualified Data.Text as T +import qualified Data.Sequence as S import Text.Printf(printf) import Yi.Boot import Yi.Buffer hiding (modifyMode) @@ -373,5 +373,5 @@ killringAccumulate = configKillringAccumulateA -- | ? -bufferUpdateHandler :: Field [[Update] -> BufferM ()] +bufferUpdateHandler :: Field (S.Seq (S.Seq Update -> BufferM ())) bufferUpdateHandler = bufferUpdateHandlerA diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Core.hs new/yi-core-0.13.7/src/Yi/Core.hs --- old/yi-core-0.13.5/src/Yi/Core.hs 2016-10-23 20:14:40.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Core.hs 2017-06-14 18:26:30.000000000 +0200 @@ -46,12 +46,11 @@ import Prelude hiding (elem, mapM_, or) -import Control.Concurrent (ThreadId, forkIO, forkOS, - modifyMVar, modifyMVar_, - newMVar, readMVar, threadDelay) +import Control.Concurrent (forkOS, modifyMVar, modifyMVar_ + ,newMVar, readMVar, threadDelay) import Control.Exc (ignoringException) import Control.Exception (SomeException, handle) -import Lens.Micro.Platform (mapped, use, view, (%=), (%~), +import Lens.Micro.Platform (mapped, use, view, (%=), (%~), (&), (.=), (.~), (^.)) import Control.Monad (forever, void, when) import Control.Monad.Base (MonadBase (liftBase)) @@ -65,7 +64,7 @@ import Data.List.Split (splitOn) import qualified Data.Map as M (assocs, delete, empty, fromList, insert, member) import Data.Maybe (fromMaybe, isNothing) -import Data.Monoid (First (First, getFirst), (<>)) +import Data.Monoid (First (First, getFirst), (<>), mempty) import qualified Data.Text as T (Text, pack, unwords) import Data.Time (getCurrentTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) @@ -320,8 +319,8 @@ -- Terminate stale processes. terminateSubprocesses (staleProcess $ buffers e7) yi var {yiEditor = e7} where - clearUpdates = pendingUpdatesA .~ [] - clearFollow = pointFollowsWindowA .~ const False + clearUpdates = pendingUpdatesA .~ mempty + clearFollow = pointFollowsWindowA .~ mempty -- Is this process stale? (associated with a deleted buffer) staleProcess bs p = not (bufRef p `M.member` bs) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Editor.hs new/yi-core-0.13.7/src/Yi/Editor.hs --- old/yi-core-0.13.5/src/Yi/Editor.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Editor.hs 2017-06-14 18:26:30.000000000 +0200 @@ -112,7 +112,7 @@ import Data.Default (Default, def) import qualified Data.DelayList as DelayList (insert) import Data.DynamicState.Serializable (getDyn, putDyn) -import Data.Foldable (Foldable (foldl, foldr), all, concatMap, toList) +import Data.Foldable (Foldable (foldl, foldl', foldr), all, concatMap, toList) import Data.List (delete, (\\)) import Data.List.NonEmpty (NonEmpty (..), fromList, nub) import qualified Data.List.NonEmpty as NE (filter, head, length, toList, (<|)) @@ -128,6 +128,7 @@ import Data.Maybe (fromJust, fromMaybe, isNothing) import qualified Data.Monoid as Mon ((<>)) import Data.Semigroup ((<>)) +import qualified Data.Sequence as S import qualified Data.Text as T (Text, null, pack, unlines, unpack, unwords) import System.FilePath (splitPath) import Yi.Buffer @@ -149,7 +150,7 @@ assign :: MonadState s m => ASetter s s a b -> b -> m () assign = (.=) -uses l f = f <$> use l +uses l f = f <$> use l instance Binary Editor where put (Editor bss bs supply ts dv _sl msh kr regex _dir _ev _cwa ) = @@ -369,16 +370,17 @@ (v, us, b') = runBufferFull w b f in (e & buffersA .~ mapAdjust' (const b') k (buffers e) & killringA %~ - if accum && all updateIsDelete us - then foldl (.) id $ reverse [ krPut dir s - | Delete _ dir s <- us ] - else id - + (\kr -> + if accum && all updateIsDelete us + then let putDelKr kr' (Delete _ dir s) = krPut dir s kr' + putDelKr kr' _ = kr' + in foldl' putDelKr kr (S.reverse us) + else kr) , (us, v)) (us, v) <- getsAndModify edit updHandler <- return . bufferUpdateHandler =<< ask - unless (null us || null updHandler) $ + unless (S.null us || S.null updHandler) $ forM_ updHandler (\h -> withGivenBufferAndWindow w k (h us)) return v diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Eval.hs new/yi-core-0.13.7/src/Yi/Eval.hs --- old/yi-core-0.13.5/src/Yi/Eval.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Eval.hs 2017-06-14 18:26:30.000000000 +0200 @@ -177,7 +177,9 @@ instance YiVariable HelpCache #ifdef HINT -type HintRequest = (String, MVar (Either LHI.InterpreterError Action)) +data HintRequest = HintEvaluate String (MVar (Either LHI.InterpreterError Action)) + | HintGetNames (MVar (Either LHI.InterpreterError [LHI.ModuleElem])) + | HintDescribe String (MVar (Either LHI.InterpreterError String)) newtype HintThreadVar = HintThreadVar (Maybe (MVar HintRequest)) deriving (Typeable, Default) @@ -211,10 +213,17 @@ -- Yi.Keymap: Action lives there LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")] - forever $ do - (s,response) <- lift $ takeMVar request - res <- try $ LHI.interpret ("Yi.makeAction (" ++ s ++ ")") (LHI.as :: Action) - lift $ putMVar response res + + forever $ lift (takeMVar request) >>= \case + HintEvaluate s response -> do + res <- try $ LHI.interpret ("Yi.makeAction (" ++ s ++ ")") (LHI.as :: Action) + lift $ putMVar response res + HintGetNames response -> do + res <- try $ LHI.getModuleExports "Yi" + lift $ putMVar response res + HintDescribe name response -> do + res <- try $ LHI.typeOf name + lift $ putMVar response res -- Evaluator implemented by calling GHCi. This evaluator can run -- arbitrary expressions in the class 'YiAction'. @@ -241,7 +250,7 @@ request <- getHintThread res <- io $ do response <- newEmptyMVar - putMVar request (s,response) + putMVar request (HintEvaluate s response) takeMVar response case res of Left err -> errorEditor (showT err) @@ -252,11 +261,13 @@ NamesCache cache <- getEditorDyn result <- if null cache then do - res <- io $ LHI.runInterpreter $ do - LHI.set [LHI.searchPath LHI.:= []] - LHI.getModuleExports "Yi" + request <- getHintThread + res <- io $ do + response <- newEmptyMVar + putMVar request (HintGetNames response) + takeMVar response return $ case res of - Left err ->[show err] + Left err -> [show err] Right exports -> flattenExports exports else return $ sort cache putEditorDyn $ NamesCache result @@ -275,14 +286,12 @@ HelpCache cache <- getEditorDyn description <- case name `M.lookup` cache of Nothing -> do - result <- io $ LHI.runInterpreter $ do - LHI.set [LHI.searchPath LHI.:= []] - -- when haveUserContext $ do - -- LHI.loadModules [contextFile] - -- LHI.setTopLevelModules ["Env"] - LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")] - LHI.typeOf name - let newDescription = either show id result + request <- getHintThread + res <- io $ do + response <- newEmptyMVar + putMVar request (HintDescribe name response) + takeMVar response + let newDescription = either show id res putEditorDyn $ HelpCache $ M.insert name newDescription cache return newDescription Just description -> return description diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/IncrementalParse.hs new/yi-core-0.13.7/src/Yi/IncrementalParse.hs --- old/yi-core-0.13.5/src/Yi/IncrementalParse.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/IncrementalParse.hs 2017-06-14 18:26:30.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} module Yi.IncrementalParse (recoverWith, symbol, eof, lookNext, testNext, State, P, Parser(..), AlexState (..), scanner) where @@ -26,8 +27,9 @@ run :: State st token result -> [(State st token result, result)] run (st,process) = updateState0 process $ scanRun input st + updateState0 :: Process token result -> [(st,token)] -> [(State st token result, result)] updateState0 _ [] = [] updateState0 curState toks@((st,tok):rest) = ((st, curState), result) : updateState0 nextState rest - where nextState = evalL $ pushSyms [tok] curState + where !nextState = evalL $ pushSyms [tok] curState result = fst $ evalR $ pushEof $ pushSyms (fmap snd toks) curState diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/KillRing.hs new/yi-core-0.13.7/src/Yi/KillRing.hs --- old/yi-core-0.13.5/src/Yi/KillRing.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/KillRing.hs 2017-06-14 18:26:30.000000000 +0200 @@ -34,10 +34,10 @@ import qualified Yi.Rope as R (YiString, length) -data Killring = Killring { _krKilled :: Bool - , _krAccumulate :: Bool - , _krContents :: NonEmpty R.YiString - , _krLastYank :: Bool +data Killring = Killring { _krKilled :: !Bool + , _krAccumulate :: !Bool + , _krContents :: !(NonEmpty R.YiString) + , _krLastYank :: !Bool } deriving (Show, Eq) instance Binary Killring where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Main.hs new/yi-core-0.13.7/src/Yi/Main.hs --- old/yi-core-0.13.5/src/Yi/Main.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Main.hs 2017-06-17 18:50:43.000000000 +0200 @@ -125,7 +125,7 @@ (os, _, u:us, []) -> if ignoreUnknown then handle options os else fail $ "unknown arguments: " ++ intercalate ", " (u:us) - (os, ex, ey, errs) -> fail (concat errs) + (_os, _ex, _ey, errs) -> fail (concat errs) where shouldOpenInTabs = ("--" ++ openInTabsLong) `elem` args || ('-':[openInTabsShort]) `elem` args diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Mode/Common.hs new/yi-core-0.13.7/src/Yi/Mode/Common.hs --- old/yi-core-0.13.5/src/Yi/Mode/Common.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Mode/Common.hs 2017-06-14 18:26:30.000000000 +0200 @@ -21,9 +21,8 @@ import Control.Applicative ((<|>)) import Control.Monad (void) import qualified Data.Attoparsec.Text as P -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe) import System.FilePath (takeExtension) -import qualified Data.Text as T (Text) import Yi.Buffer import qualified Yi.IncrementalParse as IncrParser (scanner) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Process.hs new/yi-core-0.13.7/src/Yi/Process.hs --- old/yi-core-0.13.5/src/Yi/Process.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Process.hs 2017-06-14 18:26:30.000000000 +0200 @@ -17,8 +17,10 @@ import Yi.Buffer.Basic (BufferRef) import Yi.Monad (repeatUntilM) -#ifndef mingw32_HOST_OS -import System.Posix.IO (createPipe, fdToHandle) +#ifdef mingw32_HOST_OS +import System.Process (runInteractiveProcess) +#else +import System.Posix.IO (createPipe, fdToHandle) #endif runProgCommand :: ListLikeProcessIO a c => String -> [String] -> IO (ExitCode, a, a) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Search.hs new/yi-core-0.13.7/src/Yi/Search.hs --- old/yi-core-0.13.5/src/Yi/Search.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Search.hs 2017-06-14 18:26:30.000000000 +0200 @@ -71,7 +71,7 @@ import Yi.Buffer import Yi.Editor import Yi.History (historyFinishGen, historyMoveGen, historyStartGen) -import Yi.Regex +import Yi.Regex (SearchOption(..), makeSearchOptsM, emptyRegex, SearchExp(..)) import qualified Yi.Rope as R (YiString, null, toString, toText) import Yi.Search.Internal (getRegexE, resetRegexE, setRegexE) import Yi.String (showT) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/src/Yi/Types.hs new/yi-core-0.13.7/src/Yi/Types.hs --- old/yi-core-0.13.5/src/Yi/Types.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/src/Yi/Types.hs 2017-06-14 18:26:30.000000000 +0200 @@ -28,9 +28,10 @@ import Control.Concurrent (MVar, modifyMVar, modifyMVar_, readMVar) import Control.Monad.Base (MonadBase, liftBase) -import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT) -import Control.Monad.RWS.Strict (MonadWriter, RWS, ap, liftM3, void) -import Control.Monad.State (MonadState (..), State, forever, runState) +import Control.Monad.Reader +import Control.Monad.State.Strict +import Control.Monad (ap, liftM3, void, forever) +import qualified Data.Set as Set import Data.Binary (Binary) import qualified Data.Binary as B (get, put) import Data.Default (Default, def) @@ -40,11 +41,12 @@ import Data.Function (on) import Data.List.NonEmpty (NonEmpty) import Data.List.PointedList (PointedList) -import qualified Data.Map as M (Map) +import qualified Data.Map.Strict as M (Map) import qualified Data.Text as T (Text) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Time (UTCTime (..)) import Data.Typeable (Typeable) +import qualified Data.Sequence as S import Data.Word (Word8) import Yi.Buffer.Basic (BufferRef, WindowRef) import Yi.Buffer.Implementation @@ -164,16 +166,18 @@ -- Yi.Buffer.Misc -- | The BufferM monad writes the updates performed. -newtype BufferM a = BufferM { fromBufferM :: RWS Window [Update] FBuffer a } - deriving (Monad, Functor, MonadWriter [Update], MonadState FBuffer, MonadReader Window, Typeable) +newtype BufferM a = BufferM { fromBufferM :: ReaderT Window (State FBuffer) a } + deriving ( Monad, Functor, Typeable + , MonadState FBuffer + , MonadReader Window ) -- | Currently duplicates some of Vim's indent settings. Allowing a -- buffer to specify settings that are more dynamic, perhaps via -- closures, could be useful. data IndentSettings = IndentSettings - { expandTabs :: Bool -- ^ Insert spaces instead of tabs as possible - , tabSize :: Int -- ^ Size of a Tab - , shiftWidth :: Int -- ^ Indent by so many columns + { expandTabs :: !Bool -- ^ Insert spaces instead of tabs as possible + , tabSize :: !Int -- ^ Size of a Tab + , shiftWidth :: !Int -- ^ Indent by so many columns } deriving (Eq, Show, Typeable) instance Applicative BufferM where @@ -193,7 +197,7 @@ type WinMarks = MarkSet Mark data MarkSet a = MarkSet { fromMark, insMark, selMark :: !a } - deriving (Traversable, Foldable, Functor) + deriving (Traversable, Foldable, Functor, Show) instance Binary a => Binary (MarkSet a) where put (MarkSet f i s) = B.put f >> B.put i >> B.put s @@ -211,7 +215,7 @@ -- ^ prefered column to arrive at visually (ie, respecting wrap) , stickyEol :: !Bool -- ^ stick to the end of line (used by vim bindings mostly) - , pendingUpdates :: ![UIUpdate] + , pendingUpdates :: !(S.Seq UIUpdate) -- ^ updates that haven't been synched in the UI yet , selectionStyle :: !SelectionStyle , keymapProcess :: !KeymapProcess @@ -222,33 +226,36 @@ , readOnly :: !Bool -- ^ read-only flag , inserting :: !Bool -- ^ the keymap is ready for insertion into this buffer , directoryContent :: !Bool -- ^ does buffer contain directory contents - , pointFollowsWindow :: !(WindowRef -> Bool) + , pointFollowsWindow :: !(Set.Set WindowRef) , updateTransactionInFlight :: !Bool - , updateTransactionAccum :: ![Update] + , updateTransactionAccum :: !(S.Seq Update) , fontsizeVariation :: !Int - , encodingConverterName :: Maybe R.ConverterName + , encodingConverterName :: !(Maybe R.ConverterName) -- ^ How many points (frontend-specific) to change -- the font by in this buffer + , updateStream :: !(S.Seq Update) + -- ^ Updates that we've seen in this buffer, basically + -- "write-only". Work-around for broken WriterT. } deriving Typeable instance Binary Yi.Types.Attributes where put (Yi.Types.Attributes n b u bd pc pv se pu selectionStyle_ - _proc wm law lst ro ins _dc _pfw isTransacPresent transacAccum fv cn) = do + _proc wm law lst ro ins _dc _pfw isTransacPresent transacAccum fv cn lg') = do let putTime (UTCTime x y) = B.put (fromEnum x) >> B.put (fromEnum y) B.put n >> B.put b >> B.put u >> B.put bd B.put pc >> B.put pv >> B.put se >> B.put pu >> B.put selectionStyle_ >> B.put wm B.put law >> putTime lst >> B.put ro >> B.put ins >> B.put _dc - B.put isTransacPresent >> B.put transacAccum >> B.put fv >> B.put cn + B.put isTransacPresent >> B.put transacAccum >> B.put fv >> B.put cn >> B.put lg' get = Yi.Types.Attributes <$> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> pure I.End <*> B.get <*> B.get <*> getTime <*> B.get <*> B.get <*> B.get - <*> pure (const False) <*> B.get <*> B.get <*> B.get <*> B.get + <*> pure ({- TODO can serialise now -}mempty) <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get where getTime = UTCTime <$> (toEnum <$> B.get) <*> (toEnum <$> B.get) -data BufferId = MemBuffer T.Text - | FileBuffer FilePath +data BufferId = MemBuffer !T.Text + | FileBuffer !FilePath deriving (Show, Eq, Ord) instance Binary BufferId where @@ -263,7 +270,7 @@ data SelectionStyle = SelectionStyle { highlightSelection :: !Bool , rectangleSelection :: !Bool - } deriving Typeable + } deriving (Typeable, Show) instance Binary SelectionStyle where put (SelectionStyle h r) = B.put h >> B.put r @@ -407,29 +414,29 @@ -- | Configuration record. All Yi hooks can be set here. data Config = Config {startFrontEnd :: UIBoot, -- ^ UI to use. - configUI :: UIConfig, + configUI :: !UIConfig, -- ^ UI-specific configuration. - startActions :: [Action], + startActions :: ![Action], -- ^ Actions to run when the editor is started. - initialActions :: [Action], + initialActions :: ![Action], -- ^ Actions to run after startup (after startActions) or reload. - defaultKm :: KeymapSet, + defaultKm :: !KeymapSet, -- ^ Default keymap to use. - configInputPreprocess :: I.P Event Event, - modeTable :: [AnyMode], + configInputPreprocess :: !(I.P Event Event), + modeTable :: ![AnyMode], -- ^ List modes by order of preference. - debugMode :: Bool, + debugMode :: !Bool, -- ^ Produce a .yi.dbg file with a lot of debug information. - configRegionStyle :: RegionStyle, + configRegionStyle :: !RegionStyle, -- ^ Set to 'Exclusive' for an emacs-like behaviour. - configKillringAccumulate :: Bool, + configKillringAccumulate :: !Bool, -- ^ Set to 'True' for an emacs-like behaviour, where -- all deleted text is accumulated in a killring. - configCheckExternalChangesObsessively :: Bool, - bufferUpdateHandler :: [[Update] -> BufferM ()], - layoutManagers :: [AnyLayoutManager], + configCheckExternalChangesObsessively :: !Bool, + bufferUpdateHandler :: !(S.Seq (S.Seq Update -> BufferM ())), + layoutManagers :: ![AnyLayoutManager], -- ^ List of layout managers for 'cycleLayoutManagersNext' - configVars :: ConfigState.DynamicState + configVars :: !ConfigState.DynamicState -- ^ Custom configuration, containing the 'YiConfigVariable's. Configure with 'configVariableA'. } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/test/Spec.hs new/yi-core-0.13.7/test/Spec.hs --- old/yi-core-0.13.5/test/Spec.hs 2016-08-20 13:31:50.000000000 +0200 +++ new/yi-core-0.13.7/test/Spec.hs 2017-06-14 18:26:30.000000000 +0200 @@ -1,6 +1,7 @@ import Test.Tasty import qualified Yi.CompletionTreeTests as CompletionTree (testSuite) +import qualified Yi.CompletionTests as Completion (testSuite) import qualified Yi.TagTests as Tag (testSuite) import qualified Yi.Mode.CommonTests as Mode.Common (testSuite) @@ -9,7 +10,8 @@ tests :: TestTree tests = testGroup "all" - [ CompletionTree.testSuite + [ Completion.testSuite + , CompletionTree.testSuite , Tag.testSuite , Mode.Common.testSuite ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/test/Yi/CompletionTests.hs new/yi-core-0.13.7/test/Yi/CompletionTests.hs --- old/yi-core-0.13.5/test/Yi/CompletionTests.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/yi-core-0.13.7/test/Yi/CompletionTests.hs 2017-06-14 18:26:30.000000000 +0200 @@ -0,0 +1,28 @@ +module Yi.CompletionTests (testSuite) where + +import Data.List (sort,nub) +import Data.Maybe(isJust) +import Data.Monoid +import Data.Text.Arbitrary() +import Test.Tasty +import Test.Tasty.QuickCheck +import Yi.Completion as C +import qualified Data.Map as M +import qualified Data.Text as T + +testSuite :: TestTree +testSuite = testGroup "Completion" [propertyTests] + +propertyTests :: TestTree +propertyTests = testGroup "properties" + [ testProperty "infixUptoEndMatch needle (pre <> needle <> post) == Just (needle <> post) if needle and post not empty and needle not in pre" $ + \pre needle post -> + not (needle `T.isInfixOf` pre) ==> + not (T.null post) ==> + infixUptoEndMatch needle (pre <> needle <> post) == Just (needle <> post) + , testProperty "infixUptoEndMatch \"\" x == Just x" $ + \x -> infixUptoEndMatch T.empty x == Just x + , testProperty "isJust (infixUptoEndMatch needle haystack) == needle `Data.Text.isInfixOf` haystack" $ + \needle haystack -> + isJust (infixUptoEndMatch needle haystack) == needle `T.isInfixOf` haystack + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yi-core-0.13.5/yi-core.cabal new/yi-core-0.13.7/yi-core.cabal --- old/yi-core-0.13.5/yi-core.cabal 2016-12-10 10:39:40.000000000 +0100 +++ new/yi-core-0.13.7/yi-core.cabal 2017-06-17 19:57:23.000000000 +0200 @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.14.0. +-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: yi-core -version: 0.13.5 +version: 0.13.7 synopsis: Yi editor core library category: Yi homepage: https://github.com/yi-editor/yi#readme @@ -168,10 +168,10 @@ Yi.UI.Utils Yi.Window System.FriendlyPath + Parser.Incremental other-modules: Control.Exc Data.DelayList - Parser.Incremental System.CanonicalizePath Yi.Buffer.Implementation Paths_yi_core @@ -224,6 +224,7 @@ , tasty , tasty-hunit , tasty-quickcheck + , quickcheck-text , yi-core , text , containers @@ -234,7 +235,63 @@ build-depends: unix other-modules: + Yi.CompletionTests Yi.CompletionTreeTests Yi.Mode.CommonTests Yi.TagTests default-language: Haskell2010 + +benchmark all + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: + bench + ghc-options: -Wall -ferror-spans -Wall -ferror-spans -rtsopts + build-depends: + base >= 4.8 && < 5 + , array + , attoparsec + , binary >= 0.7 + , bytestring >= 0.9.1 + , containers + , data-default + , directory + , dlist >= 0.4.1 + , dynamic-state >= 0.1.0.5 + , dyre >= 0.8.11 + , exceptions + , filepath >= 1.1 + , hashable >= 1.1.2.5 + , Hclip >= 3 + , ListLike >= 4.5 + , microlens-platform + , mtl >= 0.1.0.1 + , old-locale + , oo-prototypes + , parsec >= 3.0 + , pointedlist >= 0.5 + , process >= 1.0.1.1 + , process-extras >= 0.3.3.8 + , safe >= 0.3.4 + , semigroups + , split >= 0.2 + , text >= 1.1.1.3 + , text-icu >= 0.7 + , time >= 1.1 + , transformers-base + , unix-compat >= 0.1 + , unordered-containers >= 0.1.3 + , word-trie >= 0.2.0.4 + , xdg-basedir >= 0.2.1 + , yi-language >= 0.1.1.0 + , yi-rope >= 0.7.0.0 + , yi-core + , criterion + , deepseq + if os(win32) + build-depends: + Win32 + else + build-depends: + unix + default-language: Haskell2010
