%  Copyright (C) 2003-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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\section{Dependencies}
\begin{code}
module Depends ( get_common_and_uncommon, get_tags_right,
                 optimize_patchset, deep_optimize_patchset,
                 slightly_optimize_patchset,
                 get_patches_beyond_tag, get_patches_in_tag,
                 is_tag,
               ) where
import List ( elem, delete, intersect )
import Monad ( liftM )

import Patch ( Patch, getdeps, join_patches, flatten, commute )
import PatchInfo ( PatchInfo, just_name, human_friendly )
import RepoTypes ( PatchSet, PatchSequence )
#include "impossible.h"
\end{code}

\begin{code}
get_tags_right :: PatchSet -> [PatchInfo]
get_common_and_uncommon :: (PatchSet,PatchSet) ->
                           ([PatchInfo],PatchSet,PatchSet)
\end{code}

\begin{code}
safehead :: [[a]] -> [a]
safehead [] = []
safehead (a:_) = a
get_common_and_uncommon (ps1,ps2) = gcau (optimize_patchset ps1, ps2)
gcau (ps1,ps2) | null ps1 || null ps2 = ([],[concat ps1],[concat ps2])
gcau (ps1,[[]]) = ([],[concat ps1],[[]])
gcau ([[]],ps2) = ([],[[]],[concat ps2])
gcau ([(pi1,_)]:_,[(pi2,_)]:_) | pi1 == pi2 = ([pi1],[[]],[[]])
gcau (ps1:ps1b:ps1s,ps2:ps2b:ps2s) =
  if (fst $ last ps1) == (fst $ last ps2)
  then case (map fst ps1) `intersect` (map fst ps2) of
       common -> (map fst $ safehead $ optimize_patchset $
                  [filter ((`elem` common).fst) ps1],
                  [get_extra [] common ps1],
                  [get_extra [] common ps2])
  else if length ps1 > length ps2
       then gcau (ps1:ps1b:ps1s, (ps2++ps2b):ps2s)
       else gcau ((ps1++ps1b):ps1s, ps2:ps2b:ps2s)

gcau (ps1:ps1b:ps1s,[ps2]) =
  if (fst $ last ps1) == (fst $ last ps2)
  then case map fst ps1 `intersect` map fst ps2 of
       common -> (map fst $ safehead $ optimize_patchset $
                  [filter ((`elem` common).fst) ps1],
                  [get_extra [] common ps1],
                  [get_extra [] common ps2])
  else gcau ((ps1++ps1b):ps1s, [ps2])
gcau ([ps1],ps2:ps2b:ps2s) =
  if (fst $ last ps1) == (fst $ last ps2)
  then case map fst ps1 `intersect` map fst ps2 of
       common -> (map fst $ safehead $ optimize_patchset $
                  [filter ((`elem` common).fst) ps1],
                  [get_extra [] common ps1],
                  [get_extra [] common ps2])
  else gcau ([ps1], (ps2++ps2b):ps2s)

gcau ([ps1],[ps2]) =
    case (map fst ps1) `intersect` (map fst ps2) of
    common -> (map fst $ safehead $ optimize_patchset $
               [filter ((`elem` common).fst) ps1],
               [get_extra [] common ps1],
               [get_extra [] common ps2])
gcau ([ps1],ps2s) = gcau ([ps1],[concat ps2s])
gcau (ps1s,[ps2]) = gcau ([concat ps1s],[ps2])
gcau _ = bug "Unchecked args possibility in get_common_and_uncommon"

get_extra :: [Patch] -> [PatchInfo]
          -> [(PatchInfo, Maybe Patch)] -> [(PatchInfo, Maybe Patch)]
get_extra _ _ [] = []
get_extra [] common ((pinfo, mp):pps) =
    if pinfo `elem` common && is_tag pinfo
    then case liftM getdeps mp of
         Just ds -> get_extra [fromJust mp] (ds++delete pinfo common) pps
         Nothing -> get_extra [fromJust mp] (delete pinfo common) pps
    else if pinfo `elem` common
         then get_extra [fromJust mp] (delete pinfo common) pps
         else (pinfo,mp) : get_extra [] common pps
get_extra skipped common ((pinfo, mp):pps) =
    if pinfo `elem` common && is_tag pinfo
    then case liftM getdeps mp of
         Just ds -> get_extra (fromJust mp:skipped) (ds++delete pinfo common) pps
         Nothing -> get_extra (fromJust mp:skipped) (delete pinfo common) pps
    else if pinfo `elem` common
         then get_extra (fromJust mp:skipped) (delete pinfo common) pps
         else case commute (join_patches skipped, fromJust mp) of
              Just (p', skipped_patch') ->
                  (pinfo,Just p') : get_extra (flatten skipped_patch') common pps
              Nothing -> error $ "bug in get_extra - please report this!"
\end{code}

\begin{code}
get_patches_beyond_tag :: PatchInfo -> PatchSet -> PatchSet
get_patches_beyond_tag t ([(pinfo,_)]:_) | pinfo == t = [[]]
get_patches_beyond_tag t patchset@(((pinfo,mp):ps):pps) =
    if pinfo == t
    then [get_extra [] [t] $ concat patchset]
    else (pinfo,mp) -:- get_patches_beyond_tag t (ps:pps)
get_patches_beyond_tag t ([]:pps) = get_patches_beyond_tag t pps
get_patches_beyond_tag _ [] = [[]]

get_patches_in_tag :: PatchInfo -> PatchSet -> PatchSet
get_patches_in_tag t pps@([(pinfo,_)]:xs)
    | pinfo == t = pps
    | otherwise = get_patches_in_tag t xs

get_patches_in_tag t (((pinfo,_):ps):xs)
    | pinfo /= t = get_patches_in_tag t (ps:xs)

get_patches_in_tag _ ((pa@(_, Just tp):ps):xs) = gpit thepis [pa] (ps:xs)
    where thepis = getdeps tp
          gpit _ sofar [] = [reverse sofar]
          gpit deps sofar ([(tinfo,_)]:xs')
              | tinfo `elem` deps = (reverse sofar) : xs'
              | otherwise = gpit deps sofar xs'
          gpit deps sofar ([]:xs') = gpit deps sofar xs'
          gpit deps sofar (((pinf, Just p):ps'):xs')
              | pinf `elem` deps
                  = let odeps = filter (/=pinf) deps
                        alldeps = if is_tag pinf
                                  then odeps ++ getdeps p
                                  else odeps
                    in gpit alldeps ((pinf, Just p):sofar) (ps':xs')
              | otherwise
                  = gpit deps (commute_by sofar p) (ps':xs')
          gpit _ _ (((pinf, Nothing):_):_)
              = error $ "Failure reading patch file\n"++ human_friendly pinf

get_patches_in_tag t _ = error $ "Couldn't read tag\n"++human_friendly t

commute_by :: [(PatchInfo, Maybe Patch)] -> Patch
           -> [(PatchInfo, Maybe Patch)]
commute_by [] _ = []
commute_by ((pinf, Just a):xs) p =
    case commute (a,p) of
    Nothing -> bug "Failure commuting patches in commute_by called by gpit!"
    Just (p', a') -> (pinf, Just a') : commute_by xs p'
commute_by ((pinf, Nothing):_) _ =
    error $ "Couldn't read patch\n"++ human_friendly pinf
\end{code}

\begin{code}
is_tag :: PatchInfo -> Bool
is_tag pinfo = take 4 (just_name pinfo) == "TAG "

get_tags_right [] = []
get_tags_right (ps:_) = get_tags_r ps
    where
    get_tags_r [] = []
    get_tags_r ((pinfo,mp):pps)
        | is_tag pinfo = case liftM getdeps mp of
                         Just ds -> pinfo : get_tags_r (drop_tags_r ds pps)
                         Nothing -> pinfo : map fst pps
        | otherwise = pinfo : get_tags_r pps
    drop_tags_r :: [PatchInfo] -> PatchSequence -> PatchSequence
    drop_tags_r [] pps = pps
    drop_tags_r _ [] = []
    drop_tags_r ds ((pinfo,mp):pps)
        | pinfo `elem` ds && is_tag pinfo =
            case liftM getdeps mp of
            Just ds' -> drop_tags_r (ds'++delete pinfo ds) pps
            Nothing -> drop_tags_r (delete pinfo ds) pps
        | pinfo `elem` ds = drop_tags_r (delete pinfo ds) pps
        | otherwise = (pinfo,mp) : drop_tags_r ds pps
\end{code}

\begin{code}
deep_optimize_patchset :: PatchSet -> PatchSet
deep_optimize_patchset pss = optimize_patchset [concat pss]

optimize_patchset :: PatchSet -> PatchSet
optimize_patchset [] = []
optimize_patchset (ps:pss) = opsp ps ++ pss
opsp :: [(PatchInfo,Maybe Patch)] -> PatchSet
opsp [] = []
opsp ((pinfo,mp):pps)
     | is_tag pinfo && get_tags_right [(pinfo,mp):pps] == [pinfo]
         = [(pinfo,mp)] : opsp pps
     | otherwise = (pinfo,mp) -:- opsp pps

(-:-) :: (PatchInfo, Maybe Patch) -> PatchSet -> PatchSet
pp -:- [] = [[pp]]
pp -:- (p:ps) = ((pp:p) : ps)

slightly_optimize_patchset :: PatchSet -> PatchSet
slightly_optimize_patchset [] = []
slightly_optimize_patchset (ps:pss) = sops ps ++ pss
    where sops [] = []
          sops [(pinfo,mp)] = [[(pinfo,mp)]]
          sops ((pinfo,mp):pps) | is_tag pinfo && get_tags_right [(pinfo,mp):pps] == [pinfo]
                                 = [(pinfo,mp)] : [pps]
                             | otherwise = (pinfo,mp) -:- sops pps
\end{code}