-- Copyright (C) 2011 Petr Rockai
--
-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use, copy,
-- modify, merge, publish, distribute, sublicense, and/or sell copies
-- of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.


module Darcs.Patch.Prim.FileUUID.Core
    ( Prim(..)
    , Hunk(..)
    , HunkMove(..)
    -- re-exports
    , Object(..)
    , UUID(..)
    , Location(..)
    , Name
    , FileContent
    ) where

import Darcs.Prelude

import Darcs.Patch.Witnesses.Eq ( Eq2(..) )
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import Darcs.Patch.Witnesses.Unsafe
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.FileUUID.ObjectMap

-- -----------------------------------------------------------------------------
-- Hunk

data Hunk wX wY = H !Int !FileContent !FileContent
  deriving (Hunk wX wY -> Hunk wX wY -> Bool
(Hunk wX wY -> Hunk wX wY -> Bool)
-> (Hunk wX wY -> Hunk wX wY -> Bool) -> Eq (Hunk wX wY)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall wX wY. Hunk wX wY -> Hunk wX wY -> Bool
/= :: Hunk wX wY -> Hunk wX wY -> Bool
$c/= :: forall wX wY. Hunk wX wY -> Hunk wX wY -> Bool
== :: Hunk wX wY -> Hunk wX wY -> Bool
$c== :: forall wX wY. Hunk wX wY -> Hunk wX wY -> Bool
Eq, Int -> Hunk wX wY -> ShowS
[Hunk wX wY] -> ShowS
Hunk wX wY -> String
(Int -> Hunk wX wY -> ShowS)
-> (Hunk wX wY -> String)
-> ([Hunk wX wY] -> ShowS)
-> Show (Hunk wX wY)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall wX wY. Int -> Hunk wX wY -> ShowS
forall wX wY. [Hunk wX wY] -> ShowS
forall wX wY. Hunk wX wY -> String
showList :: [Hunk wX wY] -> ShowS
$cshowList :: forall wX wY. [Hunk wX wY] -> ShowS
show :: Hunk wX wY -> String
$cshow :: forall wX wY. Hunk wX wY -> String
showsPrec :: Int -> Hunk wX wY -> ShowS
$cshowsPrec :: forall wX wY. Int -> Hunk wX wY -> ShowS
Show)

type role Hunk nominal nominal

instance Show1 (Hunk wX)

instance Show2 Hunk

invertHunk :: Hunk wX wY -> Hunk wY wX
invertHunk :: Hunk wX wY -> Hunk wY wX
invertHunk (H Int
off FileContent
old FileContent
new) = Int -> FileContent -> FileContent -> Hunk wY wX
forall wX wY. Int -> FileContent -> FileContent -> Hunk wX wY
H Int
off FileContent
new FileContent
old

instance Eq2 Hunk where
  unsafeCompare :: Hunk wA wB -> Hunk wC wD -> Bool
unsafeCompare Hunk wA wB
p Hunk wC wD
q = Hunk wA wB -> Hunk wC wD
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Hunk wA wB
p Hunk wC wD -> Hunk wC wD -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk wC wD
q

-- -----------------------------------------------------------------------------
-- HunkMove

data HunkMove wX wY = HM !UUID !Int !UUID !Int !FileContent
  deriving (HunkMove wX wY -> HunkMove wX wY -> Bool
(HunkMove wX wY -> HunkMove wX wY -> Bool)
-> (HunkMove wX wY -> HunkMove wX wY -> Bool)
-> Eq (HunkMove wX wY)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall wX wY. HunkMove wX wY -> HunkMove wX wY -> Bool
/= :: HunkMove wX wY -> HunkMove wX wY -> Bool
$c/= :: forall wX wY. HunkMove wX wY -> HunkMove wX wY -> Bool
== :: HunkMove wX wY -> HunkMove wX wY -> Bool
$c== :: forall wX wY. HunkMove wX wY -> HunkMove wX wY -> Bool
Eq, Int -> HunkMove wX wY -> ShowS
[HunkMove wX wY] -> ShowS
HunkMove wX wY -> String
(Int -> HunkMove wX wY -> ShowS)
-> (HunkMove wX wY -> String)
-> ([HunkMove wX wY] -> ShowS)
-> Show (HunkMove wX wY)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall wX wY. Int -> HunkMove wX wY -> ShowS
forall wX wY. [HunkMove wX wY] -> ShowS
forall wX wY. HunkMove wX wY -> String
showList :: [HunkMove wX wY] -> ShowS
$cshowList :: forall wX wY. [HunkMove wX wY] -> ShowS
show :: HunkMove wX wY -> String
$cshow :: forall wX wY. HunkMove wX wY -> String
showsPrec :: Int -> HunkMove wX wY -> ShowS
$cshowsPrec :: forall wX wY. Int -> HunkMove wX wY -> ShowS
Show)

type role HunkMove nominal nominal

invertHunkMove :: HunkMove wX wY -> HunkMove wY wX
invertHunkMove :: HunkMove wX wY -> HunkMove wY wX
invertHunkMove (HM UUID
sid Int
soff UUID
tid Int
toff FileContent
content) = UUID -> Int -> UUID -> Int -> FileContent -> HunkMove wY wX
forall wX wY.
UUID -> Int -> UUID -> Int -> FileContent -> HunkMove wX wY
HM UUID
tid Int
toff UUID
sid Int
soff FileContent
content

instance Eq2 HunkMove where
  unsafeCompare :: HunkMove wA wB -> HunkMove wC wD -> Bool
unsafeCompare (HM UUID
sid1 Int
soff1 UUID
tid1 Int
toff1 FileContent
c1) (HM UUID
sid2 Int
soff2 UUID
tid2 Int
toff2 FileContent
c2) =
    UUID
sid1 UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
sid2 Bool -> Bool -> Bool
&& Int
soff1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
soff2 Bool -> Bool -> Bool
&& UUID
tid1 UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
tid2 Bool -> Bool -> Bool
&& Int
toff1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
toff2 Bool -> Bool -> Bool
&& FileContent
c1 FileContent -> FileContent -> Bool
forall a. Eq a => a -> a -> Bool
== FileContent
c2

-- -----------------------------------------------------------------------------
-- Prim

data Prim wX wY where
  Hunk :: !UUID -> !(Hunk wX wY) -> Prim wX wY
  HunkMove :: !(HunkMove wX wY) -> Prim wX wY
  Manifest :: !UUID -> !Location -> Prim wX wY
  Demanifest :: !UUID -> !Location -> Prim wX wY
  Identity :: Prim wX wX

deriving instance Eq (Prim wX wY)
deriving instance Show (Prim wX wY)

instance Show1 (Prim wX)

instance Show2 Prim

-- TODO: PrimClassify doesn't make sense for FileUUID prims
instance PrimClassify Prim where
  primIsAddfile :: Prim wX wY -> Bool
primIsAddfile Prim wX wY
_ = Bool
False
  primIsRmfile :: Prim wX wY -> Bool
primIsRmfile Prim wX wY
_ = Bool
False
  primIsAdddir :: Prim wX wY -> Bool
primIsAdddir Prim wX wY
_ = Bool
False
  primIsRmdir :: Prim wX wY -> Bool
primIsRmdir Prim wX wY
_ = Bool
False
  primIsHunk :: Prim wX wY -> Bool
primIsHunk Prim wX wY
_ = Bool
False
  primIsMove :: Prim wX wY -> Bool
primIsMove Prim wX wY
_ = Bool
False
  primIsBinary :: Prim wX wY -> Bool
primIsBinary Prim wX wY
_ = Bool
False
  primIsTokReplace :: Prim wX wY -> Bool
primIsTokReplace Prim wX wY
_ = Bool
False
  primIsSetpref :: Prim wX wY -> Bool
primIsSetpref Prim wX wY
_ = Bool
False
  is_filepatch :: Prim wX wY -> Maybe AnchoredPath
is_filepatch Prim wX wY
_ = Maybe AnchoredPath
forall a. Maybe a
Nothing

-- TODO: PrimConstruct makes no sense for FileUUID prims
instance PrimConstruct Prim where
  addfile :: AnchoredPath -> Prim wX wY
addfile AnchoredPath
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct addfile"
  rmfile :: AnchoredPath -> Prim wX wY
rmfile AnchoredPath
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct rmfile"
  adddir :: AnchoredPath -> Prim wX wY
adddir AnchoredPath
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct adddir"
  rmdir :: AnchoredPath -> Prim wX wY
rmdir AnchoredPath
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct rmdir"
  move :: AnchoredPath -> AnchoredPath -> Prim wX wY
move AnchoredPath
_ AnchoredPath
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct move"
  changepref :: String -> String -> String -> Prim wX wY
changepref String
_ String
_ String
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct changepref"
  hunk :: AnchoredPath -> Int -> [FileContent] -> [FileContent] -> Prim wX wY
hunk AnchoredPath
_ Int
_ [FileContent]
_ [FileContent]
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct hunk"
  tokreplace :: AnchoredPath -> String -> String -> String -> Prim wX wY
tokreplace AnchoredPath
_ String
_ String
_ String
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct tokreplace"
  binary :: AnchoredPath -> FileContent -> FileContent -> Prim wX wY
binary AnchoredPath
_ FileContent
_ FileContent
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct binary"
  primFromHunk :: FileHunk wX wY -> Prim wX wY
primFromHunk FileHunk wX wY
_ = String -> Prim wX wY
forall a. HasCallStack => String -> a
error String
"PrimConstruct primFromHunk"

instance IsHunk Prim where
  isHunk :: Prim wX wY -> Maybe (FileHunk wX wY)
isHunk Prim wX wY
_ = Maybe (FileHunk wX wY)
forall a. Maybe a
Nothing

instance Invert Prim where
  invert :: Prim wX wY -> Prim wY wX
invert (Hunk UUID
x Hunk wX wY
h) = UUID -> Hunk wY wX -> Prim wY wX
forall wX wY. UUID -> Hunk wX wY -> Prim wX wY
Hunk UUID
x (Hunk wY wX -> Prim wY wX) -> Hunk wY wX -> Prim wY wX
forall a b. (a -> b) -> a -> b
$ Hunk wX wY -> Hunk wY wX
forall wX wY. Hunk wX wY -> Hunk wY wX
invertHunk Hunk wX wY
h
  invert (HunkMove HunkMove wX wY
hm) = HunkMove wY wX -> Prim wY wX
forall wX wY. HunkMove wX wY -> Prim wX wY
HunkMove (HunkMove wY wX -> Prim wY wX) -> HunkMove wY wX -> Prim wY wX
forall a b. (a -> b) -> a -> b
$ HunkMove wX wY -> HunkMove wY wX
forall wX wY. HunkMove wX wY -> HunkMove wY wX
invertHunkMove HunkMove wX wY
hm
  invert (Manifest UUID
x Location
y) = UUID -> Location -> Prim wY wX
forall wX wY. UUID -> Location -> Prim wX wY
Demanifest UUID
x Location
y
  invert (Demanifest UUID
x Location
y) = UUID -> Location -> Prim wY wX
forall wX wY. UUID -> Location -> Prim wX wY
Manifest UUID
x Location
y
  invert Prim wX wY
Identity = Prim wY wX
forall wX. Prim wX wX
Identity

instance PatchInspect Prim where
  -- We don't need this for FileUUID. Slashes are not allowed in Manifest and
  -- Demanifest patches and nothing else uses working-copy paths.
  listTouchedFiles :: Prim wX wY -> [AnchoredPath]
listTouchedFiles Prim wX wY
_ = []

  -- TODO (used for --match 'hunk ...', presumably)
  hunkMatches :: (FileContent -> Bool) -> Prim wX wY -> Bool
hunkMatches FileContent -> Bool
_ Prim wX wY
_ = Bool
False

instance Eq2 Prim where
  unsafeCompare :: Prim wA wB -> Prim wC wD -> Bool
unsafeCompare (Hunk UUID
a Hunk wA wB
b) (Hunk UUID
c Hunk wC wD
d) = UUID
a UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
c Bool -> Bool -> Bool
&& Hunk wA wB
b Hunk wA wB -> Hunk wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` Hunk wC wD
d
  unsafeCompare (Manifest UUID
a Location
b) (Manifest UUID
c Location
d) = UUID
a UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
c Bool -> Bool -> Bool
&& Location
b Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
== Location
d
  unsafeCompare (Demanifest UUID
a Location
b) (Demanifest UUID
c Location
d) = UUID
a UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
c Bool -> Bool -> Bool
&& Location
b Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
== Location
d
  unsafeCompare Prim wA wB
Identity Prim wC wD
Identity = Bool
True
  unsafeCompare Prim wA wB
_ Prim wC wD
_ = Bool
False