Skip to content

Commit

Permalink
switch all file system access to async/promise functionality
Browse files Browse the repository at this point in the history
  • Loading branch information
@HLWeil
HLWeil committed Nov 20, 2024
1 parent eb10eaa commit a4a991a
Show file tree
Hide file tree
Showing 10 changed files with 357 additions and 243 deletions.
59 changes: 34 additions & 25 deletions src/ARCtrl/ARC.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ open ARCtrl.Spreadsheet
open FsSpreadsheet
open Fable.Core
open ARCtrl.ArcPathHelper
open CrossAsync

module ARCAux =

Expand Down Expand Up @@ -88,29 +89,36 @@ type ARC(?isa : ArcInvestigation, ?cwl : unit, ?fs : FileSystem.FileSystem) =
with get() = _fs
and set(fs) = _fs <- fs

member this.Write(arcPath) =
member this.WriteAsync(arcPath) =
this.GetWriteContracts()
|> fullFillContractBatch arcPath
|> fullFillContractBatchAsync arcPath

member this.Update(arcPath) =
member this.UpdateAsync(arcPath) =
this.GetUpdateContracts()
|> fullFillContractBatch arcPath
|> fullFillContractBatchAsync arcPath

static member load (arcPath : string) =
let paths = FileSystemHelper.getAllFilePaths arcPath
let arc = ARC.fromFilePaths (paths |> Seq.toArray)
static member loadAsync (arcPath : string) =
crossAsync {

let contracts = arc.GetReadContracts()
let! paths = FileSystemHelper.getAllFilePathsAsync arcPath
let arc = ARC.fromFilePaths (paths |> Seq.toArray)

let fulFilledContracts =
contracts
|> fullFillContractBatch arcPath
let contracts = arc.GetReadContracts()



let! fulFilledContracts =
contracts
|> fullFillContractBatchAsync arcPath

match fulFilledContracts with
| Ok c ->
arc.SetISAFromContracts(c)
Ok arc
| Error e -> Error e
match fulFilledContracts with
| Ok c ->
arc.SetISAFromContracts(c)
return Ok arc
| Error e -> return Error e
}



member this.GetAssayRemoveContracts(assayIdentifier: string) =
let isa =
Expand All @@ -132,9 +140,9 @@ type ARC(?isa : ArcInvestigation, ?cwl : unit, ?fs : FileSystem.FileSystem) =
s.ToUpdateContract()
|]

member this.RemoveAssay(arcPath : string, assayIdentifier: string) =
member this.RemoveAssayAsync(arcPath : string, assayIdentifier: string) =
this.GetAssayRemoveContracts(assayIdentifier)
|> fullFillContractBatch arcPath
|> fullFillContractBatchAsync arcPath

member this.GetAssayRenameContracts(oldAssayIdentifier: string, newAssayIdentifier: string) =
let isa =
Expand All @@ -154,9 +162,9 @@ type ARC(?isa : ArcInvestigation, ?cwl : unit, ?fs : FileSystem.FileSystem) =
yield! this.GetUpdateContracts()
|]

member this.RenameAssay(arcPath : string, oldAssayIdentifier: string, newAssayIdentifier: string) =
member this.RenameAssayAsync(arcPath : string, oldAssayIdentifier: string, newAssayIdentifier: string) =
this.GetAssayRenameContracts(oldAssayIdentifier,newAssayIdentifier)
|> fullFillContractBatch arcPath
|> fullFillContractBatchAsync arcPath

member this.GetStudyRemoveContracts(studyIdentifier: string) =
let isa =
Expand All @@ -173,9 +181,9 @@ type ARC(?isa : ArcInvestigation, ?cwl : unit, ?fs : FileSystem.FileSystem) =
isa.ToUpdateContract()
|]

member this.RemoveStudy(arcPath : string, studyIdentifier: string) =
member this.RemoveStudyAsync(arcPath : string, studyIdentifier: string) =
this.GetStudyRemoveContracts(studyIdentifier)
|> fullFillContractBatch arcPath
|> fullFillContractBatchAsync arcPath

member this.GetStudyRenameContracts(oldStudyIdentifier: string, newStudyIdentifier: string) =
let isa =
Expand All @@ -195,9 +203,9 @@ type ARC(?isa : ArcInvestigation, ?cwl : unit, ?fs : FileSystem.FileSystem) =
yield! this.GetUpdateContracts()
|]

member this.RenameStudy(arcPath : string, oldStudyIdentifier: string, newStudyIdentifier: string) =
member this.RenameStudyAsync(arcPath : string, oldStudyIdentifier: string, newStudyIdentifier: string) =
this.GetStudyRenameContracts(oldStudyIdentifier,newStudyIdentifier)
|> fullFillContractBatch arcPath
|> fullFillContractBatchAsync arcPath

//static member updateISA (isa : ISA.Investigation) (arc : ARC) : ARC =
// raise (System.NotImplementedException())
Expand Down Expand Up @@ -281,7 +289,8 @@ type ARC(?isa : ArcInvestigation, ?cwl : unit, ?fs : FileSystem.FileSystem) =

// to-do: function that returns read contracts based on a list of paths.
member this.GetReadContracts () : Contract [] =
_fs.Tree.ToFilePaths() |> Array.choose Contract.ARC.tryISAReadContractFromPath
_fs.Tree.ToFilePaths()
|> Array.choose Contract.ARC.tryISAReadContractFromPath

/// <summary>
/// This function creates the ARC-model from fullfilled READ contracts. The necessary READ contracts can be created with `ARC.getReadContracts`.
Expand Down
98 changes: 48 additions & 50 deletions src/ARCtrl/ContractIO/ContractIO.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,35 +3,38 @@ module ARCtrl.Contract
open ARCtrl
open ARCtrl.Contract
open FsSpreadsheet
open CrossAsync

let fulfillReadContract basePath (c : Async<Contract>) =
async {
let! c = c

let fulfillReadContractAsync basePath (c : Contract) =
crossAsync {
try
match c.DTOType with
| Some DTOType.ISA_Assay
| Some DTOType.ISA_Investigation
| Some DTOType.ISA_Study
| Some DTOType.ISA_Datamap ->
let path = ArcPathHelper.combine basePath c.Path
let wb = FileSystemHelper.readFileXlsx path |> box |> DTO.Spreadsheet
return Ok {c with DTO = Some wb}
let! wb = FileSystemHelper.readFileXlsxAsync path
let dto = wb |> box |> DTO.Spreadsheet
return Ok {c with DTO = Some dto}
| Some DTOType.PlainText ->
let path = ArcPathHelper.combine basePath c.Path
let text = FileSystemHelper.readFileText path |> DTO.Text
return Ok {c with DTO = Some text}
let! text = FileSystemHelper.readFileTextAsync path
let dto = text |> DTO.Text
return Ok {c with DTO = Some dto}
| _ ->
return Error (sprintf "Contract %s is not an ISA contract" c.Path)
with
| e -> return Error (sprintf "Error reading contract %s: %s" c.Path e.Message)
}

let fullfillContractBatchBy
(contractF : string -> Async<Contract> -> Async<Result<Contract, string>>)
let fullfillContractBatchAsyncBy
(contractF : string -> Contract -> CrossAsync<Result<Contract, string>>)
(basePath : string)
(cs : (Async<Contract>) [])
: Async<Result<Contract [], string []>> =
async {
(cs : (Contract) [])
: CrossAsync<Result<Contract [], string []>> =
crossAsync {
let! seq =
cs
|> Array.map (contractF basePath)
Expand All @@ -49,97 +52,92 @@ let fullfillContractBatchBy
return res
}

let fulfillWriteContract basePath (c : Async<Contract>) =
async {
let! c = c
let fulfillWriteContractAsync basePath (c : Contract) =
crossAsync {
try
match c.DTO with
| Some (DTO.Spreadsheet wb) ->
let path = ArcPathHelper.combine basePath c.Path
FileSystemHelper.ensureDirectoryOfFile path
FileSystemHelper.writeFileXlsx path (wb :?> FsWorkbook)
do! FileSystemHelper.ensureDirectoryOfFileAsync path
do! FileSystemHelper.writeFileXlsxAsync path (wb :?> FsWorkbook)
return Ok (c)
| Some (DTO.Text t) ->
let path = ArcPathHelper.combine basePath c.Path
FileSystemHelper.ensureDirectoryOfFile path
FileSystemHelper.writeFileText path t
do! FileSystemHelper.ensureDirectoryOfFileAsync path
do! FileSystemHelper.writeFileTextAsync path t
return Ok (c)
| None ->
let path = ArcPathHelper.combine basePath c.Path
FileSystemHelper.ensureDirectoryOfFile path
FileSystemHelper.writeFileText path ""
do! FileSystemHelper.ensureDirectoryOfFileAsync path
do! FileSystemHelper.writeFileTextAsync path ""
return Ok (c)
| _ ->
return Error (sprintf "Contract %s is not an ISA contract" c.Path)
with
| e -> return Error (sprintf "Error writing contract %s: %s" c.Path e.Message)
}

let fulfillUpdateContract basePath (c : Async<Contract>) =
async {
let! c = c
let fulfillUpdateContractAsync basePath (c : Contract) =
crossAsync {
try
match c.DTO with
| Some (DTO.Spreadsheet wb) ->
let path = ArcPathHelper.combine basePath c.Path
FileSystemHelper.ensureDirectoryOfFile path
FileSystemHelper.writeFileXlsx path (wb :?> FsWorkbook)
do! FileSystemHelper.ensureDirectoryOfFileAsync path
do! FileSystemHelper.writeFileXlsxAsync path (wb :?> FsWorkbook)
return Ok (c)
| Some (DTO.Text t) ->
let path = ArcPathHelper.combine basePath c.Path
FileSystemHelper.ensureDirectoryOfFile path
FileSystemHelper.writeFileText path t
do! FileSystemHelper.ensureDirectoryOfFileAsync path
do! FileSystemHelper.writeFileTextAsync path t
return Ok (c)
| None ->
let path = ArcPathHelper.combine basePath c.Path
FileSystemHelper.ensureDirectoryOfFile path
FileSystemHelper.writeFileText path ""
do! FileSystemHelper.ensureDirectoryOfFileAsync path
do! FileSystemHelper.writeFileTextAsync path ""
return Ok (c)
| _ ->
return Error (sprintf "Contract %s is not an ISA contract" c.Path)
with
| e -> return Error (sprintf "Error updating contract %s: %s" c.Path e.Message)
}

let fullfillRenameContract basePath (c : Async<Contract>) =
async {
let! c = c
let fullfillRenameContractAsync basePath (c : Contract) =
crossAsync {
try
match c.DTO with
| Some (DTO.Text t) when t = c.Path ->
return Error (sprintf "Rename Contract %s old and new Path are the same" c.Path)
| Some (DTO.Text t) ->
let newPath = ArcPathHelper.combine basePath t
let oldPath = ArcPathHelper.combine basePath c.Path
FileSystemHelper.renameFileOrDirectory oldPath newPath
do! FileSystemHelper.renameFileOrDirectoryAsync oldPath newPath
return Ok (c)
| _ -> return Error (sprintf "Rename Contract %s does not contain new Path" c.Path)
with
| e -> return Error (sprintf "Error renaming contract %s: %s" c.Path e.Message)
}

let fullfillDeleteContract basePath (c : Async<Contract>) =
async {
let! c = c
let fullfillDeleteContractAsync basePath (c : Contract) =
crossAsync {
try
let path = ArcPathHelper.combine basePath c.Path
FileSystemHelper.deleteFileOrDirectory path
do! FileSystemHelper.deleteFileOrDirectoryAsync path
return Ok (c)
with
| e -> return Error (sprintf "Error deleting contract %s: %s" c.Path e.Message)
}

let fullFillContract basePath (c : Async<Contract>) =
async {
let! cSync = c
match cSync.Operation with
| Operation.READ -> return! fulfillReadContract basePath c
| Operation.CREATE -> return! fulfillWriteContract basePath c
| Operation.UPDATE -> return! fulfillUpdateContract basePath c
| Operation.DELETE -> return! fullfillDeleteContract basePath c
| Operation.RENAME -> return! fullfillRenameContract basePath c
| _ -> return Error (sprintf "Operation %A not supported" cSync.Operation)
let fullFillContract basePath (c : Contract) =
crossAsync {
match c.Operation with
| Operation.READ -> return! fulfillReadContractAsync basePath c
| Operation.CREATE -> return! fulfillWriteContractAsync basePath c
| Operation.UPDATE -> return! fulfillUpdateContractAsync basePath c
| Operation.DELETE -> return! fullfillDeleteContractAsync basePath c
| Operation.RENAME -> return! fullfillRenameContractAsync basePath c
| _ -> return Error (sprintf "Operation %A not supported" c.Operation)
}

let fullFillContractBatch basePath (cs : (Async<Contract>) []) =
fullfillContractBatchBy fullFillContract basePath cs
let fullFillContractBatchAsync basePath (cs : Contract []) =
fullfillContractBatchAsyncBy fullFillContract basePath cs
Loading

0 comments on commit a4a991a

Please sign in to comment.