packages feed

edit-lenses-demo 0.1 → 0.1.1

raw patch · 12 files changed

+1/−450 lines, 12 filessetup-changed

Files

− Data/.svn/all-wcprops 
@@ -1,5 +0,0 @@-K 25-svn:wc:ra_dav:version-url-V 53-/svn/symmetric/!svn/ver/859/implementation/demos/Data-END
− Data/.svn/entries 
@@ -1,34 +0,0 @@-10--dir-876-https://webdav.seas.upenn.edu/svn/symmetric/implementation/demos/Data-https://webdav.seas.upenn.edu/svn/symmetric----2012-01-05T11:04:26.259154Z-859-wagnerdm---------------aa241a2e-9b9f-11de-8e07-5b05083ecc8c--Lens-dir--Module-dir-
− Data/Lens/.svn/all-wcprops 
@@ -1,5 +0,0 @@-K 25-svn:wc:ra_dav:version-url-V 58-/svn/symmetric/!svn/ver/859/implementation/demos/Data/Lens-END
− Data/Lens/.svn/entries 
@@ -1,31 +0,0 @@-10--dir-876-https://webdav.seas.upenn.edu/svn/symmetric/implementation/demos/Data/Lens-https://webdav.seas.upenn.edu/svn/symmetric----2012-01-05T11:04:26.259154Z-859-wagnerdm---------------aa241a2e-9b9f-11de-8e07-5b05083ecc8c--Edit-dir-
− Data/Lens/Edit/.svn/all-wcprops 
@@ -1,11 +0,0 @@-K 25-svn:wc:ra_dav:version-url-V 63-/svn/symmetric/!svn/ver/859/implementation/demos/Data/Lens/Edit-END-String.hs-K 25-svn:wc:ra_dav:version-url-V 73-/svn/symmetric/!svn/ver/859/implementation/demos/Data/Lens/Edit/String.hs-END
− Data/Lens/Edit/.svn/entries 
@@ -1,62 +0,0 @@-10--dir-876-https://webdav.seas.upenn.edu/svn/symmetric/implementation/demos/Data/Lens/Edit-https://webdav.seas.upenn.edu/svn/symmetric----2012-01-05T11:04:26.259154Z-859-wagnerdm---------------aa241a2e-9b9f-11de-8e07-5b05083ecc8c--String.hs-file-----2012-01-06T16:47:07.208237Z-03005d26259ff686dc4483b67cba7035-2012-01-05T11:04:26.259154Z-859-wagnerdm----------------------974-
− Data/Lens/Edit/.svn/text-base/String.hs.svn-base 
@@ -1,27 +0,0 @@-module Data.Lens.Edit.String where--import Data.Lens.Edit.Container-import Data.Lens.Edit.Primitive-import Data.Lens.Edit.Product-import Data.Module.String--copyEmpty :: String -> (Match, Id [Edit], Match)-copyEmpty s = (Match s, Id, Match s)--copyNonEmpty :: v -> String -> (NewDefaultMatch v, Id (NewDefaultModule v), NewDefaultMatch v)-copyNonEmpty v s = (NewDefaultMatch s, Id, NewDefaultMatch s)--skipEmpty :: String -> (Match, Disconnect [Edit] [Edit], Match)-skipEmpty s = (Match s, Disconnect, Match "")--skipNonEmpty :: v -> String -> (NewDefaultMatch v, Disconnect (NewDefaultModule v) [Edit], Match)-skipNonEmpty v s = (NewDefaultMatch s, Disconnect, Match "")--(#) :: (a, k, b) -> (c, l, d) -> ((a, c), CompactProduct k l, (b, d))-(#) (a, k, b) (c, l, d) = ((a, c), CompactProduct k l, (b, d))--op :: (a, l, b) -> (b, Op l, a)-op (a, l, b) = (b, Op l, a)--star :: (a, l, b) -> (Asterisk a, Map Int l, Asterisk b)-star (a, l, b) = (Asterisk a, Map l, Asterisk b)
− Data/Module/.svn/all-wcprops 
@@ -1,11 +0,0 @@-K 25-svn:wc:ra_dav:version-url-V 60-/svn/symmetric/!svn/ver/859/implementation/demos/Data/Module-END-String.hs-K 25-svn:wc:ra_dav:version-url-V 70-/svn/symmetric/!svn/ver/859/implementation/demos/Data/Module/String.hs-END
− Data/Module/.svn/entries 
@@ -1,62 +0,0 @@-10--dir-876-https://webdav.seas.upenn.edu/svn/symmetric/implementation/demos/Data/Module-https://webdav.seas.upenn.edu/svn/symmetric----2012-01-05T11:04:26.259154Z-859-wagnerdm---------------aa241a2e-9b9f-11de-8e07-5b05083ecc8c--String.hs-file-----2012-01-06T16:47:07.604237Z-5cde9f4d5ab75f3482364ef388c8b121-2012-01-05T11:04:26.259154Z-859-wagnerdm----------------------8937-
− Data/Module/.svn/text-base/String.hs.svn-base 
@@ -1,199 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies #-}-module Data.Module.String where--import Control.Arrow-import Control.Monad-import Data.Algorithm.Diff-import Data.Default-import Data.List-import Data.Maybe-import Data.Module.Class-import Data.Module.Container (ContainerAtom)-import Data.Module.Product-import Data.Module.Shape-import Data.Monoid-import Text.Regex.PCRE-import qualified Data.Map as M-import qualified Data.Module.Container as C--class Module (M m) => StringModule m where-	type M m-	valid  :: m -> String -- returns a regex telling what strings are valid-	parse  :: m -> String -> Maybe (V (M m))-	pprint :: m -> V (M m) -> String-	edit   :: m -> V (M m) -> [Edit] -> M m--data Edit = Insert Int String | Delete Int Int deriving (Show, Read)--instance PartialEdit Edit where-	type V_0 Edit = String-	apply_0 (Insert n s') s = Just (take n s ++ s' ++ drop n s)-	apply_0 (Delete n n') s = Just (take n s ++ drop n' s)--newtype Match = Match String deriving (Eq, Ord, Show, Read)-maybeMatch re s = guard (s =~ re == (0 :: Int, length s)) >> return s-instance StringModule Match where-	type M Match = [Edit]-	valid (Match re) = re-	parse  = maybeMatch . valid-	pprint = const id-	edit   = const (const id)--instance (StringModule dX, StringModule dY) => StringModule (dX, dY) where-	type M (dX, dY) = (M dX, M dY)-	valid (mx, my) = valid mx ++ valid my-	parse (mx, my) s = do-		let (m , n ) =        s =~ valid mx-		    (m', n') = drop n s =~ valid my-		guard ([m, m', n + n'] == [0, 0, length s])-		vx <- parse mx (take n s)-		vy <- parse my (drop n s)-		return (vx, vy)-	pprint (mx, my) (vx, vy) = pprint mx vx ++ pprint my vy-	edit = editProd--editProd (mx, my) (vx, vy) es = edit mx vx *** edit my vy $ case splitMap of-	Nothing -> (replace sx sx', replace sy sy')-	Just ms -> (exs, eys)-	where-	die = error "The impossible happened! A [Edit] didn't successfully apply to a String in editProd."-	sx  = pprint mx vx-	sy  = pprint my vy-	sn  = fromMaybe die (apply es (sx ++ sy))-	oldSplit     = length sx-	newSplit     = snd (sn =~ valid mx :: (Int, Int))-	(sx', sy')   = splitAt newSplit sn-	easySplits   = trackEdits [oldSplit] es-	splitMap     = M.lookup newSplit easySplits-	-- this is dangerous, only use the variables it binds when splitMap is definitely a Just!-	(exs, eys)   = splitEdits (fromJust splitMap) oldSplit es-	replace s s' = [Insert 0 s', Delete 0 (length s)]--trackEdit :: Edit -> (Int, M.Map Int (M.Map Int Int)) -> (Int, M.Map Int (M.Map Int Int))-trackEdit (Insert n s) (i, m) = (i + 1, m') where-	(smaller, larger') = M.split n m-	len    = length s-	larger = M.mapKeysMonotonic (+ len) larger'-	exact  = case M.lookup n m of-		Nothing -> M.empty-		Just im -> M.fromList [(n + i', M.insert i i' im) | i' <- [0 .. len]]-	m'     = smaller `M.union` larger `M.union` exact-trackEdit (Delete n n') (i, m)-	| n >  n' = trackEdit (Delete n' n) (i, m)-	| n == n' = (i + 1, m)-	| n <  n' = (i + 1, m') where-	(smaller, notSmaller) = M.split (n +1) m-	(deleted, larger')    = M.split (n'-1) notSmaller-	len    = n' - n-	larger = M.mapKeysMonotonic (subtract len) larger'-	m'     = smaller `M.union` larger-	-- NOTE: this arbitrarily prefers the edits on the left-hand side of the-	-- deletion boundary over the edits on the right-hand side of the deletion-	-- boundary when a chunk boundary happens to fall on a position that-	-- matches the deletion boundary---- input: the locations of chunk boundaries, plus some edits--- returns:---   The inner Map Int Int tells, for each index into the edits, whether to split the resulting edit and where.---   The outer Map tells, for each position, if a chunk boundary ends up landing there, how to split the edits.-trackEdits :: [Int] -> [Edit] -> M.Map Int (M.Map Int Int)-trackEdits boundaries = snd . foldr trackEdit (0, M.fromList (zip boundaries (repeat M.empty)))--splitEdits :: M.Map Int Int -> Int -> [Edit] -> ([Edit], [Edit])-splitEdits m split = snd . foldr splitEdit ((0, split), ([], [])) where-	splitEdit :: Edit -> ((Int, Int), ([Edit], [Edit])) -> ((Int, Int), ([Edit], [Edit]))-	splitEdit e@(Delete n n') ((i, split), (els, ers))-		| n > n' = splitEdit (Delete n' n) ((i, split), (els, ers))-		| n' <= split = ((i+1, split-n'+n), (e:els, ers))-		| n  >= split = ((i+1, split), (els, Delete (n-split) (n'-split) : ers))-		| otherwise   = error "The impossible happened! A deletion crossed a chunk boundary."-		--  | otherwise   = ((i+1, n), (Delete n split : els, Delete 0 (n'-split) : ers))-	splitEdit e@(Insert n s) ((i, split), (els, ers)) = case M.lookup i m of-		Nothing-			| n < split -> ((i+1, split+length s), (e:els, ers))-			| n > split -> ((i+1, split), (els, Insert (n-split) s : ers))-			| otherwise -> error "The impossible happened! An insertion crossed a chunk boundary without being in the splitting map."-		Just n' -> ((i+1, split+n'), (consInsert n (take n' s) els, consInsert 0 (drop n' s) ers))-	consInsert n "" es = es-	consInsert n s  es = Insert n s : es--data Asterisk m = Asterisk m-instance StringModule m => StringModule (Asterisk m) where-	type M (Asterisk m) = [ContainerAtom Int (M m)]-	valid  (Asterisk m) = "(" ++ valid m ++ ")*"-	pprint (Asterisk m) = containerToList >=> pprint m-	edit   (Asterisk m) = editList m . containerToList-	parse  (Asterisk m) = liftM listToContainer . parseList m--parseList m = splitList (valid m) >=> mapM (parse m)-splitList re "" = return []-splitList re s  = do-	-- pattern match failure means the regex didn't match at the beginning,-	-- and results in a failed parse overall-	("", sMatch, rest) <- return (s =~ re)-	liftM (sMatch:) (splitList re rest)---- Heuristic: if we can track where *all* the old splits went, then go ahead--- and do that. Nice! Otherwise, use diff to compare the entire old list with--- the entire new list.------ There's a lot of room for improvement: we could take the regions between--- successfully tracked splits and the regions with unsuccessfully tracked--- splits and run the diff only on the unsuccessful regions, for example.--- Additionally, note that when we are tracking splits, we assume that no--- splits are inserted or deleted. A more sophisticated heuristic might try to--- relax this assumption somehow (though the only way I could think of to relax--- it would result in an exponential-time algorithm).--editList m vs es = fromMaybe diffy exact where-	exact = editListExact m vs oldss newss es 0-	diffy = editListDiff  m    oldss newss-	oldss = map (pprint m) vs-	newss = fromJust (splitList (valid m) =<< apply es (concat oldss)) :: [String]--editListExact m (v:vs) (olds:oldss) (news:newss) es i = case splitMap of-	Nothing -> Nothing-	Just ms -> liftM (C.Modify i (edit m v e) :) (editListExact m vs oldss newss erest (i+1))-	where-	oldSplit     = length olds-	newSplit     = length news-	easySplits   = trackEdits [oldSplit] es-	splitMap     = M.lookup newSplit easySplits-	-- this is dangerous, only use the variables it binds when splitMap is definitely a Just!-	(e, erest)   = splitEdits (fromJust splitMap) oldSplit es-editListExact m [] [] [] [] i = Just []-editListExact _ _  _  _  _  _ = Nothing--editListDiff m oldss newss = result where-	diff = getDiff oldss newss-	tags = map fst diff-	count place        = length . filter (==place) $ tags-	match place B      = [True]-	match place place' = [False | place == place']-	reordered place    = map fst . uncurry (++) . partition snd . zip [0..] $ (tags >>= match place)-	create s = edit m def [Insert 0 s, Delete 0 . length . pprint m $ def]-	result-		= C.Rearrange (Sum 0) (\_ i -> fromJust (findIndex (==i) (reordered S)))-		: zipWith C.Modify [count B .. count B + count S - 1] [create news | (S, news) <- diff] ++-		[ C.Insert . Sum          . count $ S-		, C.Delete . Sum . negate . count $ F-		, C.Rearrange (Sum 0) (\_ i -> reordered F !! i)-		]---- a few utilities for defining string modules whose default value is not ""-newtype NewDefault v = NewDefault String deriving (Eq, Ord)-instance Show (NewDefault v) where show (NewDefault s) = show s-instance Read (NewDefault v) where readsPrec n s = map (first NewDefault) (readsPrec n s)-instance (Default v, Show v) => Default (NewDefault v) where def = NewDefault (show (def :: v))-newtype NewDefaultModule v = NewDefaultModule [Edit] deriving (Show, Read, Monoid)-instance (Default v, Show v) => Module (NewDefaultModule v) where-	type V (NewDefaultModule v) = NewDefault v-	apply (NewDefaultModule es) (NewDefault v) = liftM NewDefault (apply es v)-newtype NewDefaultMatch v = NewDefaultMatch String deriving (Eq, Ord, Show, Read)--instance (Default v, Show v) => StringModule (NewDefaultMatch v) where-	type M (NewDefaultMatch v) = NewDefaultModule v-	valid (NewDefaultMatch re) = re-	parse  m                   = liftM NewDefault . maybeMatch (valid m)-	pprint m (NewDefault s)    = s-	edit                       = const (const NewDefaultModule)
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
edit-lenses-demo.cabal view
@@ -1,5 +1,5 @@ name:                edit-lenses-demo-version:             0.1+version:             0.1.1 synopsis:            Programs demoing the use of symmetric, stateful edit lenses Description:         Some simple demo programs showing ways to use the edit-lenses package. -- Homepage:            http://dmwit.com/edit-lenses