patrick/managed-git
1
0
Fork 0
mirror of https://github.com/Smaug123/managed-git synced 2025-10-10 10:18:41 +00:00
Code Issues Packages Projects Releases Wiki Activity

A bit of professionalisation (#1)

Browse Source
This commit is contained in:
Patrick Stevens
2022-09-02 22:56:06 +01:00
committed by GitHub
parent e533ab1bc5
commit 7a593dd97a
29 changed files with 662 additions and 385 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
.config/dotnet-tools.json Normal file
View File

@@ -0,0 +1,12 @@
{
"version": 1,
"isRoot": true,
"tools": {
"fantomas": {
"version": "5.0.0-beta-009",
"commands": [
"fantomas"
]
}
}
}

14
.editorconfig Normal file
View File

@@ -0,0 +1,14 @@
root = true
[*.{fs,fsi,fsx}]
fsharp_space_before_uppercase_invocation=true
fsharp_space_before_member=true
fsharp_space_before_colon=true
fsharp_space_before_semicolon=true
fsharp_multiline_block_brackets_on_same_column=true
fsharp_newline_between_type_definition_and_members=true
fsharp_experimental_keep_indent_in_branch=true
fsharp_align_function_signature_to_indentation=true
fsharp_alternative_long_member_definitions=true
fsharp_multi_line_lambda_closing_newline=true
fsharp_max_infix_operator_expression=50

35
.github/workflows/dotnet.yml vendored Normal file
View File

@@ -0,0 +1,35 @@
name: .NET
on:
push:
branches: [ master ]
pull_request:
branches: [ master ]
jobs:
build:
strategy:
matrix:
os:
- ubuntu-latest
- macOS-latest
- windows-latest
runs-on: ${{matrix.os}}
steps:
- uses: actions/checkout@v2
- name: Setup .NET
uses: actions/setup-dotnet@v1
with:
dotnet-version: 6.0.x
- name: Restore dependencies
run: dotnet restore
- name: Build
run: dotnet build --no-restore
- name: Test
run: dotnet test --no-build --verbosity normal
- name: Prepare .NET tools
run: dotnet tool restore
- name: Run Fantomas
run: ./hooks/pre-push

25
.github/workflows/dotnetcore.yml vendored
View File

@@ -1,25 +0,0 @@
name: .NET Core
on:
push:
branches: [ master ]
pull_request:
branches: [ master ]
jobs:
build:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2
- name: Setup .NET Core
uses: actions/setup-dotnet@v1
with:
dotnet-version: 3.1.101
- name: Install dependencies
run: dotnet restore
- name: Build
run: dotnet build --configuration Release --no-restore
- name: Test
run: dotnet test --no-restore --verbosity normal

4
Git.Test/Git.Test.fsproj
View File

@@ -1,10 +1,8 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netcoreapp3.1</TargetFramework>
<TargetFramework>net6.0</TargetFramework>
<IsPackable>false</IsPackable>
<GenerateProgramFile>false</GenerateProgramFile>
</PropertyGroup>
<ItemGroup>

22
Git.Test/TestBlob.fs
View File

@@ -4,13 +4,14 @@ open Git
open NUnit.Framework
open FsUnitTyped
open System
open System.Text
open System.IO.Abstractions.TestingHelpers
[<TestFixture>]
module TestBlob =
[<Test>]
let ``Commit hash from Git Book`` () =
let t = "what is up, doc?".ToCharArray () |> Array.map byte
let t = Encoding.ASCII.GetBytes "what is up, doc?"
Object.Blob t
|> EncodedObject.encode
@@ -20,25 +21,26 @@ module TestBlob =
[<Test>]
let ``Write the commit hash to a file`` () =
let t = "what is up, doc?".ToCharArray () |> Array.map byte
let b =
Object.Blob t
|> EncodedObject.encode
let t = Encoding.ASCII.GetBytes "what is up, doc?"
let b = Object.Blob t |> EncodedObject.encode
let fs = MockFileSystem ()
let dir = fs.Path.GetTempFileName ()
let gitDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test")
gitDir.Create()
gitDir.Create ()
let repo = match Repository.init gitDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e
let repo =
match Repository.init gitDir with
| Ok r -> r
| Error e -> failwithf "Oh no: %+A" e
b
|> EncodedObject.write repo
|> ignore
b |> EncodedObject.write repo |> ignore
let backIn =
EncodedObject.catFile repo (EncodedObject.hash b)
|> EncodedObject.decode
match backIn with
| Object.Blob b ->
b

9
Git.Test/TestCommit.fs
View File

@@ -14,9 +14,12 @@ module TestCommit =
let fs = MockFileSystem ()
let dir = fs.Path.GetTempFileName ()
let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test")
versionDir.Create()
versionDir.Create ()
let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e
let repo =
match Repository.init versionDir with
| Ok r -> r
| Error e -> failwithf "Oh no: %+A" e
let scott =
{
@@ -31,7 +34,7 @@ module TestCommit =
Committer = scott
Author = scott
CommitMessage = "First commit\n"
Parents = [Hash.ofString "c7929fc1cc938780ffdd9f94e0d364e0ea74f210"]
Parents = [ Hash.ofString "c7929fc1cc938780ffdd9f94e0d364e0ea74f210" ]
Tree = Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579"
}
|> Object.Commit

128
Git.Test/TestFromGitBook.fs
View File

@@ -3,6 +3,7 @@ namespace Git.Test
open System
open System.IO
open System.IO.Abstractions.TestingHelpers
open System.Text
open NUnit.Framework
open FsUnitTyped
open Microsoft.FSharp.Data.UnitSystems.SI.UnitNames
@@ -17,30 +18,35 @@ module TestFromGitBook =
let fs = MockFileSystem ()
let dir = fs.Path.GetTempFileName ()
let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test")
versionDir.Create()
versionDir.Create ()
let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e
let repo =
match Repository.init versionDir with
| Ok r -> r
| Error e -> failwithf "Oh no: %+A" e
// Directory structure is correct:
let objectsDir = fs.Path.Combine (Repository.gitDir(repo).FullName, "objects") |> fs.DirectoryInfo.FromDirectoryName
let objectsDir =
fs.Path.Combine (Repository.gitDir(repo).FullName, "objects")
|> fs.DirectoryInfo.FromDirectoryName
objectsDir.EnumerateDirectories ()
|> Seq.map (fun d -> d.Name)
|> Seq.toList
|> List.sort
|> shouldEqual [
"info"
"pack"
]
|> shouldEqual [ "info" ; "pack" ]
objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories)
|> shouldBeEmpty
// Write our first object
let h =
"test content\n".ToCharArray ()
|> Array.map byte
"test content\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
h
|> shouldEqual (Hash.ofString "d670460b4b4aece5915caf5c68d12f560a9fe3e4")
@@ -51,7 +57,10 @@ module TestFromGitBook =
|> shouldEqual ("d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4")
// Read it back in
match EncodedObject.catFile repo h |> EncodedObject.decode with
match
EncodedObject.catFile repo h
|> EncodedObject.decode
with
| Object.Blob b ->
b
|> Array.map char
@@ -62,20 +71,22 @@ module TestFromGitBook =
// Version control
// TODO - add helper methods for dealing with file contents
let h1 =
"version 1\n".ToCharArray ()
|> Array.map byte
"version 1\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
h1
|> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
let h2 =
"version 2\n".ToCharArray ()
|> Array.map byte
"version 2\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
h2
|> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a")
@@ -83,13 +94,17 @@ module TestFromGitBook =
|> Seq.map (fun f -> f.Directory.Name, f.Name)
|> Seq.toList
|> List.sort
|> shouldEqual [
|> shouldEqual
[
"1f", "7a7a472abf3dd9643fd615f6da379c4acb3e3a"
"83", "baae61804e65cc73a7201a7252750c76066a30"
"d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4"
]
match EncodedObject.catFile repo h1 |> EncodedObject.decode with
match
EncodedObject.catFile repo h1
|> EncodedObject.decode
with
| Object.Blob b ->
b
|> Array.map char
@@ -97,7 +112,10 @@ module TestFromGitBook =
|> shouldEqual "version 1\n"
| s -> failwithf "Oh no: +%A" s
match EncodedObject.catFile repo h2 |> EncodedObject.decode with
match
EncodedObject.catFile repo h2
|> EncodedObject.decode
with
| Object.Blob b ->
b
|> Array.map char
@@ -117,13 +135,19 @@ module TestFromGitBook =
|> Object.Tree
|> EncodedObject.encode
|> EncodedObject.write repo
tree1 |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
match EncodedObject.catFile repo tree1 |> EncodedObject.decode with
tree1
|> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
match
EncodedObject.catFile repo tree1
|> EncodedObject.decode
with
| Object.Tree t ->
t
|> List.exactlyOne
|> shouldEqual {
|> shouldEqual
{
Mode = 100644
Name = "test.txt"
Hash = h1
@@ -131,12 +155,14 @@ module TestFromGitBook =
| s -> failwithf "Oh no: +%A" s
let newHash =
"new file\n".ToCharArray ()
|> Array.map byte
"new file\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
newHash |> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92")
newHash
|> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92")
let tree2 =
[
@@ -154,12 +180,18 @@ module TestFromGitBook =
|> Object.Tree
|> EncodedObject.encode
|> EncodedObject.write repo
tree2 |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
match EncodedObject.catFile repo tree2 |> EncodedObject.decode with
tree2
|> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
match
EncodedObject.catFile repo tree2
|> EncodedObject.decode
with
| Object.Tree t ->
t
|> shouldEqual [
|> shouldEqual
[
{
Mode = 100644
Name = "new.txt"
@@ -195,12 +227,18 @@ module TestFromGitBook =
|> Object.Tree
|> EncodedObject.encode
|> EncodedObject.write repo
tree3 |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
match EncodedObject.catFile repo tree3 |> EncodedObject.decode with
tree3
|> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
match
EncodedObject.catFile repo tree3
|> EncodedObject.decode
with
| Object.Tree t ->
t
|> shouldEqual [
|> shouldEqual
[
{
Mode = 40000
Name = "bak"
@@ -259,14 +297,16 @@ module TestFromGitBook =
Committer = scott
Author = scott
CommitMessage = "Second commit\n"
Parents = [c1Hash]
Parents = [ c1Hash ]
Tree = tree2
}
|> Object.Commit
let c2Hash =
commit2
|> EncodedObject.encode
|> EncodedObject.write repo
c2Hash
|> Hash.toString
|> shouldEqual "1513b13a72f5277252cfce4ed0eda0620aca2f6a"
@@ -280,14 +320,16 @@ module TestFromGitBook =
Committer = scott
Author = scott
CommitMessage = "Third commit\n"
Parents = [c2Hash]
Parents = [ c2Hash ]
Tree = tree3
}
|> Object.Commit
let c3Hash =
commit3
|> EncodedObject.encode
|> EncodedObject.write repo
c3Hash
|> Hash.toString
|> shouldEqual "95cce637b4e889eee8042515db402128bd62c0d2"
@@ -300,7 +342,8 @@ module TestFromGitBook =
|> Seq.map (fun f -> f.Directory.Name, f.Name)
|> Seq.toList
|> List.sort
|> shouldEqual [
|> shouldEqual
[
"01", "55eb4229851634a0f03eb265b69f5a2d56f341" // tree 2
"15", "13b13a72f5277252cfce4ed0eda0620aca2f6a" // commit 2
"1f", "7a7a472abf3dd9643fd615f6da379c4acb3e3a" // test.txt v2
@@ -315,15 +358,15 @@ module TestFromGitBook =
// References
let refsDir = fs.Path.Combine (Repository.gitDir(repo).FullName, "refs") |> fs.DirectoryInfo.FromDirectoryName
let refsDir =
fs.Path.Combine (Repository.gitDir(repo).FullName, "refs")
|> fs.DirectoryInfo.FromDirectoryName
refsDir.EnumerateDirectories ("*", SearchOption.AllDirectories)
|> Seq.map (fun i -> i.Name)
|> Seq.toList
|> List.sort
|> shouldEqual [
"heads"
"tags"
]
|> shouldEqual [ "heads" ; "tags" ]
c3Hash
|> Reference.write repo "master"
@@ -334,11 +377,16 @@ module TestFromGitBook =
|> Reference.write repo "test"
|> shouldEqual { Was = None ; Now = c2Hash }
let exn = Assert.Throws<Exception> (fun () -> SymbolicReference.write repo SymbolicRef.Head "test")
exn.Message |> shouldEqual "refusing to point HEAD outside of refs/"
let exn =
Assert.Throws<Exception> (fun () -> SymbolicReference.write repo SymbolicRef.Head "test")
exn.Message
|> shouldEqual "refusing to point HEAD outside of refs/"
SymbolicReference.write repo SymbolicRef.Head "refs/heads/test"
repo.Fs.Path.Combine ((Repository.gitDir repo).FullName, "HEAD") |> repo.Fs.File.ReadAllText
repo.Fs.Path.Combine ((Repository.gitDir repo).FullName, "HEAD")
|> repo.Fs.File.ReadAllText
|> shouldEqual "ref: refs/heads/test"
SymbolicReference.lookup repo SymbolicRef.Head

7
Git.Test/TestLog.fs
View File

@@ -14,9 +14,12 @@ module TestLog =
let fs = MockFileSystem ()
let dir = fs.Path.GetTempFileName ()
let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test")
versionDir.Create()
versionDir.Create ()
let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e
let repo =
match Repository.init versionDir with
| Ok r -> r
| Error e -> failwithf "Oh no: %+A" e
let commits = Utils.gitBookSetup repo

72
Git.Test/TestObject.fs
View File

@@ -1,8 +1,9 @@
namespace Git.Test
open System
open System.Collections.Generic
open System.IO.Abstractions.TestingHelpers
open System.Runtime.InteropServices
open System.Text
open NUnit.Framework
open FsUnitTyped
open FsCheck
@@ -12,66 +13,69 @@ open Git
module TestObject =
let private intToChar (i : int) (upper : bool) : char =
if i < 10 then (byte i + byte '0') else (byte i - 10uy + byte (if upper then 'A' else 'a'))
if i < 10 then
(byte i + byte '0')
else
(byte i - 10uy + byte (if upper then 'A' else 'a'))
|> char
let private boolGen : Gen<bool> = Gen.choose (0, 1) |> Gen.map ((=) 1)
let hashPrefixGenerator (len : byte) =
gen {
let! n = Gen.choose (0, int len)
let! c = Gen.listOfLength n (Gen.zip (Gen.choose (0, 15)) (Gen.choose (0, 1) |> Gen.map (fun i -> i = 0)))
let ans = c |> List.map (fun (i, u) -> intToChar i u) |> Array.ofList
return String ans
}
let! prefixLength = Gen.choose (0, int len)
let prefixesOf (s : string) : Gen<string> =
Gen.choose (0, s.Length)
|> Gen.map (fun i -> s.Substring(0, i))
[<Test>]
let ``prefixesOf generates prefixes`` () =
let property (s1 : string, pref : string) =
s1.StartsWith pref
let gen =
let! hash =
gen {
let! s = Arb.Default.String().Generator |> Gen.filter (fun i -> not <| Object.ReferenceEquals (i, null))
let! pref = prefixesOf s
return (s, pref)
let! isUpper = boolGen
let! hexDigit = Gen.choose (0, 15)
return intToChar hexDigit isUpper
}
|> Gen.listOfLength prefixLength
property
|> Prop.forAll (Arb.fromGen gen)
|> Check.QuickThrowOnFailure
return String (Array.ofList hash)
}
[<Test>]
let ``Can look up a partial hash`` () =
let fs = MockFileSystem ()
let dir = fs.Path.GetTempFileName ()
let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test")
versionDir.Create()
versionDir.Create ()
let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e
let repo =
match Repository.init versionDir with
| Ok r -> r
| Error e -> failwithf "Oh no: %+A" e
let h =
"test content\n".ToCharArray ()
|> Array.map byte
"test content\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
let expected = "d670460b4b4aece5915caf5c68d12f560a9fe3e4"
let expectedHash = Hash.ofString expected
h
|> shouldEqual (Hash.ofString expected)
h |> shouldEqual (Hash.ofString expected)
let property (prefix : string) : bool =
if expected.StartsWith prefix then
Object.disambiguate repo prefix = [expectedHash]
let isMatch =
if RuntimeInformation.IsOSPlatform OSPlatform.Windows then
// Windows filesystem is case-insensitive
expected.StartsWith (prefix, StringComparison.InvariantCultureIgnoreCase)
else
expected.StartsWith prefix
if isMatch then
Object.disambiguate repo prefix = [ expectedHash ]
else
Object.disambiguate repo prefix = []
property
|> Prop.forAll (Arb.fromGen (hashPrefixGenerator 40uy))
|> Check.QuickThrowOnFailure
property
|> Prop.forAll (Arb.fromGen (prefixesOf expected))
|> Check.QuickThrowOnFailure
for subStringEnd in 0 .. expected.Length - 1 do
property expected.[0..subStringEnd]
|> shouldEqual true

21
Git.Test/TestTree.fs
View File

@@ -39,26 +39,25 @@ module TestTree =
Mode = 40000
}
]
let b =
Object.Tree t
|> EncodedObject.encode
let b = Object.Tree t |> EncodedObject.encode
let fs = MockFileSystem ()
let dir = fs.Path.GetTempFileName ()
let gitDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test")
gitDir.Create()
gitDir.Create ()
let repo = match Repository.init gitDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e
let repo =
match Repository.init gitDir with
| Ok r -> r
| Error e -> failwithf "Oh no: %+A" e
b
|> EncodedObject.write repo
|> ignore
b |> EncodedObject.write repo |> ignore
let backIn =
EncodedObject.catFile repo (EncodedObject.hash b)
|> EncodedObject.decode
match backIn with
| Object.Tree entries ->
entries
|> shouldEqual t
| Object.Tree entries -> entries |> shouldEqual t
| _ -> failwithf "Oh no: %+A" backIn

56
Git.Test/Utils.fs
View File

@@ -1,5 +1,6 @@
namespace Git.Test
open System.Text
open Git
open FsUnitTyped
open Microsoft.FSharp.Data.UnitSystems.SI.UnitNames
@@ -9,20 +10,22 @@ module Utils =
let gitBookSetup (repo : Repository) : Map<Hash, CommitEntry> =
let h1 =
"version 1\n".ToCharArray ()
|> Array.map byte
"version 1\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
h1
|> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
let h2 =
"version 2\n".ToCharArray ()
|> Array.map byte
"version 2\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
h2
|> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a")
@@ -38,15 +41,19 @@ module Utils =
|> Object.Tree
|> EncodedObject.encode
|> EncodedObject.write repo
tree1 |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
tree1
|> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
let newHash =
"new file\n".ToCharArray ()
|> Array.map byte
"new file\n"
|> Encoding.ASCII.GetBytes
|> Object.Blob
|> EncodedObject.encode
|> EncodedObject.write repo
newHash |> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92")
newHash
|> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92")
let tree2 =
[
@@ -64,7 +71,9 @@ module Utils =
|> Object.Tree
|> EncodedObject.encode
|> EncodedObject.write repo
tree2 |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
tree2
|> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
// and the prefix one
let tree3 =
@@ -88,7 +97,9 @@ module Utils =
|> Object.Tree
|> EncodedObject.encode
|> EncodedObject.write repo
tree3 |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
tree3
|> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
let scott =
{
@@ -112,6 +123,7 @@ module Utils =
commit1
|> EncodedObject.encode
|> EncodedObject.write repo
c1Hash
|> Hash.toString
|> shouldEqual "70d4408b5020e81d19906d6abdd87a73233ebf34"
@@ -121,14 +133,16 @@ module Utils =
Committer = scott
Author = scott
CommitMessage = "Second commit\n"
Parents = [c1Hash]
Parents = [ c1Hash ]
Tree = tree2
}
|> Object.Commit
let c2Hash =
commit2
|> EncodedObject.encode
|> EncodedObject.write repo
c2Hash
|> Hash.toString
|> shouldEqual "1513b13a72f5277252cfce4ed0eda0620aca2f6a"
@@ -138,22 +152,32 @@ module Utils =
Committer = scott
Author = scott
CommitMessage = "Third commit\n"
Parents = [c2Hash]
Parents = [ c2Hash ]
Tree = tree3
}
|> Object.Commit
let c3Hash =
commit3
|> EncodedObject.encode
|> EncodedObject.write repo
c3Hash
|> Hash.toString
|> shouldEqual "95cce637b4e889eee8042515db402128bd62c0d2"
[
c1Hash, match commit1 with | Object.Commit c -> c | _ -> failwith ""
c2Hash, match commit2 with | Object.Commit c -> c | _ -> failwith ""
c3Hash, match commit3 with | Object.Commit c -> c | _ -> failwith ""
c1Hash,
match commit1 with
| Object.Commit c -> c
| _ -> failwith ""
c2Hash,
match commit2 with
| Object.Commit c -> c
| _ -> failwith ""
c3Hash,
match commit3 with
| Object.Commit c -> c
| _ -> failwith ""
]
|> Map.ofList

3
Git/Blob.fs
View File

@@ -3,5 +3,4 @@
[<RequireQualifiedAccess>]
module Blob =
let encode (content : byte array) : byte array = content
let decode (file : byte array) : byte array =
file
let decode (file : byte array) : byte array = file

13
Git/Commands/Log.fs
View File

@@ -9,18 +9,25 @@ module Log =
let rec log (h : Hash) (c : CommitEntry) : seq<Hash * CommitEntry> =
seq {
yield (h, c)
yield!
c.Parents
|> List.map (fun i ->
match EncodedObject.catFile repo i |> EncodedObject.decode with
match
EncodedObject.catFile repo i
|> EncodedObject.decode
with
| Object.Commit c -> (i, c)
| s -> failwithf "Not a commit: %O (%+A)" i s)
| s -> failwithf "Not a commit: %O (%+A)" i s
)
|> Seq.collect (fun (i, c) -> log i c)
}
h
|> EncodedObject.catFile repo
|> EncodedObject.decode
|> function | Object.Commit h -> h | s -> failwithf "Not a commit: %+A" s
|> function
| Object.Commit h -> h
| s -> failwithf "Not a commit: %+A" s
|> log h
|> Map.ofSeq

127
Git/Commit.fs
View File

@@ -2,6 +2,7 @@ namespace Git
open System
open System.IO
open System.Text
open Microsoft.FSharp.Data.UnitSystems.SI.UnitNames
open Git.Internals
@@ -12,6 +13,7 @@ type Contributor =
Date : int<second>
DateTimezone : string
}
override this.ToString () =
sprintf "%s <%s> %i %s" this.Name this.Email this.Date this.DateTimezone
@@ -23,11 +25,14 @@ type CommitEntry =
Author : Contributor
CommitMessage : string
}
override this.ToString () =
sprintf
"tree %O\n%sauthor %O\ncommitter %O\n\n%s"
this.Tree
(this.Parents |> List.map (Hash.toString >> sprintf "parent %s\n") |> String.concat "\n")
(this.Parents
|> List.map (Hash.toString >> sprintf "parent %s\n")
|> String.concat "\n")
this.Author
this.Committer
this.CommitMessage
@@ -35,57 +40,84 @@ type CommitEntry =
// TODO - implement signed commits too
[<RequireQualifiedAccess>]
module Commit =
let private assertValid (context : string) (s : string) : unit =
if s.IndexOfAny [| '<' ; '\n' |] > 0 then
failwithf "%s '%s' contains forbidden character" context s
let encode (content : CommitEntry) : byte array =
if content.Author.Name.Contains '<' || content.Author.Name.Contains '\n' then
failwithf "Author name '%s' contains forbidden character" content.Author.Name
if content.Committer.Name.Contains '<' || content.Committer.Name.Contains '\n' then
failwithf "Committer name '%s' contains forbidden character" content.Committer.Name
if content.Author.Email.Contains '>' || content.Author.Email.Contains '\n' then
failwithf "Author email '%s' contains forbidden character" content.Author.Email
if content.Committer.Email.Contains '>' || content.Committer.Email.Contains '\n' then
failwithf "Committer email '%s' contains forbidden character" content.Committer.Email
assertValid "Author name" content.Author.Name
assertValid "Committer name" content.Committer.Name
assertValid "Author email" content.Author.Email
assertValid "Committer email" content.Committer.Email
seq {
yield sprintf "tree %s" (Hash.toString content.Tree)
yield! content.Parents |> List.map (Hash.toString >> sprintf "parent %s") |> Array.ofList
yield sprintf "author %s <%s> %i %s" content.Author.Name content.Author.Email content.Author.Date content.Author.DateTimezone
yield sprintf "committer %s <%s> %i %s" content.Committer.Name content.Committer.Email content.Committer.Date content.Committer.DateTimezone
yield!
content.Parents
|> List.map (Hash.toString >> sprintf "parent %s")
|> Array.ofList
yield
sprintf
"author %s <%s> %i %s"
content.Author.Name
content.Author.Email
content.Author.Date
content.Author.DateTimezone
yield
sprintf
"committer %s <%s> %i %s"
content.Committer.Name
content.Committer.Email
content.Committer.Date
content.Committer.DateTimezone
yield sprintf "\n%s" content.CommitMessage
}
|> String.concat "\n"
|> fun s -> s.ToCharArray ()
|> Array.map byte
// TODO: assumption that may not be compatible with Git: UTF8 is used for names, emails etc
|> Encoding.UTF8.GetBytes
let private parseInt (chars : byte array) =
let rec acc (i : int) (soFar : int) =
if i = chars.Length then soFar else
if byte '0' <= chars.[i] && chars.[i] <= byte '9' then
if i = chars.Length then
soFar
else if byte '0' <= chars.[i] && chars.[i] <= byte '9' then
acc (i + 1) (10 * soFar + int (chars.[i] - byte '0'))
else failwithf "non-digit character '%i' ('%c') at index %i" chars.[i] (char chars.[i]) i
else
failwithf "non-digit character '%i' ('%c') at index %i" chars.[i] (char chars.[i]) i
acc 0 0
let decode (file : byte array) : CommitEntry =
use ms = new MemoryStream(file)
use ms = new MemoryStream (file)
let consumeWord (OneOf expecting) =
let word = Stream.consumeTo ms 32uy
match word with
| None ->
failwithf "Expected a word '%s' in a commit object, but stream ran out" (expecting |> String.concat "//")
failwithf
"Expected a word '%s' in a commit object, but stream ran out"
(expecting |> String.concat "//")
| Some word ->
let word =
word
|> Array.map char
|> String
let word = word |> Array.map char |> String
if not <| List.contains word expecting then
failwithf "Expected a word '%s' in a commit object, but got '%s'" (expecting |> String.concat "//") word
word
let consumeHash (context : string) =
let hash = Stream.consumeTo ms 10uy
match hash with
| None -> failwithf "Stream ended before we could read hash in context '%s'." context
| Some hash ->
hash |> Hash.ofSpelling
| Some hash -> hash |> Hash.ofSpelling
let consumeLabelledHash (expecting : OneOf) : string * Hash =
let w = consumeWord (expecting)
@@ -93,33 +125,47 @@ module Commit =
w, h
let consumePerson (id : string) =
let name = Stream.consumeTo ms (byte '<') |> Option.map (Array.map char >> String)
let name =
Stream.consumeTo ms (byte '<')
|> Option.map (Array.map char >> String)
match name with
| None ->
failwithf "No %s name present in commit object." id
| None -> failwithf "No %s name present in commit object." id
| Some name ->
if name.[name.Length - 1] <> ' ' then
failwithf "Name of %s '%s' unexpectedly fails to end with a space" id name
let name = name.Substring (0, name.Length - 1)
let email = Stream.consumeTo ms (byte '>') |> Option.map (Array.map char >> String)
let email =
Stream.consumeTo ms (byte '>')
|> Option.map (Array.map char >> String)
match email with
| None ->
failwithf "No %s email present in commit object." id
| None -> failwithf "No %s email present in commit object." id
| Some email ->
let space = Stream.consumeTo ms 32uy
match space with
| None -> failwithf "Commit object ended after %s email" id
| Some s -> if s.Length <> 0 then failwithf "Expected a space immediately after %s email, got '%s'" id (s |> Array.map char |> String)
| Some s ->
if s.Length <> 0 then
failwithf "Expected a space immediately after %s email, got '%s'" id (s |> Array.map char |> String)
let timestamp = Stream.consumeTo ms 32uy
match timestamp with
| None -> failwithf "Commit object ended before %s timestamp" id
| Some timestamp ->
let timestamp = parseInt timestamp * 1<second>
let offset = Stream.consumeTo ms 10uy |> Option.map (Array.map char >> String)
let offset =
Stream.consumeTo ms 10uy
|> Option.map (Array.map char >> String)
match offset with
| None -> failwithf "Commit object ended before %s timezone" id
| Some offset ->
@@ -131,13 +177,15 @@ module Commit =
DateTimezone = offset
}
let treeWord, treeHash = consumeLabelledHash (OneOf ["tree"])
let treeWord, treeHash = consumeLabelledHash (OneOf [ "tree" ])
if treeWord <> "tree" then
failwithf "Malformed tree indicator '%s'" treeWord
let parents, author =
let rec consumeParentsAndAuthor (parents : Hash list) =
let w = consumeWord (OneOf ["author" ; "parent" ])
let w = consumeWord (OneOf [ "author" ; "parent" ])
if w = "parent" then
let parent = consumeHash "parent"
consumeParentsAndAuthor (parent :: parents)
@@ -149,13 +197,18 @@ module Commit =
consumeParentsAndAuthor []
let _ = consumeWord (OneOf ["committer"])
let _ = consumeWord (OneOf [ "committer" ])
let committer = consumePerson "committer"
let trailingNewline = Stream.consumeTo ms 10uy
match trailingNewline with
| None -> failwith "Commit object ended at end of committer"
| Some s -> if s.Length <> 0 then failwithf "Expected an extra newline immediately after committer, got %s" (s |> Array.map char |> String)
| Some s ->
if s.Length <> 0 then
failwithf
"Expected an extra newline immediately after committer, got %s"
(s |> Array.map char |> String)
let message = Stream.consumeToEnd ms |> Array.map char |> String
//if message.[message.Length - 1] <> '\n' then

2
Git/Domain.fs
View File

@@ -1,3 +1 @@
namespace Git

60
Git/EncodedObject.fs
View File

@@ -1,8 +1,8 @@
namespace Git
open System.IO
open System.IO.Compression
open System.Security.Cryptography
open Ionic.Zlib
type EncodedObject =
{
@@ -22,41 +22,31 @@ module EncodedObject =
{
Header =
match o with
| Object.Blob _ ->
Header.Blob contents.Length
| Object.Tree _ ->
Header.Tree contents.Length
| Object.Commit _ ->
Header.Commit contents.Length
| Object.Blob _ -> Header.Blob contents.Length
| Object.Tree _ -> Header.Tree contents.Length
| Object.Commit _ -> Header.Commit 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
| Header.Commit _ ->
Commit.decode e.Content
|> Object.Commit
| Header.Tree _ -> Tree.decode e.Content |> Object.Tree
| Header.Blob _ -> Blob.decode e.Content |> Object.Blob
| Header.Commit _ -> Commit.decode e.Content |> Object.Commit
let hash (o : EncodedObject) : Hash =
use hasher = SHA1.Create ()
let content = Array.concat [| Header.toBytes o.Header ; o.Content |]
hasher.ComputeHash content
|> Hash.ofBytes
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 Ionic.Zlib.ZlibStream(dest, CompressionMode.Compress, CompressionLevel.Level0)
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.
@@ -64,46 +54,52 @@ module EncodedObject =
let rec bytes () : byte seq =
seq {
let newByte = s.Read ()
if newByte < 0 then failwith "ran out of bytes"
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"
match bytes () |> Seq.toArray |> Header.ofAsciiBytes with
| None -> failwith "malformed header"
| Some b -> b
let private uncompress (s : Stream) : EncodedObject =
use ms = new MemoryStream ()
use ds = new Ionic.Zlib.ZlibStream(s, CompressionMode.Decompress)
use ds = new DeflateStream (s, CompressionMode.Decompress)
ds.CopyTo ms
ms.Seek(0L, SeekOrigin.Begin) |> ignore
ms.Seek (0L, SeekOrigin.Begin) |> ignore
use r = new BinaryReader(ms)
use r = new BinaryReader (ms)
let header = consumeHeader r
let expectedLength =
match header with
| Header.Blob i -> i
| Header.Tree i -> i
| Header.Commit i -> i
let result =
{
Header = header
Content = r.ReadBytes expectedLength
}
if r.PeekChar () <> -1 then failwith "unexpectedly not at end"
if r.PeekChar () <> -1 then
failwith "unexpectedly not at end"
result
let write (r : Repository) (o : EncodedObject) : Hash =
let hash = hash o
let hashStr = Hash.toString hash
let objectName = hashStr.[2..]
let subdir = hashStr.[0..1]
let subDir = hashStr.[0..1]
let d = Repository.createSubdir (Repository.objectDir r) subdir
let d = Repository.createSubdir (Repository.objectDir r) subDir
use filestream = r.Fs.File.Create (r.Fs.Path.Combine (d.FullName, objectName))
compress o filestream
@@ -113,10 +109,10 @@ module EncodedObject =
let catFile (r : Repository) (hash : Hash) : EncodedObject =
let hash = hash |> Hash.toString
let objectName = hash.[2..]
let subdir = hash.[0..1]
let subDir = hash.[0..1]
use filestream =
r.Fs.Path.Combine ((Repository.objectDir r).FullName, subdir, objectName)
r.Fs.Path.Combine ((Repository.objectDir r).FullName, subDir, objectName)
|> r.Fs.File.OpenRead
uncompress filestream

5
Git/Git.fsproj
View File

@@ -1,7 +1,8 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netcoreapp3.1</TargetFramework>
<TargetFramework>netstandard2.0</TargetFramework>
<DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
</PropertyGroup>
<ItemGroup>
@@ -22,8 +23,8 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Ionic.Zlib" Version="1.9.1.5" />
<PackageReference Include="System.IO.Abstractions" Version="11.0.4" />
<PackageReference Include="FSharp.Core" Version="4.3.4" />
</ItemGroup>
</Project>

31
Git/Hash.fs
View File

@@ -6,18 +6,23 @@ open System.Text
type Hash =
| Hash of byte list
override this.ToString () =
match this with
| Hash h ->
let t = StringBuilder (List.length h * 2)
h
|> List.iter (fun b -> t.AppendFormat ("{0:x2}" , b) |> ignore)
|> List.iter (fun b -> t.AppendFormat ("{0:x2}", b) |> ignore)
t.ToString ()
[<RequireQualifiedAccess>]
module Hash =
let ofBytes s = s |> Seq.toList |> Hash
let ofString (s : string) : Hash =
let rec b (pos : int) =
seq {
@@ -25,17 +30,22 @@ module Hash =
yield Byte.Parse (s.Substring (pos, 2), NumberStyles.AllowHexSpecifier)
yield! b (pos + 2)
}
b 0
|> ofBytes
b 0 |> ofBytes
// Given a byte array of *characters* spelling out e.g. 'b' 'd' '6' '3', return the hash this is spelling out.
let ofSpelling (input : byte array) : Hash =
let inline value (b : byte) =
let c = char b
if '0' <= c && c <= '9' then b - byte '0'
elif 'A' <= c && c <= 'F' then b - (byte 'A') + 10uy
elif 'a' <= c && c <= 'f' then b - (byte 'a') + 10uy
else failwithf "Byte '%i' ('%c') is not a hex digit" b (char b)
if '0' <= c && c <= '9' then
b - byte '0'
elif 'A' <= c && c <= 'F' then
b - (byte 'A') + 10uy
elif 'a' <= c && c <= 'f' then
b - (byte 'a') + 10uy
else
failwithf "Byte '%i' ('%c') is not a hex digit" b (char b)
let rec b (pos : int) =
seq {
@@ -43,8 +53,7 @@ module Hash =
yield value (input.[pos]) * 16uy + value input.[pos + 1]
yield! b (pos + 2)
}
b 0
|> ofBytes
let toString (h : Hash) : string =
h.ToString ()
b 0 |> ofBytes
let toString (h : Hash) : string = h.ToString ()

89
Git/Header.fs
View File

@@ -1,43 +1,74 @@
namespace Git
open System
type Header =
| Blob of int // length of content
| Tree of int // length of content
| Commit of int // length of content
// | Tag
// | Tag
[<RequireQualifiedAccess>]
module internal Header =
let private parseIntFromAsciiBytes (startIndex : int) (a : byte array) =
let mutable acc = 0
for i in startIndex .. a.Length - 1 do
acc <- 10 * acc + int<byte> (a.[i] + byte '0')
acc
let toBytes (h : Header) : byte array =
let s =
match h with
| Header.Blob length ->
// TODO - internationalisation issue here
sprintf "blob %i" length
| Header.Tree length ->
sprintf "tree %i" length
| Header.Commit length ->
sprintf "commit %i" length
[|
s.ToCharArray () |> Array.map byte
[| 0uy |]
|]
|> Array.concat
| Header.Blob length -> sprintf "blob %i" length
| Header.Tree length -> sprintf "tree %i" length
| Header.Commit length -> sprintf "commit %i" length
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
elif s.[0..3] = ("tree".ToCharArray () |> Array.map byte) then
let number = s.[5..] |> Array.map char |> String |> Int32.Parse
Header.Tree number
|> Some
elif s.[0..5] = ("commit".ToCharArray () |> Array.map byte) then
let number = s.[7..] |> Array.map char |> String |> Int32.Parse
Header.Commit number
|> Some
else None
// If perf critical, could optimise allocation here
Array.append (System.Text.Encoding.ASCII.GetBytes s) [| 0uy |]
let ofAsciiBytes (s : byte array) : Header option =
if s.Length <= 5 then
None
else
match s.[0] with
| 98uy ->
// 'b', then "lob "
if
s.[1] = 108uy
&& s.[2] = 111uy
&& s.[3] = 98uy
&& s.[4] = 32uy
then
let number = parseIntFromAsciiBytes 5 s
Header.Blob number |> Some
else
None
| 116uy ->
// 't', then "ree "
if
s.[1] = 114uy
&& s.[2] = 101uy
&& s.[3] = 101uy
&& s.[4] = 32uy
then
let number = parseIntFromAsciiBytes 5 s
Header.Tree number |> Some
else
None
| 99uy ->
// 'c', then "ommit "
if
s.Length > 7
&& s.[1] = 111uy
&& s.[2] = 109uy
&& s.[3] = 109uy
&& s.[4] = 105uy
&& s.[5] = 116uy
&& s.[6] = 32uy
then
let number = parseIntFromAsciiBytes 7 s
Header.Commit number |> Some
else
None
| _ -> None

25
Git/Object.fs
View File

@@ -9,43 +9,48 @@ type Object =
override this.ToString () =
match this with
| Blob b ->
sprintf "blob: %+A" b
| Blob b -> sprintf "blob: %+A" b
| Tree t ->
t
|> List.map (fun i -> i.ToString ())
|> String.concat "\n"
|> sprintf "tree:\n%+A"
| Commit c ->
sprintf "commit:\n%O" c
| Commit c -> sprintf "commit:\n%O" c
[<RequireQualifiedAccess>]
module Object =
/// Get the object hashes which match this start.
let disambiguate (r : Repository) (startOfHash : string) : Hash list =
match startOfHash.Length with
| 0 ->
(Repository.objectDir r).EnumerateFiles("*", SearchOption.AllDirectories)
| 0 -> (Repository.objectDir r).EnumerateFiles ("*", SearchOption.AllDirectories)
| 1 ->
(Repository.objectDir r).EnumerateFiles("*", SearchOption.AllDirectories)
|> Seq.filter (fun i -> i.Directory.Name.StartsWith startOfHash.[0])
(Repository.objectDir r).EnumerateFiles ("*", SearchOption.AllDirectories)
|> Seq.filter (fun i ->
i.Directory.Name.Length > 0
&& i.Directory.Name.[0] = startOfHash.[0]
)
| 2 ->
let subDir =
r.Fs.Path.Combine ((Repository.objectDir r).FullName, startOfHash)
|> r.Fs.DirectoryInfo.FromDirectoryName
if subDir.Exists then
subDir.EnumerateFiles ()
else Seq.empty
else
Seq.empty
| _ ->
let prefix = startOfHash.Substring (0, 2)
let suffix = startOfHash.Substring (2, startOfHash.Length - 2)
let subDir =
r.Fs.Path.Combine ((Repository.objectDir r).FullName, prefix)
|> r.Fs.DirectoryInfo.FromDirectoryName
if subDir.Exists then
subDir.EnumerateFiles ()
|> Seq.filter (fun i -> i.Name.StartsWith suffix)
else Seq.empty
else
Seq.empty
|> Seq.map (fun i -> sprintf "%s%s" i.Directory.Name i.Name)
|> Seq.map Hash.ofString

31
Git/Reference.fs
View File

@@ -1,16 +1,15 @@
namespace Git
type ReferenceUpdate =
{
Was : Hash option
Now : Hash
}
type ReferenceUpdate = { Was : Hash option ; Now : Hash }
[<RequireQualifiedAccess>]
module Reference =
let write (r : Repository) (name : string) (hash : Hash) : ReferenceUpdate =
let refFile = r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name) |> r.Fs.FileInfo.FromFileName
let refFile =
r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name)
|> r.Fs.FileInfo.FromFileName
let was =
if refFile.Exists then
r.Fs.File.ReadAllText refFile.FullName
@@ -20,13 +19,21 @@ module Reference =
do
use _v = refFile.Create ()
()
None
r.Fs.File.WriteAllText (refFile.FullName, hash.ToString ())
{
Was = was
Now = hash
}
{ Was = was ; Now = hash }
let lookup (r : Repository) (name : string) : Hash option =
let refFile = r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name) |> r.Fs.FileInfo.FromFileName
if refFile.Exists then Some (r.Fs.File.ReadAllText refFile.FullName |> Hash.ofString) else None
let refFile =
r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name)
|> r.Fs.FileInfo.FromFileName
if refFile.Exists then
Some (
r.Fs.File.ReadAllText refFile.FullName
|> Hash.ofString
)
else
None

41
Git/Repository.fs
View File

@@ -8,6 +8,7 @@ type Repository =
{
Directory : IDirectoryInfo
}
member this.Fs = this.Directory.FileSystem
type InitFailure =
@@ -17,35 +18,47 @@ type InitFailure =
[<RequireQualifiedAccess>]
module Repository =
let gitDir (r : Repository) : IDirectoryInfo =
r.Fs.Path.Combine(r.Directory.FullName, ".git") |> r.Fs.DirectoryInfo.FromDirectoryName
r.Fs.Path.Combine (r.Directory.FullName, ".git")
|> r.Fs.DirectoryInfo.FromDirectoryName
let internal objectDir (r : Repository) : IDirectoryInfo =
r.Fs.Path.Combine((gitDir r).FullName, "objects") |> r.Fs.DirectoryInfo.FromDirectoryName
r.Fs.Path.Combine ((gitDir r).FullName, "objects")
|> r.Fs.DirectoryInfo.FromDirectoryName
let internal refDir (r : Repository) : IDirectoryInfo =
r.Fs.Path.Combine((gitDir r).FullName, "refs") |> r.Fs.DirectoryInfo.FromDirectoryName
r.Fs.Path.Combine ((gitDir r).FullName, "refs")
|> r.Fs.DirectoryInfo.FromDirectoryName
let internal createSubdir (r : IDirectoryInfo) (name : string) : IDirectoryInfo =
let output =
r.FileSystem.Path.Combine(r.FullName, name)
r.FileSystem.Path.Combine (r.FullName, name)
|> r.FileSystem.DirectoryInfo.FromDirectoryName
output.Create ()
output
let make (dir : IDirectoryInfo) : Repository option =
if dir.Exists && dir.EnumerateDirectories () |> Seq.map (fun i -> i.Name) |> Seq.contains ".git" then
if
dir.Exists
&& dir.EnumerateDirectories ()
|> Seq.map (fun i -> i.Name)
|> Seq.contains ".git"
then
Some { Directory = dir }
else None
else
None
let init (dir : IDirectoryInfo) : Result<Repository, InitFailure> =
if not dir.Exists then Error DirectoryDoesNotExist
elif not <| Seq.isEmpty (dir.EnumerateDirectories ".git") then Error AlreadyGit
if not dir.Exists then
Error DirectoryDoesNotExist
elif
not
<| Seq.isEmpty (dir.EnumerateDirectories ".git")
then
Error AlreadyGit
else
let r =
{
Directory = dir
}
let r = { Directory = dir }
let gitDir = createSubdir dir ".git"
let objectDir = createSubdir gitDir "objects"
@@ -55,6 +68,4 @@ module Repository =
let headsDir = createSubdir refsDir "heads"
let tagsDir = createSubdir refsDir "tags"
r
|> Ok
r |> Ok

23
Git/Stream.fs
View File

@@ -12,7 +12,10 @@ module internal Stream =
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 < 0 then
failwithf "Stream ended in the middle while consuming to '%i'." stopAt
if b <> int stopAt then
yield byte b
yield! consumeTo ()
@@ -20,10 +23,15 @@ module internal Stream =
// Read the first one to see if we can
let firstByte = b.ReadByte ()
if firstByte < 0 then None else
if firstByte < 0 then
None
else
let firstByte = byte firstByte
if firstByte = stopAt then Array.empty |> Some
if firstByte = stopAt then
Array.empty |> Some
else
seq {
yield firstByte
@@ -36,10 +44,13 @@ module internal Stream =
let consume (b : Stream) (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
if total <> n then
failwithf "Reached the end of the stream while consuming %i bytes" n
output
let consumeToEnd (b : MemoryStream) : byte array =
use newMs = new MemoryStream()
b.CopyTo(newMs)
use newMs = new MemoryStream ()
b.CopyTo (newMs)
newMs.ToArray ()

16
Git/SymbolicReference.fs
View File

@@ -14,6 +14,7 @@ type SymbolicRef =
| OrigHead
// TODO - determine how an arbitrary symbolicref actually behaves
| Verbatim of string
override this.ToString () : string =
match this with
| CherryPickHead -> "CHERRY_PICK_HEAD"
@@ -28,7 +29,9 @@ type SymbolicRef =
module SymbolicRef =
let getFile (r : Repository) (name : SymbolicRef) : IFileInfo =
name.ToString ()
|> fun i -> r.Fs.Path.Combine ((Repository.gitDir r).FullName, i) |> r.Fs.FileInfo.FromFileName
|> fun i ->
r.Fs.Path.Combine ((Repository.gitDir r).FullName, i)
|> r.Fs.FileInfo.FromFileName
type SymbolicRefLookupError =
| RefDidNotExist
@@ -40,18 +43,21 @@ module SymbolicReference =
/// This is effectively `git symbolic-ref NAME`.
let lookup (r : Repository) (name : SymbolicRef) : Result<SymbolicRefTarget, SymbolicRefLookupError> =
let f = SymbolicRef.getFile r name
if not <| f.Exists then Error RefDidNotExist
if not <| f.Exists then
Error RefDidNotExist
else
r.Fs.File.ReadAllText f.FullName
|> fun contents ->
if contents.Substring (0, 5) = "ref: " then contents.Substring 5 |> SymbolicRefTarget |> Ok
if contents.Substring (0, 5) = "ref: " then
contents.Substring 5 |> SymbolicRefTarget |> Ok
else
Error (MalformedRef contents)
let write (r : Repository) (name : SymbolicRef) (contents : string) : unit =
if not <| contents.StartsWith "refs/" then
failwithf "refusing to point %O outside of refs/" name
r.Fs.File.WriteAllText ((SymbolicRef.getFile r name).FullName, sprintf "ref: %s" contents)
let delete (r : Repository) (name : SymbolicRef) : unit =
(SymbolicRef.getFile r name).Delete ()
let delete (r : Repository) (name : SymbolicRef) : unit = (SymbolicRef.getFile r name).Delete ()

37
Git/Tree.fs
View File

@@ -1,6 +1,7 @@
namespace Git
open System
open System.Collections.Generic
open System.IO
open System.Text
open Git.Internals
@@ -11,6 +12,7 @@ type TreeEntry =
Name : string
Hash : Hash
}
override this.ToString () =
sprintf "%i %s %O" this.Mode this.Name this.Hash
@@ -18,36 +20,40 @@ type TreeEntry =
module Tree =
/// emits a byte array because the header needs to know a length
let encode (tree : TreeEntry list) : byte [] =
let encode (tree : TreeEntry list) : byte array =
// 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
let b = ResizeArray ()
b.ToString().ToCharArray ()
|> Array.map byte
for t in tree do
b.AddRange (Encoding.ASCII.GetBytes (sprintf "%i %s" t.Mode t.Name))
b.Add 0uy
let (Hash h) = t.Hash
b.AddRange h
b.ToArray ()
/// 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)
use b = new MemoryStream (b)
let stripRow () : TreeEntry option =
let mode = Stream.consumeTo b 32uy
match mode with
| None -> None
| Some mode ->
let name = Stream.consumeTo b 0uy
match name with
| None -> failwith "Stream ended before we could consume a name"
| Some name ->
let hash = Stream.consume b 20
{
Mode = mode |> Array.map char |> String |> Int32.Parse
Name = name |> Array.map char |> String
@@ -58,13 +64,12 @@ module Tree =
let rec allRows () : TreeEntry seq =
seq {
let r = stripRow ()
match r with
| Some r ->
yield r
yield! allRows ()
| None ->
()
| None -> ()
}
allRows ()
|> Seq.toList
allRows () |> Seq.toList

4
global.json Normal file
View File

@@ -0,0 +1,4 @@
{
"version": "6.0.300",
"rollForward": "latestPatch"
}

17
hooks/pre-push Executable file
View File

@@ -0,0 +1,17 @@
#!/usr/bin/python3
import subprocess
def check_fantomas():
result = subprocess.run(["dotnet", "tool", "run", "fantomas", "--check", "-r", "."])
if result.returncode != 0:
print(result.stdout)
raise Exception(f"Formatting incomplete (return code: {result.returncode}). Consider running `dotnet tool run fantomas -r .`")
def main():
check_fantomas()
if __name__ == "__main__":
main()