{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}

--   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.

#include "gadts.h"

module Darcs.Population ( Population, patchChanges, applyToPop,
                    getPopFrom,
                    setPopState,
                    DirMark(..),
                    getRepoPop, getRepoPopVersion,
                    modifiedToXml,
                    lookupPop, lookupCreationPop,
                  ) where

import qualified Data.ByteString.Char8 as BC ( unpack, singleton, pack )
import Data.Maybe ( catMaybes )
import Darcs.Utils ( withCurrentDirectory )

import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )
import Darcs.Patch.FileName ( fn2fp, fp2fn, fn2ps, normPath )
import Darcs.Patch ( RepoPatch, applyToPop, patchcontents, patchChanges,
                     Effect, effect )
import Darcs.Witnesses.Ordered ( FL(..), RL(..), reverseRL, concatRL, mapRL )
import Darcs.Patch.Info ( PatchInfo, idpatchinfo, toXml )
import Darcs.Patch.Set ( PatchSet(..), newset2FL, newset2RL )
#ifdef GADT_WITNESSES
import Darcs.Patch.Set ( Origin )
#endif
import Darcs.Witnesses.Sealed ( Sealed(..), seal, unseal )
import Darcs.Repository ( withRepositoryDirectory, ($-), readRepo )
import Darcs.Repository.Pristine ( identifyPristine, getPristinePop )
import Darcs.PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..),
                        setPopState, getPopFrom )
import Printer ( empty, text, ($$), (<>), Doc )
import Control.Monad ( liftM )

#include "impossible.h"

-- | population of an empty repository
initPop :: Population
initPop = Pop idpatchinfo (PopDir i [])
 where i = Info {nameI          = BC.singleton '.',
                 modifiedByI    = idpatchinfo,
                 modifiedHowI   = DullDir,
                 createdByI     = Nothing,
                 creationNameI  = Just (BC.singleton '.')}

-- | apply a patchset to a population
applyPatchSetPop :: RepoPatch p => PatchSet p C(Origin x) -> Population -> Population
applyPatchSetPop ps pop = applyPatchesPop (newset2FL ps) pop

-- | apply Patches to a population
applyPatchesPop :: Effect p => FL (PatchInfoAnd p) C(x y) -> Population -> Population
applyPatchesPop NilFL = id
applyPatchesPop (hp:>:hps) = applyPatchesPop hps .
                             applyToPop (info hp) (effect $ patchcontents $ hopefully hp)
-- | get the pristine population from a repo
getRepoPop :: FilePath -> IO Population
getRepoPop repobasedir
 = withRepositoryDirectory [] repobasedir $- \repository -> do
      pinfo <- (head . mapRL info . newset2RL) `liftM` readRepo 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 <- newset2RL `liftM` readRepo repository
      return $ (unseal applyPatchSetPop) (mkPatchSet $ dropWhileRL ((/=pinfo).info) pips) initPop
             where mkPatchSet (Sealed xs) = seal $ PatchSet xs NilRL
                   dropWhileRL :: (FORALL(x y) a C(x y) -> Bool) -> RL a C(r v) -> Sealed (RL a C(r))
                   dropWhileRL _ NilRL = seal NilRL
                   dropWhileRL p xs@(x:<:xs')
                               | p x       = dropWhileRL p xs'
                               | otherwise = seal xs

-- Routines for pulling data conveniently out of a Population

lookupPop :: FilePath -> Population -> Maybe Population
lookupPop f p = lookupPop' (BC.unpack $ fn2ps $ fp2fn f) p

lookupPop' :: String -> Population -> Maybe Population
lookupPop' f p@(Pop _ (PopFile i))
    | BC.unpack (nameI i) == f = Just p
    | otherwise = Nothing
lookupPop' d p@(Pop pinfo (PopDir i c))
    | BC.unpack (nameI i) == "." =
        case catMaybes $ map (lookupPop' (dropDS d).(Pop pinfo)) c of
        [apop] -> Just apop
        [] -> Nothing
        _ -> impossible
    | BC.unpack (nameI i) == takeWhile (/='/') d =
        case dropWhile (=='/') $ dropWhile (/='/') d of
        "" -> Just p
        d' -> case catMaybes $ map (lookupPop' d'.(Pop pinfo)) c of
              [apop] -> Just apop
              [] -> Nothing
              _ -> impossible
    | otherwise = Nothing
    where dropDS ('.':'/':f) = dropDS f
          dropDS f = f

lookupCreationPop :: PatchInfo -> FilePath -> Population -> Maybe Population
lookupCreationPop pinfo f p = lookupCreationPop' pinfo (BC.unpack $ fn2ps $ fp2fn f) p

lookupCreationPop' :: PatchInfo -> String -> Population -> Maybe Population
lookupCreationPop' 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 = BC.pack . fn2fp . normPath . fp2fn . BC.unpack
          f = Just $ BC.pack $ fn2fp $ normPath $ fp2fn a
          who = Just b

modifiedToXml :: Info -> Doc
modifiedToXml i | modifiedHowI i == DullDir = empty
                  | modifiedHowI i == DullFile = empty
modifiedToXml i = text "<modified>"
                 $$ text "<modified_how>" <> text (show (modifiedHowI i)) <>
                    text "</modified_how>"
                 $$ toXml (modifiedByI i)
                 $$ text "</modified>"
