summaryrefslogtreecommitdiff
path: root/Git
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-16 02:23:34 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-16 02:41:46 -0400
commit9290095fc21953cd1fe0a71f7c8a454934194e3b (patch)
treec4ac1373ca1961e5f76ba80b840491b7077c5ab9 /Git
parent272a67921cdc6d8d40641a9cb71b744ef1f76128 (diff)
improve type signatures with a Ref newtype
In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for those. Note that this does not prevent mixing up of eg, refs and branches at the type level. Since git really doesn't care, except rare cases like git update-ref, or git tag -d, that seems ok for now. There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref may or may not be a tree-ish, depending on the object type, so there seems no point in trying to represent it at the type level.
Diffstat (limited to 'Git')
-rw-r--r--Git/CatFile.hs10
-rw-r--r--Git/LsTree.hs8
-rw-r--r--Git/UnionMerge.hs34
3 files changed, 25 insertions, 27 deletions
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index 83c123508..c1cafb8ba 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -37,14 +37,14 @@ catFileStop (pid, from, to) = do
forceSuccess pid
{- Reads a file from a specified branch. -}
-catFile :: CatFileHandle -> String -> FilePath -> IO L.ByteString
-catFile h branch file = catObject h (branch ++ ":" ++ file)
+catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
+catFile h branch file = catObject h $ Ref $ show branch ++ ":" ++ file
{- Uses a running git cat-file read the content of an object.
- Objects that do not exist will have "" returned. -}
-catObject :: CatFileHandle -> String -> IO L.ByteString
+catObject :: CatFileHandle -> Ref -> IO L.ByteString
catObject (_, from, to) object = do
- hPutStrLn to object
+ hPutStrLn to $ show object
hFlush to
header <- hGetLine from
case words header of
@@ -53,7 +53,7 @@ catObject (_, from, to) object = do
validobjtype objtype -> handle size
| otherwise -> empty
_
- | header == object ++ " missing" -> empty
+ | header == show object ++ " missing" -> empty
| otherwise -> error $ "unknown response from git cat-file " ++ header
where
handle size = case reads size of
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 1fcdf13ed..8aa16a308 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -19,8 +19,6 @@ import qualified Data.ByteString.Lazy.Char8 as L
import Git
import Utility.SafeCommand
-type Treeish = String
-
data TreeItem = TreeItem
{ mode :: FileMode
, typeobj :: String
@@ -28,10 +26,10 @@ data TreeItem = TreeItem
, file :: FilePath
} deriving Show
-{- Lists the contents of a Treeish -}
-lsTree :: Treeish -> Repo -> IO [TreeItem]
+{- Lists the contents of a Ref -}
+lsTree :: Ref -> Repo -> IO [TreeItem]
lsTree t repo = map parseLsTree <$>
- pipeNullSplitB [Params "ls-tree --full-tree -z -r --", File t] repo
+ pipeNullSplitB [Params "ls-tree --full-tree -z -r --", File $ show t] repo
{- Parses a line of ls-tree output.
- (The --long format is not currently supported.) -}
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index 60ccd6dcd..edc8cb20b 100644
--- a/Git/UnionMerge.hs
+++ b/Git/UnionMerge.hs
@@ -22,12 +22,14 @@ import Common
import Git
import Git.CatFile
+type Streamer = (String -> IO ()) -> IO ()
+
{- Performs a union merge between two branches, staging it in the index.
- Any previously staged changes in the index will be lost.
-
- Should be run with a temporary index file configured by Git.useIndex.
-}
-merge :: String -> String -> Repo -> IO ()
+merge :: Ref -> Ref -> Repo -> IO ()
merge x y repo = do
h <- catFileStart repo
stream_update_index repo
@@ -38,7 +40,7 @@ merge x y repo = do
{- Merges a list of branches into the index. Previously staged changed in
- the index are preserved (and participate in the merge). -}
-merge_index :: CatFileHandle -> Repo -> [String] -> IO ()
+merge_index :: CatFileHandle -> Repo -> [Ref] -> IO ()
merge_index h repo bs =
stream_update_index repo $ map (\b -> merge_tree_index b h repo) bs
@@ -48,8 +50,6 @@ merge_index h repo bs =
update_index :: Repo -> [String] -> IO ()
update_index repo ls = stream_update_index repo [\s -> mapM_ s ls]
-type Streamer = (String -> IO ()) -> IO ()
-
{- Streams content into update-index. -}
stream_update_index :: Repo -> [Streamer] -> IO ()
stream_update_index repo as = do
@@ -66,22 +66,22 @@ stream_update_index repo as = do
{- Generates a line suitable to be fed into update-index, to add
- a given file with a given sha. -}
-update_index_line :: String -> FilePath -> String
-update_index_line sha file = "100644 blob " ++ sha ++ "\t" ++ file
+update_index_line :: Sha -> FilePath -> String
+update_index_line sha file = "100644 blob " ++ show sha ++ "\t" ++ file
-{- Gets the contents of a tree. -}
-ls_tree :: String -> Repo -> Streamer
-ls_tree x repo streamer = mapM_ streamer =<< pipeNullSplit params repo
+{- Gets the current tree for a ref. -}
+ls_tree :: Ref -> Repo -> Streamer
+ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
where
params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]
{- For merging two trees. -}
-merge_trees :: String -> String -> CatFileHandle -> Repo -> Streamer
-merge_trees x y h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
+merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
+merge_trees (Ref x) (Ref y) h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
{- For merging a single tree into the index. -}
-merge_tree_index :: String -> CatFileHandle -> Repo -> Streamer
-merge_tree_index x h = calc_merge h $ "diff-index":diff_opts ++ ["--cached", x]
+merge_tree_index :: Ref -> CatFileHandle -> Repo -> Streamer
+merge_tree_index (Ref x) h = calc_merge h $ "diff-index":diff_opts ++ ["--cached", x]
diff_opts :: [String]
diff_opts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
@@ -101,7 +101,7 @@ calc_merge ch differ repo streamer = gendiff >>= go
- a line suitable for update_index that union merges the two sides of the
- diff. -}
mergeFile :: String -> FilePath -> CatFileHandle -> Repo -> IO (Maybe String)
-mergeFile info file h repo = case filter (/= nullsha) [asha, bsha] of
+mergeFile info file h repo = case filter (/= nullsha) [Ref asha, Ref bsha] of
[] -> return Nothing
(sha:[]) -> return $ Just $ update_index_line sha file
shas -> do
@@ -110,11 +110,11 @@ mergeFile info file h repo = case filter (/= nullsha) [asha, bsha] of
return $ Just $ update_index_line sha file
where
[_colonamode, _bmode, asha, bsha, _status] = words info
- nullsha = replicate shaSize '0'
+ nullsha = Ref $ replicate shaSize '0'
unionmerge = L.unlines . nub . L.lines
-{- Injects some content into git, returning its hash. -}
-hashObject :: L.ByteString -> Repo -> IO String
+{- Injects some content into git, returning its Sha. -}
+hashObject :: L.ByteString -> Repo -> IO Sha
hashObject content repo = getSha subcmd $ do
(h, s) <- pipeWriteRead (map Param params) content repo
L.length s `seq` do