From 09ccb7b90c007b03a6fdd709404b23678a2b1eea Mon Sep 17 00:00:00 2001 From: Patrick Stevens Date: Sat, 2 Sep 2023 21:48:31 +0100 Subject: [PATCH] Some stuff I found lying around my disk (#11) --- .config/dotnet-tools.json | 2 +- .editorconfig | 13 +- .github/workflows/dotnet.yml | 2 +- Git.Test/Git.Test.fsproj | 6 +- Git.Test/Result.fs | 14 +++ Git.Test/TestBlob.fs | 9 +- Git.Test/TestCommit.fs | 8 +- Git.Test/TestFromGitBook.fs | 125 +++++++------------- Git.Test/TestInit.fs | 3 +- Git.Test/{TestObject.fs => TestRevParse.fs} | 20 ++-- Git.Test/TestString.fs | 86 ++++++++++++++ Git.Test/TestTree.fs | 3 +- Git.Test/Utils.fs | 30 ++--- Git.Tool/Git.Tool.fsproj | 2 +- Git.Tool/Program.fs | 22 ++++ Git/AssemblyInfo.fs | 6 + Git/Commands/Branch.fs | 36 ++++++ Git/Commands/Log.fs | 5 +- Git/Commands/Printer.fs | 9 +- Git/Commands/RevParse.fs | 22 ++++ Git/Commit.fs | 3 +- Git/EncodedObject.fs | 4 +- Git/Git.fsproj | 7 +- Git/Hash.fs | 11 +- Git/Header.fs | 14 +-- Git/Object.fs | 46 ------- Git/PackFile.fs | 94 ++++++--------- Git/Parse.fs | 14 +-- Git/Reference.fs | 56 ++++++--- Git/RevParse.fs | 65 ++++++++++ Git/String.fs | 18 +++ Git/SymbolicReference.fs | 61 +++++++--- Git/Tag.fs | 17 +-- Git/VerifyPack.fs | 19 +-- global.json | 4 +- hooks/pre-push | 4 +- 36 files changed, 501 insertions(+), 359 deletions(-) create mode 100644 Git.Test/Result.fs rename Git.Test/{TestObject.fs => TestRevParse.fs} (83%) create mode 100644 Git.Test/TestString.fs create mode 100644 Git/AssemblyInfo.fs create mode 100644 Git/Commands/Branch.fs create mode 100644 Git/Commands/RevParse.fs create mode 100644 Git/RevParse.fs create mode 100644 Git/String.fs diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 59807bf..2a80148 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -3,7 +3,7 @@ "isRoot": true, "tools": { "fantomas": { - "version": "5.0.0-beta-009", + "version": "6.2.0", "commands": [ "fantomas" ] diff --git a/.editorconfig b/.editorconfig index adcac9b..669c589 100644 --- a/.editorconfig +++ b/.editorconfig @@ -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 diff --git a/.github/workflows/dotnet.yml b/.github/workflows/dotnet.yml index 3bf86a6..068fd05 100644 --- a/.github/workflows/dotnet.yml +++ b/.github/workflows/dotnet.yml @@ -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 diff --git a/Git.Test/Git.Test.fsproj b/Git.Test/Git.Test.fsproj index 226c998..bbf36c3 100644 --- a/Git.Test/Git.Test.fsproj +++ b/Git.Test/Git.Test.fsproj @@ -1,7 +1,7 @@ - net6.0 + net7.0 false @@ -16,17 +16,19 @@ + + - + diff --git a/Git.Test/Result.fs b/Git.Test/Result.fs new file mode 100644 index 0000000..b94e55b --- /dev/null +++ b/Git.Test/Result.fs @@ -0,0 +1,14 @@ +namespace Git.Test + +[] +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 diff --git a/Git.Test/TestBlob.fs b/Git.Test/TestBlob.fs index 36953f8..ce6a9d8 100644 --- a/Git.Test/TestBlob.fs +++ b/Git.Test/TestBlob.fs @@ -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 diff --git a/Git.Test/TestCommit.fs b/Git.Test/TestCommit.fs index d887ebf..32603aa 100644 --- a/Git.Test/TestCommit.fs +++ b/Git.Test/TestCommit.fs @@ -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 diff --git a/Git.Test/TestFromGitBook.fs b/Git.Test/TestFromGitBook.fs index 3cbcf82..b2cfc2e 100644 --- a/Git.Test/TestFromGitBook.fs +++ b/Git.Test/TestFromGitBook.fs @@ -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 (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)) diff --git a/Git.Test/TestInit.fs b/Git.Test/TestInit.fs index 5cb99f6..89ba8cb 100644 --- a/Git.Test/TestInit.fs +++ b/Git.Test/TestInit.fs @@ -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) diff --git a/Git.Test/TestObject.fs b/Git.Test/TestRevParse.fs similarity index 83% rename from Git.Test/TestObject.fs rename to Git.Test/TestRevParse.fs index f3f9ba4..8039f71 100644 --- a/Git.Test/TestObject.fs +++ b/Git.Test/TestRevParse.fs @@ -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 [] -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 diff --git a/Git.Test/TestString.fs b/Git.Test/TestString.fs new file mode 100644 index 0000000..3279286 --- /dev/null +++ b/Git.Test/TestString.fs @@ -0,0 +1,86 @@ +namespace Git.Test + +open System.Threading +open FsCheck +open Git +open NUnit.Framework +open FsUnitTyped + +[] +module TestString = + + [] + let ``chopStart does nothing when chopping a non-start`` () = + let badCount = ref 0 + let goodCount = ref 0 + + let property (NonNull s : NonNull) : 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 + + [] + let ``chopStart does nothing when chopping the empty string`` () = + let property (NonNull s) : bool = s |> String.chopStart "" |> (=) s + + Check.QuickThrowOnFailure property + + [] + let ``chopStart does nothing when chopping by the empty string`` () = + let property (NonNull s) : bool = "" |> String.chopStart s |> (=) "" + + Check.QuickThrowOnFailure property + + [] + let ``chopStart chops the initial`` () = + let property (NonNull toChop) (NonNull from : NonNull) : bool = + (toChop + from) |> String.chopStart toChop |> (=) from + + Check.QuickThrowOnFailure property + + [] + let ``chopEnd does nothing when chopping a non-end`` () = + let badCount = ref 0 + let goodCount = ref 0 + + let property (NonNull s : NonNull) : 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 + + [] + let ``chopEnd does nothing when chopping the empty string`` () = + let property (NonNull s) : bool = s |> String.chopEnd "" |> (=) s + + Check.QuickThrowOnFailure property + + [] + let ``chopEnd does nothing when chopping by the empty string`` () = + let property (NonNull s) : bool = "" |> String.chopEnd s |> (=) "" + + Check.QuickThrowOnFailure property + + [] + let ``chopEnd chops the final`` () = + let property (NonNull toChop) (NonNull from : NonNull) : bool = + (from + toChop) |> String.chopEnd toChop |> (=) from + + Check.QuickThrowOnFailure property diff --git a/Git.Test/TestTree.fs b/Git.Test/TestTree.fs index 5948b51..2419849 100644 --- a/Git.Test/TestTree.fs +++ b/Git.Test/TestTree.fs @@ -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 diff --git a/Git.Test/Utils.fs b/Git.Test/Utils.fs index 064a882..3882ca8 100644 --- a/Git.Test/Utils.fs +++ b/Git.Test/Utils.fs @@ -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 diff --git a/Git.Tool/Git.Tool.fsproj b/Git.Tool/Git.Tool.fsproj index 5df59f7..0cd1b16 100644 --- a/Git.Tool/Git.Tool.fsproj +++ b/Git.Tool/Git.Tool.fsproj @@ -2,7 +2,7 @@ Exe - net6.0 + net7.0 diff --git a/Git.Tool/Program.fs b/Git.Tool/Program.fs index 9a1425b..b15abb6 100644 --- a/Git.Tool/Program.fs +++ b/Git.Tool/Program.fs @@ -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" diff --git a/Git/AssemblyInfo.fs b/Git/AssemblyInfo.fs new file mode 100644 index 0000000..a5523f3 --- /dev/null +++ b/Git/AssemblyInfo.fs @@ -0,0 +1,6 @@ +module AssemblyInfo + +open System.Runtime.CompilerServices + +[] +do () diff --git a/Git/Commands/Branch.fs b/Git/Commands/Branch.fs new file mode 100644 index 0000000..5168e4f --- /dev/null +++ b/Git/Commands/Branch.fs @@ -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 + +[] +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 = + // 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 diff --git a/Git/Commands/Log.fs b/Git/Commands/Log.fs index 157fcb5..29d7643 100644 --- a/Git/Commands/Log.fs +++ b/Git/Commands/Log.fs @@ -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 ) diff --git a/Git/Commands/Printer.fs b/Git/Commands/Printer.fs index a9ed109..74b6707 100644 --- a/Git/Commands/Printer.fs +++ b/Git/Commands/Printer.fs @@ -1,8 +1,13 @@ namespace Git.Commands -type Printer = { WriteLine : string -> unit } +type Printer = + { + WriteLine : string -> unit + } [] module Printer = let make () = - { WriteLine = System.Console.WriteLine } + { + WriteLine = System.Console.WriteLine + } diff --git a/Git/Commands/RevParse.fs b/Git/Commands/RevParse.fs new file mode 100644 index 0000000..1147a20 --- /dev/null +++ b/Git/Commands/RevParse.fs @@ -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 + +[] +module RevParse = + + let rec parse (r : Repository) (s : string) : Result = + match RevParse.parse r s with + | [ s ] -> Ok s + | (_ :: _ :: _) as matches -> Error (RevParseError.MultipleMatches (s, matches)) + | [] -> Error (RevParseError.Unrecognised s) diff --git a/Git/Commit.fs b/Git/Commit.fs index b501489..2738474 100644 --- a/Git/Commit.fs +++ b/Git/Commit.fs @@ -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 diff --git a/Git/EncodedObject.fs b/Git/EncodedObject.fs index bff7aa7..5f1ba59 100644 --- a/Git/EncodedObject.fs +++ b/Git/EncodedObject.fs @@ -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) diff --git a/Git/Git.fsproj b/Git/Git.fsproj index 7bb2e0a..8aad247 100644 --- a/Git/Git.fsproj +++ b/Git/Git.fsproj @@ -7,7 +7,9 @@ + + @@ -22,15 +24,18 @@ + + + - + diff --git a/Git/Hash.fs b/Git/Hash.fs index f937bdf..64b47ff 100644 --- a/Git/Hash.fs +++ b/Git/Hash.fs @@ -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 diff --git a/Git/Header.fs b/Git/Header.fs index 8fee4d0..0fadda6 100644 --- a/Git/Header.fs +++ b/Git/Header.fs @@ -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 diff --git a/Git/Object.fs b/Git/Object.fs index 03bd2cd..c886a88 100644 --- a/Git/Object.fs +++ b/Git/Object.fs @@ -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 = [] 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 diff --git a/Git/PackFile.fs b/Git/PackFile.fs index 3e25b18..0094709 100644 --- a/Git/PackFile.fs +++ b/Git/PackFile.fs @@ -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 + ) diff --git a/Git/Parse.fs b/Git/Parse.fs index 48202f8..aee275c 100644 --- a/Git/Parse.fs +++ b/Git/Parse.fs @@ -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 [] 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 - 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 diff --git a/Git/Reference.fs b/Git/Reference.fs index da97384..808e436 100644 --- a/Git/Reference.fs +++ b/Git/Reference.fs @@ -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 + } [] 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 diff --git a/Git/RevParse.fs b/Git/RevParse.fs new file mode 100644 index 0000000..795d804 --- /dev/null +++ b/Git/RevParse.fs @@ -0,0 +1,65 @@ +namespace Git + +open System +open System.IO + +[] +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 diff --git a/Git/String.fs b/Git/String.fs new file mode 100644 index 0000000..19f00e9 --- /dev/null +++ b/Git/String.fs @@ -0,0 +1,18 @@ +namespace Git + +open System + +[] +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 diff --git a/Git/SymbolicReference.fs b/Git/SymbolicReference.fs index fa71461..4fbec33 100644 --- a/Git/SymbolicReference.fs +++ b/Git/SymbolicReference.fs @@ -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 s) + | SymbolicRefLookupError.MalformedRef (ref, contents) -> + sprintf "Symbolic ref %s had malformed contents: %s" (string 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 [] module SymbolicReference = @@ -44,20 +59,32 @@ module SymbolicReference = let lookup (r : Repository) (name : SymbolicRef) : Result = 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 = + 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 () diff --git a/Git/Tag.fs b/Git/Tag.fs index 7b27214..8650148 100644 --- a/Git/Tag.fs +++ b/Git/Tag.fs @@ -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 diff --git a/Git/VerifyPack.fs b/Git/VerifyPack.fs index c57cfc8..3c4fe3d 100644 --- a/Git/VerifyPack.fs +++ b/Git/VerifyPack.fs @@ -11,10 +11,7 @@ type PackVerificationLine = let typeString = string 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 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 { diff --git a/global.json b/global.json index d3f2e44..6d29ffd 100644 --- a/global.json +++ b/global.json @@ -1,4 +1,4 @@ { - "version": "6.0.300", - "rollForward": "latestPatch" + "version": "7.0.300", + "rollForward": "latestFeature" } diff --git a/hooks/pre-push b/hooks/pre-push index afe90e6..c2cbf4d 100755 --- a/hooks/pre-push +++ b/hooks/pre-push @@ -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():