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

Some stuff I found lying around my disk (#11)

Browse Source
This commit is contained in:
Patrick Stevens
2023-09-02 21:48:31 +01:00
committed by GitHub
parent 96593f399a
commit 09ccb7b90c
36 changed files with 501 additions and 359 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
.config/dotnet-tools.json
View File

@@ -3,7 +3,7 @@
"isRoot": true,
"tools": {
"fantomas": {
"version": "5.0.0-beta-009",
"version": "6.2.0",
"commands": [
"fantomas"
]

13
.editorconfig
View File

@@ -1,14 +1,19 @@
root = true
[*.{fs,fsi,fsx}]
[*.{fs,fsi}]
fsharp_bar_before_discriminated_union_declaration=true
fsharp_space_before_uppercase_invocation=true
fsharp_space_before_class_constructor=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_multiline_bracket_style=aligned
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
fsharp_experimental_keep_indent_in_branch=true
fsharp_max_value_binding_width=80
fsharp_max_record_width=0
max_line_length=120
end_of_line=lf

2
.github/workflows/dotnet.yml vendored
View File

@@ -22,7 +22,7 @@ jobs:
- name: Setup .NET
uses: actions/setup-dotnet@v1
with:
dotnet-version: 6.0.x
dotnet-version: 7.0.x
- name: Restore dependencies
run: dotnet restore
- name: Build

6
Git.Test/Git.Test.fsproj
View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<TargetFramework>net7.0</TargetFramework>
<IsPackable>false</IsPackable>
</PropertyGroup>
@@ -16,17 +16,19 @@
</ItemGroup>
<ItemGroup>
<Compile Include="Result.fs" />
<Compile Include="Resource.fs" />
<Compile Include="Printer.fs" />
<Compile Include="TestString.fs" />
<Compile Include="TestInit.fs" />
<Compile Include="TestBlob.fs" />
<Compile Include="TestTree.fs" />
<Compile Include="TestFromGitBook.fs" />
<Compile Include="Utils.fs" />
<Compile Include="TestCommit.fs" />
<Compile Include="TestObject.fs" />
<Compile Include="TestLog.fs" />
<Compile Include="TestPack.fs" />
<Compile Include="TestRevParse.fs" />
<EmbeddedResource Include="pack-fd1ac4dab39afd8713d495c8bc30ae9ea6157eea.idx" />
<EmbeddedResource Include="pack-fd1ac4dab39afd8713d495c8bc30ae9ea6157eea.pack" />
<EmbeddedResource Include="verify-pack.txt" />

14
Git.Test/Result.fs Normal file
View File

@@ -0,0 +1,14 @@
namespace Git.Test
[<RequireQualifiedAccess>]
module Result =
let get<'res, 'err> (r : Result<'res, 'err>) : 'res =
match r with
| Ok x -> x
| Error e -> failwithf "Expected Ok, but got Error: %+A" e
let getError<'res, 'err> (r : Result<'res, 'err>) : 'err =
match r with
| Error e -> e
| Ok x -> failwithf "Expected Error, but got Ok: %+A" x

9
Git.Test/TestBlob.fs
View File

@@ -38,13 +38,8 @@ module TestBlob =
b |> EncodedObject.write repo |> ignore
let backIn =
EncodedObject.catFile repo (EncodedObject.hash b)
|> EncodedObject.decode
EncodedObject.catFile repo (EncodedObject.hash b) |> EncodedObject.decode
match backIn with
| Object.Blob b ->
b
|> Array.map char
|> String
|> shouldEqual "what is up, doc?"
| Object.Blob b -> b |> Array.map char |> String |> shouldEqual "what is up, doc?"
| _ -> failwithf "Oh no: %+A" backIn

8
Git.Test/TestCommit.fs
View File

@@ -40,12 +40,8 @@ module TestCommit =
}
|> Object.Commit
let h =
EncodedObject.encode commit1
|> EncodedObject.write repo
let h = EncodedObject.encode commit1 |> EncodedObject.write repo
let c =
EncodedObject.catFile repo h
|> EncodedObject.decode
let c = EncodedObject.catFile repo h |> EncodedObject.decode
c |> shouldEqual commit1

125
Git.Test/TestFromGitBook.fs
View File

@@ -36,8 +36,7 @@ module TestFromGitBook =
|> List.sort
|> shouldEqual [ "info" ; "pack" ]
objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories)
|> shouldBeEmpty
objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories) |> shouldBeEmpty
// Write our first object
let h =
@@ -47,8 +46,7 @@ module TestFromGitBook =
|> EncodedObject.encode
|> EncodedObject.write repo
h
|> shouldEqual (Hash.ofString "d670460b4b4aece5915caf5c68d12f560a9fe3e4")
h |> shouldEqual (Hash.ofString "d670460b4b4aece5915caf5c68d12f560a9fe3e4")
// Check that it's appeared
objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories)
@@ -57,15 +55,8 @@ module TestFromGitBook =
|> shouldEqual ("d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4")
// Read it back in
match
EncodedObject.catFile repo h
|> EncodedObject.decode
with
| Object.Blob b ->
b
|> Array.map char
|> String
|> shouldEqual "test content\n"
match EncodedObject.catFile repo h |> EncodedObject.decode with
| Object.Blob b -> b |> Array.map char |> String |> shouldEqual "test content\n"
| s -> failwithf "Oh no: +%A" s
// Version control
@@ -77,8 +68,7 @@ module TestFromGitBook =
|> EncodedObject.encode
|> EncodedObject.write repo
h1
|> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
h1 |> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
let h2 =
"version 2\n"
@@ -87,8 +77,7 @@ module TestFromGitBook =
|> EncodedObject.encode
|> EncodedObject.write repo
h2
|> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a")
h2 |> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a")
objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories)
|> Seq.map (fun f -> f.Directory.Name, f.Name)
@@ -101,26 +90,12 @@ module TestFromGitBook =
"d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4"
]
match
EncodedObject.catFile repo h1
|> EncodedObject.decode
with
| Object.Blob b ->
b
|> Array.map char
|> String
|> shouldEqual "version 1\n"
match EncodedObject.catFile repo h1 |> EncodedObject.decode with
| Object.Blob b -> b |> Array.map char |> String |> shouldEqual "version 1\n"
| s -> failwithf "Oh no: +%A" s
match
EncodedObject.catFile repo h2
|> EncodedObject.decode
with
| Object.Blob b ->
b
|> Array.map char
|> String
|> shouldEqual "version 2\n"
match EncodedObject.catFile repo h2 |> EncodedObject.decode with
| Object.Blob b -> b |> Array.map char |> String |> shouldEqual "version 2\n"
| s -> failwithf "Oh no: +%A" s
// Add to the tree
@@ -136,13 +111,9 @@ module TestFromGitBook =
|> EncodedObject.encode
|> EncodedObject.write repo
tree1
|> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
tree1 |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
match
EncodedObject.catFile repo tree1
|> EncodedObject.decode
with
match EncodedObject.catFile repo tree1 |> EncodedObject.decode with
| Object.Tree t ->
t
|> List.exactlyOne
@@ -181,13 +152,9 @@ module TestFromGitBook =
|> EncodedObject.encode
|> EncodedObject.write repo
tree2
|> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
tree2 |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
match
EncodedObject.catFile repo tree2
|> EncodedObject.decode
with
match EncodedObject.catFile repo tree2 |> EncodedObject.decode with
| Object.Tree t ->
t
|> shouldEqual
@@ -228,13 +195,9 @@ module TestFromGitBook =
|> EncodedObject.encode
|> EncodedObject.write repo
tree3
|> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
tree3 |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
match
EncodedObject.catFile repo tree3
|> EncodedObject.decode
with
match EncodedObject.catFile repo tree3 |> EncodedObject.decode with
| Object.Tree t ->
t
|> shouldEqual
@@ -277,10 +240,7 @@ module TestFromGitBook =
}
|> Object.Commit
let c1Hash =
commit1
|> EncodedObject.encode
|> EncodedObject.write repo
let c1Hash = commit1 |> EncodedObject.encode |> EncodedObject.write repo
// For reasons I don't understand, `git` diverges from Pro Git at this point.
// Pro Git's version: "fdf4fc3344e67ab068f836878b6c4951e3b15f3d"
// `git` (version 2.26.1):
@@ -289,9 +249,7 @@ module TestFromGitBook =
|> shouldEqual "70d4408b5020e81d19906d6abdd87a73233ebf34"
// Note that we can roundtrip (not done explicitly in the book):
EncodedObject.catFile repo c1Hash
|> EncodedObject.decode
|> shouldEqual commit1
EncodedObject.catFile repo c1Hash |> EncodedObject.decode |> shouldEqual commit1
let commit2 =
{
@@ -304,18 +262,13 @@ module TestFromGitBook =
}
|> Object.Commit
let c2Hash =
commit2
|> EncodedObject.encode
|> EncodedObject.write repo
let c2Hash = commit2 |> EncodedObject.encode |> EncodedObject.write repo
c2Hash
|> Hash.toString
|> shouldEqual "1513b13a72f5277252cfce4ed0eda0620aca2f6a"
EncodedObject.catFile repo c2Hash
|> EncodedObject.decode
|> shouldEqual commit2
EncodedObject.catFile repo c2Hash |> EncodedObject.decode |> shouldEqual commit2
let commit3 =
{
@@ -328,18 +281,13 @@ module TestFromGitBook =
}
|> Object.Commit
let c3Hash =
commit3
|> EncodedObject.encode
|> EncodedObject.write repo
let c3Hash = commit3 |> EncodedObject.encode |> EncodedObject.write repo
c3Hash
|> Hash.toString
|> shouldEqual "95cce637b4e889eee8042515db402128bd62c0d2"
EncodedObject.catFile repo c3Hash
|> EncodedObject.decode
|> shouldEqual commit3
EncodedObject.catFile repo c3Hash |> EncodedObject.decode |> shouldEqual commit3
objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories)
|> Seq.map (fun f -> f.Directory.Name, f.Name)
@@ -373,27 +321,36 @@ module TestFromGitBook =
c3Hash
|> Reference.write repo "master"
|> shouldEqual { Was = None ; Now = c3Hash }
|> shouldEqual
{
Was = None
Now = c3Hash
}
Object.disambiguate repo "1513b1"
RevParse.disambiguateLooseHash repo "1513b1"
|> List.exactlyOne
|> Reference.write repo "test"
|> shouldEqual { Was = None ; Now = c2Hash }
|> shouldEqual
{
Was = None
Now = c2Hash
}
let exn =
Assert.Throws<Exception> (fun () -> SymbolicReference.write repo SymbolicRef.Head "test")
let error = SymbolicReference.write repo SymbolicRef.Head "test" |> Result.getError
exn.Message
|> shouldEqual "refusing to point HEAD outside of refs/"
error
|> shouldEqual (SymbolicRefWriteError.PointingOutsideRefs SymbolicRef.Head)
SymbolicReference.write repo SymbolicRef.Head "refs/heads/test"
error.ToString () |> shouldEqual "refusing to point HEAD outside of refs/"
SymbolicReference.write repo SymbolicRef.Head "refs/heads/test" |> Result.get
repo.Fs.Path.Combine ((Repository.gitDir repo).FullName, "HEAD")
|> repo.Fs.File.ReadAllText
|> shouldEqual "ref: refs/heads/test"
|> shouldEqual "ref: refs/heads/test\n"
SymbolicReference.lookup repo SymbolicRef.Head
|> shouldEqual (Ok (SymbolicRefTarget "refs/heads/test"))
SymbolicReference.lookup repo SymbolicRef.FetchHead
|> shouldEqual (Error RefDidNotExist)
|> shouldEqual (Error (RefDidNotExist SymbolicRef.FetchHead))

3
Git.Test/TestInit.fs
View File

@@ -25,5 +25,4 @@ module TestInit =
| Ok r -> r
| Error r -> failwithf "Failed to init repo: %+A" r
Repository.init (BranchName "main") gitDir
|> shouldEqual (Error AlreadyGit)
Repository.init (BranchName "main") gitDir |> shouldEqual (Error AlreadyGit)

20
Git.Test/TestObject.fs → Git.Test/TestRevParse.fs
View File

@@ -4,13 +4,14 @@ open System
open System.IO.Abstractions.TestingHelpers
open System.Runtime.InteropServices
open System.Text
open FsCheck
open NUnit.Framework
open FsUnitTyped
open FsCheck
open Git
open Git.Commands
[<TestFixture>]
module TestObject =
module TestRevParse =
let private intToChar (i : int) (upper : bool) : char =
if i < 10 then
@@ -63,23 +64,20 @@ module TestObject =
let isMatch =
if RuntimeInformation.IsOSPlatform OSPlatform.Windows then
// Windows filesystem is case-insensitive
expected.StartsWith (prefix, StringComparison.InvariantCultureIgnoreCase)
expected.StartsWith (prefix, StringComparison.OrdinalIgnoreCase)
else
expected.StartsWith prefix
expected.StartsWith (prefix, StringComparison.Ordinal)
if isMatch then
Object.disambiguate repo prefix = [ expectedHash ]
RevParse.disambiguateLooseHash repo prefix = [ expectedHash ]
else
Object.disambiguate repo prefix = []
RevParse.disambiguateLooseHash repo prefix = []
property
|> Prop.forAll (Arb.fromGen (hashPrefixGenerator 40uy))
|> Check.QuickThrowOnFailure
for subStringEnd in 0 .. expected.Length - 1 do
property expected.[0..subStringEnd]
|> shouldEqual true
property expected.[0..subStringEnd] |> shouldEqual true
expected.[0..subStringEnd].ToUpperInvariant ()
|> property
|> shouldEqual true
expected.[0..subStringEnd].ToUpperInvariant () |> property |> shouldEqual true

86
Git.Test/TestString.fs Normal file
View File

@@ -0,0 +1,86 @@
namespace Git.Test
open System.Threading
open FsCheck
open Git
open NUnit.Framework
open FsUnitTyped
[<TestFixture>]
module TestString =
[<Test>]
let ``chopStart does nothing when chopping a non-start`` () =
let badCount = ref 0
let goodCount = ref 0
let property (NonNull s : NonNull<string>) : bool =
if s.StartsWith "hi" then
Interlocked.Increment badCount |> ignore
true
else
Interlocked.Increment goodCount |> ignore
s |> String.chopStart "hi" |> (=) s
Check.QuickThrowOnFailure property
badCount.Value |> shouldBeSmallerThan goodCount.Value
goodCount.Value |> shouldBeGreaterThan 10
[<Test>]
let ``chopStart does nothing when chopping the empty string`` () =
let property (NonNull s) : bool = s |> String.chopStart "" |> (=) s
Check.QuickThrowOnFailure property
[<Test>]
let ``chopStart does nothing when chopping by the empty string`` () =
let property (NonNull s) : bool = "" |> String.chopStart s |> (=) ""
Check.QuickThrowOnFailure property
[<Test>]
let ``chopStart chops the initial`` () =
let property (NonNull toChop) (NonNull from : NonNull<string>) : bool =
(toChop + from) |> String.chopStart toChop |> (=) from
Check.QuickThrowOnFailure property
[<Test>]
let ``chopEnd does nothing when chopping a non-end`` () =
let badCount = ref 0
let goodCount = ref 0
let property (NonNull s : NonNull<string>) : bool =
if s.EndsWith "hi" then
Interlocked.Increment badCount |> ignore
true
else
Interlocked.Increment goodCount |> ignore
s |> String.chopEnd "hi" |> (=) s
Check.QuickThrowOnFailure property
badCount.Value |> shouldBeSmallerThan goodCount.Value
goodCount.Value |> shouldBeGreaterThan 10
[<Test>]
let ``chopEnd does nothing when chopping the empty string`` () =
let property (NonNull s) : bool = s |> String.chopEnd "" |> (=) s
Check.QuickThrowOnFailure property
[<Test>]
let ``chopEnd does nothing when chopping by the empty string`` () =
let property (NonNull s) : bool = "" |> String.chopEnd s |> (=) ""
Check.QuickThrowOnFailure property
[<Test>]
let ``chopEnd chops the final`` () =
let property (NonNull toChop) (NonNull from : NonNull<string>) : bool =
(from + toChop) |> String.chopEnd toChop |> (=) from
Check.QuickThrowOnFailure property

3
Git.Test/TestTree.fs
View File

@@ -55,8 +55,7 @@ module TestTree =
b |> EncodedObject.write repo |> ignore
let backIn =
EncodedObject.catFile repo (EncodedObject.hash b)
|> EncodedObject.decode
EncodedObject.catFile repo (EncodedObject.hash b) |> EncodedObject.decode
match backIn with
| Object.Tree entries -> entries |> shouldEqual t

30
Git.Test/Utils.fs
View File

@@ -16,8 +16,7 @@ module Utils =
|> EncodedObject.encode
|> EncodedObject.write repo
h1
|> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
h1 |> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
let h2 =
"version 2\n"
@@ -26,8 +25,7 @@ module Utils =
|> EncodedObject.encode
|> EncodedObject.write repo
h2
|> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a")
h2 |> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a")
// Add to the tree
let tree1 =
@@ -42,8 +40,7 @@ module Utils =
|> EncodedObject.encode
|> EncodedObject.write repo
tree1
|> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
tree1 |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
let newHash =
"new file\n"
@@ -72,8 +69,7 @@ module Utils =
|> EncodedObject.encode
|> EncodedObject.write repo
tree2
|> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
tree2 |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
// and the prefix one
let tree3 =
@@ -98,8 +94,7 @@ module Utils =
|> EncodedObject.encode
|> EncodedObject.write repo
tree3
|> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
tree3 |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
let scott =
{
@@ -120,10 +115,7 @@ module Utils =
}
|> Object.Commit
let c1Hash =
commit1
|> EncodedObject.encode
|> EncodedObject.write repo
let c1Hash = commit1 |> EncodedObject.encode |> EncodedObject.write repo
c1Hash
|> Hash.toString
@@ -140,10 +132,7 @@ module Utils =
}
|> Object.Commit
let c2Hash =
commit2
|> EncodedObject.encode
|> EncodedObject.write repo
let c2Hash = commit2 |> EncodedObject.encode |> EncodedObject.write repo
c2Hash
|> Hash.toString
@@ -160,10 +149,7 @@ module Utils =
}
|> Object.Commit
let c3Hash =
commit3
|> EncodedObject.encode
|> EncodedObject.write repo
let c3Hash = commit3 |> EncodedObject.encode |> EncodedObject.write repo
c3Hash
|> Hash.toString

2
Git.Tool/Git.Tool.fsproj
View File

@@ -2,7 +2,7 @@
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
<TargetFramework>net7.0</TargetFramework>
</PropertyGroup>
<ItemGroup>

22
Git.Tool/Program.fs
View File

@@ -25,4 +25,26 @@ module Program =
| [| "verify-pack" ; "-v" ; hash |] ->
VerifyPack.verifyVerbose printer repo hash
0
| [| "rev-parse" ; ref |] ->
let parsed = RevParse.parse repo ref
match parsed with
| Ok h ->
System.Console.WriteLine (Hash.toString h)
0
| Error (e : RevParseError) ->
System.Console.Error.WriteLine (e.ToString ())
1
| [| "branch" ; branchName |] ->
match Branch.createFromHead repo branchName with
| Error e ->
System.Console.Error.WriteLine (e.ToString ())
1
| Ok _ -> 0
| [| "branch" ; branchName ; baseRef |] ->
match Branch.create repo branchName baseRef with
| Error e ->
System.Console.Error.WriteLine (e.ToString ())
1
| Ok _ -> 0
| _ -> failwith "unrecognised args"

6
Git/AssemblyInfo.fs Normal file
View File

@@ -0,0 +1,6 @@
module AssemblyInfo
open System.Runtime.CompilerServices
[<assembly : InternalsVisibleTo("Git.Test")>]
do ()

36
Git/Commands/Branch.fs Normal file
View File

@@ -0,0 +1,36 @@
namespace Git.Commands
open Git
type BranchCreationError =
| HeadNotBelowRefsHeads of currentHead : string
| HeadDoesNotExist of SymbolicRefLookupError
override this.ToString () =
match this with
| BranchCreationError.HeadNotBelowRefsHeads _ -> "fatal: HEAD not found below refs/heads!"
| HeadDoesNotExist (err : SymbolicRefLookupError) ->
// TODO: determine what Git does here
sprintf "Could not determine head to branch from: %O" err
[<RequireQualifiedAccess>]
module Branch =
let create (r : Repository) (name : string) (baseRef : string) =
match Commands.RevParse.parse r baseRef with
| Ok ref -> Reference.write r name ref |> Ok
| Error (e : RevParseError) ->
// TODO: find out what Git does here
failwithf "Supplied ref is not known: %O" e
let createFromHead (r : Repository) (name : string) : Result<ReferenceUpdate, BranchCreationError> =
// TODO: probably want to type this more strongly, do some more parsing of the target
match SymbolicReference.lookup r SymbolicRef.Head with
| Error e -> Error (BranchCreationError.HeadDoesNotExist e)
| Ok (SymbolicRefTarget currentHead) ->
// Match Git's behaviour here!
if not (currentHead.StartsWith "refs/heads/") then
Error (BranchCreationError.HeadNotBelowRefsHeads currentHead)
else
create r name currentHead

5
Git/Commands/Log.fs
View File

@@ -13,10 +13,7 @@ module Log =
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
)

9
Git/Commands/Printer.fs
View File

@@ -1,8 +1,13 @@
namespace Git.Commands
type Printer = { WriteLine : string -> unit }
type Printer =
{
WriteLine : string -> unit
}
[<RequireQualifiedAccess>]
module Printer =
let make () =
{ WriteLine = System.Console.WriteLine }
{
WriteLine = System.Console.WriteLine
}

22
Git/Commands/RevParse.fs Normal file
View File

@@ -0,0 +1,22 @@
namespace Git.Commands
open Git
type RevParseError =
| MultipleMatches of original : string * candidates : Hash list
| Unrecognised of original : string
override this.ToString () =
match this with
| RevParseError.MultipleMatches (s, candidates) -> sprintf "fatal: ambiguous argument '%s'" s
| RevParseError.Unrecognised s ->
sprintf "fatal: ambiguous argument '%s': unknown revision or path not in the working tree." s
[<RequireQualifiedAccess>]
module RevParse =
let rec parse (r : Repository) (s : string) : Result<Hash, RevParseError> =
match RevParse.parse r s with
| [ s ] -> Ok s
| (_ :: _ :: _) as matches -> Error (RevParseError.MultipleMatches (s, matches))
| [] -> Error (RevParseError.Unrecognised s)

3
Git/Commit.fs
View File

@@ -103,8 +103,7 @@ module Commit =
| Some data when data.[0..6] = Encoding.ASCII.GetBytes "gpgsig " ->
let result = StringBuilder ()
result.Append (Encoding.ASCII.GetString data.[7..])
|> ignore
result.Append (Encoding.ASCII.GetString data.[7..]) |> ignore
result.Append '-' |> ignore

4
Git/EncodedObject.fs
View File

@@ -44,9 +44,7 @@ module EncodedObject =
hasher.ComputeHash content |> Hash.ofBytes
let private compress (o : EncodedObject) (dest : Stream) : unit =
let toWrite =
[| Header.toBytes o.Header ; o.Content |]
|> Array.concat
let toWrite = [| Header.toBytes o.Header ; o.Content |] |> Array.concat
use ms = new MemoryStream (toWrite)
use ds = new DeflateStream (dest, CompressionMode.Compress)

7
Git/Git.fsproj
View File

@@ -7,7 +7,9 @@
</PropertyGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.fs" />
<Compile Include="Domain.fs" />
<Compile Include="String.fs" />
<Compile Include="Hash.fs" />
<Compile Include="Stream.fs" />
<Compile Include="Parse.fs" />
@@ -22,15 +24,18 @@
<Compile Include="VerifyPack.fs" />
<Compile Include="EncodedObject.fs" />
<Compile Include="Reference.fs" />
<Compile Include="RevParse.fs" />
<Compile Include="SymbolicReference.fs" />
<Compile Include="Commands\Printer.fs" />
<Compile Include="Commands\Log.fs" />
<Compile Include="Commands\VerifyPack.fs" />
<Compile Include="Commands\RevParse.fs" />
<Compile Include="Commands\Branch.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Crc32.NET" Version="1.2.0" />
<PackageReference Include="SharpZipLib.NETStandard" Version="1.0.7" />
<PackageReference Include="SharpZipLib" Version="1.4.2" />
<PackageReference Include="System.IO.Abstractions" Version="11.0.4" />
<PackageReference Include="FSharp.Core" Version="4.3.4" />
</ItemGroup>

11
Git/Hash.fs
View File

@@ -48,16 +48,7 @@ module Hash =
else
failwithf "Byte '%i' ('%c') is not a hex digit" b (char b)
let rec b (pos : int) =
seq {
if pos < input.Length then
yield value input.[pos] * 16uy + value input.[pos + 1]
yield! b (pos + 2)
}
fun i ->
value input.[2 * i] * 16uy
+ value input.[2 * i + 1]
fun i -> value input.[2 * i] * 16uy + value input.[2 * i + 1]
|> Array.init (input.Length / 2)
|> ofBytes

14
Git/Header.fs
View File

@@ -34,24 +34,14 @@ module internal Header =
match s.[0] with
| 98uy ->
// 'b', then "lob "
if
s.[1] = 108uy
&& s.[2] = 111uy
&& s.[3] = 98uy
&& s.[4] = 32uy
then
if s.[1] = 108uy && s.[2] = 111uy && s.[3] = 98uy && s.[4] = 32uy then
let number = parseIntFromAsciiBytes 5 s
(ObjectType.Blob, number) |> Some
else
None
| 116uy ->
// 't', then "ree "
if
s.[1] = 114uy
&& s.[2] = 101uy
&& s.[3] = 101uy
&& s.[4] = 32uy
then
if s.[1] = 114uy && s.[2] = 101uy && s.[3] = 101uy && s.[4] = 32uy then
let number = parseIntFromAsciiBytes 5 s
(ObjectType.Tree, number) |> Some
else

46
Git/Object.fs
View File

@@ -1,7 +1,5 @@
namespace Git
open System.IO
type Object =
| Blob of byte array
| Tree of TreeEntry list
@@ -21,50 +19,6 @@ type Object =
[<RequireQualifiedAccess>]
module Object =
/// Get the object hashes which match this start.
let disambiguate (r : Repository) (startOfHash : string) : Hash list =
let objectDir = Repository.objectDir r
match startOfHash.Length with
| 0 -> objectDir.EnumerateFiles ("*", SearchOption.AllDirectories)
| 1 ->
if r.IsCaseSensitive then
objectDir.EnumerateDirectories ("*", SearchOption.AllDirectories)
|> Seq.filter (fun dir -> dir.Name.[0] = startOfHash.[0])
|> Seq.collect (fun dir -> dir.EnumerateFiles "*")
else
objectDir.EnumerateDirectories (sprintf "%c*" startOfHash.[0], SearchOption.AllDirectories)
|> Seq.collect (fun dir -> dir.EnumerateFiles "*")
| 2 ->
let subDir =
r.Fs.Path.Combine (objectDir.FullName, startOfHash)
|> r.Fs.DirectoryInfo.FromDirectoryName
if subDir.Exists then
subDir.EnumerateFiles ()
else
Seq.empty
| _ ->
let prefix = startOfHash.Substring (0, 2)
let suffix = startOfHash.Substring 2
let subDir =
r.Fs.Path.Combine (objectDir.FullName, prefix)
|> r.Fs.DirectoryInfo.FromDirectoryName
if subDir.Exists then
if r.IsCaseSensitive then
subDir.EnumerateFiles ()
|> Seq.filter (fun i -> i.Name.StartsWith suffix)
else
subDir.EnumerateFiles ()
|> Seq.filter (fun i -> i.Name.StartsWith (suffix, true, null))
else
Seq.empty
|> Seq.map (fun i -> sprintf "%s%s" i.Directory.Name i.Name)
|> Seq.map Hash.ofString
|> List.ofSeq
let getType (o : Object) : ObjectType =
match o with

94
Git/PackFile.fs
View File

@@ -4,7 +4,6 @@ open System
open System.IO
open System.IO.Abstractions
open Git.Internals
open Force.Crc32
open ICSharpCode.SharpZipLib.Zip.Compression
open ICSharpCode.SharpZipLib.Zip.Compression.Streams
@@ -206,23 +205,13 @@ module PackFile =
let toRet =
match objectType, preamble with
| PackObjectType.ObjBlob, None ->
Object.Blob decompressedObject
|> ParsedPackObject.Object
| PackObjectType.ObjBlob, None -> Object.Blob decompressedObject |> ParsedPackObject.Object
| PackObjectType.ObjCommit, None ->
Commit.decode decompressedObject
|> Object.Commit
|> ParsedPackObject.Object
| PackObjectType.ObjTree, None ->
Tree.decode decompressedObject
|> Object.Tree
|> ParsedPackObject.Object
Commit.decode decompressedObject |> Object.Commit |> ParsedPackObject.Object
| PackObjectType.ObjTree, None -> Tree.decode decompressedObject |> Object.Tree |> ParsedPackObject.Object
| PackObjectType.ObjOfsDelta, Some (preamble, _) -> ParsedPackObject.Delta (preamble, decompressedObject)
| PackObjectType.ObjRefDelta, Some (preamble, _) -> ParsedPackObject.Delta (preamble, decompressedObject)
| PackObjectType.ObjTag, None ->
Tag.decode decompressedObject
|> Object.Tag
|> ParsedPackObject.Object
| PackObjectType.ObjTag, None -> Tag.decode decompressedObject |> Object.Tag |> ParsedPackObject.Object
| PackObjectType.ObjBlob, Some _
| PackObjectType.ObjTag, Some _
| PackObjectType.ObjTree, Some _
@@ -265,14 +254,10 @@ module PackFile =
let private resolveDeltas (packs : (Hash * uint64 * (ParsedPackObject * PackObjectMetadata)) array) : PackObject[] =
let packsByOffset =
packs
|> Seq.map (fun (hash, offset, data) -> offset, (hash, data))
|> Map.ofSeq
packs |> Seq.map (fun (hash, offset, data) -> offset, (hash, data)) |> Map.ofSeq
let packsByHash =
packs
|> Seq.map (fun (hash, offset, data) -> hash, (offset, data))
|> Map.ofSeq
packs |> Seq.map (fun (hash, offset, data) -> hash, (offset, data)) |> Map.ofSeq
let rec resolve (object : ParsedPackObject) (name : Hash) (metadata : PackObjectMetadata) : PackObject =
match object with
@@ -324,8 +309,7 @@ module PackFile =
let nextObjectIndex =
// TODO probably binary search this, or maintain an incrementing
// counter
sortedObjectPositions
|> Array.tryFindIndex (fun pos -> pos > offset)
sortedObjectPositions |> Array.tryFindIndex (fun pos -> pos > offset)
// Account for the case where the index file contains garbage
let startingIndex =
@@ -334,12 +318,10 @@ module PackFile =
| Some 0 -> uint64 stream.Position
| Some i -> sortedObjectPositions.[i - 1]
stream.Seek (int64 startingIndex, SeekOrigin.Begin)
|> ignore
stream.Seek (int64 startingIndex, SeekOrigin.Begin) |> ignore
let nextObjectPosition =
nextObjectIndex
|> Option.map (fun i -> sortedObjectPositions.[i])
nextObjectIndex |> Option.map (fun i -> sortedObjectPositions.[i])
Hash.ofBytes name, startingIndex, parseObject nextObjectPosition crc stream
)
@@ -389,13 +371,10 @@ module PackFile =
let remainingBytes = Stream.consume s 3
if firstByte >= 128uy then
toUint remainingBytes
+ ((uint32 (firstByte % 128uy)) <<< 24)
toUint remainingBytes + ((uint32 (firstByte % 128uy)) <<< 24)
|> PackIndexOffset.LayerFiveEntry
else
toUint remainingBytes
+ ((uint32 firstByte) <<< 24)
|> PackIndexOffset.RawOffset
toUint remainingBytes + ((uint32 firstByte) <<< 24) |> PackIndexOffset.RawOffset
let readIndex (file : IFileInfo) : PackIndex =
use s = file.OpenRead ()
@@ -523,16 +502,14 @@ module PackFile =
if nameLookup = 0uy then
0L, Stream.consume packIndex 4 |> toUint |> int64
else
packIndex.Seek ((int64 (nameLookup - 1uy)) * 4L, SeekOrigin.Current)
|> ignore
packIndex.Seek ((int64 (nameLookup - 1uy)) * 4L, SeekOrigin.Current) |> ignore
let before = Stream.consume packIndex 4 |> toUint |> int64
let after = Stream.consume packIndex 4 |> toUint |> int64
before, after
let totalCount =
packIndex.Seek (4L + 4L + 255L * 4L, SeekOrigin.Begin)
|> ignore
packIndex.Seek (4L + 4L + 255L * 4L, SeekOrigin.Begin) |> ignore
Stream.consume packIndex 4 |> toUint |> int64
@@ -566,14 +543,7 @@ module PackFile =
| None -> None
| Some location ->
packIndex.Seek (
4L
+ 4L
+ 256L * 4L
+ totalCount * 24L
+ location * 4L,
SeekOrigin.Begin
)
packIndex.Seek (4L + 4L + 256L * 4L + totalCount * 24L + location * 4L, SeekOrigin.Begin)
|> ignore
let index = consumeOffset packIndex
@@ -582,14 +552,7 @@ module PackFile =
match index with
| PackIndexOffset.RawOffset i -> int64 i
| PackIndexOffset.LayerFiveEntry entry ->
packIndex.Seek (
4L
+ 4L
+ 256L * 4L
+ totalCount * 28L
+ (int64 entry) * 8L,
SeekOrigin.Begin
)
packIndex.Seek (4L + 4L + 256L * 4L + totalCount * 28L + (int64 entry) * 8L, SeekOrigin.Begin)
|> ignore
Stream.consume packIndex 8 |> toUint64 |> int64
@@ -610,16 +573,27 @@ module PackFile =
match subObject with
| None -> failwithf "Failed to find sub-object with name %s" (Hash.toString name)
| Some subObject ->
(subObject, data, hash, metadata)
|> PackObject.Delta
|> Some
| Preamble.Offset offset ->
(failwith "", data, hash, metadata)
|> PackObject.Delta
|> Some
| Some subObject -> (subObject, data, hash, metadata) |> PackObject.Delta |> Some
| Preamble.Offset offset -> (failwith "", data, hash, metadata) |> PackObject.Delta |> Some
let locateObject (h : Hash) (packIndex : IFileInfo) (packFile : IFileInfo) : PackObject option =
use index = packIndex.OpenRead ()
use file = packFile.OpenRead ()
locateObjectInStream h index file
/// Get all the pack files in this repository.
/// The resulting hash is a hash that can be interpolated into e.g. `id-%s.pack`,
/// or passed straight into `VerifyPack.verify`.
let allPacks (repo : Repository) : (Hash * IFileInfo) seq =
let gitDir = Repository.gitDir repo
let fs = repo.Fs
fs.Path.Combine (gitDir.FullName, "objects", "pack")
|> fs.DirectoryInfo.FromDirectoryName
|> fun di -> di.EnumerateFiles "*.pack"
|> Seq.map (fun fi ->
let hash =
fi.FullName |> String.chopStart "id-" |> String.chopEnd ".pack" |> Hash.ofString
hash, fi
)

14
Git/Parse.fs
View File

@@ -6,7 +6,7 @@ open System.IO
open System.Text
open Microsoft.FSharp.Data.UnitSystems.SI.UnitNames
type OneOf = OneOf of string list
type OneOf = | OneOf of string list
[<RequireQualifiedAccess>]
module Parse =
@@ -53,9 +53,7 @@ module Parse =
w, h
let consumePerson (id : string) (s : Stream) =
let name =
Stream.consumeTo s (byte '<')
|> Option.map Encoding.UTF8.GetString
let name = Stream.consumeTo s (byte '<') |> Option.map Encoding.UTF8.GetString
match name with
| None -> failwithf "No %s name present in object." id
@@ -66,9 +64,7 @@ module Parse =
let name = name.Substring (0, name.Length - 1)
let email =
Stream.consumeTo s (byte '>')
|> Option.map Encoding.UTF8.GetString
let email = Stream.consumeTo s (byte '>') |> Option.map Encoding.UTF8.GetString
match email with
| None -> failwithf "No %s email present in object." id
@@ -90,9 +86,7 @@ module Parse =
let timestamp = parseInt timestamp * 1<second>
let offset =
Stream.consumeTo s 10uy
|> Option.map Encoding.UTF8.GetString
let offset = Stream.consumeTo s 10uy |> Option.map Encoding.UTF8.GetString
match offset with
| None -> failwithf "Commit object ended before %s timezone" id

56
Git/Reference.fs
View File

@@ -1,7 +1,14 @@
namespace Git
open System
open System.IO
type ReferenceUpdate = { Was : Hash option ; Now : Hash }
type ReferenceUpdate =
{
Was : Hash option
Now : Hash
}
[<RequireQualifiedAccess>]
module Reference =
@@ -11,29 +18,40 @@ module Reference =
|> r.Fs.FileInfo.FromFileName
let was =
if refFile.Exists then
r.Fs.File.ReadAllText refFile.FullName
|> Hash.ofString
|> Some
else
do
use _v = refFile.Create ()
()
try
r.Fs.File.ReadAllText refFile.FullName |> Some
with :? FileNotFoundException ->
None
|> Option.map Hash.ofString
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
let lookup (name : string) =
let refFile =
r.Fs.Path.Combine ((Repository.gitDir r).FullName, name)
|> r.Fs.FileInfo.FromFileName
if refFile.Exists then
Some (
try
r.Fs.File.ReadAllText refFile.FullName
|> String.chopEnd "\n"
|> Hash.ofString
)
else
None
|> Some
with
| :? FileNotFoundException
| :? DirectoryNotFoundException -> None
seq {
yield name
yield r.Fs.Path.Combine ("refs", name)
yield r.Fs.Path.Combine ("refs", "tags", name)
yield r.Fs.Path.Combine ("refs", "heads", name)
yield r.Fs.Path.Combine ("refs", "remotes", name)
yield r.Fs.Path.Combine ("refs", "remotes", name, "HEAD")
}
|> Seq.tryPick lookup

65
Git/RevParse.fs Normal file
View File

@@ -0,0 +1,65 @@
namespace Git
open System
open System.IO
[<RequireQualifiedAccess>]
module RevParse =
/// Get the object hashes which match this start, from among the loose objects.
let disambiguateLooseHash (r : Repository) (startOfHash : string) : Hash list =
let objectDir = Repository.objectDir r
match startOfHash.Length with
| 0 -> objectDir.EnumerateFiles ("*", SearchOption.AllDirectories)
| 1 ->
if r.IsCaseSensitive then
objectDir.EnumerateDirectories ("*", SearchOption.AllDirectories)
|> Seq.filter (fun dir -> dir.Name.[0] = startOfHash.[0])
|> Seq.collect (fun dir -> dir.EnumerateFiles "*")
else
objectDir.EnumerateDirectories (sprintf "%c*" startOfHash.[0], SearchOption.AllDirectories)
|> Seq.collect (fun dir -> dir.EnumerateFiles "*")
| 2 ->
let subDir =
r.Fs.Path.Combine (objectDir.FullName, startOfHash)
|> r.Fs.DirectoryInfo.FromDirectoryName
if subDir.Exists then
subDir.EnumerateFiles ()
else
Seq.empty
| _ ->
let prefix = startOfHash.Substring (0, 2)
let suffix = startOfHash.Substring 2
let subDir =
r.Fs.Path.Combine (objectDir.FullName, prefix)
|> r.Fs.DirectoryInfo.FromDirectoryName
if subDir.Exists then
if r.IsCaseSensitive then
subDir.EnumerateFiles ()
|> Seq.filter (fun i -> i.Name.StartsWith (suffix, StringComparison.Ordinal))
else
subDir.EnumerateFiles ()
|> Seq.filter (fun i -> i.Name.StartsWith (suffix, StringComparison.OrdinalIgnoreCase))
else
Seq.empty
|> Seq.map (fun i -> sprintf "%s%s" i.Directory.Name i.Name)
|> Seq.map Hash.ofString
|> List.ofSeq
let rec parse (repo : Repository) (s : string) : Hash list =
match s with
| "@" -> parse repo "HEAD"
| _ ->
let fromBranchName = Reference.lookup repo s
let fromHash = disambiguateLooseHash repo s
Option.toList fromBranchName @ fromHash
//let disambiguatePackedHash (r : Repository) (startOfHash : string) : Hash list =
// let packs = PackFile.allPacks r

18
Git/String.fs Normal file
View File

@@ -0,0 +1,18 @@
namespace Git
open System
[<RequireQualifiedAccess>]
module internal String =
let chopStart (toChop : string) (s : string) =
if s.StartsWith (toChop, StringComparison.Ordinal) then
s.Substring toChop.Length
else
s
let chopEnd (toChop : string) (s : string) =
if s.EndsWith (toChop, StringComparison.Ordinal) then
s.Substring (0, s.Length - toChop.Length)
else
s

61
Git/SymbolicReference.fs
View File

@@ -1,9 +1,11 @@
namespace Git
open System
open System.IO
open System.IO.Abstractions
/// The target of a symbolic reference, e.g. "refs/heads/blah".
type SymbolicRefTarget = SymbolicRefTarget of string
type SymbolicRefTarget = | SymbolicRefTarget of string
type SymbolicRef =
| CherryPickHead
@@ -34,8 +36,21 @@ module SymbolicRef =
|> r.Fs.FileInfo.FromFileName
type SymbolicRefLookupError =
| RefDidNotExist
| MalformedRef of string
| RefDidNotExist of SymbolicRef
| MalformedRef of SymbolicRef * string
override this.ToString () =
match this with
| SymbolicRefLookupError.RefDidNotExist s -> sprintf "Symbolic ref %s did not exist" (string<SymbolicRef> s)
| SymbolicRefLookupError.MalformedRef (ref, contents) ->
sprintf "Symbolic ref %s had malformed contents: %s" (string<SymbolicRef> ref) contents
type SymbolicRefWriteError =
| PointingOutsideRefs of SymbolicRef
override this.ToString () =
match this with
| SymbolicRefWriteError.PointingOutsideRefs ref -> sprintf "refusing to point %O outside of refs/" ref
[<RequireQualifiedAccess>]
module SymbolicReference =
@@ -44,20 +59,32 @@ module SymbolicReference =
let lookup (r : Repository) (name : SymbolicRef) : Result<SymbolicRefTarget, SymbolicRefLookupError> =
let f = SymbolicRef.getFile r name
if not <| f.Exists then
Error RefDidNotExist
let text =
try
r.Fs.File.ReadAllText f.FullName |> Ok
with :? FileNotFoundException ->
Error (RefDidNotExist name)
text
|> Result.bind (fun contents ->
if not (contents.StartsWith ("ref: ", StringComparison.Ordinal)) then
Error (MalformedRef (name, contents))
elif not (contents.EndsWith ("\n", StringComparison.Ordinal)) then
Error (MalformedRef (name, contents))
else
// Omit the trailing newline
contents.Substring (5, contents.Length - 6) |> SymbolicRefTarget |> Ok
)
let write (r : Repository) (name : SymbolicRef) (contents : string) : Result<unit, SymbolicRefWriteError> =
if not <| contents.StartsWith ("refs/", StringComparison.Ordinal) then
Error (SymbolicRefWriteError.PointingOutsideRefs name)
else
r.Fs.File.ReadAllText f.FullName
|> fun contents ->
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\n" contents)
Ok ()
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 =
let underlyingFile = SymbolicRef.getFile r name
underlyingFile.Delete ()

17
Git/Tag.fs
View File

@@ -38,35 +38,28 @@ module Tag =
use ms = new MemoryStream (file)
let objectHash =
Parse.consumeWord "tag" (OneOf [ "object" ]) ms
|> ignore
Parse.consumeWord "tag" (OneOf [ "object" ]) ms |> ignore
match Stream.consumeTo ms (byte '\n') with
| None -> failwith "Tag object should have had a newline in"
| Some h -> h |> Hash.ofSpelling
let typeReferredTo =
Parse.consumeWord "tag" (OneOf [ "type" ]) ms
|> ignore
Parse.consumeWord "tag" (OneOf [ "type" ]) ms |> ignore
match Stream.consumeTo ms (byte '\n') with
| None -> failwith "Tag type should have had a newline in"
| Some h ->
h
|> Encoding.ASCII.GetString
|> TaggedObjectType.Parse
| Some h -> h |> Encoding.ASCII.GetString |> TaggedObjectType.Parse
let tagName =
Parse.consumeWord "tag" (OneOf [ "tag" ]) ms
|> ignore
Parse.consumeWord "tag" (OneOf [ "tag" ]) ms |> ignore
match Stream.consumeTo ms (byte '\n') with
| None -> failwith "Tag name should have had a newline in"
| Some t -> t |> Encoding.ASCII.GetString
let tagger =
Parse.consumeWord "tag" (OneOf [ "tagger" ]) ms
|> ignore
Parse.consumeWord "tag" (OneOf [ "tagger" ]) ms |> ignore
Parse.consumePerson "tagger" ms

19
Git/VerifyPack.fs
View File

@@ -11,10 +11,7 @@ type PackVerificationLine =
let typeString = string<ObjectType> this.Type
let padding =
Array.create
(ObjectType.Commit.ToString().Length
- typeString.Length)
" "
Array.create (ObjectType.Commit.ToString().Length - typeString.Length) " "
|> String.concat ""
sprintf "%s %s%s %s" (Hash.toString this.Object) typeString padding (string<PackObjectMetadata> this.Metadata)
@@ -77,16 +74,12 @@ module VerifyPack =
let id = Hash.toString idHash
let index =
fs.Path.Combine (packDir, sprintf "pack-%s.idx" id)
|> fs.FileInfo.FromFileName
fs.Path.Combine (packDir, sprintf "pack-%s.idx" id) |> fs.FileInfo.FromFileName
let packFile =
fs.Path.Combine (packDir, sprintf "pack-%s.pack" id)
|> fs.FileInfo.FromFileName
fs.Path.Combine (packDir, sprintf "pack-%s.pack" id) |> fs.FileInfo.FromFileName
let allPacks =
PackFile.readIndex index
|> PackFile.readAll packFile
let allPacks = PackFile.readIndex index |> PackFile.readAll packFile
let rec baseObject (o : PackObject) =
match o with
@@ -151,9 +144,7 @@ module VerifyPack =
let maxChainLength = chainCounts |> Map.toSeq |> Seq.last |> fst
let chainCounts =
fun length ->
Map.tryFind length chainCounts
|> Option.defaultValue 0
fun length -> Map.tryFind length chainCounts |> Option.defaultValue 0
|> Array.init (maxChainLength + 1) // for the 0 index
{

4
global.json
View File

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

4
hooks/pre-push
View File

@@ -3,10 +3,10 @@
import subprocess
def check_fantomas():
result = subprocess.run(["dotnet", "tool", "run", "fantomas", "--check", "-r", "."])
result = subprocess.run(["dotnet", "fantomas", "--check", "."])
if result.returncode != 0:
print(result.stdout)
raise Exception(f"Formatting incomplete (return code: {result.returncode}). Consider running `dotnet tool run fantomas -r .`")
raise Exception(f"Formatting incomplete (return code: {result.returncode}). Consider running `dotnet fantomas .`")
def main():