{-# 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 "", ")"]
-}