-- | A few darcs-specific utility functions. These are used for reading and
-- writing darcs and darcs-compatible hashed trees.
module Storage.Hashed.Darcs where

import Storage.Hashed.Tree hiding ( read )
import Storage.Hashed.AnchoredPath
import Storage.Hashed.Utils

import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL

import Data.List( sortBy )
import Data.Char( chr )

darcsFormatSize :: (Num a) => a -> BS.ByteString
darcsFormatSize s = BS.pack $ replicate (10 - length n) '0' ++ n
    where n = show s

darcsFormatHash :: Hash -> BS.ByteString
darcsFormatHash (Hash (Just s, h)) =
    BS.concat [ darcsFormatSize s
              , BS.singleton '-'
              , h ]
darcsFormatHash (Hash (Nothing, h)) = h

darcsDecodeWhite :: String -> FilePath
darcsDecodeWhite ('\\':cs) =
    case break (=='\\') cs of
    (theord, '\\':rest) ->
        chr (read theord) : darcsDecodeWhite rest
    _ -> error "malformed filename"
darcsDecodeWhite (c:cs) = c: darcsDecodeWhite cs
darcsDecodeWhite "" = ""

darcsFormatDir :: Tree -> BL.ByteString
darcsFormatDir t = BL.fromChunks $ concatMap string
                     (sortBy cmp $ listImmediate t)
    where cmp (Name a, _) (Name b, _) = compare a b
          string (Name name, item) =
              [ case item of
                  File _ -> BS.pack "file:\n"
                  SubTree _ -> BS.pack "directory:\n"
                  Stub _ _ ->
                      error "Trees with stubs not supported in darcsFormatDir.",
                name, BS.singleton '\n',
                case itemHash item of
                  Nothing -> error $ "darcsFormatDir: missing hash on "
                                 ++ show name
                  Just h -> darcsFormatHash h,
                BS.singleton '\n' ]

-- | Compute a darcs-compatible hash value for a tree-like structure.
darcsTreeHash :: Tree -> Hash
darcsTreeHash d = hashSetSize (sha256 bl) $ BL.length bl
    where bl = darcsFormatDir d