{-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : Precis.Diff -- Copyright : (c) Stephen Tetley 2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley <stephen.tetley@gmail.com> -- Stability : highly unstable -- Portability : to be determined. -- -- Two Diff types (3 state and 4 state) -- -------------------------------------------------------------------------------- module Precis.Diff ( -- * Edit types Edit4(..) , Edit3(..) -- * Edit operations , diff4 , diff3 , addedRemoved , conflictRemoved , addedConflictRemoved ) where import Precis.Utils import Data.List ( find ) -------------------------------------------------------------------------------- data Edit4 a = ADD a | DIF a a | EQU a | DEL a deriving (Eq,Show) -- some edits are better as ADD | EQU | DEL though... data Edit3 a = Add a | Equ a | Del a deriving (Eq,Show) instance Functor Edit4 where fmap f (ADD a) = ADD (f a) fmap f (DIF a b) = DIF (f a) (f b) fmap f (EQU a) = EQU (f a) fmap f (DEL a) = DEL (f a) instance Functor Edit3 where fmap f (Add a) = Add (f a) fmap f (Equ a) = Equ (f a) fmap f (Del a) = Del (f a) diff4 :: (a -> a -> Bool) -> (a -> a -> Bool) -> [a] -> [a] -> [Edit4 a] diff4 matches conflict as bs = toListH $ checkShort bs (checkLong as id) where checkLong [] f = f checkLong (x:xs) f = case find (matches x) bs of Just b | conflict x b -> checkLong xs (f `snocH` DIF x b) | otherwise -> checkLong xs (f `snocH` EQU x) Nothing -> checkLong xs (f `snocH` ADD x) checkShort [] f = f checkShort (y:ys) f = case find (matches y) as of Just _ -> checkShort ys f -- already found Nothing -> checkShort ys (f `snocH` DEL y) diff3 :: (a -> a -> Bool) -> [a] -> [a] -> [Edit3 a] diff3 matches as bs = toListH $ checkShort bs (checkLong as id) where checkLong [] f = f checkLong (x:xs) f = case find (matches x) bs of Just _ -> checkLong xs (f `snocH` Equ x) Nothing -> checkLong xs (f `snocH` Add x) checkShort [] f = f checkShort (y:ys) f = case find (matches y) as of Just _ -> checkShort ys f -- already found Nothing -> checkShort ys (f `snocH` Del y) addedRemoved :: [Edit4 a] -> ([a],[a]) addedRemoved = foldr fn ([],[]) where fn (ADD a) (as,rs) = (a:as,rs) fn (DEL r) (as,rs) = (as,r:rs) fn _ acc = acc addedConflictRemoved :: [Edit4 a] -> ([a],[(a,a)],[a]) addedConflictRemoved = foldr fn ([],[],[]) where fn (ADD a) (as,cs,rs) = (a:as,cs,rs) fn (DIF a b) (as,cs,rs) = (as,(a,b):cs,rs) fn (DEL r) (as,cs,rs) = (as,cs,r:rs) fn _ acc = acc conflictRemoved :: [Edit4 a] -> ([(a,a)],[a]) conflictRemoved = foldr fn ([],[]) where fn (DIF a b) (cs,rs) = ((a,b):cs,rs) fn (DEL r) (cs,rs) = (cs,r:rs) fn _ acc = acc