--  Copyright (C) 2009 Ganesh Sittampalam
--
--  BSD3
module Darcs.Patch.Rebase
    ( takeHeadRebase
    , takeHeadRebaseFL
    , takeAnyRebase
    , takeAnyRebaseAndTrailingPatches
    ) where

import Prelude ()
import Darcs.Prelude

import Darcs.Patch.Named.Wrapped ( WrappedNamed(RebaseP) )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully )
import Darcs.Patch.Rebase.Container ( Suspended(..) )
import Darcs.Patch.RepoType ( RepoType(..), RebaseType(..) )
import Darcs.Patch.Set ( PatchSet(..) )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed

{- Notes

Note [Rebase representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~

The entire rebase state is stored in a single Suspended patch
(see Darcs.Patch.Rebase.Container).

This is both unnatural and inefficient:

 - Unnatural because the rebase state is not really a patch and
   treating it as one requires various hacks:

   - It has to be given a fake name: see mkRebase

   - Since 'Named p' actually contains 'FL p', we have to
     assume/assert that the FL either contains a sequence of Normals
     or a single Suspended

   - When 'Named ps' commutes past 'Named (Suspended items :> NilFL)',
     we need to inject the name from 'Named ps' into 'items', which
     is a layering violation: see Darcs.Patch.Rebase.NameHack

   - We need to hide the patch in the UI: see Darcs.Patch.MaybeInternal

   - We need a conditional hook so that amend-record can change the
     Suspended patch itself: see Darcs.Patch.Rebase.Recontext
     (something like this might be necessary no matter what the
     representation)

 - Inefficient because we need to write the entire rebase state out
   each time, even though most operations will only affect a small
   portion near the beginning.

   - This also means that we need to commute the rebase patch back
     to the head of the repo lazily: we only do so when a rebase
     operation requires it. Otherwise, pulling in 100 patches
     would entail writing out the entire rebase patch to disk 100
     times.

The obvious alternative is to store the rebase state at the repository
level, using inventories in some appropriate way.

The main reason this wasn't done is that the repository handling code
is quite fragile and hard to modify safely.

Also, rebase relies heavily on witnesses to check correctness, and
the witnesses on the Repository type are not as reliable as those
on patch types, partly because of the cruft in the repository code,
and partly because it's inherently harder to track witnesses when
the objects being manipulated are stored on disk and being changed
imperatively.

If and when the repository code becomes easier to work with, rebase
should be changed accordingly.

-}

-- |given the repository contents, get the rebase container patch, and its contents
-- The rebase patch can be anywhere in the repository and is returned without being
-- commuted to the end.
takeAnyRebase ::  PatchSet ('RepoType 'IsRebase) p wA wB
              -> (Sealed2 (PatchInfoAnd ('RepoType 'IsRebase) p),
                  Sealed2 (Suspended p))
takeAnyRebase (PatchSet _ NilRL) =
   -- it should never be behind a tag so we can stop now
   error "internal error: no suspended patch found"
takeAnyRebase (PatchSet pss (ps :<: p))
    | RebaseP _ rs <- hopefully p = (Sealed2 p, Sealed2 rs)
    | otherwise = takeAnyRebase (PatchSet pss ps)

-- |given the repository contents, get the rebase container patch, its contents, and the
-- rest of the repository contents. Commutes the patch to the end of the repository
-- if necessary. The rebase patch must be at the head of the repository.
takeAnyRebaseAndTrailingPatches
               :: PatchSet ('RepoType 'IsRebase) p wA wB
               -> FlippedSeal (PatchInfoAnd ('RepoType 'IsRebase) p :> RL (PatchInfoAnd ('RepoType 'IsRebase) p)) wB
takeAnyRebaseAndTrailingPatches (PatchSet _ NilRL) =
   -- it should never be behind a tag so we can stop now
   error "internal error: no suspended patch found"
takeAnyRebaseAndTrailingPatches (PatchSet pss (ps :<: p))
    | RebaseP _ _ <- hopefully p = FlippedSeal (p :> NilRL)
    | otherwise = case takeAnyRebaseAndTrailingPatches (PatchSet pss ps) of
                     FlippedSeal (r :> ps') -> FlippedSeal (r :> (ps' :<: p))

-- |given the repository contents, get the rebase container patch, its contents, and the
-- rest of the repository contents. The rebase patch must be at the head of the repository.
takeHeadRebase :: PatchSet ('RepoType 'IsRebase) p wA wB
               -> (PatchInfoAnd ('RepoType 'IsRebase) p wB wB,
                   Suspended p wB wB,
                   PatchSet ('RepoType 'IsRebase) p wA wB)
takeHeadRebase (PatchSet _ NilRL) = error "internal error: must have a rebase container patch at end of repository"
takeHeadRebase (PatchSet pss (ps :<: p))
    | RebaseP _ rs <- hopefully p = (p, rs, PatchSet pss ps)
    | otherwise = error "internal error: must have a rebase container patch at end of repository"

takeHeadRebaseRL :: RL (PatchInfoAnd ('RepoType 'IsRebase) p) wA wB
                 -> (PatchInfoAnd ('RepoType 'IsRebase) p wB wB,
                     Suspended p wB wB,
                     RL (PatchInfoAnd ('RepoType 'IsRebase) p) wA wB)
takeHeadRebaseRL NilRL = error "internal error: must have a suspended patch at end of repository"
takeHeadRebaseRL (ps :<: p)
    | RebaseP _ rs <- hopefully p = (p, rs, ps)
    | otherwise = error "internal error: must have a suspended patch at end of repository"

takeHeadRebaseFL :: FL (PatchInfoAnd ('RepoType 'IsRebase) p) wA wB
                 -> (PatchInfoAnd ('RepoType 'IsRebase) p wB wB,
                     Suspended p wB wB,
                     FL (PatchInfoAnd ('RepoType 'IsRebase) p) wA wB)
takeHeadRebaseFL ps = let (a, b, c) = takeHeadRebaseRL (reverseFL ps) in (a, b, reverseRL c)