Add simple git functions to test contract behaviour

src/ARCtrl/ARCtrl.fs

@@ -237,6 +237,18 @@ type ARC(?isa : ISA.ArcInvestigation, ?cwl : CWL.CWL, ?fs : FileSystem.FileSyste
 
         )
 
+    member this.GetGitInitContracts(?branch : string,?repositoryAddress : string,?defaultGitignore : bool) = 
+        let defaultGitignore = defaultArg defaultGitignore false
+        [|
+            Contract.Git.Init.createInitContract(?branch = branch)
+            if defaultGitignore then Contract.Git.gitignoreContract
+            if repositoryAddress.IsSome then Contract.Git.Init.createAddRemoteContract repositoryAddress.Value
+        |]
+
+    static member getCloneContract(remoteUrl : string,?merge : bool ,?branch : string,?token : string*string,?nolfs : bool) =
+        Contract.Git.Clone.createCloneContract(remoteUrl,?merge = merge,?branch = branch,?token = token,?nolfs = nolfs)
+
+
     member this.Copy() = 
         let isaCopy = _isa |> Option.map (fun i -> i.Copy())
         let fsCopy = _fs.Copy()

src/ARCtrl/ARCtrl.fsproj

@@ -12,6 +12,7 @@
     <Compile Include="Contracts\Contracts.ArcAssay.fs" />
     <Compile Include="Contracts\Contracts.ArcStudy.fs" />
     <Compile Include="Contracts\Contracts.ArcInvestigation.fs" />
+    <Compile Include="Contracts\Contracts.Git.fs" />
     <Compile Include="Contracts\Contracts.ARCtrl.fs" />
     <Compile Include="Templates\Templates.fs" />
     <Compile Include="Templates\Templates.Json.fs" />
@@ -30,6 +31,9 @@
   <ItemGroup>
     <None Include="../../build/logo.png" Pack="true" PackagePath="\" />
   </ItemGroup>
+  <ItemGroup>
+    <Content Include="*.fsproj; **\*.fs; **\*.fsi" PackagePath="fable\" />
+  </ItemGroup>
   <PropertyGroup>
     <Authors>nfdi4plants, Lukas Weil, Kevin Frey, Kevin Schneider, Oliver Maus</Authors>
     <Description>Library for management of Annotated Research Contexts (ARCs) using an in-memory representation and runtimer agnostic contract systems.</Description>

src/ARCtrl/Contracts/Contracts.Git.fs

@@ -0,0 +1,59 @@
+module ARCtrl.Contract.Git
+
+open ARCtrl.Contract
+
+let [<Literal>] git = @"git"  
+let [<Literal>] defaultBranch = @"main" 
+let [<Literal>] gitignoreFileName = @".gitignore" 
+
+let gitWithArgs(arguments : string []) = CLITool.create(git,arguments)
+
+let createGitContractAt path arguments = Contract.createExecute(gitWithArgs(arguments),path)
+
+let createGitContract(arguments) = Contract.createExecute(gitWithArgs(arguments))
+
+let gitignoreContract = Contract.createCreate(gitignoreFileName,DTOType.PlainText,DTO.Text ARCtrl.FileSystem.DefaultGitignore.dgi)
+
+type Init = 
+
+    static member init = "init" 
+    static member branchFlag = "-b"
+
+    static member remote = @"remote"
+    static member add = @"add"
+    static member origin = @"origin"
+
+    static member createInitContract(?branch : string) =
+        let branch = Option.defaultValue defaultBranch branch
+        createGitContract([|Init.init;Init.branchFlag;branch|])
+
+    static member createAddRemoteContract(remoteUrl : string) =
+        createGitContract([|Init.remote;Init.add;Init.origin;remoteUrl|])
+
+and Clone = 
+
+    static member clone = "clone" 
+
+    static member branchFlag = "-b"
+
+    static member noLFSConfig = "-c \"filter.lfs.smudge = git-lfs smudge --skip -- %f\" -c \"filter.lfs.process = git-lfs filter-process --skip\""
+
+    static member formatRepoString username pass (url : string) = 
+        let comb = username + ":" + pass + "@"
+        url.Replace("https://","https://" + comb)
+
+    static member createCloneContract(remoteUrl : string,?merge : bool ,?branch : string,?token : string*string,?nolfs : bool) =
+        let nolfs = Option.defaultValue false nolfs
+        let merge = Option.defaultValue false merge
+        let remoteUrl = 
+            match token with
+            | Some (username,pass) -> Clone.formatRepoString username pass remoteUrl
+            | None -> remoteUrl
+        createGitContract([|
+            Clone.clone
+            if nolfs then Clone.noLFSConfig
+            if branch.IsSome then Clone.branchFlag
+            if branch.IsSome then branch.Value
+            remoteUrl
+            if merge then "."
+        |])

src/Contract/Contract.fs

@@ -32,6 +32,26 @@ type DTO =
     | Text of string
     | CLITool of CLITool
 
+    member this.isSpreadsheet =
+        match this with | Spreadsheet _ -> true | _ -> false
+
+    member this.isText =
+        match this with | Text _ -> true | _ -> false
+
+    member this.isCLITool =
+        match this with | CLITool _ -> true | _ -> false
+
+    member this.AsSpreadsheet() =
+        match this with | Spreadsheet s -> s | _ -> failwith "Not a spreadsheet"
+
+    member this.AsText() =
+        match this with | Text t -> t | _ -> failwith "Not text"
+
+    member this.AsCLITool() =
+        match this with | CLITool c -> c | _ -> failwith "Not a CLI tool"
+
+
+
 [<StringEnum>]
 type Operation =
     | [<CompiledName("CREATE")>] CREATE

src/FileSystem/ARCtrl.FileSystem.fsproj

@@ -5,18 +5,18 @@
     <GenerateDocumentationFile>true</GenerateDocumentationFile>
   </PropertyGroup>
   <ItemGroup>
+    <Content Include="*.fsproj; **\*.fs; **\*.fsi" PackagePath="fable\" />
     <None Include="paket.references" />
     <Compile Include="Path.fs" />
     <Compile Include="Commit.fs" />
     <Compile Include="FileSystemTree.fs" />
+    <Compile Include="DefaultGitignore.fs" />
     <Compile Include="FileSystem.fs" />
   </ItemGroup>
   <ItemGroup>
     <None Include="../../build/logo.png" Pack="true" PackagePath="\" />
   </ItemGroup>
-  <ItemGroup>
-    <Content Include="*.fsproj; **\*.fs; **\*.fsi" PackagePath="fable\" />
-  </ItemGroup>
+  <ItemGroup />
   <PropertyGroup>
     <Authors>nfdi4plants, Kevin Frey, Lukas Weil </Authors>
     <Description>ARC helper functions for filesystem management.</Description>

src/FileSystem/DefaultGitignore.fs

@@ -0,0 +1,86 @@
+module ARCtrl.FileSystem.DefaultGitignore
+
+let dgi = """# ----- macos rules -----
+# taken from https://github.com/github/gitignore/blob/main/Global/macOS.gitignore
+
+
+# General
+.DS_Store
+.AppleDouble
+.LSOverride
+
+# Icon must end with two \r
+Icon
+
+# Thumbnails
+._*
+
+# Files that might appear in the root of a volume
+.DocumentRevisions-V100
+.fseventsd
+.Spotlight-V100
+.TemporaryItems
+.Trashes
+.VolumeIcon.icns
+.com.apple.timemachine.donotpresent
+
+# Directories potentially created on remote AFP share
+.AppleDB
+.AppleDesktop
+Network Trash Folder
+Temporary Items
+.apdisk
+
+
+
+
+
+# ----- windows rules -----
+# taken from https://github.com/github/gitignore/blob/main/Global/Windows.gitignore
+
+# Windows thumbnail cache files
+Thumbs.db
+Thumbs.db:encryptable
+ehthumbs.db
+ehthumbs_vista.db
+
+# Dump file
+*.stackdump
+
+# Folder config file
+[Dd]esktop.ini
+
+# Recycle Bin used on file shares
+$RECYCLE.BIN/
+
+# Windows Installer files
+*.cab
+*.msi
+*.msix
+*.msm
+*.msp
+
+# Windows shortcuts
+*.lnk
+
+
+
+
+
+# ----- linux rules -----
+# taken from https://github.com/github/gitignore/blob/main/Global/Linux.gitignore
+
+*~
+
+# temporary files which can be created if a process still has a handle open of a deleted file
+.fuse_hidden*
+
+# KDE directory preferences
+.directory
+
+# Linux trash folder which might appear on any partition or disk
+.Trash-*
+
+# .nfs files are created when an open file is removed but is still being accessed
+.nfs*
+"""

tests/ARCtrl/ARCtrl.Contracts.Tests.fs

@@ -21,6 +21,64 @@ let tests_tryFromContract = testList "tryFromContract" [
         Expect.hasLength investigation 1 ""
 ]
 
+let tests_gitContracts = testList "gitContracts" [
+    testCase "init_basic" <| fun _ ->
+        let arc = ARC()
+        let contracts = arc.GetGitInitContracts()
+        Expect.equal contracts.Length 1 "Should be one contract"
+        Expect.equal contracts.[0].Operation Operation.EXECUTE "Should be an execute operation"
+        Expect.isSome contracts.[0].DTOType "Should have a DTO type"
+        Expect.equal contracts.[0].DTOType.Value DTOType.CLI "Should be a CLI DTO"
+        Expect.equal contracts.[0].Path "" "Should have an empty path"
+        Expect.isSome contracts.[0].DTO "Should have a DTO"
+        let dto = contracts.[0].DTO.Value
+        Expect.isTrue dto.isCLITool "Should be a CLI tool"
+        let cli = dto.AsCLITool()
+        Expect.equal cli.Name "git" "Should be git"
+        Expect.equal cli.Arguments.Length 3 "Should have two arguments"
+        Expect.sequenceEqual cli.Arguments [|"init";"-b";"main"|] "Should be init"
+
+    testCase "init_Branch" <| fun _ ->
+        let arc = ARC()
+        let branchName = "myBranch"
+        let contracts = arc.GetGitInitContracts(branch = branchName)
+        Expect.equal contracts.Length 1 "Should be one contract"
+        let dto = contracts.[0].DTO.Value
+        let cli = dto.AsCLITool()
+        Expect.sequenceEqual cli.Arguments [|"init";"-b";branchName|] "Should have new branchname"
+
+    testCase "init_remoteRepository" <| fun _ ->
+        let arc = ARC()
+        let remote = @"www.fantasyGit.net/MyAccount/MyRepo"
+        let contracts = arc.GetGitInitContracts(repositoryAddress = remote)
+        Expect.equal contracts.Length 2 "Should be two contracts"
+        let dto = contracts.[1].DTO.Value
+        let cli = dto.AsCLITool()
+        Expect.sequenceEqual cli.Arguments [|"remote";"add";"origin";remote|] "Should correctly set new remote"
+
+    testCase "init_GitIgnore" <| fun _ ->
+        let arc = ARC()
+        let contracts = arc.GetGitInitContracts(defaultGitignore = true)
+        Expect.equal contracts.Length 2 "Should be two contracts"
+        Expect.equal contracts.[1].Operation Operation.CREATE "Should be an create operation"
+        let dto = contracts.[1].DTO.Value
+        Expect.isTrue dto.isText "Should be text"
+        Expect.equal contracts.[1].Path ".gitignore" "Should be a gitignore"
+    testCase "clone_AllOptions" <| fun _ ->
+        let remoteURL = @"https://git.fantasyGit.net/MyAccount/MyRepo"
+        let user = "Lukas"
+        let token = "12345"
+        let tokenFormattedURL = @$"https://{user}:{token}@git.fantasyGit.net/MyAccount/MyRepo"
+        let branch = "myBranch"
+        let noLFSConfig = "-c \"filter.lfs.smudge = git-lfs smudge --skip -- %f\" -c \"filter.lfs.process = git-lfs filter-process --skip\""
+        let contract = ARC.getCloneContract(remoteURL,merge = true,branch = branch,token = (user,token),nolfs = true)
+        let dto = contract.DTO.Value
+        let cli = dto.AsCLITool()
+        Expect.sequenceEqual cli.Arguments [|"clone";noLFSConfig;"-b";branch;tokenFormattedURL;"."|] "some option was wrong"
+    ]
+
+
 let main = testList "Contracts" [
     tests_tryFromContract
+    tests_gitContracts
 ]

tests/ARCtrl/Utils.fs

@@ -0,0 +1,34 @@
+module TestingUtils
+
+#if FABLE_COMPILER
+open Fable.Mocha
+#else
+open Expecto
+#endif
+
+module Result =
+
+    let getMessage (r : Result<'T,string>) =
+        match r with
+        | Ok _ -> ""
+        | Error msg -> msg
+
+let private firstDiff s1 s2 =
+  let s1 = Seq.append (Seq.map Some s1) (Seq.initInfinite (fun _ -> None))
+  let s2 = Seq.append (Seq.map Some s2) (Seq.initInfinite (fun _ -> None))
+  Seq.mapi2 (fun i s p -> i,s,p) s1 s2
+  |> Seq.find (function |_,Some s,Some p when s=p -> false |_-> true)
+
+/// Expects the `actual` sequence to equal the `expected` one.
+let mySequenceEqual actual expected message =
+  match firstDiff actual expected with
+  | _,None,None -> ()
+  | i,Some a, Some e ->
+    failwithf "%s. Sequence does not match at position %i. Expected item: %A, but got %A."
+      message i e a
+  | i,None,Some e ->
+    failwithf "%s. Sequence actual shorter than expected, at pos %i for expected item %A."
+      message i e
+  | i,Some a,None ->
+    failwithf "%s. Sequence actual longer than expected, at pos %i found item %A."
+      message i a