{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

{-|

Description: A convenient way to work with directory trees.

-}

module Data.Git.FileTree
    (
      module System.Filesystem.FileTree
    , FileData
    , buildFileTree
    , loadFileTree
  ) where

import           Control.Monad
import           Control.Monad.Fail
import qualified Data.ByteString.Lazy           as BSL
import           Data.Foldable
import           Data.Git.Formats
import           Data.Git.Hash
import           Data.Git.Monad
import           Data.Git.Object
import           Data.Git.Types
import qualified Data.ListTrie.Map.Ord as LT
import qualified Data.Map                       as Map
import           System.Filesystem.FileTree

-- | The contents of a file and its executability.
type FileData = (BSL.ByteString, Bool)

-- | Write the contents of a 'FileTree' out to git and give back the new 'Tree's 'Sha1'.
buildFileTree :: MonadGit m => FileTree FileData -> m Sha1
buildFileTree fls | LT.null fls = writeTree mempty
                  | otherwise   = writeTree =<< ((Tree . Map.fromList) <$> (go . LT.children1 $ fls))
    where
      go :: MonadGit m => Map.Map PathComponent (FileTree FileData) -> m [(TreeEntry, Sha1)]
      go m = forM (Map.toList m) $ \(k, t) -> do
         case LT.toList t of
          [([], (fd, ex))] -> -- we're at a leaf
            (Entry k (if ex then ExecMode else BlobMode),)
              <$> (writeBlob . Blob $ fd)
          _ -> (Entry k TreeMode,) <$> buildFileTree t

-- | Turn the 'Sha1' of a treeish into a 'FileTree'.
loadFileTree :: (MonadFail m, MonadGit m) => Sha1 -> m (FileTree FileData)
loadFileTree r = do t <- findTreeish r
                    maybe (return LT.empty) (fmap fold . mapM go . Map.toList . getTree) t
    where
      getFiletypeHack :: Mode -> Maybe Bool
      getFiletypeHack BlobMode = Just True
      getFiletypeHack ExecMode = Just True
      getFiletypeHack TreeMode = Just False
      getFiletypeHack _ = Nothing
      go (Entry name perm, ref) = case getFiletypeHack perm of
                                        Just True -> do
                                          Just (Blob b) <- findBlob ref
                                          return $ LT.singleton [name] (b, perm == ExecMode)
                                        Just False -> do
                                          dt <- loadFileTree ref
                                          return $ LT.addPrefix [name] dt
                                        Nothing -> error $ "don't know how to load " ++ show perm

-- for debugging purposes only
{-
showTreeWith :: Show a => (FileData -> a) -> FileTree FileData -> String
showTreeWith f t = LT.showTrie (fmap f t) ""

showTree :: FileTree FileData -> String
showTree = showTreeWith go
    where
      go (fd, exec) =
        Prelude.concat ["(", show . BSL.length $ fd, " bytes", if exec then ", *" else "", ")"]
-}