Population.lhs

%  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}
{-# OPTIONS_GHC -cpp #-}
module Darcs.Population ( Population, patchChanges, applyToPop,
                    getPopFrom,
                    setPopState,
                    DirMark(..),
                    getRepoPop, getRepoPopVersion,
                    lookup_pop, lookup_creation_pop,
                    modified_to_xml,
                  ) where
import FastPackedString ( unpackPS, packString,
                        )
import Data.Maybe ( catMaybes )
import Darcs.Utils ( withCurrentDirectory )

import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )
import FileName ( fn2fp, fp2fn, fn2ps, norm_path )
import Darcs.Patch ( RepoPatch, applyToPop, patchcontents, patchChanges,
                     Effect, effect )
import Darcs.Patch.Ordered ( FL(..), RL(..), reverseRL, concatRL, mapRL )
import Darcs.Patch.Info ( PatchInfo, patchinfo, to_xml )
import Darcs.Patch.Set ( PatchSet )
import Darcs.Sealed ( liftSM )
import Darcs.Repository ( withRepositoryDirectory, ($-), read_repo )
import Darcs.Repository.Pristine ( identifyPristine, getPristinePop )
import Darcs.PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..),
                        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}

apply a patchset to a population

\begin{code}
applyPatchSetPop :: RepoPatch p => PatchSet p -> Population -> Population
applyPatchSetPop ps pop = applyPatchesPop (reverseRL $ concatRL ps) pop
\end{code}

apply Patches to a population

\begin{code}
applyPatchesPop :: Effect p => FL (PatchInfoAnd p) -> Population -> Population
applyPatchesPop NilFL = id
applyPatchesPop (hp:>:hps) = applyPatchesPop hps .
                             applyToPop (info hp) (effect $ patchcontents $ hopefully hp)
\end{code}

get the pristine population from a repo

\begin{code}

getRepoPop :: FilePath -> IO Population
getRepoPop repobasedir
 = withRepositoryDirectory [] repobasedir $- \repository -> do
      pinfo <- (head . mapRL info . concatRL) `liftSM` read_repo repository
      -- 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 = withRepositoryDirectory [] repobasedir $- \repository ->
   do pips <- concatRL `liftSM` read_repo repository
      return $ applyPatchSetPop (dropWhileRL ((/=pinfo).info) pips:<:NilRL) initPop
          where dropWhileRL f (x:<:xs) | f x = dropWhileRL f xs
                                       | otherwise = x :<: xs
                dropWhileRL _ NilRL = NilRL
\end{code}


Routines for pulling data conveniently out of a Population

\begin{code}
lookup_pop :: FilePath -> Population -> Maybe Population
lookup_pop f p = lookup_pop' (unpackPS $ fn2ps $ fp2fn f) p

lookup_pop' :: String -> 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 pinfo f p = lookup_creation_pop' pinfo (unpackPS $ fn2ps $ fp2fn f) p

lookup_creation_pop' :: PatchInfo -> String -> Population -> Maybe Population
lookup_creation_pop' b a (Pop pinfo pp) = (Pop pinfo) `fmap` lcp pp
    where lcp p@(PopFile i)
              | fixname `fmap` creationNameI i == f && createdByI i == who = Just p
              | otherwise = Nothing
          lcp p@(PopDir i c)
              | fixname `fmap` 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}