mirror of
https://github.com/Smaug123/managed-git
synced 2025-10-18 22:28:39 +00:00
Trees
This commit is contained in:
Smaug123
10
Git/Blob.fs
10
Git/Blob.fs
@@ -1,9 +1,9 @@
|
||||
namespace Git
|
||||
|
||||
open System.IO
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Blob =
|
||||
let create (content : byte array) =
|
||||
{
|
||||
Header = Header.Blob content.Length
|
||||
Content = content
|
||||
}
|
||||
let encode (content : byte array) : byte array = content
|
||||
let decode (file : byte array) : byte array =
|
||||
file
|
||||
|
||||
113
Git/EncodedObject.fs
Normal file
113
Git/EncodedObject.fs
Normal file
@@ -0,0 +1,113 @@
|
||||
namespace Git
|
||||
|
||||
open System
|
||||
open System.IO
|
||||
open System.Security.Cryptography
|
||||
open System.IO.Compression
|
||||
|
||||
type EncodedObject =
|
||||
{
|
||||
Header : Header
|
||||
Content : byte array
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module EncodedObject =
|
||||
let encode (o : Git.Object) : EncodedObject =
|
||||
let contents =
|
||||
match o with
|
||||
| Object.Blob c -> Blob.encode c
|
||||
| Object.Tree entries -> Tree.encode entries
|
||||
|
||||
{
|
||||
Header =
|
||||
match o with
|
||||
| Object.Blob _ ->
|
||||
Header.Blob contents.Length
|
||||
| Object.Tree _ ->
|
||||
Header.Tree contents.Length
|
||||
Content = contents
|
||||
}
|
||||
|
||||
let decode (e : EncodedObject) : Git.Object =
|
||||
match e.Header with
|
||||
| Header.Tree _ ->
|
||||
Tree.decode e.Content
|
||||
|> Object.Tree
|
||||
| Header.Blob _ ->
|
||||
Blob.decode e.Content
|
||||
|> Object.Blob
|
||||
|
||||
let hash (o : EncodedObject) : Hash =
|
||||
use hasher = SHA1.Create ()
|
||||
let content = Array.concat [| Header.toBytes o.Header ; o.Content |]
|
||||
|
||||
hasher.ComputeHash content
|
||||
|> Hash.ofBytes
|
||||
|
||||
let private compress (o : EncodedObject) (dest : Stream) : unit =
|
||||
let toWrite =
|
||||
[| Header.toBytes o.Header ; o.Content |]
|
||||
|> Array.concat
|
||||
|
||||
use ms = new MemoryStream(toWrite)
|
||||
use ds = new DeflateStream(dest, CompressionMode.Compress)
|
||||
ms.CopyTo ds
|
||||
|
||||
/// Read the header of the stream seeked to the beginning of the content.
|
||||
let private consumeHeader (s : BinaryReader) : Header =
|
||||
let rec bytes () : byte seq =
|
||||
seq {
|
||||
let newByte = s.Read ()
|
||||
if newByte < 0 then failwith "ran out of bytes"
|
||||
elif newByte > 0 then
|
||||
yield (byte newByte)
|
||||
yield! bytes ()
|
||||
// stop reading the header at the 0 byte
|
||||
}
|
||||
|
||||
match bytes () |> Seq.toArray |> Header.ofBytes with
|
||||
| None ->
|
||||
failwith "malformed header"
|
||||
| Some b -> b
|
||||
|
||||
let private uncompress (s : Stream) : EncodedObject =
|
||||
use ms = new MemoryStream ()
|
||||
use ds = new DeflateStream(s, CompressionMode.Decompress)
|
||||
ds.CopyTo ms
|
||||
ms.Seek(0L, SeekOrigin.Begin) |> ignore
|
||||
|
||||
use r = new BinaryReader(ms)
|
||||
let header = consumeHeader r
|
||||
let expectedLength =
|
||||
match header with
|
||||
| Header.Blob i -> i
|
||||
| Header.Tree i -> i
|
||||
let result =
|
||||
{
|
||||
Header = header
|
||||
Content = r.ReadBytes expectedLength
|
||||
}
|
||||
if r.PeekChar () <> -1 then failwith "unexpectedly not at end"
|
||||
result
|
||||
|
||||
let write (r : Repository) (o : EncodedObject) : unit =
|
||||
let hash = hash o |> Hash.toString
|
||||
let objectName = hash.[2..]
|
||||
let subdir = hash.[0..1]
|
||||
|
||||
let d = Repository.createSubdir (Repository.objectDir r) subdir
|
||||
use filestream = r.Fs.File.Create (r.Fs.Path.Combine (d.FullName, objectName))
|
||||
|
||||
compress o filestream
|
||||
|
||||
let catFile (r : Repository) (hash : Hash) : EncodedObject =
|
||||
let hash = hash |> Hash.toString
|
||||
let objectName = hash.[2..]
|
||||
let subdir = hash.[0..1]
|
||||
|
||||
use filestream =
|
||||
r.Fs.Path.Combine ((Repository.objectDir r).FullName, subdir, objectName)
|
||||
|> r.Fs.File.OpenRead
|
||||
|
||||
uncompress filestream
|
||||
@@ -9,8 +9,10 @@
|
||||
<Compile Include="Header.fs" />
|
||||
<Compile Include="Repository.fs" />
|
||||
<Compile Include="Hash.fs" />
|
||||
<Compile Include="Object.fs" />
|
||||
<Compile Include="Tree.fs" />
|
||||
<Compile Include="Blob.fs" />
|
||||
<Compile Include="Object.fs" />
|
||||
<Compile Include="EncodedObject.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
||||
11
Git/Hash.fs
11
Git/Hash.fs
@@ -1,5 +1,7 @@
|
||||
namespace Git
|
||||
|
||||
open System
|
||||
open System.Globalization
|
||||
open System.Text
|
||||
|
||||
[<Struct>]
|
||||
@@ -9,6 +11,15 @@ type Hash = Hash of byte list
|
||||
module Hash =
|
||||
|
||||
let ofBytes s = s |> Seq.toList |> Hash
|
||||
let ofString (s : string) : Hash =
|
||||
let rec b (pos : int) =
|
||||
seq {
|
||||
if pos < s.Length then
|
||||
yield Byte.Parse (s.Substring (pos, 2), NumberStyles.AllowHexSpecifier)
|
||||
yield! b (pos + 2)
|
||||
}
|
||||
b 0
|
||||
|> ofBytes
|
||||
|
||||
let toString (Hash h) : string =
|
||||
let t = StringBuilder (List.length h * 2)
|
||||
|
||||
@@ -4,28 +4,34 @@ open System
|
||||
|
||||
type Header =
|
||||
| Blob of int // length of content
|
||||
| Tree of int // length of content
|
||||
// | Commit
|
||||
// | Tree
|
||||
// | Tag
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal Header =
|
||||
|
||||
let toBytes (h : Header) : byte array =
|
||||
match h with
|
||||
| Header.Blob length ->
|
||||
// TODO - internationalisation issue here
|
||||
let s = sprintf "blob %i" length
|
||||
[|
|
||||
s.ToCharArray () |> Array.map byte
|
||||
[| 0uy |]
|
||||
|]
|
||||
|> Array.concat
|
||||
let s =
|
||||
match h with
|
||||
| Header.Blob length ->
|
||||
// TODO - internationalisation issue here
|
||||
sprintf "blob %i" length
|
||||
| Header.Tree length ->
|
||||
sprintf "tree %i" length
|
||||
[|
|
||||
s.ToCharArray () |> Array.map byte
|
||||
[| 0uy |]
|
||||
|]
|
||||
|> Array.concat
|
||||
|
||||
let ofBytes (s : byte array) : Header option =
|
||||
if s.[0..3] = ("blob".ToCharArray () |> Array.map byte) then
|
||||
let number = s.[5..] |> Array.map char |> String |> Int32.Parse
|
||||
Header.Blob number
|
||||
|> Some
|
||||
else
|
||||
None
|
||||
elif s.[0..3] = ("tree".ToCharArray () |> Array.map byte) then
|
||||
let number = s.[5..] |> Array.map char |> String |> Int32.Parse
|
||||
Header.Tree number
|
||||
|> Some
|
||||
else None
|
||||
|
||||
@@ -1,86 +1,9 @@
|
||||
namespace Git
|
||||
|
||||
open System.IO
|
||||
open System.Security.Cryptography
|
||||
open System.IO.Compression
|
||||
|
||||
type Object =
|
||||
{
|
||||
Header : Header
|
||||
Content : byte array
|
||||
}
|
||||
| Blob of byte array
|
||||
| Tree of TreeEntry list
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Object =
|
||||
let hash (o : Object) : Hash =
|
||||
use hasher = SHA1.Create ()
|
||||
let content = Array.concat [| Header.toBytes o.Header ; o.Content |]
|
||||
|
||||
hasher.ComputeHash content
|
||||
|> Hash.ofBytes
|
||||
|
||||
let private compress (o : Object) (dest : Stream) : unit =
|
||||
let toWrite =
|
||||
[| Header.toBytes o.Header ; o.Content |]
|
||||
|> Array.concat
|
||||
|
||||
use ms = new MemoryStream(toWrite)
|
||||
use ds = new DeflateStream(dest, CompressionMode.Compress)
|
||||
ms.CopyTo ds
|
||||
|
||||
/// Read the header of the stream seeked to the beginning of the content.
|
||||
let private consumeHeader (s : BinaryReader) : Header =
|
||||
let rec bytes () : byte seq =
|
||||
seq {
|
||||
let newByte = s.Read ()
|
||||
if newByte < 0 then failwith "ran out of bytes"
|
||||
elif newByte > 0 then
|
||||
yield (byte newByte)
|
||||
yield! bytes ()
|
||||
// stop reading the header at the 0 byte
|
||||
}
|
||||
|
||||
match bytes () |> Seq.toArray |> Header.ofBytes with
|
||||
| None ->
|
||||
failwith "malformed header"
|
||||
| Some b -> b
|
||||
|
||||
let private uncompress (s : Stream) : Object =
|
||||
use ms = new MemoryStream ()
|
||||
use ds = new DeflateStream(s, CompressionMode.Decompress)
|
||||
ds.CopyTo ms
|
||||
ms.Seek(0L, SeekOrigin.Begin) |> ignore
|
||||
|
||||
use r = new BinaryReader(ms)
|
||||
let header = consumeHeader r
|
||||
let expectedLength =
|
||||
match header with
|
||||
| Header.Blob i -> i
|
||||
let result =
|
||||
{
|
||||
Header = header
|
||||
Content = r.ReadBytes expectedLength
|
||||
}
|
||||
if r.PeekChar () <> -1 then failwith "unexpectedly not at end"
|
||||
result
|
||||
|
||||
let write (r : Repository) (o : Object) : unit =
|
||||
let hash = hash o |> Hash.toString
|
||||
let objectName = hash.[2..]
|
||||
let subdir = hash.[0..1]
|
||||
|
||||
let d = Repository.createSubdir (Repository.objectDir r) subdir
|
||||
use filestream = r.Fs.File.Create (r.Fs.Path.Combine (d.FullName, objectName))
|
||||
|
||||
compress o filestream
|
||||
|
||||
let catFile (r : Repository) (hash : Hash) : Object =
|
||||
let hash = hash |> Hash.toString
|
||||
let objectName = hash.[2..]
|
||||
let subdir = hash.[0..1]
|
||||
|
||||
use filestream =
|
||||
r.Fs.Path.Combine ((Repository.objectDir r).FullName, subdir, objectName)
|
||||
|> r.Fs.File.OpenRead
|
||||
|
||||
uncompress filestream
|
||||
do ()
|
||||
|
||||
@@ -43,6 +43,9 @@ module Repository =
|
||||
let objectDir = createSubdir gitDir "objects"
|
||||
let packDir = createSubdir objectDir "pack"
|
||||
let infoDir = createSubdir objectDir "info"
|
||||
let refsDir = createSubdir gitDir "refs"
|
||||
let headsDir = createSubdir refsDir "heads"
|
||||
let tagsDir = createSubdir refsDir "tags"
|
||||
|
||||
r
|
||||
|> Ok
|
||||
|
||||
92
Git/Tree.fs
Normal file
92
Git/Tree.fs
Normal file
@@ -0,0 +1,92 @@
|
||||
namespace Git
|
||||
|
||||
open System
|
||||
open System.IO
|
||||
open System.Text
|
||||
|
||||
type TreeEntry =
|
||||
{
|
||||
Mode : int
|
||||
Name : string
|
||||
Hash : Hash
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Tree =
|
||||
|
||||
/// emits a byte array because the header needs to know a length
|
||||
let encode (tree : TreeEntry list) : byte [] =
|
||||
// This is a bit odd, we should probably emit the stream in a streamy way
|
||||
// rather than constructing the whole thing
|
||||
let b = StringBuilder ()
|
||||
for t in tree do
|
||||
b.Append (sprintf "%i %s%c" t.Mode t.Name (char 0))
|
||||
|> ignore
|
||||
let (Hash h) = t.Hash
|
||||
let hashStr = String(h |> List.toArray |> Array.map char)
|
||||
b.Append (hashStr)
|
||||
|> ignore
|
||||
|
||||
b.ToString().ToCharArray ()
|
||||
|> Array.map byte
|
||||
|
||||
/// Given a stream seeked to the point where we should start consuming,
|
||||
/// decode as a tree object.
|
||||
let decode (b : byte array) : TreeEntry list =
|
||||
use b = new MemoryStream(b)
|
||||
let consumeTo (stopAt : byte) : byte array option =
|
||||
let rec consumeTo () : byte seq =
|
||||
seq {
|
||||
let b = b.ReadByte ()
|
||||
if b < 0 then failwithf "Stream ended in the middle while consuming to '%i'." stopAt
|
||||
if b <> int stopAt then
|
||||
yield byte b
|
||||
yield! consumeTo ()
|
||||
}
|
||||
|
||||
// Read the first one to see if we can
|
||||
let firstByte = b.ReadByte ()
|
||||
if firstByte < 0 then None else
|
||||
seq {
|
||||
yield byte firstByte
|
||||
yield! consumeTo ()
|
||||
}
|
||||
|> Seq.toArray
|
||||
|> Some
|
||||
|
||||
let consume (n : int) : byte array =
|
||||
let output = Array.zeroCreate<byte> n
|
||||
let total = b.Read (output, 0, n)
|
||||
if total <> n then failwithf "Reached the end of the stream while consuming %i bytes" n
|
||||
output
|
||||
|
||||
let stripRow () : TreeEntry option =
|
||||
let mode = consumeTo 32uy
|
||||
match mode with
|
||||
| None -> None
|
||||
| Some mode ->
|
||||
let name = consumeTo 0uy
|
||||
match name with
|
||||
| None -> failwith "Stream ended before we could consume a name"
|
||||
| Some name ->
|
||||
let hash = consume 20
|
||||
{
|
||||
Mode = mode |> Array.map char |> String |> Int32.Parse
|
||||
Name = name |> Array.map char |> String
|
||||
Hash = hash |> Hash.ofBytes
|
||||
}
|
||||
|> Some
|
||||
|
||||
let rec allRows () : TreeEntry seq =
|
||||
seq {
|
||||
let r = stripRow ()
|
||||
match r with
|
||||
| Some r ->
|
||||
yield r
|
||||
yield! allRows ()
|
||||
| None ->
|
||||
()
|
||||
}
|
||||
|
||||
allRows ()
|
||||
|> Seq.toList
|
||||
Reference in New Issue
Block a user