From 7a593dd97a9ffc05bb0a8faddda339a6bfe2ef9e Mon Sep 17 00:00:00 2001 From: Patrick Stevens Date: Fri, 2 Sep 2022 22:56:06 +0100 Subject: [PATCH] A bit of professionalisation (#1) --- .config/dotnet-tools.json | 12 ++ .editorconfig | 14 ++ .github/workflows/dotnet.yml | 35 +++++ .github/workflows/dotnetcore.yml | 25 ---- Git.Test/Git.Test.fsproj | 4 +- Git.Test/TestBlob.fs | 22 ++-- Git.Test/TestCommit.fs | 9 +- Git.Test/TestFromGitBook.fs | 220 +++++++++++++++++++------------ Git.Test/TestLog.fs | 7 +- Git.Test/TestObject.fs | 78 +++++------ Git.Test/TestTree.fs | 21 ++- Git.Test/Utils.fs | 56 +++++--- Git/Blob.fs | 3 +- Git/Commands/Log.fs | 13 +- Git/Commit.fs | 127 ++++++++++++------ Git/Domain.fs | 2 - Git/EncodedObject.fs | 62 ++++----- Git/Git.fsproj | 5 +- Git/Hash.fs | 31 +++-- Git/Header.fs | 89 +++++++++---- Git/Object.fs | 25 ++-- Git/Parse.fs | 2 +- Git/Reference.fs | 31 +++-- Git/Repository.fs | 41 +++--- Git/Stream.fs | 39 ++++-- Git/SymbolicReference.fs | 16 ++- Git/Tree.fs | 37 +++--- global.json | 4 + hooks/pre-push | 17 +++ 29 files changed, 662 insertions(+), 385 deletions(-) create mode 100644 .config/dotnet-tools.json create mode 100644 .editorconfig create mode 100644 .github/workflows/dotnet.yml delete mode 100644 .github/workflows/dotnetcore.yml create mode 100644 global.json create mode 100755 hooks/pre-push diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json new file mode 100644 index 0000000..59807bf --- /dev/null +++ b/.config/dotnet-tools.json @@ -0,0 +1,12 @@ +{ + "version": 1, + "isRoot": true, + "tools": { + "fantomas": { + "version": "5.0.0-beta-009", + "commands": [ + "fantomas" + ] + } + } +} diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..adcac9b --- /dev/null +++ b/.editorconfig @@ -0,0 +1,14 @@ +root = true + +[*.{fs,fsi,fsx}] +fsharp_space_before_uppercase_invocation=true +fsharp_space_before_member=true +fsharp_space_before_colon=true +fsharp_space_before_semicolon=true +fsharp_multiline_block_brackets_on_same_column=true +fsharp_newline_between_type_definition_and_members=true +fsharp_experimental_keep_indent_in_branch=true +fsharp_align_function_signature_to_indentation=true +fsharp_alternative_long_member_definitions=true +fsharp_multi_line_lambda_closing_newline=true +fsharp_max_infix_operator_expression=50 diff --git a/.github/workflows/dotnet.yml b/.github/workflows/dotnet.yml new file mode 100644 index 0000000..b0eb411 --- /dev/null +++ b/.github/workflows/dotnet.yml @@ -0,0 +1,35 @@ +name: .NET + +on: + push: + branches: [ master ] + pull_request: + branches: [ master ] + +jobs: + build: + strategy: + matrix: + os: + - ubuntu-latest + - macOS-latest + - windows-latest + + runs-on: ${{matrix.os}} + + steps: + - uses: actions/checkout@v2 + - name: Setup .NET + uses: actions/setup-dotnet@v1 + with: + dotnet-version: 6.0.x + - name: Restore dependencies + run: dotnet restore + - name: Build + run: dotnet build --no-restore + - name: Test + run: dotnet test --no-build --verbosity normal + - name: Prepare .NET tools + run: dotnet tool restore + - name: Run Fantomas + run: ./hooks/pre-push diff --git a/.github/workflows/dotnetcore.yml b/.github/workflows/dotnetcore.yml deleted file mode 100644 index f734ea7..0000000 --- a/.github/workflows/dotnetcore.yml +++ /dev/null @@ -1,25 +0,0 @@ -name: .NET Core - -on: - push: - branches: [ master ] - pull_request: - branches: [ master ] - -jobs: - build: - - runs-on: ubuntu-latest - - steps: - - uses: actions/checkout@v2 - - name: Setup .NET Core - uses: actions/setup-dotnet@v1 - with: - dotnet-version: 3.1.101 - - name: Install dependencies - run: dotnet restore - - name: Build - run: dotnet build --configuration Release --no-restore - - name: Test - run: dotnet test --no-restore --verbosity normal diff --git a/Git.Test/Git.Test.fsproj b/Git.Test/Git.Test.fsproj index 875c805..4faee67 100644 --- a/Git.Test/Git.Test.fsproj +++ b/Git.Test/Git.Test.fsproj @@ -1,10 +1,8 @@ - netcoreapp3.1 - + net6.0 false - false diff --git a/Git.Test/TestBlob.fs b/Git.Test/TestBlob.fs index be0217c..803c069 100644 --- a/Git.Test/TestBlob.fs +++ b/Git.Test/TestBlob.fs @@ -4,13 +4,14 @@ open Git open NUnit.Framework open FsUnitTyped open System +open System.Text open System.IO.Abstractions.TestingHelpers [] module TestBlob = [] let ``Commit hash from Git Book`` () = - let t = "what is up, doc?".ToCharArray () |> Array.map byte + let t = Encoding.ASCII.GetBytes "what is up, doc?" Object.Blob t |> EncodedObject.encode @@ -20,25 +21,26 @@ module TestBlob = [] let ``Write the commit hash to a file`` () = - let t = "what is up, doc?".ToCharArray () |> Array.map byte - let b = - Object.Blob t - |> EncodedObject.encode + let t = Encoding.ASCII.GetBytes "what is up, doc?" + + let b = Object.Blob t |> EncodedObject.encode let fs = MockFileSystem () let dir = fs.Path.GetTempFileName () let gitDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test") - gitDir.Create() + gitDir.Create () - let repo = match Repository.init gitDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e + let repo = + match Repository.init gitDir with + | Ok r -> r + | Error e -> failwithf "Oh no: %+A" e - b - |> EncodedObject.write repo - |> ignore + b |> EncodedObject.write repo |> ignore let backIn = EncodedObject.catFile repo (EncodedObject.hash b) |> EncodedObject.decode + match backIn with | Object.Blob b -> b diff --git a/Git.Test/TestCommit.fs b/Git.Test/TestCommit.fs index 3278207..78a8914 100644 --- a/Git.Test/TestCommit.fs +++ b/Git.Test/TestCommit.fs @@ -14,9 +14,12 @@ module TestCommit = let fs = MockFileSystem () let dir = fs.Path.GetTempFileName () let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test") - versionDir.Create() + versionDir.Create () - let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e + let repo = + match Repository.init versionDir with + | Ok r -> r + | Error e -> failwithf "Oh no: %+A" e let scott = { @@ -31,7 +34,7 @@ module TestCommit = Committer = scott Author = scott CommitMessage = "First commit\n" - Parents = [Hash.ofString "c7929fc1cc938780ffdd9f94e0d364e0ea74f210"] + Parents = [ Hash.ofString "c7929fc1cc938780ffdd9f94e0d364e0ea74f210" ] Tree = Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579" } |> Object.Commit diff --git a/Git.Test/TestFromGitBook.fs b/Git.Test/TestFromGitBook.fs index 55bc950..b635ba2 100644 --- a/Git.Test/TestFromGitBook.fs +++ b/Git.Test/TestFromGitBook.fs @@ -3,6 +3,7 @@ namespace Git.Test open System open System.IO open System.IO.Abstractions.TestingHelpers +open System.Text open NUnit.Framework open FsUnitTyped open Microsoft.FSharp.Data.UnitSystems.SI.UnitNames @@ -17,30 +18,35 @@ module TestFromGitBook = let fs = MockFileSystem () let dir = fs.Path.GetTempFileName () let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test") - versionDir.Create() + versionDir.Create () - let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e + let repo = + match Repository.init versionDir with + | Ok r -> r + | Error e -> failwithf "Oh no: %+A" e // Directory structure is correct: - let objectsDir = fs.Path.Combine (Repository.gitDir(repo).FullName, "objects") |> fs.DirectoryInfo.FromDirectoryName + let objectsDir = + fs.Path.Combine (Repository.gitDir(repo).FullName, "objects") + |> fs.DirectoryInfo.FromDirectoryName + objectsDir.EnumerateDirectories () |> Seq.map (fun d -> d.Name) |> Seq.toList |> List.sort - |> shouldEqual [ - "info" - "pack" - ] + |> shouldEqual [ "info" ; "pack" ] + objectsDir.EnumerateFiles ("*", SearchOption.AllDirectories) |> shouldBeEmpty // Write our first object let h = - "test content\n".ToCharArray () - |> Array.map byte + "test content\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo + h |> shouldEqual (Hash.ofString "d670460b4b4aece5915caf5c68d12f560a9fe3e4") @@ -51,7 +57,10 @@ module TestFromGitBook = |> shouldEqual ("d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4") // Read it back in - match EncodedObject.catFile repo h |> EncodedObject.decode with + match + EncodedObject.catFile repo h + |> EncodedObject.decode + with | Object.Blob b -> b |> Array.map char @@ -62,20 +71,22 @@ module TestFromGitBook = // Version control // TODO - add helper methods for dealing with file contents let h1 = - "version 1\n".ToCharArray () - |> Array.map byte + "version 1\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo + h1 |> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30") let h2 = - "version 2\n".ToCharArray () - |> Array.map byte + "version 2\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo + h2 |> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a") @@ -83,13 +94,17 @@ module TestFromGitBook = |> Seq.map (fun f -> f.Directory.Name, f.Name) |> Seq.toList |> List.sort - |> shouldEqual [ - "1f", "7a7a472abf3dd9643fd615f6da379c4acb3e3a" - "83", "baae61804e65cc73a7201a7252750c76066a30" - "d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4" - ] + |> shouldEqual + [ + "1f", "7a7a472abf3dd9643fd615f6da379c4acb3e3a" + "83", "baae61804e65cc73a7201a7252750c76066a30" + "d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4" + ] - match EncodedObject.catFile repo h1 |> EncodedObject.decode with + match + EncodedObject.catFile repo h1 + |> EncodedObject.decode + with | Object.Blob b -> b |> Array.map char @@ -97,7 +112,10 @@ module TestFromGitBook = |> shouldEqual "version 1\n" | s -> failwithf "Oh no: +%A" s - match EncodedObject.catFile repo h2 |> EncodedObject.decode with + match + EncodedObject.catFile repo h2 + |> EncodedObject.decode + with | Object.Blob b -> b |> Array.map char @@ -117,26 +135,34 @@ module TestFromGitBook = |> Object.Tree |> EncodedObject.encode |> EncodedObject.write repo - tree1 |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579") - match EncodedObject.catFile repo tree1 |> EncodedObject.decode with + tree1 + |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579") + + match + EncodedObject.catFile repo tree1 + |> EncodedObject.decode + with | Object.Tree t -> t |> List.exactlyOne - |> shouldEqual { - Mode = 100644 - Name = "test.txt" - Hash = h1 - } + |> shouldEqual + { + Mode = 100644 + Name = "test.txt" + Hash = h1 + } | s -> failwithf "Oh no: +%A" s let newHash = - "new file\n".ToCharArray () - |> Array.map byte + "new file\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo - newHash |> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92") + + newHash + |> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92") let tree2 = [ @@ -154,23 +180,29 @@ module TestFromGitBook = |> Object.Tree |> EncodedObject.encode |> EncodedObject.write repo - tree2 |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341") - match EncodedObject.catFile repo tree2 |> EncodedObject.decode with + tree2 + |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341") + + match + EncodedObject.catFile repo tree2 + |> EncodedObject.decode + with | Object.Tree t -> t - |> shouldEqual [ - { - Mode = 100644 - Name = "new.txt" - Hash = newHash - } - { - Mode = 100644 - Name = "test.txt" - Hash = h2 - } - ] + |> shouldEqual + [ + { + Mode = 100644 + Name = "new.txt" + Hash = newHash + } + { + Mode = 100644 + Name = "test.txt" + Hash = h2 + } + ] | s -> failwithf "Oh no: +%A" s // and the prefix one @@ -195,28 +227,34 @@ module TestFromGitBook = |> Object.Tree |> EncodedObject.encode |> EncodedObject.write repo - tree3 |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614") - match EncodedObject.catFile repo tree3 |> EncodedObject.decode with + tree3 + |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614") + + match + EncodedObject.catFile repo tree3 + |> EncodedObject.decode + with | Object.Tree t -> t - |> shouldEqual [ - { - Mode = 40000 - Name = "bak" - Hash = tree1 - } - { - Mode = 100644 - Name = "new.txt" - Hash = newHash - } - { - Mode = 100644 - Name = "test.txt" - Hash = h2 - } - ] + |> shouldEqual + [ + { + Mode = 40000 + Name = "bak" + Hash = tree1 + } + { + Mode = 100644 + Name = "new.txt" + Hash = newHash + } + { + Mode = 100644 + Name = "test.txt" + Hash = h2 + } + ] | s -> failwithf "Oh no: +%A" s // TODO: the section on commits @@ -259,14 +297,16 @@ module TestFromGitBook = Committer = scott Author = scott CommitMessage = "Second commit\n" - Parents = [c1Hash] + Parents = [ c1Hash ] Tree = tree2 } |> Object.Commit + let c2Hash = commit2 |> EncodedObject.encode |> EncodedObject.write repo + c2Hash |> Hash.toString |> shouldEqual "1513b13a72f5277252cfce4ed0eda0620aca2f6a" @@ -280,14 +320,16 @@ module TestFromGitBook = Committer = scott Author = scott CommitMessage = "Third commit\n" - Parents = [c2Hash] + Parents = [ c2Hash ] Tree = tree3 } |> Object.Commit + let c3Hash = commit3 |> EncodedObject.encode |> EncodedObject.write repo + c3Hash |> Hash.toString |> shouldEqual "95cce637b4e889eee8042515db402128bd62c0d2" @@ -300,30 +342,31 @@ module TestFromGitBook = |> Seq.map (fun f -> f.Directory.Name, f.Name) |> Seq.toList |> List.sort - |> shouldEqual [ - "01", "55eb4229851634a0f03eb265b69f5a2d56f341" // tree 2 - "15", "13b13a72f5277252cfce4ed0eda0620aca2f6a" // commit 2 - "1f", "7a7a472abf3dd9643fd615f6da379c4acb3e3a" // test.txt v2 - "3c", "4e9cd789d88d8d89c1073707c3585e41b0e614" // tree 3 - "70", "d4408b5020e81d19906d6abdd87a73233ebf34" // commit 1 - "83", "baae61804e65cc73a7201a7252750c76066a30" // test.txt v1 - "95", "cce637b4e889eee8042515db402128bd62c0d2" // commit 3 - "d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4" // 'test content' - "d8", "329fc1cc938780ffdd9f94e0d364e0ea74f579" // tree 1 - "fa", "49b077972391ad58037050f2a75f74e3671e92" // new.txt - ] + |> shouldEqual + [ + "01", "55eb4229851634a0f03eb265b69f5a2d56f341" // tree 2 + "15", "13b13a72f5277252cfce4ed0eda0620aca2f6a" // commit 2 + "1f", "7a7a472abf3dd9643fd615f6da379c4acb3e3a" // test.txt v2 + "3c", "4e9cd789d88d8d89c1073707c3585e41b0e614" // tree 3 + "70", "d4408b5020e81d19906d6abdd87a73233ebf34" // commit 1 + "83", "baae61804e65cc73a7201a7252750c76066a30" // test.txt v1 + "95", "cce637b4e889eee8042515db402128bd62c0d2" // commit 3 + "d6", "70460b4b4aece5915caf5c68d12f560a9fe3e4" // 'test content' + "d8", "329fc1cc938780ffdd9f94e0d364e0ea74f579" // tree 1 + "fa", "49b077972391ad58037050f2a75f74e3671e92" // new.txt + ] // References - let refsDir = fs.Path.Combine (Repository.gitDir(repo).FullName, "refs") |> fs.DirectoryInfo.FromDirectoryName + let refsDir = + fs.Path.Combine (Repository.gitDir(repo).FullName, "refs") + |> fs.DirectoryInfo.FromDirectoryName + refsDir.EnumerateDirectories ("*", SearchOption.AllDirectories) |> Seq.map (fun i -> i.Name) |> Seq.toList |> List.sort - |> shouldEqual [ - "heads" - "tags" - ] + |> shouldEqual [ "heads" ; "tags" ] c3Hash |> Reference.write repo "master" @@ -334,11 +377,16 @@ module TestFromGitBook = |> Reference.write repo "test" |> shouldEqual { Was = None ; Now = c2Hash } - let exn = Assert.Throws (fun () -> SymbolicReference.write repo SymbolicRef.Head "test") - exn.Message |> shouldEqual "refusing to point HEAD outside of refs/" + let exn = + Assert.Throws (fun () -> SymbolicReference.write repo SymbolicRef.Head "test") + + exn.Message + |> shouldEqual "refusing to point HEAD outside of refs/" SymbolicReference.write repo SymbolicRef.Head "refs/heads/test" - repo.Fs.Path.Combine ((Repository.gitDir repo).FullName, "HEAD") |> repo.Fs.File.ReadAllText + + repo.Fs.Path.Combine ((Repository.gitDir repo).FullName, "HEAD") + |> repo.Fs.File.ReadAllText |> shouldEqual "ref: refs/heads/test" SymbolicReference.lookup repo SymbolicRef.Head diff --git a/Git.Test/TestLog.fs b/Git.Test/TestLog.fs index 88fb912..053bc59 100644 --- a/Git.Test/TestLog.fs +++ b/Git.Test/TestLog.fs @@ -14,9 +14,12 @@ module TestLog = let fs = MockFileSystem () let dir = fs.Path.GetTempFileName () let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test") - versionDir.Create() + versionDir.Create () - let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e + let repo = + match Repository.init versionDir with + | Ok r -> r + | Error e -> failwithf "Oh no: %+A" e let commits = Utils.gitBookSetup repo diff --git a/Git.Test/TestObject.fs b/Git.Test/TestObject.fs index fa884b2..e39dc92 100644 --- a/Git.Test/TestObject.fs +++ b/Git.Test/TestObject.fs @@ -1,8 +1,9 @@ namespace Git.Test open System -open System.Collections.Generic open System.IO.Abstractions.TestingHelpers +open System.Runtime.InteropServices +open System.Text open NUnit.Framework open FsUnitTyped open FsCheck @@ -12,66 +13,69 @@ open Git module TestObject = let private intToChar (i : int) (upper : bool) : char = - if i < 10 then (byte i + byte '0') else (byte i - 10uy + byte (if upper then 'A' else 'a')) + if i < 10 then + (byte i + byte '0') + else + (byte i - 10uy + byte (if upper then 'A' else 'a')) |> char + let private boolGen : Gen = Gen.choose (0, 1) |> Gen.map ((=) 1) + let hashPrefixGenerator (len : byte) = gen { - let! n = Gen.choose (0, int len) - let! c = Gen.listOfLength n (Gen.zip (Gen.choose (0, 15)) (Gen.choose (0, 1) |> Gen.map (fun i -> i = 0))) - let ans = c |> List.map (fun (i, u) -> intToChar i u) |> Array.ofList - return String ans + let! prefixLength = Gen.choose (0, int len) + + let! hash = + gen { + let! isUpper = boolGen + let! hexDigit = Gen.choose (0, 15) + return intToChar hexDigit isUpper + } + |> Gen.listOfLength prefixLength + + return String (Array.ofList hash) } - let prefixesOf (s : string) : Gen = - Gen.choose (0, s.Length) - |> Gen.map (fun i -> s.Substring(0, i)) - - [] - let ``prefixesOf generates prefixes`` () = - let property (s1 : string, pref : string) = - s1.StartsWith pref - - let gen = - gen { - let! s = Arb.Default.String().Generator |> Gen.filter (fun i -> not <| Object.ReferenceEquals (i, null)) - let! pref = prefixesOf s - return (s, pref) - } - - property - |> Prop.forAll (Arb.fromGen gen) - |> Check.QuickThrowOnFailure - [] let ``Can look up a partial hash`` () = let fs = MockFileSystem () let dir = fs.Path.GetTempFileName () let versionDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test") - versionDir.Create() + versionDir.Create () - let repo = match Repository.init versionDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e + let repo = + match Repository.init versionDir with + | Ok r -> r + | Error e -> failwithf "Oh no: %+A" e let h = - "test content\n".ToCharArray () - |> Array.map byte + "test content\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo + let expected = "d670460b4b4aece5915caf5c68d12f560a9fe3e4" let expectedHash = Hash.ofString expected - h - |> shouldEqual (Hash.ofString expected) + h |> shouldEqual (Hash.ofString expected) let property (prefix : string) : bool = - if expected.StartsWith prefix then - Object.disambiguate repo prefix = [expectedHash] + let isMatch = + if RuntimeInformation.IsOSPlatform OSPlatform.Windows then + // Windows filesystem is case-insensitive + expected.StartsWith (prefix, StringComparison.InvariantCultureIgnoreCase) + else + expected.StartsWith prefix + + if isMatch then + Object.disambiguate repo prefix = [ expectedHash ] else Object.disambiguate repo prefix = [] property |> Prop.forAll (Arb.fromGen (hashPrefixGenerator 40uy)) |> Check.QuickThrowOnFailure - property - |> Prop.forAll (Arb.fromGen (prefixesOf expected)) - |> Check.QuickThrowOnFailure + + for subStringEnd in 0 .. expected.Length - 1 do + property expected.[0..subStringEnd] + |> shouldEqual true diff --git a/Git.Test/TestTree.fs b/Git.Test/TestTree.fs index ff4adb0..f68cac6 100644 --- a/Git.Test/TestTree.fs +++ b/Git.Test/TestTree.fs @@ -39,26 +39,25 @@ module TestTree = Mode = 40000 } ] - let b = - Object.Tree t - |> EncodedObject.encode + + let b = Object.Tree t |> EncodedObject.encode let fs = MockFileSystem () let dir = fs.Path.GetTempFileName () let gitDir = fs.DirectoryInfo.FromDirectoryName (dir + "_test") - gitDir.Create() + gitDir.Create () - let repo = match Repository.init gitDir with | Ok r -> r | Error e -> failwithf "Oh no: %+A" e + let repo = + match Repository.init gitDir with + | Ok r -> r + | Error e -> failwithf "Oh no: %+A" e - b - |> EncodedObject.write repo - |> ignore + b |> EncodedObject.write repo |> ignore let backIn = EncodedObject.catFile repo (EncodedObject.hash b) |> EncodedObject.decode + match backIn with - | Object.Tree entries -> - entries - |> shouldEqual t + | Object.Tree entries -> entries |> shouldEqual t | _ -> failwithf "Oh no: %+A" backIn diff --git a/Git.Test/Utils.fs b/Git.Test/Utils.fs index e5785df..1fb12df 100644 --- a/Git.Test/Utils.fs +++ b/Git.Test/Utils.fs @@ -1,5 +1,6 @@ namespace Git.Test +open System.Text open Git open FsUnitTyped open Microsoft.FSharp.Data.UnitSystems.SI.UnitNames @@ -9,20 +10,22 @@ module Utils = let gitBookSetup (repo : Repository) : Map = let h1 = - "version 1\n".ToCharArray () - |> Array.map byte + "version 1\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo + h1 |> shouldEqual (Hash.ofString "83baae61804e65cc73a7201a7252750c76066a30") let h2 = - "version 2\n".ToCharArray () - |> Array.map byte + "version 2\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo + h2 |> shouldEqual (Hash.ofString "1f7a7a472abf3dd9643fd615f6da379c4acb3e3a") @@ -38,15 +41,19 @@ module Utils = |> Object.Tree |> EncodedObject.encode |> EncodedObject.write repo - tree1 |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579") + + tree1 + |> shouldEqual (Hash.ofString "d8329fc1cc938780ffdd9f94e0d364e0ea74f579") let newHash = - "new file\n".ToCharArray () - |> Array.map byte + "new file\n" + |> Encoding.ASCII.GetBytes |> Object.Blob |> EncodedObject.encode |> EncodedObject.write repo - newHash |> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92") + + newHash + |> shouldEqual (Hash.ofString "fa49b077972391ad58037050f2a75f74e3671e92") let tree2 = [ @@ -64,7 +71,9 @@ module Utils = |> Object.Tree |> EncodedObject.encode |> EncodedObject.write repo - tree2 |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341") + + tree2 + |> shouldEqual (Hash.ofString "0155eb4229851634a0f03eb265b69f5a2d56f341") // and the prefix one let tree3 = @@ -88,7 +97,9 @@ module Utils = |> Object.Tree |> EncodedObject.encode |> EncodedObject.write repo - tree3 |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614") + + tree3 + |> shouldEqual (Hash.ofString "3c4e9cd789d88d8d89c1073707c3585e41b0e614") let scott = { @@ -112,6 +123,7 @@ module Utils = commit1 |> EncodedObject.encode |> EncodedObject.write repo + c1Hash |> Hash.toString |> shouldEqual "70d4408b5020e81d19906d6abdd87a73233ebf34" @@ -121,14 +133,16 @@ module Utils = Committer = scott Author = scott CommitMessage = "Second commit\n" - Parents = [c1Hash] + Parents = [ c1Hash ] Tree = tree2 } |> Object.Commit + let c2Hash = commit2 |> EncodedObject.encode |> EncodedObject.write repo + c2Hash |> Hash.toString |> shouldEqual "1513b13a72f5277252cfce4ed0eda0620aca2f6a" @@ -138,22 +152,32 @@ module Utils = Committer = scott Author = scott CommitMessage = "Third commit\n" - Parents = [c2Hash] + Parents = [ c2Hash ] Tree = tree3 } |> Object.Commit + let c3Hash = commit3 |> EncodedObject.encode |> EncodedObject.write repo + c3Hash |> Hash.toString |> shouldEqual "95cce637b4e889eee8042515db402128bd62c0d2" [ - c1Hash, match commit1 with | Object.Commit c -> c | _ -> failwith "" - c2Hash, match commit2 with | Object.Commit c -> c | _ -> failwith "" - c3Hash, match commit3 with | Object.Commit c -> c | _ -> failwith "" + c1Hash, + match commit1 with + | Object.Commit c -> c + | _ -> failwith "" + c2Hash, + match commit2 with + | Object.Commit c -> c + | _ -> failwith "" + c3Hash, + match commit3 with + | Object.Commit c -> c + | _ -> failwith "" ] |> Map.ofList - diff --git a/Git/Blob.fs b/Git/Blob.fs index e649130..da32a28 100644 --- a/Git/Blob.fs +++ b/Git/Blob.fs @@ -3,5 +3,4 @@ [] module Blob = let encode (content : byte array) : byte array = content - let decode (file : byte array) : byte array = - file + let decode (file : byte array) : byte array = file diff --git a/Git/Commands/Log.fs b/Git/Commands/Log.fs index 08fbd8a..157fcb5 100644 --- a/Git/Commands/Log.fs +++ b/Git/Commands/Log.fs @@ -9,18 +9,25 @@ module Log = let rec log (h : Hash) (c : CommitEntry) : seq = seq { yield (h, c) + yield! c.Parents |> List.map (fun i -> - match EncodedObject.catFile repo i |> EncodedObject.decode with + match + EncodedObject.catFile repo i + |> EncodedObject.decode + with | Object.Commit c -> (i, c) - | s -> failwithf "Not a commit: %O (%+A)" i s) + | s -> failwithf "Not a commit: %O (%+A)" i s + ) |> Seq.collect (fun (i, c) -> log i c) } h |> EncodedObject.catFile repo |> EncodedObject.decode - |> function | Object.Commit h -> h | s -> failwithf "Not a commit: %+A" s + |> function + | Object.Commit h -> h + | s -> failwithf "Not a commit: %+A" s |> log h |> Map.ofSeq diff --git a/Git/Commit.fs b/Git/Commit.fs index e0574b3..e870277 100644 --- a/Git/Commit.fs +++ b/Git/Commit.fs @@ -2,6 +2,7 @@ namespace Git open System open System.IO +open System.Text open Microsoft.FSharp.Data.UnitSystems.SI.UnitNames open Git.Internals @@ -12,6 +13,7 @@ type Contributor = Date : int DateTimezone : string } + override this.ToString () = sprintf "%s <%s> %i %s" this.Name this.Email this.Date this.DateTimezone @@ -23,11 +25,14 @@ type CommitEntry = Author : Contributor CommitMessage : string } + override this.ToString () = sprintf "tree %O\n%sauthor %O\ncommitter %O\n\n%s" this.Tree - (this.Parents |> List.map (Hash.toString >> sprintf "parent %s\n") |> String.concat "\n") + (this.Parents + |> List.map (Hash.toString >> sprintf "parent %s\n") + |> String.concat "\n") this.Author this.Committer this.CommitMessage @@ -35,57 +40,84 @@ type CommitEntry = // TODO - implement signed commits too [] module Commit = + + let private assertValid (context : string) (s : string) : unit = + if s.IndexOfAny [| '<' ; '\n' |] > 0 then + failwithf "%s '%s' contains forbidden character" context s + let encode (content : CommitEntry) : byte array = - if content.Author.Name.Contains '<' || content.Author.Name.Contains '\n' then - failwithf "Author name '%s' contains forbidden character" content.Author.Name - if content.Committer.Name.Contains '<' || content.Committer.Name.Contains '\n' then - failwithf "Committer name '%s' contains forbidden character" content.Committer.Name - if content.Author.Email.Contains '>' || content.Author.Email.Contains '\n' then - failwithf "Author email '%s' contains forbidden character" content.Author.Email - if content.Committer.Email.Contains '>' || content.Committer.Email.Contains '\n' then - failwithf "Committer email '%s' contains forbidden character" content.Committer.Email + assertValid "Author name" content.Author.Name + assertValid "Committer name" content.Committer.Name + assertValid "Author email" content.Author.Email + assertValid "Committer email" content.Committer.Email + seq { yield sprintf "tree %s" (Hash.toString content.Tree) - yield! content.Parents |> List.map (Hash.toString >> sprintf "parent %s") |> Array.ofList - yield sprintf "author %s <%s> %i %s" content.Author.Name content.Author.Email content.Author.Date content.Author.DateTimezone - yield sprintf "committer %s <%s> %i %s" content.Committer.Name content.Committer.Email content.Committer.Date content.Committer.DateTimezone + + yield! + content.Parents + |> List.map (Hash.toString >> sprintf "parent %s") + |> Array.ofList + + yield + sprintf + "author %s <%s> %i %s" + content.Author.Name + content.Author.Email + content.Author.Date + content.Author.DateTimezone + + yield + sprintf + "committer %s <%s> %i %s" + content.Committer.Name + content.Committer.Email + content.Committer.Date + content.Committer.DateTimezone + yield sprintf "\n%s" content.CommitMessage } |> String.concat "\n" - |> fun s -> s.ToCharArray () - |> Array.map byte + // TODO: assumption that may not be compatible with Git: UTF8 is used for names, emails etc + |> Encoding.UTF8.GetBytes let private parseInt (chars : byte array) = let rec acc (i : int) (soFar : int) = - if i = chars.Length then soFar else - if byte '0' <= chars.[i] && chars.[i] <= byte '9' then + if i = chars.Length then + soFar + else if byte '0' <= chars.[i] && chars.[i] <= byte '9' then acc (i + 1) (10 * soFar + int (chars.[i] - byte '0')) - else failwithf "non-digit character '%i' ('%c') at index %i" chars.[i] (char chars.[i]) i + else + failwithf "non-digit character '%i' ('%c') at index %i" chars.[i] (char chars.[i]) i + acc 0 0 let decode (file : byte array) : CommitEntry = - use ms = new MemoryStream(file) + use ms = new MemoryStream (file) let consumeWord (OneOf expecting) = let word = Stream.consumeTo ms 32uy + match word with | None -> - failwithf "Expected a word '%s' in a commit object, but stream ran out" (expecting |> String.concat "//") + failwithf + "Expected a word '%s' in a commit object, but stream ran out" + (expecting |> String.concat "//") | Some word -> - let word = - word - |> Array.map char - |> String + + let word = word |> Array.map char |> String + if not <| List.contains word expecting then failwithf "Expected a word '%s' in a commit object, but got '%s'" (expecting |> String.concat "//") word + word let consumeHash (context : string) = let hash = Stream.consumeTo ms 10uy + match hash with | None -> failwithf "Stream ended before we could read hash in context '%s'." context - | Some hash -> - hash |> Hash.ofSpelling + | Some hash -> hash |> Hash.ofSpelling let consumeLabelledHash (expecting : OneOf) : string * Hash = let w = consumeWord (expecting) @@ -93,33 +125,47 @@ module Commit = w, h let consumePerson (id : string) = - let name = Stream.consumeTo ms (byte '<') |> Option.map (Array.map char >> String) + let name = + Stream.consumeTo ms (byte '<') + |> Option.map (Array.map char >> String) + match name with - | None -> - failwithf "No %s name present in commit object." id + | None -> failwithf "No %s name present in commit object." id | Some name -> + if name.[name.Length - 1] <> ' ' then failwithf "Name of %s '%s' unexpectedly fails to end with a space" id name + let name = name.Substring (0, name.Length - 1) - let email = Stream.consumeTo ms (byte '>') |> Option.map (Array.map char >> String) + let email = + Stream.consumeTo ms (byte '>') + |> Option.map (Array.map char >> String) + match email with - | None -> - failwithf "No %s email present in commit object." id + | None -> failwithf "No %s email present in commit object." id | Some email -> let space = Stream.consumeTo ms 32uy + match space with | None -> failwithf "Commit object ended after %s email" id - | Some s -> if s.Length <> 0 then failwithf "Expected a space immediately after %s email, got '%s'" id (s |> Array.map char |> String) + | Some s -> + if s.Length <> 0 then + failwithf "Expected a space immediately after %s email, got '%s'" id (s |> Array.map char |> String) let timestamp = Stream.consumeTo ms 32uy + match timestamp with | None -> failwithf "Commit object ended before %s timestamp" id | Some timestamp -> + let timestamp = parseInt timestamp * 1 - let offset = Stream.consumeTo ms 10uy |> Option.map (Array.map char >> String) + let offset = + Stream.consumeTo ms 10uy + |> Option.map (Array.map char >> String) + match offset with | None -> failwithf "Commit object ended before %s timezone" id | Some offset -> @@ -131,13 +177,15 @@ module Commit = DateTimezone = offset } - let treeWord, treeHash = consumeLabelledHash (OneOf ["tree"]) + let treeWord, treeHash = consumeLabelledHash (OneOf [ "tree" ]) + if treeWord <> "tree" then failwithf "Malformed tree indicator '%s'" treeWord let parents, author = let rec consumeParentsAndAuthor (parents : Hash list) = - let w = consumeWord (OneOf ["author" ; "parent" ]) + let w = consumeWord (OneOf [ "author" ; "parent" ]) + if w = "parent" then let parent = consumeHash "parent" consumeParentsAndAuthor (parent :: parents) @@ -149,13 +197,18 @@ module Commit = consumeParentsAndAuthor [] - let _ = consumeWord (OneOf ["committer"]) + let _ = consumeWord (OneOf [ "committer" ]) let committer = consumePerson "committer" let trailingNewline = Stream.consumeTo ms 10uy + match trailingNewline with | None -> failwith "Commit object ended at end of committer" - | Some s -> if s.Length <> 0 then failwithf "Expected an extra newline immediately after committer, got %s" (s |> Array.map char |> String) + | Some s -> + if s.Length <> 0 then + failwithf + "Expected an extra newline immediately after committer, got %s" + (s |> Array.map char |> String) let message = Stream.consumeToEnd ms |> Array.map char |> String //if message.[message.Length - 1] <> '\n' then diff --git a/Git/Domain.fs b/Git/Domain.fs index 016cc03..f07ff58 100644 --- a/Git/Domain.fs +++ b/Git/Domain.fs @@ -1,3 +1 @@ namespace Git - - diff --git a/Git/EncodedObject.fs b/Git/EncodedObject.fs index 37ccf12..7c4f9b6 100644 --- a/Git/EncodedObject.fs +++ b/Git/EncodedObject.fs @@ -1,8 +1,8 @@ namespace Git open System.IO +open System.IO.Compression open System.Security.Cryptography -open Ionic.Zlib type EncodedObject = { @@ -22,41 +22,31 @@ module EncodedObject = { Header = match o with - | Object.Blob _ -> - Header.Blob contents.Length - | Object.Tree _ -> - Header.Tree contents.Length - | Object.Commit _ -> - Header.Commit contents.Length + | Object.Blob _ -> Header.Blob contents.Length + | Object.Tree _ -> Header.Tree contents.Length + | Object.Commit _ -> Header.Commit contents.Length Content = contents } let decode (e : EncodedObject) : Git.Object = match e.Header with - | Header.Tree _ -> - Tree.decode e.Content - |> Object.Tree - | Header.Blob _ -> - Blob.decode e.Content - |> Object.Blob - | Header.Commit _ -> - Commit.decode e.Content - |> Object.Commit + | Header.Tree _ -> Tree.decode e.Content |> Object.Tree + | Header.Blob _ -> Blob.decode e.Content |> Object.Blob + | Header.Commit _ -> Commit.decode e.Content |> Object.Commit let hash (o : EncodedObject) : Hash = use hasher = SHA1.Create () let content = Array.concat [| Header.toBytes o.Header ; o.Content |] - hasher.ComputeHash content - |> Hash.ofBytes + hasher.ComputeHash content |> Hash.ofBytes let private compress (o : EncodedObject) (dest : Stream) : unit = let toWrite = [| Header.toBytes o.Header ; o.Content |] |> Array.concat - use ms = new MemoryStream(toWrite) - use ds = new Ionic.Zlib.ZlibStream(dest, CompressionMode.Compress, CompressionLevel.Level0) + use ms = new MemoryStream (toWrite) + use ds = new DeflateStream (dest, CompressionMode.Compress) ms.CopyTo ds /// Read the header of the stream seeked to the beginning of the content. @@ -64,46 +54,52 @@ module EncodedObject = let rec bytes () : byte seq = seq { let newByte = s.Read () - if newByte < 0 then failwith "ran out of bytes" + + if newByte < 0 then + failwith "ran out of bytes" elif newByte > 0 then yield (byte newByte) yield! bytes () - // stop reading the header at the 0 byte + // stop reading the header at the 0 byte } - match bytes () |> Seq.toArray |> Header.ofBytes with - | None -> - failwith "malformed header" + match bytes () |> Seq.toArray |> Header.ofAsciiBytes with + | None -> failwith "malformed header" | Some b -> b let private uncompress (s : Stream) : EncodedObject = use ms = new MemoryStream () - use ds = new Ionic.Zlib.ZlibStream(s, CompressionMode.Decompress) + use ds = new DeflateStream (s, CompressionMode.Decompress) ds.CopyTo ms - ms.Seek(0L, SeekOrigin.Begin) |> ignore + ms.Seek (0L, SeekOrigin.Begin) |> ignore - use r = new BinaryReader(ms) + use r = new BinaryReader (ms) let header = consumeHeader r + let expectedLength = match header with | Header.Blob i -> i | Header.Tree i -> i | Header.Commit i -> i + let result = { Header = header Content = r.ReadBytes expectedLength } - if r.PeekChar () <> -1 then failwith "unexpectedly not at end" + + if r.PeekChar () <> -1 then + failwith "unexpectedly not at end" + result let write (r : Repository) (o : EncodedObject) : Hash = let hash = hash o let hashStr = Hash.toString hash let objectName = hashStr.[2..] - let subdir = hashStr.[0..1] + let subDir = hashStr.[0..1] - let d = Repository.createSubdir (Repository.objectDir r) subdir + let d = Repository.createSubdir (Repository.objectDir r) subDir use filestream = r.Fs.File.Create (r.Fs.Path.Combine (d.FullName, objectName)) compress o filestream @@ -113,10 +109,10 @@ module EncodedObject = let catFile (r : Repository) (hash : Hash) : EncodedObject = let hash = hash |> Hash.toString let objectName = hash.[2..] - let subdir = hash.[0..1] + let subDir = hash.[0..1] use filestream = - r.Fs.Path.Combine ((Repository.objectDir r).FullName, subdir, objectName) + r.Fs.Path.Combine ((Repository.objectDir r).FullName, subDir, objectName) |> r.Fs.File.OpenRead uncompress filestream diff --git a/Git/Git.fsproj b/Git/Git.fsproj index 8660364..c8f1ad7 100644 --- a/Git/Git.fsproj +++ b/Git/Git.fsproj @@ -1,7 +1,8 @@  - netcoreapp3.1 + netstandard2.0 + true @@ -22,8 +23,8 @@ - + diff --git a/Git/Hash.fs b/Git/Hash.fs index bb3c041..8829192 100644 --- a/Git/Hash.fs +++ b/Git/Hash.fs @@ -6,18 +6,23 @@ open System.Text type Hash = | Hash of byte list + override this.ToString () = match this with | Hash h -> + let t = StringBuilder (List.length h * 2) + h - |> List.iter (fun b -> t.AppendFormat ("{0:x2}" , b) |> ignore) + |> List.iter (fun b -> t.AppendFormat ("{0:x2}", b) |> ignore) + t.ToString () [] module Hash = let ofBytes s = s |> Seq.toList |> Hash + let ofString (s : string) : Hash = let rec b (pos : int) = seq { @@ -25,17 +30,22 @@ module Hash = yield Byte.Parse (s.Substring (pos, 2), NumberStyles.AllowHexSpecifier) yield! b (pos + 2) } - b 0 - |> ofBytes + + b 0 |> ofBytes // Given a byte array of *characters* spelling out e.g. 'b' 'd' '6' '3', return the hash this is spelling out. let ofSpelling (input : byte array) : Hash = let inline value (b : byte) = let c = char b - if '0' <= c && c <= '9' then b - byte '0' - elif 'A' <= c && c <= 'F' then b - (byte 'A') + 10uy - elif 'a' <= c && c <= 'f' then b - (byte 'a') + 10uy - else failwithf "Byte '%i' ('%c') is not a hex digit" b (char b) + + if '0' <= c && c <= '9' then + b - byte '0' + elif 'A' <= c && c <= 'F' then + b - (byte 'A') + 10uy + elif 'a' <= c && c <= 'f' then + b - (byte 'a') + 10uy + else + failwithf "Byte '%i' ('%c') is not a hex digit" b (char b) let rec b (pos : int) = seq { @@ -43,8 +53,7 @@ module Hash = yield value (input.[pos]) * 16uy + value input.[pos + 1] yield! b (pos + 2) } - b 0 - |> ofBytes - let toString (h : Hash) : string = - h.ToString () \ No newline at end of file + b 0 |> ofBytes + + let toString (h : Hash) : string = h.ToString () diff --git a/Git/Header.fs b/Git/Header.fs index c29eab0..b13ebf9 100644 --- a/Git/Header.fs +++ b/Git/Header.fs @@ -1,43 +1,74 @@ namespace Git -open System - type Header = | Blob of int // length of content | Tree of int // length of content | Commit of int // length of content - // | Tag +// | Tag [] module internal Header = + let private parseIntFromAsciiBytes (startIndex : int) (a : byte array) = + let mutable acc = 0 + + for i in startIndex .. a.Length - 1 do + acc <- 10 * acc + int (a.[i] + byte '0') + + acc + let toBytes (h : Header) : byte array = let s = match h with - | Header.Blob length -> - // TODO - internationalisation issue here - sprintf "blob %i" length - | Header.Tree length -> - sprintf "tree %i" length - | Header.Commit length -> - sprintf "commit %i" length - [| - s.ToCharArray () |> Array.map byte - [| 0uy |] - |] - |> Array.concat + | Header.Blob length -> sprintf "blob %i" length + | Header.Tree length -> sprintf "tree %i" length + | Header.Commit length -> sprintf "commit %i" length - let ofBytes (s : byte array) : Header option = - if s.[0..3] = ("blob".ToCharArray () |> Array.map byte) then - let number = s.[5..] |> Array.map char |> String |> Int32.Parse - Header.Blob number - |> Some - elif s.[0..3] = ("tree".ToCharArray () |> Array.map byte) then - let number = s.[5..] |> Array.map char |> String |> Int32.Parse - Header.Tree number - |> Some - elif s.[0..5] = ("commit".ToCharArray () |> Array.map byte) then - let number = s.[7..] |> Array.map char |> String |> Int32.Parse - Header.Commit number - |> Some - else None + // If perf critical, could optimise allocation here + Array.append (System.Text.Encoding.ASCII.GetBytes s) [| 0uy |] + + let ofAsciiBytes (s : byte array) : Header option = + if s.Length <= 5 then + None + else + match s.[0] with + | 98uy -> + // 'b', then "lob " + if + s.[1] = 108uy + && s.[2] = 111uy + && s.[3] = 98uy + && s.[4] = 32uy + then + let number = parseIntFromAsciiBytes 5 s + Header.Blob number |> Some + else + None + | 116uy -> + // 't', then "ree " + if + s.[1] = 114uy + && s.[2] = 101uy + && s.[3] = 101uy + && s.[4] = 32uy + then + let number = parseIntFromAsciiBytes 5 s + Header.Tree number |> Some + else + None + | 99uy -> + // 'c', then "ommit " + if + s.Length > 7 + && s.[1] = 111uy + && s.[2] = 109uy + && s.[3] = 109uy + && s.[4] = 105uy + && s.[5] = 116uy + && s.[6] = 32uy + then + let number = parseIntFromAsciiBytes 7 s + Header.Commit number |> Some + else + None + | _ -> None diff --git a/Git/Object.fs b/Git/Object.fs index b8e0455..9e66dfa 100644 --- a/Git/Object.fs +++ b/Git/Object.fs @@ -9,43 +9,48 @@ type Object = override this.ToString () = match this with - | Blob b -> - sprintf "blob: %+A" b + | Blob b -> sprintf "blob: %+A" b | Tree t -> t |> List.map (fun i -> i.ToString ()) |> String.concat "\n" |> sprintf "tree:\n%+A" - | Commit c -> - sprintf "commit:\n%O" c + | Commit c -> sprintf "commit:\n%O" c [] module Object = /// Get the object hashes which match this start. let disambiguate (r : Repository) (startOfHash : string) : Hash list = match startOfHash.Length with - | 0 -> - (Repository.objectDir r).EnumerateFiles("*", SearchOption.AllDirectories) + | 0 -> (Repository.objectDir r).EnumerateFiles ("*", SearchOption.AllDirectories) | 1 -> - (Repository.objectDir r).EnumerateFiles("*", SearchOption.AllDirectories) - |> Seq.filter (fun i -> i.Directory.Name.StartsWith startOfHash.[0]) + (Repository.objectDir r).EnumerateFiles ("*", SearchOption.AllDirectories) + |> Seq.filter (fun i -> + i.Directory.Name.Length > 0 + && i.Directory.Name.[0] = startOfHash.[0] + ) | 2 -> let subDir = r.Fs.Path.Combine ((Repository.objectDir r).FullName, startOfHash) |> r.Fs.DirectoryInfo.FromDirectoryName + if subDir.Exists then subDir.EnumerateFiles () - else Seq.empty + else + Seq.empty | _ -> let prefix = startOfHash.Substring (0, 2) let suffix = startOfHash.Substring (2, startOfHash.Length - 2) + let subDir = r.Fs.Path.Combine ((Repository.objectDir r).FullName, prefix) |> r.Fs.DirectoryInfo.FromDirectoryName + if subDir.Exists then subDir.EnumerateFiles () |> Seq.filter (fun i -> i.Name.StartsWith suffix) - else Seq.empty + else + Seq.empty |> Seq.map (fun i -> sprintf "%s%s" i.Directory.Name i.Name) |> Seq.map Hash.ofString diff --git a/Git/Parse.fs b/Git/Parse.fs index fd2632a..dcc3f3c 100644 --- a/Git/Parse.fs +++ b/Git/Parse.fs @@ -1,3 +1,3 @@ namespace Git.Internals -type OneOf = OneOf of string list \ No newline at end of file +type OneOf = OneOf of string list diff --git a/Git/Reference.fs b/Git/Reference.fs index 3f00cfc..da97384 100644 --- a/Git/Reference.fs +++ b/Git/Reference.fs @@ -1,16 +1,15 @@ namespace Git -type ReferenceUpdate = - { - Was : Hash option - Now : Hash - } +type ReferenceUpdate = { Was : Hash option ; Now : Hash } [] module Reference = let write (r : Repository) (name : string) (hash : Hash) : ReferenceUpdate = - let refFile = r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name) |> r.Fs.FileInfo.FromFileName + let refFile = + r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name) + |> r.Fs.FileInfo.FromFileName + let was = if refFile.Exists then r.Fs.File.ReadAllText refFile.FullName @@ -20,13 +19,21 @@ module Reference = do use _v = refFile.Create () () + None + r.Fs.File.WriteAllText (refFile.FullName, hash.ToString ()) - { - Was = was - Now = hash - } + { Was = was ; Now = hash } let lookup (r : Repository) (name : string) : Hash option = - let refFile = r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name) |> r.Fs.FileInfo.FromFileName - if refFile.Exists then Some (r.Fs.File.ReadAllText refFile.FullName |> Hash.ofString) else None + let refFile = + r.Fs.Path.Combine ((Repository.refDir r).FullName, "heads", name) + |> r.Fs.FileInfo.FromFileName + + if refFile.Exists then + Some ( + r.Fs.File.ReadAllText refFile.FullName + |> Hash.ofString + ) + else + None diff --git a/Git/Repository.fs b/Git/Repository.fs index b435e40..9595ac5 100644 --- a/Git/Repository.fs +++ b/Git/Repository.fs @@ -8,6 +8,7 @@ type Repository = { Directory : IDirectoryInfo } + member this.Fs = this.Directory.FileSystem type InitFailure = @@ -17,35 +18,47 @@ type InitFailure = [] module Repository = let gitDir (r : Repository) : IDirectoryInfo = - r.Fs.Path.Combine(r.Directory.FullName, ".git") |> r.Fs.DirectoryInfo.FromDirectoryName + r.Fs.Path.Combine (r.Directory.FullName, ".git") + |> r.Fs.DirectoryInfo.FromDirectoryName let internal objectDir (r : Repository) : IDirectoryInfo = - r.Fs.Path.Combine((gitDir r).FullName, "objects") |> r.Fs.DirectoryInfo.FromDirectoryName + r.Fs.Path.Combine ((gitDir r).FullName, "objects") + |> r.Fs.DirectoryInfo.FromDirectoryName let internal refDir (r : Repository) : IDirectoryInfo = - r.Fs.Path.Combine((gitDir r).FullName, "refs") |> r.Fs.DirectoryInfo.FromDirectoryName + r.Fs.Path.Combine ((gitDir r).FullName, "refs") + |> r.Fs.DirectoryInfo.FromDirectoryName let internal createSubdir (r : IDirectoryInfo) (name : string) : IDirectoryInfo = let output = - r.FileSystem.Path.Combine(r.FullName, name) + r.FileSystem.Path.Combine (r.FullName, name) |> r.FileSystem.DirectoryInfo.FromDirectoryName + output.Create () output let make (dir : IDirectoryInfo) : Repository option = - if dir.Exists && dir.EnumerateDirectories () |> Seq.map (fun i -> i.Name) |> Seq.contains ".git" then + if + dir.Exists + && dir.EnumerateDirectories () + |> Seq.map (fun i -> i.Name) + |> Seq.contains ".git" + then Some { Directory = dir } - else None + else + None let init (dir : IDirectoryInfo) : Result = - if not dir.Exists then Error DirectoryDoesNotExist - elif not <| Seq.isEmpty (dir.EnumerateDirectories ".git") then Error AlreadyGit + if not dir.Exists then + Error DirectoryDoesNotExist + elif + not + <| Seq.isEmpty (dir.EnumerateDirectories ".git") + then + Error AlreadyGit else - let r = - { - Directory = dir - } + let r = { Directory = dir } let gitDir = createSubdir dir ".git" let objectDir = createSubdir gitDir "objects" @@ -55,6 +68,4 @@ module Repository = let headsDir = createSubdir refsDir "heads" let tagsDir = createSubdir refsDir "tags" - r - |> Ok - + r |> Ok diff --git a/Git/Stream.fs b/Git/Stream.fs index 8439e55..1dc41d6 100644 --- a/Git/Stream.fs +++ b/Git/Stream.fs @@ -12,7 +12,10 @@ module internal Stream = let rec consumeTo () : byte seq = seq { let b = b.ReadByte () - if b < 0 then failwithf "Stream ended in the middle while consuming to '%i'." stopAt + + if b < 0 then + failwithf "Stream ended in the middle while consuming to '%i'." stopAt + if b <> int stopAt then yield byte b yield! consumeTo () @@ -20,26 +23,34 @@ module internal Stream = // Read the first one to see if we can let firstByte = b.ReadByte () - if firstByte < 0 then None else - let firstByte = byte firstByte - if firstByte = stopAt then Array.empty |> Some + if firstByte < 0 then + None else - seq { - yield firstByte - yield! consumeTo () - } - |> Seq.toArray - |> Some + + let firstByte = byte firstByte + + if firstByte = stopAt then + Array.empty |> Some + else + seq { + yield firstByte + yield! consumeTo () + } + |> Seq.toArray + |> Some /// Consume the first n bytes of the stream. Throw if the stream runs out first. let consume (b : Stream) (n : int) : byte array = let output = Array.zeroCreate n let total = b.Read (output, 0, n) - if total <> n then failwithf "Reached the end of the stream while consuming %i bytes" n + + if total <> n then + failwithf "Reached the end of the stream while consuming %i bytes" n + output - let consumeToEnd (b : MemoryStream) : byte array = - use newMs = new MemoryStream() - b.CopyTo(newMs) + let consumeToEnd (b : MemoryStream) : byte array = + use newMs = new MemoryStream () + b.CopyTo (newMs) newMs.ToArray () diff --git a/Git/SymbolicReference.fs b/Git/SymbolicReference.fs index 5d3ab32..d6c3131 100644 --- a/Git/SymbolicReference.fs +++ b/Git/SymbolicReference.fs @@ -14,6 +14,7 @@ type SymbolicRef = | OrigHead // TODO - determine how an arbitrary symbolicref actually behaves | Verbatim of string + override this.ToString () : string = match this with | CherryPickHead -> "CHERRY_PICK_HEAD" @@ -28,7 +29,9 @@ type SymbolicRef = module SymbolicRef = let getFile (r : Repository) (name : SymbolicRef) : IFileInfo = name.ToString () - |> fun i -> r.Fs.Path.Combine ((Repository.gitDir r).FullName, i) |> r.Fs.FileInfo.FromFileName + |> fun i -> + r.Fs.Path.Combine ((Repository.gitDir r).FullName, i) + |> r.Fs.FileInfo.FromFileName type SymbolicRefLookupError = | RefDidNotExist @@ -40,18 +43,21 @@ module SymbolicReference = /// This is effectively `git symbolic-ref NAME`. let lookup (r : Repository) (name : SymbolicRef) : Result = let f = SymbolicRef.getFile r name - if not <| f.Exists then Error RefDidNotExist + + if not <| f.Exists then + Error RefDidNotExist else r.Fs.File.ReadAllText f.FullName |> fun contents -> - if contents.Substring (0, 5) = "ref: " then contents.Substring 5 |> SymbolicRefTarget |> Ok + if contents.Substring (0, 5) = "ref: " then + contents.Substring 5 |> SymbolicRefTarget |> Ok else Error (MalformedRef contents) let write (r : Repository) (name : SymbolicRef) (contents : string) : unit = if not <| contents.StartsWith "refs/" then failwithf "refusing to point %O outside of refs/" name + r.Fs.File.WriteAllText ((SymbolicRef.getFile r name).FullName, sprintf "ref: %s" contents) - let delete (r : Repository) (name : SymbolicRef) : unit = - (SymbolicRef.getFile r name).Delete () + let delete (r : Repository) (name : SymbolicRef) : unit = (SymbolicRef.getFile r name).Delete () diff --git a/Git/Tree.fs b/Git/Tree.fs index cf5cd95..72cef0b 100644 --- a/Git/Tree.fs +++ b/Git/Tree.fs @@ -1,6 +1,7 @@ namespace Git open System +open System.Collections.Generic open System.IO open System.Text open Git.Internals @@ -11,6 +12,7 @@ type TreeEntry = Name : string Hash : Hash } + override this.ToString () = sprintf "%i %s %O" this.Mode this.Name this.Hash @@ -18,36 +20,40 @@ type TreeEntry = module Tree = /// emits a byte array because the header needs to know a length - let encode (tree : TreeEntry list) : byte [] = + let encode (tree : TreeEntry list) : byte array = // This is a bit odd, we should probably emit the stream in a streamy way // rather than constructing the whole thing - let b = StringBuilder () - for t in tree do - b.Append (sprintf "%i %s%c" t.Mode t.Name (char 0)) - |> ignore - let (Hash h) = t.Hash - let hashStr = String(h |> List.toArray |> Array.map char) - b.Append (hashStr) - |> ignore + let b = ResizeArray () - b.ToString().ToCharArray () - |> Array.map byte + for t in tree do + b.AddRange (Encoding.ASCII.GetBytes (sprintf "%i %s" t.Mode t.Name)) + b.Add 0uy + + let (Hash h) = t.Hash + b.AddRange h + + b.ToArray () /// Given a stream seeked to the point where we should start consuming, /// decode as a tree object. let decode (b : byte array) : TreeEntry list = - use b = new MemoryStream(b) + use b = new MemoryStream (b) let stripRow () : TreeEntry option = let mode = Stream.consumeTo b 32uy + match mode with | None -> None | Some mode -> + let name = Stream.consumeTo b 0uy + match name with | None -> failwith "Stream ended before we could consume a name" | Some name -> + let hash = Stream.consume b 20 + { Mode = mode |> Array.map char |> String |> Int32.Parse Name = name |> Array.map char |> String @@ -58,13 +64,12 @@ module Tree = let rec allRows () : TreeEntry seq = seq { let r = stripRow () + match r with | Some r -> yield r yield! allRows () - | None -> - () + | None -> () } - allRows () - |> Seq.toList + allRows () |> Seq.toList diff --git a/global.json b/global.json new file mode 100644 index 0000000..d3f2e44 --- /dev/null +++ b/global.json @@ -0,0 +1,4 @@ +{ + "version": "6.0.300", + "rollForward": "latestPatch" +} diff --git a/hooks/pre-push b/hooks/pre-push new file mode 100755 index 0000000..afe90e6 --- /dev/null +++ b/hooks/pre-push @@ -0,0 +1,17 @@ +#!/usr/bin/python3 + +import subprocess + +def check_fantomas(): + result = subprocess.run(["dotnet", "tool", "run", "fantomas", "--check", "-r", "."]) + if result.returncode != 0: + print(result.stdout) + raise Exception(f"Formatting incomplete (return code: {result.returncode}). Consider running `dotnet tool run fantomas -r .`") + + +def main(): + check_fantomas() + + +if __name__ == "__main__": + main()