{-# LANGUAGE CPP #-}
module Git.Tree.Working where

import           Control.Applicative
-- import           Control.Concurrent.Async.Lifted
import           Control.Exception
import           Control.Monad
import           Control.Monad.IO.Class (MonadIO(..))
import           Control.Monad.IO.Unlift
-- import           Control.Monad.Trans.Control
import qualified Data.ByteString as B (readFile)
import qualified Data.ByteString.Char8 as B8
import           Data.Foldable (foldl')
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import           Data.Maybe
import           Data.Tagged
import           Data.Time
import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import           Git hiding (Options)
import           Prelude hiding (log)
import           UnliftIO.Async
import           System.FilePath.Posix
#ifndef mingw32_HOST_OS
import           System.Posix.Files
#else
import           System.PosixCompat.Files
#endif

data FileEntry m = FileEntry
    { fileModTime  :: UTCTime
    , fileBlobOid  :: BlobOid m
    , fileBlobKind :: BlobKind
    , fileChecksum :: BlobOid m
    }

type FileTree m = HashMap TreeFilePath (FileEntry m)

readFileTree :: (MonadGit r m, MonadUnliftIO m)
             => RefName
             -> FilePath
             -> Bool
             -> m (FileTree r)
readFileTree ref wdir getHash = do
    h <- resolveReference ref
    case h of
        Nothing -> pure Map.empty
        Just h' -> do
            tr <- lookupTree . commitTree =<< lookupCommit (Tagged h')
            readFileTree' tr wdir getHash

readFileTree' :: (MonadGit r m, MonadUnliftIO m)
              => Tree r -> FilePath -> Bool
              -> m (FileTree r)
readFileTree' tr wdir getHash = do
    blobs <- treeBlobEntries tr
    stats <- mapConcurrently go blobs
    return $ foldl' (\m (!fp,!fent) -> maybe m (flip (Map.insert fp) m) fent)
        Map.empty stats
  where
    go (!fp,!oid,!kind) = do
        fent <- readModTime wdir getHash (B8.unpack fp) oid kind
        fent `seq` return (fp,fent)

readModTime :: (MonadIO m, MonadGit r m)
            => FilePath
            -> Bool
            -> FilePath
            -> BlobOid r
            -> BlobKind
            -> m (Maybe (FileEntry r))
readModTime wdir getHash fp oid kind = do
    let path = wdir </> fp
    -- debug' $ pack $ "Checking file: " ++ path
    estatus <- liftIO $ try $ getSymbolicLinkStatus path
    case (estatus :: Either SomeException FileStatus) of
        Right status | isRegularFile status ->
            Just <$> (FileEntry
                          <$> pure (posixSecondsToUTCTime
                                    (realToFrac (modificationTime status)))
                          <*> pure oid
                          <*> pure kind
                          <*> if getHash
                              then hashContents . BlobString
                                  =<< liftIO (B.readFile path)
                              else return oid)
        _ -> return Nothing