module Darcs.Patch.V1.Core
    ( RepoPatchV1(..),
      isMerger, mergerUndo
    ) where

import Darcs.Prelude

import Darcs.Patch.Format
    ( PatchListFormat(..)
    , ListFormat(ListFormatV1)
    )
import Darcs.Patch.Debug ( PatchDebug(..) )
import Darcs.Patch.FromPrim
    ( FromPrim(..)
    , PrimPatchBase(..)
    , ToPrim(..)
    )
import Darcs.Patch.Ident ( PatchId )
import Darcs.Patch.Prim ( PrimPatch )
import Darcs.Patch.Repair ( Check )

import Darcs.Patch.Witnesses.Ordered ( FL(..), RL )
import Darcs.Patch.Witnesses.Show ( Show1, Show2, appPrec, showsPrec2 )

-- This haddock could be put on the individual bits of Merger instead
-- once haddock supports doc comments on GADT constructors
{- |
The format of a merger is @Merger undos unwindings conflicting original@.

@undos@ = the effect of the merger

@unwindings@ = TODO: eh?

@conflicting@ = the patch we conflict with

@original@ = the patch we really are
-}
data RepoPatchV1 prim wX wY where
    PP :: prim wX wY -> RepoPatchV1 prim wX wY
    Merger :: FL (RepoPatchV1 prim) wX wY
           -> RL (RepoPatchV1 prim) wX wB
           -> RepoPatchV1 prim wC wX
           -> RepoPatchV1 prim wC wD
           -> RepoPatchV1 prim wX wY
    Regrem :: FL (RepoPatchV1 prim) wX wY
           -> RL (RepoPatchV1 prim) wX wB
           -> RepoPatchV1 prim wC wX
           -> RepoPatchV1 prim wC wD
           -> RepoPatchV1 prim wY wX

instance Show2 prim => Show (RepoPatchV1 prim wX wY)  where
    showsPrec :: Int -> RepoPatchV1 prim wX wY -> ShowS
showsPrec Int
d (PP prim wX wY
p) =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"PP " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> prim wX wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) prim wX wY
p
    showsPrec Int
d (Merger FL (RepoPatchV1 prim) wX wY
undos RL (RepoPatchV1 prim) wX wB
unwindings RepoPatchV1 prim wC wX
conflicting RepoPatchV1 prim wC wD
original) =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"Merger " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FL (RepoPatchV1 prim) wX wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) FL (RepoPatchV1 prim) wX wY
undos ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RL (RepoPatchV1 prim) wX wB -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) RL (RepoPatchV1 prim) wX wB
unwindings ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RepoPatchV1 prim wC wX -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) RepoPatchV1 prim wC wX
conflicting ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RepoPatchV1 prim wC wD -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) RepoPatchV1 prim wC wD
original
    showsPrec Int
d (Regrem FL (RepoPatchV1 prim) wY wX
undos RL (RepoPatchV1 prim) wY wB
unwindings RepoPatchV1 prim wC wY
conflicting RepoPatchV1 prim wC wD
original) =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"Regrem " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FL (RepoPatchV1 prim) wY wX -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) FL (RepoPatchV1 prim) wY wX
undos ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RL (RepoPatchV1 prim) wY wB -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) RL (RepoPatchV1 prim) wY wB
unwindings ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RepoPatchV1 prim wC wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) RepoPatchV1 prim wC wY
conflicting ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RepoPatchV1 prim wC wD -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) RepoPatchV1 prim wC wD
original

instance Show2 prim => Show1 (RepoPatchV1 prim wX)

instance Show2 prim => Show2 (RepoPatchV1 prim)

instance PrimPatch prim => PrimPatchBase (RepoPatchV1 prim) where
    type PrimOf (RepoPatchV1 prim) = prim

type instance PatchId (RepoPatchV1 prim) = ()

instance FromPrim (RepoPatchV1 prim) where
    fromAnonymousPrim :: forall wX wY.
PrimOf (RepoPatchV1 prim) wX wY -> RepoPatchV1 prim wX wY
fromAnonymousPrim = prim wX wY -> RepoPatchV1 prim wX wY
PrimOf (RepoPatchV1 prim) wX wY -> RepoPatchV1 prim wX wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV1 prim wX wY
PP

instance ToPrim (RepoPatchV1 prim) where
    toPrim :: forall wX wY.
RepoPatchV1 prim wX wY -> Maybe (PrimOf (RepoPatchV1 prim) wX wY)
toPrim (PP prim wX wY
p) = prim wX wY -> Maybe (prim wX wY)
forall a. a -> Maybe a
Just prim wX wY
p
    toPrim RepoPatchV1 prim wX wY
_ = Maybe (prim wX wY)
Maybe (PrimOf (RepoPatchV1 prim) wX wY)
forall a. Maybe a
Nothing

isMerger :: RepoPatchV1 prim wA wB -> Bool
isMerger :: forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
isMerger (Merger{}) = Bool
True
isMerger (Regrem{}) = Bool
True
isMerger RepoPatchV1 prim wA wB
_ = Bool
False

mergerUndo :: RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo :: forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo (Merger FL (RepoPatchV1 prim) wX wY
undo RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
_ RepoPatchV1 prim wC wD
_) = FL (RepoPatchV1 prim) wX wY
undo
mergerUndo RepoPatchV1 prim wX wY
_ = String -> FL (RepoPatchV1 prim) wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"

instance PatchListFormat (RepoPatchV1 prim) where
   -- In principle we could use ListFormatDefault when prim /= V1 Prim patches,
   -- as those are the only case where we need to support a legacy on-disk
   -- format. In practice we don't expect Patch to be used with any other argument
   -- anyway, so it doesn't matter.
   patchListFormat :: ListFormat (RepoPatchV1 prim)
patchListFormat = ListFormat (RepoPatchV1 prim)
forall (p :: * -> * -> *). ListFormat p
ListFormatV1

instance Check (RepoPatchV1 prim)
   -- no checks

instance PatchDebug prim => PatchDebug (RepoPatchV1 prim)