%  Copyright (C) 2002-2004 David Roundy
%
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2, or (at your option)
%  any later version.
%
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  GNU General Public License for more details.
%
%  You should have received a copy of the GNU General Public License
%  along with this program; see the file COPYING.  If not, write to
%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
%  Boston, MA 02110-1301, USA.

\section{darcs record}
\begin{code}
module PatchChoices ( PatchChoices, patch_choices, patch_choices_tps,
                      is_patch_first,
                      get_first_choice, get_middle_choice, get_last_choice,
                      separate_first_middle_from_last,
                      separate_first_from_middle_last,
                      separate_middle_last_from_first,
                      separate_last_from_first_middle,
                      force_first, force_firsts, force_last, force_lasts,
                      force_matching_first, force_matching_last,
                      select_all_middles,
                      make_uncertain, make_everything_later,
                      TaggedPatch, tp_patch,
                    ) where

import Monad ( liftM )

import System.IO.Unsafe ( unsafePerformIO )
import Data.IORef ( newIORef, writeIORef, readIORef )
import Patch
#include "impossible.h"
\end{code}

PatchChoices divides a sequence of patches into three sets: ``first'',
``middle'' and ``last'', such that all patches can be applied, if you first
apply the first ones then the middle ones and then the last ones.
Obviously if there are dependencies between the patches that will put a
constraint on how you can choose to divide them up.  The PatchChoices data
type and associated functions are here to deal with many of the common
cases that come up when choosing a subset of a group of patches.

\verb!force_last! tells PatchChoices that a particular patch is required to be in
the ``last'' group, which also means that any patches that depend on it
must be in the ``last'' group.

Internally, a PatchChoices doesn't actually reorder the patches until it is
asked for the final output (e.g.\ by \verb!get_first_choice!).  Instead, each
patch is placed in a state of definitely first, definitely last and
undecided---undecided leans towards ``middle''.  In case you're wondering
about the first-middle-last language, it's because in some cases the
``yes'' answers will be last (as is the case for the revert command), and
in others first (as in record, pull and push).

\begin{code}
type Tag = Integer
data TaggedPatch = TP Tag Patch
data PatchChoice = PC TaggedPatch (Maybe Bool)
newtype PatchChoices = PCs EasyPC
type EasyPC = [PatchChoice]

instance Eq TaggedPatch where
    TP t1 _ == TP t2 _ = t1 == t2

tp_patch :: TaggedPatch -> Patch
tp_patch (TP _ p) = p

liftTP :: (Patch -> Patch) -> (TaggedPatch -> TaggedPatch)
liftTP f (TP t p) = TP t (f p)

invertTP :: TaggedPatch -> TaggedPatch
invertTP = liftTP invert

patch_choices :: [Patch] -> PatchChoices
patch_choices = fst . patch_choices_tps

patch_choices_tps :: [Patch] -> (PatchChoices, [TaggedPatch])
patch_choices_tps ps = let tps = zipWith TP [1..] ps
                       in (PCs $ zipWith PC tps (repeat Nothing), tps)

get_first_choice :: PatchChoices -> [TaggedPatch]
get_last_choice :: PatchChoices -> [TaggedPatch]
get_middle_choice :: PatchChoices -> [TaggedPatch]

force_matching_first :: (TaggedPatch -> Bool) -> PatchChoices -> PatchChoices
force_matching_last :: (TaggedPatch -> Bool) -> PatchChoices -> PatchChoices
force_firsts :: [TaggedPatch] -> PatchChoices -> PatchChoices
force_first :: TaggedPatch -> PatchChoices -> PatchChoices
force_lasts :: [TaggedPatch] -> PatchChoices -> PatchChoices
force_last :: TaggedPatch -> PatchChoices -> PatchChoices
make_uncertain :: TaggedPatch -> PatchChoices -> PatchChoices
make_everything_later :: PatchChoices -> PatchChoices

is_patch_first :: TaggedPatch -> PatchChoices -> Maybe Bool
\end{code}

\begin{code}
reverse_easy :: EasyPC -> EasyPC
reverse_easy
 = reverse . map (\(PC tp mf) -> PC (invertTP tp) (liftM not mf))

reverse_tagged_patches :: [TaggedPatch] -> [TaggedPatch]
reverse_tagged_patches tps = reverse $ map invertTP tps

separate_first_from_middle_last :: PatchChoices
                                -> ([TaggedPatch], [TaggedPatch])
separate_first_from_middle_last (PCs e) = pull_only_firsts e

separate_first_middle_from_last :: PatchChoices
                                -> ([TaggedPatch], [TaggedPatch])
separate_first_middle_from_last (PCs e) = pull_firsts_middles e

separate_last_from_first_middle :: PatchChoices
                                -> ([TaggedPatch], [TaggedPatch])
separate_last_from_first_middle pc =
    (get_last_choice pc, get_first_choice pc ++ get_middle_choice pc)

separate_middle_last_from_first :: PatchChoices
                                -> ([TaggedPatch], [TaggedPatch])
separate_middle_last_from_first pc =
    (get_middle_choice pc ++ get_last_choice pc, get_first_choice pc)

get_first_choice (PCs e) = fst $ pull_firsts e
get_last_choice (PCs e)
 = reverse_tagged_patches $ fst $ pull_firsts $ reverse_easy e
get_middle_choice (PCs e) =
    [ tp | PC tp _ <- reverse_easy $ snd $ pull_firsts $ reverse_easy
                                   $ snd $ pull_firsts e ]

pull_firsts_middles :: EasyPC -> ([TaggedPatch], [TaggedPatch])
pull_firsts_middles easyPC =
    let r = unsafePerformIO
          $ newIORef (error "pull_firsts_middles called badly")
        f acc [] = unsafePerformIO (writeIORef r (reverse acc)) `seq` []
        f acc (PC tp (Just False):e) = f (tp:acc) e
        f acc (PC (TP t p) _:e) = case commute_up_list p acc of
                                  (acc', p') -> TP t p':f acc' e
        xs = f [] easyPC
    in (xs, unsafePerformIO (readIORef r))

pull_only_firsts :: EasyPC -> ([TaggedPatch], [TaggedPatch])
pull_only_firsts easyPC =
    let r = unsafePerformIO
          $ newIORef (error "pull_only_firsts called badly")
        f acc [] = unsafePerformIO (writeIORef r (reverse acc)) `seq` []
        f acc (PC (TP t p) (Just True):e) = case commute_up_list p acc of
                                            (acc', p') -> TP t p':f acc' e
        f acc (PC tp _:e) = f (tp:acc) e
        xs = f [] easyPC
    in (xs, unsafePerformIO (readIORef r))

{-
pull_middles_lasts :: EasyPC -> ([TaggedPatch], [TaggedPatch])
pull_middles_lasts easyPC =
    let r = unsafePerformIO
          $ newIORef (error "pull_middles_lasts called badly")
        f acc [] = unsafePerformIO (writeIORef r (reverse acc)) `seq` []
        f acc (PC tp (Just True):e) = f (tp:acc) e
        f acc (PC (TP t p) _:e) = case commute_up_list p acc of
                                  (acc', p') -> TP t p':f acc' e
        xs = f [] easyPC
    in (xs, unsafePerformIO (readIORef r))
-}

--pull_only_lasts :: EasyPC -> ([TaggedPatch], [TaggedPatch])
--pull_only_lasts easyPC =
--    let r = unsafePerformIO
--          $ newIORef (error "pull_only_lasts called badly")
--        f acc [] = unsafePerformIO (writeIORef r (reverse acc)) `seq` []
--        f acc (PC (TP t p) (Just False):e) = case commute_up_list p acc of
--                                             (acc', p') -> TP t p':f acc' e
--        f acc (PC tp _:e) = f (tp:acc) e
--        xs = f [] easyPC
--    in (xs, unsafePerformIO (readIORef r))

commute_up_list :: Patch -> [TaggedPatch] -> ([TaggedPatch], Patch)
commute_up_list p [] = ([], p)
commute_up_list pat (TP t p:tps)
 = case commute (pat, p) of
       Just (p', pat') -> let (tps', pat'') = commute_up_list pat' tps
                          in (TP t p':tps', pat'')
       Nothing -> impossible

pull_firsts :: EasyPC -> ([TaggedPatch], EasyPC)
pull_firsts e = case pull_first e of
                Nothing -> ([],e)
                Just (p,e') -> case pull_firsts e' of
                               (ps,e'') -> (p:ps,e'')

pull_lasts :: EasyPC -> ([TaggedPatch], EasyPC)
pull_lasts e = case pull_firsts $ reverse_easy e of
               (ps,e') -> (reverse_tagged_patches ps, reverse_easy e')

pull_first :: EasyPC -> Maybe (TaggedPatch, EasyPC)
pull_first [] = Nothing
pull_first (PC tp (Just True):e) = Just (tp, e)
pull_first (PC (TP t p) (Just False):e) =
    case pull_first e of
    Just (TP t2 p2,e') ->
        case commute (p2,p) of
        Just (p',p2') -> Just (TP t2 p2', PC (TP t p') (Just False):e')
        Nothing -> error "Aaack fixme!"
    Nothing -> Nothing
pull_first (PC tp@(TP t p) Nothing:e) =
    case pull_first e of
    Just (TP t2 p2,e') ->
        case commute (p2,p) of
        Just (p',p2') -> Just (TP t2 p2',(PC (TP t p') Nothing:e'))
        Nothing -> Just (tp, PC (TP (-t2) p2) (Just True):e')
    Nothing -> Nothing
\end{code}

\begin{code}
is_patch_first tp (PCs e) = ipf e
  where ipf (PC a mb:e') | a == tp   = mb
                         | otherwise = ipf e'
        ipf [] = error "Aaack in ipf! Please report this bug."

set_simplys :: [Tag] -> Bool -> EasyPC -> EasyPC
set_simplys ts b e = map ch e
    where ch (PC tp@(TP t _) _)
           | t `elem` ts = PC tp (Just b)
           | otherwise   = PC tp Nothing

m2ids :: (TaggedPatch -> Bool) -> EasyPC -> [Tag]
m2ids m (PC tp@(TP t _) _:e)
 | m tp = t:m2ids m e
 | otherwise = m2ids m e
m2ids _ [] = []

force_matching_first m (PCs e) =
    let thd (PC (TP t _) _) = t
        xs = m2ids m e
        not_needed = map thd $ snd $ pull_firsts $ set_simplys xs True e
        ch pc@(PC tp@(TP t _) _)
         | t `elem` not_needed = pc
         | otherwise = PC tp (Just True)
    in PCs $ map ch e
force_firsts ps pc = force_matching_first (`elem` ps) pc
force_first p pc = force_matching_first (== p) pc

select_all_middles :: Bool -> PatchChoices -> PatchChoices
select_all_middles b (PCs e) = PCs (map f e)
    where f (PC tp Nothing) = PC tp (Just b')
          f pc = pc
          b' = not b

reverse_pc :: PatchChoices -> PatchChoices
reverse_pc (PCs e) = PCs $ reverse_easy e

force_matching_last m (PCs e) =
    let thd (PC (TP t _) _) = t
        xs = m2ids m e
        not_needed = map thd $ snd $ pull_lasts $ set_simplys xs False e
        ch pc@(PC tp@(TP t _) _)
         | t `elem` not_needed = pc
         | otherwise = PC tp (Just False)
    in PCs $ map ch e

force_last p pc = reverse_pc $ force_first (invertTP p) $ reverse_pc pc
force_lasts ps pc = reverse_pc $ force_firsts (map invertTP ps) $ reverse_pc pc

make_uncertain tp (PCs e) = PCs $ map ch e
    where ch pc@(PC x _) = if tp == x then PC tp Nothing else pc

make_everything_later (PCs e) = PCs $ map ch e
                               where ch (PC tp Nothing) = PC tp (Just False)
                                     ch (PC tp (Just True)) = PC tp Nothing
                                     ch x = x
\end{code}