%  Copyright (C) 2005 David Roundy
%
%  This file is licensed under the GPL, version two or later.

\begin{code}
module RepoFormat ( RepoFormat, RepoProperty(..), identifyRepoFormat,
                    parse_repo_format, write_problem, read_problem,
                    format_has,
                  ) where

import Monad ( liftM )

import External ( fetchFilePS, Cachable( Cachable ) )
import FastPackedString ( PackedString, packString, nilPS, unpackPS,
                          nullPS, linesPS, splitPS )
import DarcsUtils ( catchall )
#include "impossible.h"

data RepoProperty = Darcs1_0
newtype RepoFormat = RF [[PackedString]]
\end{code}

\begin{code}
df, gf :: FilePath
df = "_darcs/format"
gf = ".git/darcs-format"

identifyRepoFormat :: String -> IO RepoFormat
identifyRepoFormat repo =
 do dff <- fetchFilePS (repo ++ "/" ++ df) Cachable `catchall` return nilPS
    if nullPS dff
       then do gff <- fetchFilePS (repo ++ "/" ++ gf) Cachable
                      `catchall` return nilPS
               if nullPS gff
                  then return default_repo_format
                  else return $ parse_repo_format gff
       else return $ parse_repo_format dff

parse_repo_format :: PackedString -> RepoFormat
parse_repo_format ps =
    RF $ map (splitPS '|') $ filter (not.nullPS) $ linesPS ps

default_repo_format :: RepoFormat
default_repo_format = RF [[rp2ps Darcs1_0]]
\end{code}

\begin{code}
-- Nothing means we can write
write_problem :: RepoFormat -> Maybe String
write_problem (RF ks) = unlines `liftM` sequence (map wp ks)
    where wp x | all is_known x = Nothing
          wp [] = impossible
          wp x = Just $ unwords $ "Can't write repository format: " :
                 map unpackPS (filter (not . is_known) x)
\end{code}

\begin{code}
read_problem :: RepoFormat -> Maybe String
read_problem (RF ks) = unlines `liftM` sequence (map rp ks)
    where rp x | any is_known x = Nothing
          rp [] = impossible
          rp x = Just $ unwords $
                 "Can't understand repository format:" : map unpackPS x

is_known :: PackedString -> Bool
is_known p = p `elem` map rp2ps known_properties

known_properties :: [RepoProperty]
known_properties = [Darcs1_0]
\end{code}

\begin{code}
format_has :: RepoProperty -> RepoFormat -> Bool
format_has f (RF ks) = rp2ps f `elem` concat ks
\end{code}

\begin{code}
rp2ps :: RepoProperty -> PackedString
rp2ps Darcs1_0 = packString "darcs-1.0"
\end{code}