Hello community, here is the log from the commit of package ghc-text-region for openSUSE:Factory checked in at 2017-08-31 21:00:33 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-region (Old) and /work/SRC/openSUSE:Factory/.ghc-text-region.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-region" Thu Aug 31 21:00:33 2017 rev:2 rq:513516 version:0.3.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-region/ghc-text-region.changes 2016-11-02 12:44:14.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-text-region.new/ghc-text-region.changes 2017-08-31 21:00:34.852706285 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:37 UTC 2017 - psimons@suse.com + +- Update to version 0.3.0.0. + +------------------------------------------------------------------- Old: ---- text-region-0.1.0.1.tar.gz New: ---- text-region-0.3.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-region.spec ++++++ --- /var/tmp/diff_new_pack.NOCqMm/_old 2017-08-31 21:00:36.496475331 +0200 +++ /var/tmp/diff_new_pack.NOCqMm/_new 2017-08-31 21:00:36.516472521 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-text-region # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,29 +19,25 @@ %global pkg_name text-region %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.0.1 +Version: 0.3.0.0 Release: 0 Summary: Marking text regions License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-aeson-devel BuildRequires: ghc-base-unicode-symbols-devel BuildRequires: ghc-bytestring-devel -BuildRequires: ghc-containers-devel BuildRequires: ghc-groups-devel BuildRequires: ghc-lens-devel -BuildRequires: ghc-mtl-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} BuildRequires: ghc-hspec-devel %endif -# End cabal-rpm deps %description Provides functions to update text region positions according to text edit @@ -61,20 +57,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ text-region-0.1.0.1.tar.gz -> text-region-0.3.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/src/Data/Text/Region/Types.hs new/text-region-0.3.0.0/src/Data/Text/Region/Types.hs --- old/text-region-0.1.0.1/src/Data/Text/Region/Types.hs 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/src/Data/Text/Region/Types.hs 2017-04-26 03:18:31.000000000 +0200 @@ -1,17 +1,14 @@ {-# LANGUAGE TemplateHaskell, RankNTypes, TypeSynonymInstances, FlexibleInstances, OverloadedStrings, GeneralizedNewtypeDeriving, FlexibleContexts #-} module Data.Text.Region.Types ( - Point(..), pointLine, pointColumn, Size, (.-.), (.+.), + Point(..), pointLine, pointColumn, pointRegion, Size, (.-.), (.+.), Region(..), regionFrom, regionTo, Map(..), Contents, emptyContents, concatCts, splitCts, splitted, Editable(..), contents, by, measure, - Replace(..), replaceRegion, replaceWith, Chain(..), chain, Edit, - ActionIso(..), action, actionBack, - ActionStack(..), undoStack, redoStack, emptyStack, - EditState(..), editState, history, edited, regions, - EditM(..), + Replace(..), replaceRegion, replaceWith, Edit(..), replaces, + Regioned(..), module Data.Group ) where @@ -21,7 +18,6 @@ import Control.Category import Control.Lens hiding ((.=)) -import Control.Monad.State import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as L import Data.Group @@ -37,6 +33,10 @@ makeLenses ''Point +-- | As empty region +pointRegion ∷ Iso' Point Region +pointRegion = iso (\p → Region p p) _regionFrom + instance ToJSON Point where toJSON (Point l c) = object ["line" .= l, "column" .= c] @@ -66,7 +66,9 @@ | bl ≡ l = Point 0 (max 0 (c - bc)) | otherwise = Point 0 0 --- | Opposite to ".-.", @(pt .-. base) .+. base = pt@ +-- | Opposite to '.-.' +-- +-- prop> (pt .-. base) .+. base = pt (.+.) ∷ Point → Point → Point (Point l c) .+. (Point bl bc) | l ≡ 0 = Point bl (c + bc) @@ -94,6 +96,7 @@ -- Combining this functions while edit, we get function, that maps regions from source data to edited one -- To get back function, we must also combine opposite actions, or we can represent actions as 'Iso' -- Same idea goes for modifying contents, represent each action as isomorphism and combine them together +-- This works if we don't use overlapped regions newtype Map = Map { mapIso :: Iso' Region Region } instance Monoid Map where @@ -179,75 +182,30 @@ instance (Editable s, ToJSON s) ⇒ Show (Replace s) where show = L.unpack ∘ encode --- | Chain of edit actions -newtype Chain e s = Chain { - _chain ∷ [e s] } deriving (Eq, Show, Monoid) - -makeLenses ''Chain - -instance ToJSON (e s) ⇒ ToJSON (Chain e s) where - toJSON = toJSON ∘ _chain - -instance FromJSON (e s) ⇒ FromJSON (Chain e s) where - parseJSON = fmap Chain ∘ parseJSON - -type Edit s = Chain Replace s - --- | Some action with its inverse -data ActionIso e = ActionIso { - _action ∷ e, - _actionBack ∷ e } - -makeLenses ''ActionIso - -instance Monoid e ⇒ Monoid (ActionIso e) where - mempty = ActionIso mempty mempty - ActionIso l l' `mappend` ActionIso r r' = ActionIso (l `mappend` r) (r' `mappend` l') - -instance Monoid e ⇒ Group (ActionIso e) where - invert (ActionIso f b) = ActionIso b f - -instance ToJSON e ⇒ ToJSON (ActionIso e) where - toJSON (ActionIso f b) = object ["fore" .= f, "back" .= b] - -instance FromJSON e ⇒ FromJSON (ActionIso e) where - parseJSON = withObject "action-iso" $ \v → ActionIso <$> v .: "fore" <*> v .: "back" - --- | Stack of undo/redo actions -data ActionStack e = ActionStack { - _undoStack ∷ [ActionIso e], - _redoStack ∷ [ActionIso e] } - -makeLenses ''ActionStack - -instance ToJSON e ⇒ ToJSON (ActionStack e) where - toJSON (ActionStack u r) = object ["undo" .= u, "redo" .= r] +-- | Edit is several replace actions, applied simultaneously, must not overlap +newtype Edit s = Edit { + _replaces ∷ [Replace s] } + deriving (Eq, Show, Monoid) -instance FromJSON e ⇒ FromJSON (ActionStack e) where - parseJSON = withObject "action-stack" $ \v → ActionStack <$> v .: "undo" <*> v .: "redo" +makeLenses ''Edit -emptyStack ∷ ActionStack e -emptyStack = ActionStack [] [] +instance (Editable s, ToJSON s) ⇒ ToJSON (Edit s) where + toJSON = toJSON ∘ _replaces --- | Edit state -data EditState s r = EditState { - -- | Edit history is stack of edit actions - _history ∷ ActionStack (Edit s), - -- | Currently edited data - _edited ∷ Contents s, - -- | Some region-based state, that will be updated on each edit - _regions ∷ r } +instance (Editable s, FromJSON s) ⇒ FromJSON (Edit s) where + parseJSON = fmap Edit ∘ parseJSON -makeLenses ''EditState +class Regioned a where + regions ∷ Traversal' a Region -instance (Editable s, ToJSON s, ToJSON r) ⇒ ToJSON (EditState s r) where - toJSON (EditState h e rs) = object ["history" .= h, "contents" .= view (from contents) e, "regions" .= rs ] +instance Regioned Point where + regions = pointRegion -instance (Editable s, FromJSON s, FromJSON r) ⇒ FromJSON (EditState s r) where - parseJSON = withObject "edit-state" $ \v → EditState <$> v .: "history" <*> fmap (view contents) (v .: "contents") <*> v .: "regions" +instance Regioned Region where + regions = id --- | Make edit state for contents -editState ∷ Editable s ⇒ s → r → EditState s r -editState x = EditState emptyStack (x ^. contents) +instance Regioned (Replace s) where + regions = replaceRegion -newtype EditM s r a = EditM { runEditM ∷ State (EditState s r) a } deriving (Applicative, Functor, Monad, MonadState (EditState s r)) +instance Regioned (Edit s) where + regions = replaces . each . replaceRegion diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/src/Data/Text/Region.hs new/text-region-0.3.0.0/src/Data/Text/Region.hs --- old/text-region-0.1.0.1/src/Data/Text/Region.hs 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/src/Data/Text/Region.hs 2017-04-26 03:18:31.000000000 +0200 @@ -2,10 +2,9 @@ module Data.Text.Region ( pt, start, lineStart, regionLength, till, linesSize, regionLines, emptyRegion, line, - regionSize, expandLines, atRegion, ApplyMap(..), updateMap, cutMap, insertMap, + regionSize, expandLines, atRegion, overlaps, applyMap, cutMap, insertMap, cutRegion, insertRegion, - EditAction(..), cut, paste, overwrite, inverse, applyEdit, apply, - edit, edit_, push, run_, run, runGroup, undo, redo, + EditAction(..), replace, cut, paste, overwrite, apply, update, undo, module Data.Text.Region.Types ) where @@ -13,10 +12,8 @@ import Prelude hiding (id, (.)) import Prelude.Unicode -import Control.Arrow import Control.Category import Control.Lens -import Control.Monad.State import Data.Text.Region.Types @@ -74,33 +71,15 @@ fromc cts = cts ^. splitted (r ^. regionTo) . _1 . splitted (r ^. regionFrom) . _2 toc cts cts' = (cts ^. splitted (r ^. regionFrom) . _1) `concatCts` cts' `concatCts` (cts ^. splitted (r ^. regionTo) . _2) -class ApplyMap a where - applyMap ∷ Map → a → a +-- | Does regions overlaps +overlaps ∷ Region → Region → Bool +overlaps l r + | r ^. regionFrom ≥ l ^. regionTo = False + | r ^. regionTo ≤ l ^. regionFrom = False + | otherwise = True -instance ApplyMap () where - applyMap _ = id - -instance ApplyMap a ⇒ ApplyMap [a] where - applyMap m = map (applyMap m) - -instance ApplyMap Map where - applyMap = mappend - -instance ApplyMap Region where - applyMap = view ∘ mapIso - -instance ApplyMap Point where - applyMap m p = view regionFrom $ applyMap m (p `till` p) - -instance ApplyMap (Replace s) where - applyMap m (Replace r w) = Replace (applyMap m r) w - -instance ApplyMap (e s) ⇒ ApplyMap (Chain e s) where - applyMap m (Chain rs) = Chain (map (applyMap m) rs) - --- | Update 'Region' after some action -updateMap ∷ (EditAction e s, ApplyMap a) ⇒ e s → a → a -updateMap = applyMap ∘ actionMap +applyMap ∷ Map → Region → Region +applyMap = view ∘ mapIso -- | Cut 'Region' mapping cutMap ∷ Region → Map @@ -116,106 +95,67 @@ (if is < s then (s .-. ie) .+. is else s) (if is < e then (e .-. ie) .+. is else e) --- | Update second region position as if it was data inserted at first region +-- | Update second region position as if it was data inserted at first region (region sets insertion point and data size) +-- Region tries not to extend if data inserted at region bound except when region is empty +-- This allows define replace as cut and insert in special case when we replace region itself insertRegion ∷ Region → Region → Region -insertRegion (Region is ie) (Region s e) = Region - (if is < s then (s .-. is) .+. ie else s) - (if is < e then (e .-. is) .+. ie else e) +insertRegion (Region is ie) (Region s e) + | (s ≡ e) ∧ (is ≡ s) = Region is ie + | otherwise = Region + (if is ≤ s then (s .-. is) .+. ie else s) + (if is < e then (e .-. is) .+. ie else e) -class (Editable s, ApplyMap (e s)) ⇒ EditAction e s where +class Editable s ⇒ EditAction e s where -- | Make replace action over 'Region' and 'Contents' - replace ∷ Region → Contents s → e s + replaceAction ∷ Region → Contents s → e s -- | Make 'Map' from action actionMap ∷ e s → Map - -- | Perform action, modifying 'Contents' and returning inverse (undo) action - perform ∷ e s → State (Contents s) (e s) + -- | Perform action, modifying 'Contents' + perform ∷ e s → Contents s → Contents s + -- | Get action undo + inversed ∷ e s → Contents s → e s + +-- | Replace region with data +replace ∷ EditAction e s ⇒ Region → s → e s +replace r = replaceAction r ∘ view contents -- | Cuts region cut ∷ EditAction e s ⇒ Region → e s -cut r = replace r emptyContents +cut r = replaceAction r emptyContents -- | Pastes 'Contents' at some 'Point' -paste ∷ EditAction e s ⇒ Point → Contents s → e s -paste p = replace (p `till` p) +paste ∷ EditAction e s ⇒ Point → s → e s +paste p = replaceAction (p `till` p) ∘ view contents -- | Overwrites 'Contents' at some 'Point' -overwrite ∷ EditAction e s ⇒ Point → Contents s → e s -overwrite p c = replace (p `regionSize` measure c) c - --- | Get undo-action -inverse ∷ EditAction e s ⇒ Contents s → e s → e s -inverse cts act = evalState (perform act) cts - --- | Apply action to 'Contents' -applyEdit ∷ EditAction e s ⇒ e s → Contents s → Contents s -applyEdit act = snd ∘ runState (perform act) - --- | 'applyEdit' for 'Edit' -apply ∷ EditAction Replace s ⇒ Edit s → Contents s → Contents s -apply = applyEdit +overwrite ∷ EditAction e s ⇒ Point → s → e s +overwrite p c = replaceAction (p `regionSize` measure cts) cts where + cts = view contents c + +-- | 'perform' for 'Edit' +apply ∷ Editable s ⇒ Edit s → s → s +apply = over contents ∘ perform + +-- | Get undo +undo ∷ Editable s ⇒ Edit s → s → Edit s +undo e = inversed e ∘ view contents + +-- | Update regions +update ∷ (Editable s, Regioned r) ⇒ Edit s → r → r +update e = over regions (applyMap ∘ actionMap $ e) instance Editable s ⇒ EditAction Replace s where - replace = Replace - actionMap (Replace r w) = insertMap ((r ^. regionFrom) `regionSize` measure w) `mappend` cutMap r - perform (Replace r w) = state $ \cts → (Replace ((r ^. regionFrom) `regionSize` measure w) (cts ^. atRegion r), atRegion r .~ w $ cts) - -instance EditAction e s ⇒ EditAction (Chain e) s where - replace rgn txt = Chain [replace rgn txt] - actionMap (Chain []) = mempty - actionMap (Chain (r : rs)) = actionMap (applyMap (actionMap r) (Chain rs)) `mappend` actionMap r - perform (Chain rs) = (Chain ∘ reverse) <$> go mempty rs where - go _ [] = return [] - go m (c : cs) = (:) <$> perform (applyMap m c) <*> go (actionMap (applyMap m c) `mappend` m) cs - --- | Run edit monad and return result with updated contents -edit ∷ EditAction Replace s ⇒ s → r → EditM s r a → (a, s) -edit txt rs act = second (view $ edited . from contents) $ runState (runEditM act) (editState txt rs) - --- | Run edit monad and return updated contents -edit_ ∷ EditAction Replace s ⇒ s → r → EditM s r a → s -edit_ txt rs = snd ∘ edit txt rs - --- | Push action into history, also drops redo stack -push ∷ ActionIso (Edit s) → EditM s r () -push e = modify (over (history . undoStack) (e :)) >> modify (set (history . redoStack) []) - --- | Run edit action and returns corresponding redo-undo action -run_ ∷ (EditAction Replace s, ApplyMap r) ⇒ Edit s → EditM s r (ActionIso (Edit s)) -run_ e = do - cts ← gets (view edited) - let - (undo', cts') = runState (perform e) cts - modify (set edited cts') - modify (over regions (applyMap $ actionMap e)) - return $ ActionIso e undo' - --- | Run edit action with updating undo/redo stack -run ∷ (EditAction Replace s, ApplyMap r) ⇒ Edit s → EditM s r () -run e = run_ e >>= push - --- | Run edit actions, updating undo/redo stack for each of them, but act like they was applied simultaneously --- For example, cutting 1-st and then 3-rd letter: --- @run (cut first) >> run (cut third) -- 1234 -> 234 -> 23@ --- @runGroup [cut first, cut third] -- 1234 -> 234 -> 24@ -runGroup ∷ (EditAction Replace s, ApplyMap r) ⇒ [Edit s] → EditM s r () -runGroup = go mempty where - go _ [] = return () - go m (e:es) = run e' >> go (applyMap m $ actionMap e') es where - e' = applyMap m e - --- | Undo last action -undo ∷ (EditAction Replace s, ApplyMap r) ⇒ EditM s r () -undo = do - us@(~(u:_)) ← gets (view $ history . undoStack) - unless (null us) $ do - _ ← run_ (u ^. actionBack) - modify (over (history . undoStack) tail) - modify (over (history . redoStack) (u :)) - -redo ∷ (EditAction Replace s, ApplyMap r) ⇒ EditM s r () -redo = do - rs@(~(r:_)) ← gets (view $ history . redoStack) - unless (null rs) $ do - _ ← run_ (r ^. action) - modify (over (history . redoStack) tail) - modify (over (history . undoStack) (r :)) + replaceAction = Replace + actionMap (Replace r w) = insertMap (r & regionLength .~ measure w) `mappend` cutMap r + perform (Replace r w) cts = cts & atRegion r .~ w + inversed (Replace r w) cts = Replace (r & regionLength .~ measure w) (cts ^. atRegion r) + +instance Editable s ⇒ EditAction Edit s where + replaceAction rgn txt = Edit [replaceAction rgn txt] + actionMap = foldr go mempty ∘ view replaces where + go r m = actionMap (over replaceRegion (applyMap m) r) `mappend` m + perform = snd ∘ foldr go (mempty, id) ∘ view replaces where + go r (m, fn) = (actionMap r' `mappend` m, perform r' ∘ fn) where + r' = over replaceRegion (applyMap m) r + inversed e@(Edit rs) cts = Edit [Replace (applyMap m r) (cts ^. atRegion r) | Replace r _ ← rs] where + m = actionMap e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/tests/Test.hs new/text-region-0.3.0.0/tests/Test.hs --- old/text-region-0.1.0.1/tests/Test.hs 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/tests/Test.hs 2017-04-26 03:18:31.000000000 +0200 @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} + module Main ( main ) where @@ -5,7 +7,6 @@ import Prelude.Unicode import Control.Lens -import Control.Monad.State import Data.Text.Region import Test.Hspec @@ -28,21 +29,18 @@ main = hspec $ do describe "regions are updated" $ do it "should delete correctly" $ - apply (cut quux `mappend` cut bar) (by text) ≡ by "foo baz" - describe "editor monad" $ do - it "should perform undo/redo" $ - (≡ text) $ edit_ text () $ do - runGroup [ - cut bar, - replace quux (by nums), - paste start (by xxx)] - undo >> redo >> undo >> undo >> undo + apply (cut quux `mappend` cut bar) text ≡ "foo baz" + it "should perform undo" $ + let + act' = mconcat [cut bar, replace quux nums, paste start xxx] + undo' = undo act' text + in + (apply undo' ∘ apply act') text ≡ text it "should reverse text" $ - (≡ reverse text) $ edit_ text (pt 0 (length text)) $ replicateM_ (length text) $ do - -- cut first letter and insert at caret - let - l = pt 0 0 `till` pt 0 1 - c ← gets (view regions) - cts ← gets (view edited) - run $ paste c (view (atRegion l) cts) - run $ cut l + let + go 0 _ txt = txt + go n c txt = go (n - 1) (update act' c) (apply act' txt) where + act' = mconcat [cut first, paste c (txt ^. contents . atRegion first . from contents)] + first = pt 0 0 `till` pt 0 1 + in + go (length text) (pt 0 (length text)) text ≡ reverse text diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/text-region.cabal new/text-region-0.3.0.0/text-region.cabal --- old/text-region-0.1.0.1/text-region.cabal 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/text-region.cabal 2017-04-26 03:18:32.000000000 +0200 @@ -1,5 +1,5 @@ name: text-region -version: 0.1.0.1 +version: 0.3.0.0 synopsis: Marking text regions description: Provides functions to update text region positions according to text edit actions homepage: https://github.com/mvoidex/text-region @@ -28,10 +28,10 @@ base-unicode-symbols >= 0.2, aeson >= 0.9, bytestring >= 0.10, - containers >= 0.5, + -- containers >= 0.5, groups >= 0.4.0, lens >= 4.12, - mtl >= 2.2, + -- mtl >= 2.2, text >= 1.2.1 test-suite test @@ -46,7 +46,7 @@ base-unicode-symbols >= 0.2, text-region, hspec, - containers >= 0.5, + -- containers >= 0.5, lens >= 4.12, - mtl >= 2.2, + -- mtl >= 2.2, text >= 1.2.1