--  Copyright (C) 2009 Ganesh Sittampalam
--
--  BSD3
module Darcs.Patch.Rebase
    ( takeHeadRebase
    , takeHeadRebaseFL
    , takeAnyRebase
    , takeAnyRebaseAndTrailingPatches
    , dropAnyRebase
    ) 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(..)
    , IsRepoType(..)
    , SRepoType(..)
    , SRebaseType(..)
    )
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
   bug "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. The rebase patch can be
-- anywhere in the repository and is returned without being commuted to the end.
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
   bug "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))

-- | Remove the rebase patch from a 'PatchSet'.
dropAnyRebase :: forall rt p wA wB. IsRepoType rt
              => PatchSet rt p wA wB -> PatchSet rt p wA wB
dropAnyRebase ps@(PatchSet tags patches) =
  case singletonRepoType::SRepoType rt of
    SRepoType SNoRebase -> ps
    SRepoType SIsRebase -> PatchSet tags (dropRebaseRL patches)

-- | Remove the rebase patch from an 'RL' of patches.
dropRebaseRL :: RL (PatchInfoAnd ('RepoType 'IsRebase) p) wA wB
             -> RL (PatchInfoAnd ('RepoType 'IsRebase) p) wA wB
dropRebaseRL NilRL = bug "internal error: no suspended patch found"
dropRebaseRL (ps :<: p)
  | RebaseP _ _ <- hopefully p = ps
  | otherwise = dropRebaseRL 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 pss (ps :<: p))
    | RebaseP _ rs <- hopefully p = (p, rs, PatchSet pss ps)
takeHeadRebase _ =
    bug "internal error: must have a rebase container patch at end of repository"

-- | Same as 'takeHeadRebase' but for an 'RL' of patches.
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 (ps :<: p)
    | RebaseP _ rs <- hopefully p = (p, rs, ps)
takeHeadRebaseRL _ =
    bug "internal error: must have a suspended patch at end of repository"

-- | Same as 'takeHeadRebase' but for an 'FL' of patches.
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)