%  Copyright (C) 2003-2004 Jan Scheffczyk and 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{Population}
NOTE: this documentation belongs in a ``libdarcs API'' chapter, which
currently doesn't exist.
\begin{code}
module Population ( Population, patchChanges, adjustPopStates, applyToPop,
                    applyPatchesPop, applyPatchSetPop, getPopFrom,
                    popUnfold, popUnfoldDirty,
                    initPop, cleanPop, setPopState,
                    DirMark(..),
                    getRepoPop, getRepoPopVersion,
                    lookup_pop, lookup_creation_pop,
                    modified_to_xml,
                  ) where
import FastPackedString ( PackedString, unpackPS, packString,
                          splitPS, appendPS, nilPS )
import Monad ( liftM )
import List ( nub )
import Maybe ( catMaybes )
import DarcsUtils ( withCurrentDirectory )

import FileName ( fn2fp, fp2fn, norm_path )
import PatchInfo ( PatchInfo, patchinfo, to_xml )
import Patch ( Patch, applyToPop, patchChanges )
import DarcsRepo ( read_repo )
import Pristine ( identifyPristine, getPristinePop )
import PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..),
                        notModified, setPopState, getPopFrom )
import Printer ( empty, text, ($$), (<>), Doc )
#include "impossible.h"
\end{code}

a dummy PatchInfo

\begin{code}
nullPI :: PatchInfo
nullPI = patchinfo [] [] [] []
\end{code}

population of an empty repository

\begin{code}
initPop :: Population
initPop = Pop nullPI (PopDir i [])
 where i = Info {nameI = packString ".",
                 modifiedByI = nullPI,
                 modifiedHowI = DullDir,
                 createdByI = Nothing,
                 creationNameI = Just (packString ".")}
\end{code}

get the actual documents and folders (with full name)
from a population tree (and their modification times)
(take care for ``deleted'' files and dirs)

\begin{code}
popUnfold :: Population -> ([(PackedString,PatchInfo)],
                            [(PackedString,PatchInfo)])
popUnfold (Pop _ s) = popUnfold' nilPS s
 where popUnfold' pre (PopDir f ss)
        | modifiedHowI f == RemovedDir = (ds,fs)
        | otherwise = (ds,f':fs)
         where f' = (newname, modifiedByI f)
               newname = if pre == nilPS
                            then nameI f
                            else pre `appendPS` (packString "/") `appendPS` nameI f
               (dss,fss) = (unzip . map (popUnfold' newname)) ss
               ds = concat dss
               fs = concat fss
       popUnfold' pre (PopFile d)
        | modifiedHowI d == RemovedFile = ([],[])
        | pre == nilPS = ([(nameI d,modifiedByI d)],[])
        | otherwise = ([(pre `appendPS` (packString "/") `appendPS`
                         nameI d,
                         modifiedByI d)],[])
\end{code}

get the changed ``dirty'' documents and folders (with full name)
from a population tree (and their modification times)
(take care for ``deleted'' files and dirs)

\begin{code}
popUnfoldDirty :: Population -> ([(PackedString,PatchInfo)],
                                 [(PackedString,PatchInfo)])
popUnfoldDirty (Pop _ s) = popUnfold' nilPS s
 where popUnfold' pre (PopDir f ss)
        | notModified f || modifiedHowI f == RemovedDir = (ds,fs)
        | otherwise = (ds,f':fs)
         where f' = (newname, modifiedByI f)
               newname = if pre == nilPS
                            then nameI f
                            else pre `appendPS` (packString "/") `appendPS` nameI f
               (dss,fss) = (unzip . map (popUnfold' newname)) ss
               ds = concat dss
               fs = concat fss
       popUnfold' pre (PopFile d)
        | notModified d || modifiedHowI d == RemovedFile = ([],[])
        | pre == nilPS = ([(nameI d,modifiedByI d)],[])
        | otherwise = ([(pre `appendPS` (packString "/") `appendPS`
                         nameI d,
                         modifiedByI d)],[])
\end{code}

apply a patchset to a population

[[(PatchInfo, Maybe Patch)]] is actually a PatchSet but this provokes
cycles in import hierarchy

\begin{code}
applyPatchSetPop :: [[(PatchInfo, Maybe Patch)]] -> Population -> Population
applyPatchSetPop ps pop = applyPatchesPop (reverse $ catMaybes' $ concat ps) pop
 where catMaybes' [] = []
       catMaybes' ((_,Nothing):xs) = catMaybes' xs
       catMaybes' ((a,Just x):xs) = (a,x) : catMaybes' xs
\end{code}

apply Patches to a population

\begin{code}
applyPatchesPop :: [(PatchInfo,Patch)] -> Population -> Population
applyPatchesPop pips pop =
    foldl (\a_pop (pinfo,p) -> applyToPop pinfo p a_pop) pop pips
\end{code}

adjust the ``modifiedBy'' fields of a population
this is necessary for backward restoring a population
Patches must be in !reverse! order and already inversed!

Usually they go from the populations PatchInfo back to the initial
PatchInfo.

Note that backward restoring invalidates (must!) the fields createdBy and
creationName.

This is necessary because while backward creation of a population we use
inverted patches.

So RmFile becomes an AddFile etc. which means that the file ``would be
created after it has been changed''!

\begin{code}
adjustPopStates :: [(PatchInfo,Patch)] -> Population -> Population
adjustPopStates  pips (Pop _ tree)
 = Pop (fst (pips!!pips_index)) tree'
 where (tree',pips_index) = adjustTimesPTree tree
       -- snd component: greatest number of PI which changed the population (0 based)
       -- that is the youngest given patchinfo (relied on the order of the given list)
       adjustTimesPTree :: PopTree -> (PopTree,Int)
       adjustTimesPTree tr@(PopDir f trs)
        | modifiedHowI f == RemovedDir = (tr,0) -- for removed dirs there is no previous modifying patch!
        | otherwise
        = let (pinfo,dm,i) = lastChange 0 (nameI f) changes
              (trs',is) = unzip (map adjustTimesPTree trs)
              i' = max (maximum is) i
          in (PopDir (f {modifiedByI = pinfo,
                         modifiedHowI = dm,
                         createdByI = Nothing,
                         creationNameI = Nothing}) trs'
             ,i')
       adjustTimesPTree tr@(PopFile f)
        | modifiedHowI f == RemovedFile = (tr,0) -- for removed files there is no previous modifying patch!
        | otherwise
        = let (pinfo,dm,i) = lastChange 0 (nameI f) changes
          in (PopFile (f {modifiedByI = pinfo,
                          modifiedHowI = dm,
                          createdByI = Nothing,
                          creationNameI = Nothing})
             ,i)
       lastChange :: Int -> PackedString -> [(PatchInfo,[(PackedString,DirMark)])]
                                         -> (PatchInfo,DirMark,Int)
       lastChange _ n [] = error ("lastChange internal error: No modifying patch for " ++ show n)
       lastChange i n ((pinfo,ssdm):sss)
         = case lookupBy (\ss -> n `elem` (splitPS '/' ss)) ssdm of
            Just dm -> (pinfo,dm,i) -- pinfo changes n somehow (indicated by the DirMark dm)
            _ -> lastChange (i+1) n sss
       changes = map (\ (pinfo,p) -> (pinfo,nub $ map (\ (s,d) -> (packString s,d)) $ patchChanges p)) pips

lookupBy :: (a -> Bool) -> [(a,b)] -> Maybe b
lookupBy f ((a,b):a_and_bs)
 | f a = Just b
 | otherwise = lookupBy f a_and_bs
lookupBy _ [] = Nothing
\end{code}

clean up a population
remove any change markers, delete ``deleted'' files and dirs

\begin{code}
cleanPop :: Population -> Population
cleanPop (Pop t tr) = Pop t (fromJust (cleanPopTr tr))
 where cleanPopTr (PopDir i trs)
        | modifiedHowI i == RemovedDir = Nothing
        | otherwise = Just $ PopDir (modInfo DullDir i)
                                    (catMaybes (map cleanPopTr trs))
       cleanPopTr (PopFile i)
        | modifiedHowI i == RemovedFile = Nothing
        | otherwise = Just $ PopFile (modInfo DullFile i)
       modInfo s i = i {modifiedByI = nullPI,
                        modifiedHowI = s}
\end{code}


get the pristine population from a repo

\begin{code}

getRepoPop :: FilePath -> IO Population
getRepoPop repobasedir
 = do pinfo <- liftM (fst . head . concat) (read_repo repobasedir)
      -- pinfo is the latest patchinfo
      mp <- withCurrentDirectory repobasedir $
                identifyPristine >>= getPristinePop pinfo
      case mp of
          (Just pop) -> return pop
          (Nothing) -> getRepoPopVersion repobasedir pinfo

getRepoPopVersion :: FilePath -> PatchInfo -> IO Population
getRepoPopVersion repobasedir pinfo
 = do pips <- concat `liftM` read_repo repobasedir
      return $ applyPatchSetPop [dropWhile ((/=pinfo).fst) pips] initPop
\end{code}


Routines for pulling data conveniently out of a Population

\begin{code}
lookup_pop :: FilePath -> Population -> Maybe Population
lookup_pop f p@(Pop _ (PopFile i))
    | unpackPS (nameI i) == f = Just p
    | otherwise = Nothing
lookup_pop d p@(Pop pinfo (PopDir i c))
    | unpackPS (nameI i) == "." =
        case catMaybes $ map (lookup_pop (dropDS d).(Pop pinfo)) c of
        [apop] -> Just apop
        [] -> Nothing
        _ -> impossible
    | unpackPS (nameI i) == takeWhile (/='/') d =
        case dropWhile (=='/') $ dropWhile (/='/') d of
        "" -> Just p
        d' -> case catMaybes $ map (lookup_pop d'.(Pop pinfo)) c of
              [apop] -> Just apop
              [] -> Nothing
              _ -> impossible
    | otherwise = Nothing
    where dropDS ('.':'/':f) = dropDS f
          dropDS f = f

lookup_creation_pop :: PatchInfo -> FilePath -> Population -> Maybe Population
lookup_creation_pop b a (Pop pinfo pp) = (Pop pinfo) `liftM` lcp pp
    where lcp p@(PopFile i)
              | fixname `liftM` creationNameI i == f && createdByI i == who = Just p
              | otherwise = Nothing
          lcp p@(PopDir i c)
              | fixname `liftM` creationNameI i == f && createdByI i == who = Just p
              | otherwise = case catMaybes $ map lcp c of
                            [apop] -> Just apop
                            _ -> Nothing
          fixname = packString . fn2fp . norm_path . fp2fn . unpackPS
          f = Just $ packString $ fn2fp $ norm_path $ fp2fn a
          who = Just b
\end{code}

\begin{code}
modified_to_xml :: Info -> Doc
modified_to_xml i | modifiedHowI i == DullDir = empty
                  | modifiedHowI i == DullFile = empty
modified_to_xml i = text "<modified>"
                 $$ text "<modified_how>" <> text (show (modifiedHowI i)) <>
                    text "</modified_how>"
                 $$ to_xml (modifiedByI i)
                 $$ text "</modified>"
\end{code}