    {-# 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,
                        modified_to_xml,
                        lookup_pop, lookup_creation_pop,
                      ) 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, norm_path )
    import Darcs.Patch ( RepoPatch, applyToPop, patchcontents, patchChanges,
                         Effect, effect )
    import Darcs.Witnesses.Ordered ( FL(..), RL(..), reverseRL, concatRL, mapRL )
    import Darcs.Patch.Info ( PatchInfo, idpatchinfo, to_xml )
    import Darcs.Patch.Set ( PatchSet )
    import Darcs.Witnesses.Sealed ( Sealed(..), seal, unseal )
    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 )
    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(x) -> Population -> Population
    applyPatchSetPop ps pop = applyPatchesPop (reverseRL $ concatRL 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 . concatRL) `liftM` 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 `liftM` read_repo repository
          return $ (unseal applyPatchSetPop) (mkPatchSet $ dropWhileRL ((/=pinfo).info) pips) initPop
                 where mkPatchSet (Sealed xs) = seal $ 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

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

    lookup_pop' :: String -> Population -> Maybe Population
    lookup_pop' f p@(Pop _ (PopFile i))
        | BC.unpack (nameI i) == f = Just p
        | otherwise = Nothing
    lookup_pop' d p@(Pop pinfo (PopDir i c))
        | BC.unpack (nameI i) == "." =
            case catMaybes $ map (lookup_pop' (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 (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 (BC.unpack $ 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 = BC.pack . fn2fp . norm_path . fp2fn . BC.unpack
              f = Just $ BC.pack $ fn2fp $ norm_path $ fp2fn a
              who = Just b

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