#include "gadts.h"
module Darcs.Patch.Prim.V3.Core
( Prim(..), Hunk(..), UUID(..), Location, Object(..), touches, hunkEdit )
where
import qualified Data.ByteString as BS
import Darcs.Witnesses.Eq ( MyEq(..) )
import Darcs.Patch.FileHunk( IsHunk(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Prim.Class ( PrimConstruct(..), PrimClassify(..) )
import Darcs.Patch.Prim.V3.ObjectMap
data Hunk C(x y) where
Hunk :: !Int -> BS.ByteString -> BS.ByteString -> Hunk C(x y)
invertHunk :: Hunk C(x y) -> Hunk C(y x)
invertHunk (Hunk off old new) = Hunk off new old
hunkEdit :: Hunk C(x y) -> BS.ByteString -> BS.ByteString
hunkEdit (Hunk off old new) bs = case splice bs (off) (off + BS.length old) of
x | x == old -> BS.concat [ BS.take off bs, new, BS.drop (off + BS.length old) bs ]
| otherwise -> error $ "error applying hunk: " ++ show off ++ " " ++ show old ++ " "
++ show new ++ " to " ++ show bs
where splice bs' x y = BS.drop x $ BS.take y bs'
instance MyEq Hunk where
unsafeCompare (Hunk i x y) (Hunk i' x' y') = i == i' && x == x' && y == y'
data Prim C(x y) where
BinaryHunk :: !UUID -> Hunk C(x y) -> Prim C(x y)
TextHunk :: !UUID -> Hunk C(x y) -> Prim C(x y)
Manifest :: !UUID -> Location -> Prim C(x y)
Demanifest :: !UUID -> Location -> Prim C(x y)
Move :: !UUID -> Location -> Location -> Prim C(x y)
Identity :: Prim C(x x)
touches :: Prim C(x y) -> [UUID]
touches (BinaryHunk x _) = [x]
touches (TextHunk x _) = [x]
touches (Manifest _ (x, _)) = [x]
touches (Demanifest _ (x, _)) = [x]
touches (Move _ (x, _) (y, _)) = [x, y]
touches Identity = []
instance PrimClassify Prim where
primIsAddfile _ = False
primIsRmfile _ = False
primIsAdddir _ = False
primIsRmdir _ = False
primIsHunk _ = False
primIsMove _ = False
primIsBinary _ = False
primIsTokReplace _ = False
primIsSetpref _ = False
is_filepatch _ = Nothing
instance PrimConstruct Prim where
addfile _ = error "PrimConstruct addfile"
rmfile _ = error "PrimConstruct rmfile"
adddir _ = error "PrimConstruct adddir"
rmdir _ = error "PrimConstruct rmdir"
move _ _ = error "PrimConstruct move"
changepref _ _ _ = error "PrimConstruct changepref"
hunk _ _ _ _ = error "PrimConstruct hunk"
tokreplace _ _ _ _ = error "PrimConstruct tokreplace"
binary _ _ _ = error "PrimConstruct binary"
primFromHunk _ = error "PrimConstruct primFromHunk"
anIdentity = Identity
instance IsHunk Prim where
isHunk _ = Nothing
instance Invert Prim where
invert (BinaryHunk x h) = BinaryHunk x $ invertHunk h
invert (TextHunk x h) = TextHunk x $ invertHunk h
invert (Manifest x y) = Demanifest x y
invert (Demanifest x y) = Manifest x y
invert (Move x y z) = Move x z y
invert Identity = Identity
instance PatchInspect Prim where
listTouchedFiles _ = []
hunkMatches _ _ = False
instance MyEq Prim where
unsafeCompare (BinaryHunk a b) (BinaryHunk c d) = a == c && b `unsafeCompare` d
unsafeCompare (TextHunk a b) (TextHunk c d) = a == c && b `unsafeCompare` d
unsafeCompare (Manifest a b) (Manifest c d) = a == c && b == d
unsafeCompare (Demanifest a b) (Demanifest c d) = a == c && b == d
unsafeCompare Identity Identity = True
unsafeCompare _ _ = False
instance Eq (Prim C(x y)) where
(==) = unsafeCompare