-- |
-- 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 Control.Applicative ((<$>))

import qualified Filesystem as F
import qualified Filesystem.Path.Rules as FP (posix, decode, encode, encodeString, decodeString)
import Filesystem.Path.CurrentOS hiding (root)

import Data.String
import Data.Git.Path
import Data.Git.Ref
import Data.List (isPrefixOf)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Prelude hiding (FilePath)

-- | 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 = RefDirect Ref
                  | 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 = [ '~', '^', ':', '\\', '*', '?', '[' ]

isValidRefFilepath :: FilePath -> Bool
isValidRefFilepath f
    | valid f   = isValidRefName $ encodeString f
    | otherwise = False

-- FIXME BC.unpack/pack should be probably be utf8.toString,
-- however i don't know if encoding is consistant.
-- it should probably be overridable.
pathDecode :: B.ByteString -> FilePath
pathDecode = FP.decode FP.posix

pathEncode :: FilePath -> B.ByteString
pathEncode = FP.encode FP.posix

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 :: FilePath -> RefSpecTy -> FilePath
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 :: FilePath
               -> ([(RefName, Ref)] -> a)
               -> IO (PackedRefs a)
readPackedRefs gitRepo constr = do
    exists <- F.isFile (packedRefsPath gitRepo)
    if exists then readLines else return $ finalize emptyPackedRefs
  where emptyPackedRefs = PackedRefs [] [] []
        readLines = finalize . foldl accu emptyPackedRefs . BC.lines <$> F.readFile (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) = B.splitAt 40 l
                    name     = FP.encodeString FP.posix $ pathDecode $ B.tail r
                 in case toRefTy name of
                        -- accumulate tag, branch and remotes
                        RefTag refname    -> a { packedTags    = (refname, fromHex ref) : packedTags a }
                        RefBranch refname -> a { packedBranchs = (refname, fromHex ref) : packedBranchs a }
                        RefRemote refname -> a { packedRemotes = (refname, fromHex 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 :: FilePath -> IO [RefName]
listRefs root = listRefsAcc [] root
  where listRefsAcc acc dir = do
            files <- F.listDirectory dir
            getRefsRecursively dir acc files
        getRefsRecursively _   acc []     = return acc
        getRefsRecursively dir acc (x:xs) = do
            isDir <- F.isDirectory x
            extra <- if isDir
                        then listRefsAcc [] dir
                        else let r = stripRoot x
                              in if isValidRefFilepath r
                                    then return [fromString $ encodeString r]
                                    else return []
            getRefsRecursively dir (extra ++ acc) xs
        stripRoot p = maybe (error "stripRoot invalid") id $ stripPrefix root p

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

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

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

existsRefFile :: FilePath -> RefSpecTy -> IO Bool
existsRefFile gitRepo specty = F.isFile $ toPath gitRepo specty

writeRefFile :: FilePath -> RefSpecTy -> RefContentTy -> IO ()
writeRefFile gitRepo specty refcont = F.writeFile filepath $ fromRefContent refcont
    where filepath = toPath gitRepo specty
          fromRefContent (RefLink link)        = B.concat ["ref: ", pathEncode $ FP.decodeString FP.posix $ fromRefTy link, B.singleton 0xa]
          fromRefContent (RefDirect ref)       = B.concat [toHex ref, B.singleton 0xa]
          fromRefContent (RefContentUnknown c) = c

readRefFile :: FilePath -> RefSpecTy -> IO RefContentTy
readRefFile gitRepo specty = toRefContent <$> F.readFile filepath
    where filepath = toPath gitRepo specty
          toRefContent content
            | "ref: " `B.isPrefixOf` content = RefLink $ toRefTy $ FP.encodeString FP.posix $ pathDecode $ head $ BC.lines $ B.drop 5 content
            | B.length content < 42          = RefDirect $ fromHex $ B.take 40 content
            | otherwise                      = RefContentUnknown content