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

.config/dotnet-tools.json

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

.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

.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

Git.Test/Git.Test.fsproj

@@ -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" />

Git.Test/Result.fs

@@ -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

Git.Test/TestBlob.fs

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

Git.Test/TestCommit.fs

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

Git.Test/TestFromGitBook.fs

@@ -36,8 +36,7 @@ module TestFromGitBook =
         |> List.sort
         |> shouldEqual [ "info" ; "pack" ]
 
-        objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories)
+        objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories) |> shouldBeEmpty
-        |> shouldBeEmpty
 
         // Write our first object
         let h =
@@ -47,8 +46,7 @@ module TestFromGitBook =
             |> EncodedObject.encode
             |> EncodedObject.write repo
 
-        h
+        h |> shouldEqual (Hash.ofString "d670460b4b4aece5915caf5c68d12f560a9fe3e4")
-        |> 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
+        match EncodedObject.catFile repo h |> EncodedObject.decode with
-            EncodedObject.catFile repo h
+        | Object.Blob b -> b |> Array.map char |> String |> shouldEqual "test content\n"
-            |> 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
+        h1 |> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
-        |> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30")
 
         let h2 =
             "version 2\n"
@@ -87,8 +77,7 @@ module TestFromGitBook =
             |> EncodedObject.encode
             |> EncodedObject.write repo
 
-        h2
+        h2 |> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a")
-        |> 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
+        match EncodedObject.catFile repo h1 |> EncodedObject.decode with
-            EncodedObject.catFile repo h1
+        | Object.Blob b -> b |> Array.map char |> String |> shouldEqual "version 1\n"
-            |> EncodedObject.decode
-        with
-        | Object.Blob b ->
-            b
-            |> Array.map char
-            |> String
-            |> shouldEqual "version 1\n"
         | s -> failwithf "Oh no: +%A" s
 
-        match
+        match EncodedObject.catFile repo h2 |> EncodedObject.decode with
-            EncodedObject.catFile repo h2
+        | Object.Blob b -> b |> Array.map char |> String |> shouldEqual "version 2\n"
-            |> 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
+        tree1 |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
-        |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579")
 
-        match
+        match EncodedObject.catFile repo tree1 |> EncodedObject.decode with
-            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
+        tree2 |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
-        |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341")
 
-        match
+        match EncodedObject.catFile repo tree2 |> EncodedObject.decode with
-            EncodedObject.catFile repo tree2
-            |> EncodedObject.decode
-        with
         | Object.Tree t ->
             t
             |> shouldEqual
@@ -228,13 +195,9 @@ module TestFromGitBook =
             |> EncodedObject.encode
             |> EncodedObject.write repo
 
-        tree3
+        tree3 |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
-        |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614")
 
-        match
+        match EncodedObject.catFile repo tree3 |> EncodedObject.decode with
-            EncodedObject.catFile repo tree3
-            |> EncodedObject.decode
-        with
         | Object.Tree t ->
             t
             |> shouldEqual
@@ -277,10 +240,7 @@ module TestFromGitBook =
             }
             |> Object.Commit
 
-        let c1Hash =
+        let c1Hash = commit1 |> EncodedObject.encode |> EncodedObject.write repo
-            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.catFile repo c1Hash |> EncodedObject.decode |> shouldEqual commit1
-        |> EncodedObject.decode
-        |> shouldEqual commit1
 
         let commit2 =
             {
@@ -304,18 +262,13 @@ module TestFromGitBook =
             }
             |> Object.Commit
 
-        let c2Hash =
+        let c2Hash = commit2 |> EncodedObject.encode |> EncodedObject.write repo
-            commit2
-            |> EncodedObject.encode
-            |> EncodedObject.write repo
 
         c2Hash
         |> Hash.toString
         |> shouldEqual "1513b13a72f5277252cfce4ed0eda0620aca2f6a"
 
-        EncodedObject.catFile repo c2Hash
+        EncodedObject.catFile repo c2Hash |> EncodedObject.decode |> shouldEqual commit2
-        |> EncodedObject.decode
-        |> shouldEqual commit2
 
         let commit3 =
             {
@@ -328,18 +281,13 @@ module TestFromGitBook =
             }
             |> Object.Commit
 
-        let c3Hash =
+        let c3Hash = commit3 |> EncodedObject.encode |> EncodedObject.write repo
-            commit3
-            |> EncodedObject.encode
-            |> EncodedObject.write repo
 
         c3Hash
         |> Hash.toString
         |> shouldEqual "95cce637b4e889eee8042515db402128bd62c0d2"
 
-        EncodedObject.catFile repo c3Hash
+        EncodedObject.catFile repo c3Hash |> EncodedObject.decode |> shouldEqual commit3
-        |> 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 =
+        let error = SymbolicReference.write repo SymbolicRef.Head "test" |> Result.getError
-            Assert.Throws<Exception> (fun () -> SymbolicReference.write repo SymbolicRef.Head "test")
 
-        exn.Message
+        error
-        |> shouldEqual "refusing to point HEAD outside of refs/"
+        |> 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))

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
+        Repository.init (BranchName "main") gitDir |> shouldEqual (Error AlreadyGit)
-        |> shouldEqual (Error AlreadyGit)

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
 
 [<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]
+            property expected.[0..subStringEnd] |> shouldEqual true
-            |> shouldEqual true
 
-            expected.[0..subStringEnd].ToUpperInvariant ()
+            expected.[0..subStringEnd].ToUpperInvariant () |> property |> shouldEqual true
-            |> property
-            |> shouldEqual true

Git.Test/TestString.fs

@@ -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

Git.Test/TestTree.fs

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

Git.Test/Utils.fs

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

Git.Tool/Git.Tool.fsproj

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

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"

Git/AssemblyInfo.fs

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

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
+
+[<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

Git/Commands/Log.fs

@@ -13,10 +13,7 @@ module Log =
                 yield!
                     c.Parents
                     |> List.map (fun i ->
-                        match
+                        match EncodedObject.catFile repo i |> EncodedObject.decode with
-                            EncodedObject.catFile repo i
-                            |> EncodedObject.decode
-                        with
                         | Object.Commit c -> (i, c)
                         | s -> failwithf "Not a commit: %O (%+A)" i s
                     )

Git/Commands/Printer.fs

@@ -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
+        }

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
+
+[<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)

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..])
+                result.Append (Encoding.ASCII.GetString data.[7..]) |> ignore
-                |> ignore
 
                 result.Append '-' |> ignore
 

Git/EncodedObject.fs

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

Git/Git.fsproj

@@ -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>

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) =
+        fun i -> value input.[2 * i] * 16uy + value input.[2 * i + 1]
-            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]
         |> Array.init (input.Length / 2)
         |> ofBytes
 

Git/Header.fs

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

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 =
 
 [<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

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 ->
+            | PackObjectType.ObjBlob, None -> Object.Blob decompressedObject |> ParsedPackObject.Object
-                Object.Blob decompressedObject
-                |> ParsedPackObject.Object
             | PackObjectType.ObjCommit, None ->
-                Commit.decode decompressedObject
+                Commit.decode decompressedObject |> Object.Commit |> ParsedPackObject.Object
-                |> Object.Commit
+            | PackObjectType.ObjTree, None -> Tree.decode decompressedObject |> Object.Tree |> ParsedPackObject.Object
-                |> 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 ->
+            | PackObjectType.ObjTag, None -> Tag.decode decompressedObject |> Object.Tag |> ParsedPackObject.Object
-                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
+            packs |> Seq.map (fun (hash, offset, data) -> offset, (hash, data)) |> Map.ofSeq
-            |> Seq.map (fun (hash, offset, data) -> offset, (hash, data))
-            |> Map.ofSeq
 
         let packsByHash =
-            packs
+            packs |> Seq.map (fun (hash, offset, data) -> hash, (offset, data)) |> Map.ofSeq
-            |> 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
+                    sortedObjectPositions |> Array.tryFindIndex (fun pos -> pos > offset)
-                    |> 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)
+                stream.Seek (int64 startingIndex, SeekOrigin.Begin) |> ignore
-                |> ignore
 
                 let nextObjectPosition =
-                    nextObjectIndex
+                    nextObjectIndex |> Option.map (fun i -> sortedObjectPositions.[i])
-                    |> 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
+            toUint remainingBytes + ((uint32 (firstByte % 128uy)) <<< 24)
-            + ((uint32 (firstByte % 128uy)) <<< 24)
             |> PackIndexOffset.LayerFiveEntry
         else
-            toUint remainingBytes
+            toUint remainingBytes + ((uint32 firstByte) <<< 24) |> PackIndexOffset.RawOffset
-            + ((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)
+                packIndex.Seek ((int64 (nameLookup - 1uy)) * 4L, SeekOrigin.Current) |> ignore
-                |> 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)
+            packIndex.Seek (4L + 4L + 255L * 4L, SeekOrigin.Begin) |> ignore
-            |> ignore
 
             Stream.consume packIndex 4 |> toUint |> int64
 
@@ -566,14 +543,7 @@ module PackFile =
         | None -> None
         | Some location ->
 
-        packIndex.Seek (
+        packIndex.Seek (4L + 4L + 256L * 4L + totalCount * 24L + location * 4L, SeekOrigin.Begin)
-            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 (
+                packIndex.Seek (4L + 4L + 256L * 4L + totalCount * 28L + (int64 entry) * 8L, SeekOrigin.Begin)
-                    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 ->
+            | Some subObject -> (subObject, data, hash, metadata) |> PackObject.Delta |> Some
-                (subObject, data, hash, metadata)
+        | Preamble.Offset offset -> (failwith "", data, hash, metadata) |> PackObject.Delta |> Some
-                |> 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
+        )

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
 
 [<RequireQualifiedAccess>]
 module Parse =
@@ -53,9 +53,7 @@ module Parse =
         w, h
 
     let consumePerson (id : string) (s : Stream) =
-        let name =
+        let name = Stream.consumeTo s (byte '<') |> Option.map Encoding.UTF8.GetString
-            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 =
+        let email = Stream.consumeTo s (byte '>') |> Option.map Encoding.UTF8.GetString
-            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 =
+        let offset = Stream.consumeTo s 10uy |> Option.map Encoding.UTF8.GetString
-            Stream.consumeTo s 10uy
-            |> Option.map Encoding.UTF8.GetString
 
         match offset with
         | None -> failwithf "Commit object ended before %s timezone" id

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
+    }
 
 [<RequireQualifiedAccess>]
 module Reference =
@@ -11,29 +18,40 @@ module Reference =
             |> r.Fs.FileInfo.FromFileName
 
         let was =
-            if refFile.Exists then
+            try
-                r.Fs.File.ReadAllText refFile.FullName
+                r.Fs.File.ReadAllText refFile.FullName |> Some
-                |> Hash.ofString
+            with :? FileNotFoundException ->
-                |> Some
-            else
-                do
-                    use _v = refFile.Create ()
-                    ()
-
                 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 =
+        let lookup (name : string) =
-            r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name)
+            let refFile =
-            |> r.Fs.FileInfo.FromFileName
+                r.Fs.Path.Combine ((Repository.gitDir r).FullName, name)
+                |> r.Fs.FileInfo.FromFileName
 
-        if refFile.Exists then
+            try
-            Some (
                 r.Fs.File.ReadAllText refFile.FullName
+                |> String.chopEnd "\n"
                 |> Hash.ofString
-            )
+                |> Some
-        else
+            with
-            None
+            | :? 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

Git/RevParse.fs

@@ -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

Git/String.fs

@@ -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

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
+    | RefDidNotExist of SymbolicRef
-    | MalformedRef of string
+    | 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
+        let text =
-            Error RefDidNotExist
+            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 =
+        r.Fs.File.WriteAllText ((SymbolicRef.getFile r name).FullName, sprintf "ref: %s\n" contents)
-        if not <| contents.StartsWith "refs/" then
+        Ok ()
-            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 =
-
+        let underlyingFile = SymbolicRef.getFile r name
-    let delete (r : Repository) (name : SymbolicRef) : unit = (SymbolicRef.getFile r name).Delete ()
+        underlyingFile.Delete ()

Git/Tag.fs

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

Git/VerifyPack.fs

@@ -11,10 +11,7 @@ type PackVerificationLine =
         let typeString = string<ObjectType> this.Type
 
         let padding =
-            Array.create
+            Array.create (ObjectType.Commit.ToString().Length - typeString.Length) " "
-                (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.Path.Combine (packDir, sprintf "pack-%s.idx" id) |> fs.FileInfo.FromFileName
-            |> fs.FileInfo.FromFileName
 
         let packFile =
-            fs.Path.Combine (packDir, sprintf "pack-%s.pack" id)
+            fs.Path.Combine (packDir, sprintf "pack-%s.pack" id) |> fs.FileInfo.FromFileName
-            |> fs.FileInfo.FromFileName
 
-        let allPacks =
+        let allPacks = PackFile.readIndex index |> PackFile.readAll packFile
-            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 ->
+            fun length -> Map.tryFind length chainCounts |> Option.defaultValue 0
-                Map.tryFind length chainCounts
-                |> Option.defaultValue 0
             |> Array.init (maxChainLength + 1) // for the 0 index
 
         {

global.json

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

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():