-- |
-- Module      : Data.Git.Named
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unix
--
-- Manipulation of named references
-- * reading packed-refs file
-- * reading single heads/tags/remote file
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Git.Named
    ( RefSpecTy(..)
    , RefContentTy(..)
    , RefName(..)
    , readPackedRefs
    , PackedRefs(..)
    -- * manipulating loosed name references
    , existsRefFile
    , writeRefFile
    , readRefFile
    -- * listings looses name references
    , looseHeadsList
    , looseTagsList
    , looseRemotesList
    ) where

import Data.String
import Data.Git.Path
import Data.Git.Ref
import Data.Git.Imports
import Data.Git.OS
import Data.List (isPrefixOf)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.UTF8 as UTF8

-- | Represent a named specifier.
data RefSpecTy = RefHead
               | RefOrigHead
               | RefFetchHead
               | RefBranch RefName
               | RefTag RefName
               | RefRemote RefName
               | RefPatches String
               | RefStash
               | RefOther String
               deriving (Show,Eq,Ord)

-- | content of a ref file.
data RefContentTy hash =
      RefDirect (Ref hash)
    | RefLink   RefSpecTy
    | RefContentUnknown B.ByteString
    deriving (Show,Eq)

newtype RefName = RefName { refNameRaw :: String }
    deriving (Show,Eq,Ord)

instance IsString RefName where
    fromString s
        | isValidRefName s = RefName s
        | otherwise        = error ("invalid RefName " ++ show s)

isValidRefName :: String -> Bool
isValidRefName s = not (or $ map isBadChar s)
  where isBadChar :: Char -> Bool
        isBadChar c = c <= ' ' || c >= toEnum 0x7f || c `elem` badAscii
        badAscii = [ '~', '^', ':', '\\', '*', '?', '[' ]

toRefTy :: String -> RefSpecTy
toRefTy s
    | "refs/tags/" `isPrefixOf` s    = RefTag $ RefName $ drop 10 s
    | "refs/heads/" `isPrefixOf` s   = RefBranch $ RefName $ drop 11 s
    | "refs/remotes/" `isPrefixOf` s = RefRemote $ RefName $ drop 13 s
    | "refs/patches/" `isPrefixOf` s = RefPatches $ drop 13 s
    | "refs/stash" == s              = RefStash
    | "HEAD" == s                    = RefHead
    | "ORIG_HEAD" == s               = RefOrigHead
    | "FETCH_HEAD" == s              = RefFetchHead
    | otherwise                      = RefOther $ s

fromRefTy :: RefSpecTy -> String
fromRefTy (RefBranch h)  = "refs/heads/" ++ refNameRaw h
fromRefTy (RefTag h)     = "refs/tags/" ++ refNameRaw h
fromRefTy (RefRemote h)  = "refs/remotes/" ++ refNameRaw h
fromRefTy (RefPatches h) = "refs/patches/" ++ h
fromRefTy RefStash       = "refs/stash"
fromRefTy RefHead        = "HEAD"
fromRefTy RefOrigHead    = "ORIG_HEAD"
fromRefTy RefFetchHead   = "FETCH_HEAD"
fromRefTy (RefOther h)   = h

toPath :: LocalPath -> RefSpecTy -> LocalPath
toPath gitRepo (RefBranch h)  = gitRepo </> "refs" </> "heads" </> fromString (refNameRaw h)
toPath gitRepo (RefTag h)     = gitRepo </> "refs" </> "tags" </> fromString (refNameRaw h)
toPath gitRepo (RefRemote h)  = gitRepo </> "refs" </> "remotes" </> fromString (refNameRaw h)
toPath gitRepo (RefPatches h) = gitRepo </> "refs" </> "patches" </> fromString h
toPath gitRepo RefStash       = gitRepo </> "refs" </> "stash"
toPath gitRepo RefHead        = gitRepo </> "HEAD"
toPath gitRepo RefOrigHead    = gitRepo </> "ORIG_HEAD"
toPath gitRepo RefFetchHead   = gitRepo </> "FETCH_HEAD"
toPath gitRepo (RefOther h)   = gitRepo </> fromString h

data PackedRefs a = PackedRefs
    { packedRemotes :: a
    , packedBranchs :: a
    , packedTags    :: a
    }

readPackedRefs :: HashAlgorithm hash
               => LocalPath
               -> ([(RefName, Ref hash)] -> a)
               -> IO (PackedRefs a)
readPackedRefs gitRepo constr = do
    exists <- isFile (packedRefsPath gitRepo)
    if exists then readLines else return $ finalize emptyPackedRefs
  where emptyPackedRefs = PackedRefs [] [] []
        readLines = finalize . foldl accu emptyPackedRefs . BC.lines <$> readBinaryFile (packedRefsPath gitRepo)
        finalize (PackedRefs a b c) = PackedRefs (constr a) (constr b) (constr c)
        accu a l
            | "#" `BC.isPrefixOf` l = a
            | otherwise =
                let (ref, r) = consumeHexRef hashAlg l
                    name     = UTF8.toString $ B.tail r
                 in case toRefTy name of
                        -- accumulate tag, branch and remotes
                        RefTag refname    -> a { packedTags    = (refname, ref) : packedTags a }
                        RefBranch refname -> a { packedBranchs = (refname, ref) : packedBranchs a }
                        RefRemote refname -> a { packedRemotes = (refname, ref) : packedRemotes a }
                        -- anything else that shouldn't be there get dropped on the floor
                        _                 -> a

-- | list all the loose refs available recursively from a directory starting point
listRefs :: LocalPath -> IO [RefName]
listRefs root = listRefsAcc [] root
  where listRefsAcc acc dir = do
            files <- listDirectory dir
            getRefsRecursively dir acc files
        getRefsRecursively _   acc []     = return acc
        getRefsRecursively dir acc (x:xs) = do
            isDir <- isDirectory x
            extra <- if isDir
                        then listRefsAcc [] x
                        else let r = UTF8.toString $ localPathEncode $ stripRoot x
                              in if isValidRefName r
                                    then return [fromString r]
                                    else return []
            getRefsRecursively dir (extra ++ acc) xs
        stripRoot p = maybe (error "stripRoot invalid") id $ stripPrefix root p

looseHeadsList :: LocalPath -> IO [RefName]
looseHeadsList gitRepo = listRefs (headsPath gitRepo)

looseTagsList :: LocalPath -> IO [RefName]
looseTagsList gitRepo = listRefs (tagsPath gitRepo)

looseRemotesList :: LocalPath -> IO [RefName]
looseRemotesList gitRepo = listRefs (remotesPath gitRepo)

existsRefFile :: LocalPath -> RefSpecTy -> IO Bool
existsRefFile gitRepo specty = isFile $ toPath gitRepo specty

writeRefFile :: LocalPath -> RefSpecTy -> RefContentTy hash -> IO ()
writeRefFile gitRepo specty refcont = do
    createParentDirectory filepath
    writeBinaryFile filepath $ fromRefContent refcont
    where filepath = toPath gitRepo specty
          fromRefContent (RefLink link)        = B.concat ["ref: ", UTF8.fromString $ fromRefTy link, B.singleton 0xa]
          fromRefContent (RefDirect ref)       = B.concat [toHex ref, B.singleton 0xa]
          fromRefContent (RefContentUnknown c) = c

readRefFile :: HashAlgorithm hash => LocalPath -> RefSpecTy -> IO (RefContentTy hash)
readRefFile gitRepo specty = toRefContent <$> readBinaryFile filepath
    where filepath = toPath gitRepo specty
          toRefContent content
            | "ref: " `B.isPrefixOf` content = RefLink $ toRefTy $ UTF8.toString $ head $ BC.lines $ B.drop 5 content
            | B.length content < 42          = RefDirect $ fst $ consumeHexRef hashAlg content
            | otherwise                      = RefContentUnknown content

consumeHexRef :: HashAlgorithm hash => hash -> B.ByteString -> (Ref hash, B.ByteString)
consumeHexRef alg b = let (b1,b2) = B.splitAt (hashDigestSize alg * 2) b in (fromHex b1, b2)