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

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

    module Darcs.Repository.Format ( RepoFormat(..), RepoProperty(..), identifyRepoFormat,
                        createRepoFormat, writeRepoFormat,
                        writeProblem, readProblem, readfromAndWritetoProblem,
                        formatHas, formatHasTogether,
                      ) where

    import Data.List ( sort )
    import Data.Maybe ( isJust, catMaybes )
    import Control.Monad ( msum )

    import Darcs.SignalHandler ( catchNonSignal )
    import Darcs.External ( fetchFilePS, Cachable( Cachable ) )
    import Darcs.Flags ( DarcsFlag ( UseFormat2, UseHashedInventory,
                                     UseOldFashionedInventory ) )
    import Darcs.Lock ( writeBinFile )
    import Darcs.Utils ( catchall, prettyException )
    import Progress ( beginTedious, endTedious, finishedOneIO )
    import Darcs.Global ( darcsdir )

    import ByteStringUtils ( linesPS )
    import qualified Data.ByteString.Char8 as BC (split, unpack, singleton, elemIndex, pack)
    import qualified Data.ByteString       as B (ByteString, null, empty)
    import qualified ByteStringUtils       as BU ( intercalate )

    #include "impossible.h"

    data RepoProperty = Darcs1_0 | Darcs2 | HashedInventory

    -- | @RepoFormat@ is the representation of the format of a
    -- repository. Each sublist corresponds to a line in the format
    -- file. Each line is decomposed into words.
    newtype RepoFormat = RF [[B.ByteString]] deriving ( Show )

    -- | The file where the format information should be.
    df :: FilePath
    df = darcsdir++"/format"

    -- | @identifyRepoFormat URL@ identifies the format of the repository
    -- at the given address. Return @Left reason@ if it fails, where
    -- @reason@ explains why we weren't able to identify the format.
    identifyRepoFormat :: String -> IO (Either String RepoFormat)
    identifyRepoFormat repo =
     do let k = "Identifying repository "++repo
        beginTedious k
        finishedOneIO k "format"
        dff <- fetchFilePS (repo ++ "/" ++ df) Cachable `catchall` return B.empty
        -- below is a workaround for servers that don't return a 404 on nonexistent files
        rf <- if B.null dff || isJust (BC.elemIndex '<' dff)
              then do finishedOneIO k "inventory"
                      have_inventory <- doesRemoteFileExist (repo++"/"++darcsdir++"/inventory")
                      case have_inventory of
                        Right _ -> return $ Right defaultRepoFormat
                        Left e -> return $ Left $ "Not a repository: "++repo++" ("++e++")"
              else return $ Right $ parseRepoFormat dff
        endTedious k
        return rf
        where drfe x = fetchFilePS x Cachable >> return True
              doesRemoteFileExist x = (fmap Right) (drfe x) `catchNonSignal`
                                      (\e -> return (Left (prettyException e)))

    -- | @writeRepoFormat@ writes the repo format to the given file.
    writeRepoFormat :: RepoFormat -> FilePath -> IO ()
    writeRepoFormat (RF rf) loc = writeBinFile loc $ unlines $
                                  map (BC.unpack . BU.intercalate (BC.singleton '|')) rf

    parseRepoFormat :: B.ByteString -> RepoFormat
    parseRepoFormat ps =
        RF $ map (BC.split '|') $ filter (not . B.null) $ linesPS ps

    -- | The repo format we assume if we do not find a format file.
    defaultRepoFormat :: RepoFormat
    defaultRepoFormat = RF [[rp2ps Darcs1_0]]

    createRepoFormat :: [DarcsFlag] -> RepoFormat
    createRepoFormat fs = RF ([map rp2ps flags2inv] ++ maybe2)
        where flags2inv | UseFormat2 `elem` fs = [HashedInventory]
                        | UseHashedInventory `elem` fs = [HashedInventory]
                        | UseOldFashionedInventory `elem` fs = [Darcs1_0]
                        | otherwise = [HashedInventory]
              maybe2 = if UseFormat2 `notElem` fs &&
                          (UseOldFashionedInventory `elem` fs ||
                           UseHashedInventory `elem` fs)
                       then []
                       else [[rp2ps Darcs2]]

    -- | @writeProblem from@ tells if we can write to a repo in format @form@.
    -- it returns @Nothing@ if there's no problem writing to such a repository.
    writeProblem :: RepoFormat -> Maybe String
    writeProblem rf | isJust $ readProblem rf = readProblem rf
    writeProblem (RF ks) = unlines `fmap` justsOrNothing (map wp ks)
        where wp x | all isKnown x = Nothing
              wp [] = impossible
              wp x = Just $ unwords $ "Can't write repository format: " :
                     map BC.unpack (filter (not . isKnown) x)

    -- | @writeProblem from@ tells if we can read and write to a repo in
    -- format @form@.  it returns @Nothing@ if there's no problem reading
    -- and writing to such a repository.
    readfromAndWritetoProblem :: RepoFormat -> RepoFormat -> Maybe String
    readfromAndWritetoProblem inrf outrf
        | formatHas Darcs2 inrf /= formatHas Darcs2 outrf
            = Just "Cannot mix darcs-2 repositories with older formats"
        | otherwise = msum [readProblem inrf, writeProblem outrf]

    -- | @readProblem from@ tells if we can write to a repo in format @form@.
    -- it returns @Nothing@ if there's no problem reading from such a repository.
    readProblem :: RepoFormat -> Maybe String
    readProblem rf | formatHas Darcs1_0 rf && formatHas Darcs2 rf
                        = Just "Invalid repositoryformat:  format 2 is incompatible with format 1"
    readProblem (RF ks) = unlines `fmap` justsOrNothing (map rp ks)
        where rp x | any isKnown x = Nothing
              rp [] = impossible
              rp x = Just $ unwords $
                     "Can't understand repository format:" : map BC.unpack x

    -- | Does this version of darcs know how to handle this property?
    isKnown :: B.ByteString -> Bool
    isKnown p = p `elem` map rp2ps knownProperties

    -- | This is the list of properties which this version of darcs knows
    -- how to handle.
    knownProperties :: [RepoProperty]
    knownProperties = [Darcs1_0, Darcs2, HashedInventory]

    justsOrNothing :: [Maybe x] -> Maybe [x]
    justsOrNothing mxs =
     case catMaybes mxs of
       [] -> Nothing
       xs -> Just xs

    formatHas :: RepoProperty -> RepoFormat -> Bool
    formatHas f (RF ks) = rp2ps f `elem` concat ks

    formatHasTogether :: [RepoProperty] -> RepoFormat -> Bool
    formatHasTogether fs (RF ks) = fht (sort $ map rp2ps fs) ks
        where fht _ [] = False
              fht x (y:ys) | x == sort y = True
                           | otherwise = fht x ys

    rp2ps :: RepoProperty -> B.ByteString
    rp2ps Darcs1_0 = BC.pack "darcs-1.0"
    rp2ps Darcs2 = BC.pack "darcs-2"
    rp2ps HashedInventory = BC.pack "hashed"