wip: work on abstraction levelsm not quite happy yet

src/BackingStore.fs

@@ -1,9 +1,93 @@
-module FS3
+namespace BackingStore
 
 open System
 open System.IO
-open MessagePack
 open Thoth.Json.Net
 open FSharpPlus
 
-open Types
+type Format =
+    | OZone of string
+    | Zarr of string
+    | Nc of string
+    | Json of string
+    member this.Value =
+        match this with
+        | OZone x -> x
+        | Zarr x -> x
+        | Nc x -> x
+        | Json x -> x
+    static member fromUri (uri: Uri) =
+        if uri.LocalPath.EndsWith ".nc" then Nc uri.LocalPath
+        elif uri.LocalPath.EndsWith ".zarr" then Zarr uri.LocalPath
+        elif uri.LocalPath.EndsWith ".json" then Json uri.LocalPath
+        else OZone uri.LocalPath
+
+type Store =
+    | O3 of Format
+    | S3 of Format
+    | Dir of Format
+    | File of Format
+    | Unknown
+    static member fromUri (uri: Uri) =
+        let archive = Format.fromUri uri
+        match uri.Scheme with
+        | "o3" -> O3 archive
+        | "s3" -> S3 archive
+        | "dir" -> Dir archive
+        | "file" ->
+            match archive with
+            | OZone _ -> Unknown
+            | _ -> File archive
+        | _ -> Unknown
+
+type XAttrs = {
+    frames: int
+    start: int
+    ctime: DateTime
+    atime: DateTime
+    archiveType: string
+    version: byte
+} with
+    static member empty = {
+        frames = 0
+        start = 0
+        ctime = DateTime.UnixEpoch
+        atime = DateTime.UnixEpoch
+        archiveType = ""
+        version = 0uy
+    }
+
+type IBackingStore =
+    abstract readText: key: string -> string
+    abstract writeText: key: string * data: string -> unit
+    abstract readBinary: key: string -> byte[]
+    abstract writeBinary: key: string * data: byte[] -> unit
+    abstract readXAttrs: key: string -> XAttrs
+    abstract writeXAttrs: key: string * XAttrs -> unit
+
+module Dir =
+    let newDirectoryStore (path: string)  = {
+        new IBackingStore with
+            member this.readText key =
+                let fname = Path.Join [| path; $"{key}" |]
+                File.ReadAllText fname
+            member this.writeText (name, data) =
+                let fname = Path.Join [| path; $"{name}" |]
+                File.WriteAllText (fname, data)
+            member this.readBinary key =
+                let fname = Path.Join [| path; $"{key}" |]
+                File.ReadAllBytes fname
+            member this.writeBinary (name, data) =
+                let fname = Path.Join [| path; $"{name}" |]
+                File.WriteAllBytes (fname, data)
+            member this.readXAttrs key =
+                let fname = Path.Join [| path; $"{key}.xattrs" |]
+                File.ReadAllText fname
+                |> Decode.Auto.fromString<XAttrs>
+                |> Result.defaultWith (fun x -> failwith $"invalid xattr: {x}")
+            member this.writeXAttrs (name, attrs) =
+                let fname = Path.Join [| path; $"{name}.xattrs" |]
+                let json = Encode.Auto.toString attrs
+                File.WriteAllText (fname, json)
+    }
+

src/Copy.fs

@@ -6,9 +6,10 @@ open Serilog
 open FSharp.Compression
 open Oceanbox.FvcomKit
 open Types
-open Tzar.Cli
-open Tzar.OZone
-open Fvcom
+open Cli
+open Format.OZone
+open Format.Fvcom
+open BackingStore
 
 let private witherZfp tol x =
     // Log.Debug $"Witherign data with ZFP@{tol}"
@@ -92,7 +93,10 @@ let private writeToDest (dst: Uri) (transform: single[] -> single[]) (source: (i
                 let data = toOzoneData transform p
                 ozoneWrite dst.LocalPath aid t data
             )
-            ozoneWritePoolTable dst.LocalPath aid {
+            let bucket, key = S3.getBucketAndKey dst.LocalPath
+            let store = S3.newS3Store bucket key
+            let o3 = O3Archive store
+            o3.writePoolTable aid {
                 pools = [| dst.LocalPath |]
                 frames = Array.ofSeq source |> Array.map (fun (t, _) -> (t, 0uy))
             }

src/Diff.fs

@@ -5,7 +5,8 @@ open Serilog
 open Oceanbox.FvcomKit
 open Types
 open Tzar.Cli
-open Fvcom
+open Format.Fvcom
+open BackingStore
 
 let private readSourceProps (src: Uri) =
     let notImplemented x = failwith $"source not implemented: {x}"

src/Fvcom.fs

@@ -1,4 +1,4 @@
-module Format.Fvnc
+module Format.Fvcom
 
 open System
 open Microsoft.Research.Science.Data

src/Init.fs

@@ -2,14 +2,17 @@ module Tzar.Init
 
 open System
 open System.IO
+open Format.OZone
 open Microsoft.Research.Science.Data.NetCDF4
 open MessagePack
 open Oceanbox.FvcomKit
 open Serilog
-open Serilog.Events
 open ProjNet.FSharp
+
 open Types
-open Tzar.Cli
+open Cli
+open Format
+open BackingStore
 
 let private toBinGrid (proj: string option) (grid: Grid3D) =
     let nodes =
@@ -57,7 +60,7 @@ let private mkBath (buf: byte[]) : single[] = [||]
 
 let private readSourceGrid (proj: string option) (src: Uri) : Grid3D =
     let notImplemented x = failwith $"source not implemented: {x}"
-    match uriToArchiveStore src with
+    match Store.fromUri src with
     | Dir x when x.IsOZone ->
         if Directory.Exists src.LocalPath then
             let aid = src.LocalPath.Split '/' |> Array.last
@@ -130,18 +133,10 @@ let private readSourceGrid (proj: string option) (src: Uri) : Grid3D =
     | File x when x.IsOZone -> failwith "Not possible"
     | _ -> failwith "Invalid source URI"
 
-let private fileHandler (args: InitArgs) (f: string -> InitArgs -> unit) =
-    let dst = args.Archive
-    if File.Exists dst.LocalPath then
-        failwith "destination file exists"
-    else
-        let aid = dst.Query[1..]
-        f aid args
-
 let private writeDestGrid (dst: Uri) (grid: BinGrid) =
     let notImplemented x =
         failwith $"destination not implemented: {x}"
-    match uriToArchiveStore dst with
+    match Store.fromUri dst with
     | Dir x ->
         if not (Directory.Exists dst.LocalPath) then
             failwith $"Archive directory does not exist: {dst.LocalPath}"
@@ -177,58 +172,6 @@ let private writeDestGrid (dst: Uri) (grid: BinGrid) =
     | File x when x.IsZarr -> notImplemented ()
     | _ -> failwith "Not supported"
 
-let private initDest (dst: Uri) (source: Grid3D) =
-    let notImplemented x =
-        failwith $"destination not implemented: {x}"
-    match dst.Scheme with
-    | "file" ->
-        if dst.LocalPath.EndsWith ".nc" then
-            Fvcom.makeFvcomFile source dst.LocalPath
-        elif dst.LocalPath.EndsWith ".zarr" then
-            notImplemented "file/zarr"
-        // mkdir + meta
-        elif dst.LocalPath.EndsWith ".o3" then
-            if Directory.Exists dst.LocalPath then
-                failwith "directory exists!"
-            else
-                Directory.CreateDirectory dst.LocalPath |> ignore
-            let aid = Guid.Parse dst.Query[1..]
-            OZone.ozoneWriteMeta dst.LocalPath aid OZone.ArchiveMeta.empty
-        else
-            failwith "Unknown format"
-    | "s3" ->
-        let bucket, key = S3.getBucketAndKey dst.LocalPath
-        if dst.LocalPath.EndsWith ".nc" then
-            notImplemented "s3/nc"
-        elif dst.LocalPath.EndsWith ".zarr" then
-            notImplemented "s3/zarr"
-        else
-            notImplemented "s3/r3"
-    | "rados" ->
-        if dst.LocalPath.EndsWith ".nc" then
-            notImplemented "rados/nc"
-        elif dst.LocalPath.EndsWith ".zarr" then
-            notImplemented "rados/zarr"
-        else
-            notImplemented "rados/r3"
-    | _ -> failwith "Invalid source URI"
-
-let private xxx (args: InitArgs) =
-    let dst = args.Archive
-    match uriToArchiveStore dst with
-    | Dir x when x.IsNc -> ()
-    | Dir x when x.IsZarr -> ()
-    | Dir x when x.IsOZone -> ()
-    | S3 x when x.IsNc -> ()
-    | S3 x when x.IsZarr -> ()
-    | S3 x when x.IsOZone -> ()
-    | O3 x when x.IsOZone -> ()
-    | O3 x -> failwith $"Invalid archive format for O3: {x}"
-    | File x when x.IsNc -> ()
-    | File x when x.IsZarr -> ()
-    | File x when x.IsOZone -> ()
-    | _ -> failwith "Failure"
-
 let writeObc (proj: string) (src: Uri) (dst: Uri) = printfn $"obc({proj}) {src} -> {dst}"
 
 let private initNc (args: InitArgs) dst =
@@ -240,22 +183,56 @@ let private initNc (args: InitArgs) dst =
 
 let private initZarr (args: InitArgs) dst = failwith "not implemented"
 
-let initArchvive (args: InitArgs) =
+let readIndex (src: Uri)=
+    let readIdx (file: string) =
+        File.ReadAllText file
+        |> Thoth.Json.Decode.Auto.fromString<O3Index>
+        |> Result.defaultWith (failwith "invalid index")
+    match Store.fromUri src with
+    | File x when x.IsJson -> readIdx x.Value
+    | File x -> failwith "Invalid index store/format"
+    | Dir x ->
+        if not (Directory.Exists src.LocalPath) then failwith "Directory does not exist"
+        let idxFile = Path.Join [| src.LocalPath; if x.IsOZone then src.Query[1..] else "index.json" |]
+        if not (File.Exists idxFile) then failwith "Index file does not exists"
+        readIdx idxFile
+    | S3 x -> failwith "not implemented"
+    | O3 x when x.IsOZone -> failwith "not implemented"
+    | O3 _ -> failwith "Not supported"
+    | _ ->
+        eprintfn "Not supported archive destination format."
+        exit 1
+
+let initArchive (args: InitArgs) =
     let dst = args.Archive
-    match uriToArchiveStore dst with
+    match Store.fromUri dst with
     | File x when x.IsNc -> initNc args x.Value
     | File x when x.IsZarr -> initZarr args x.Value
     | Dir x ->
         if not (Directory.Exists dst.LocalPath) then
             Directory.CreateDirectory dst.LocalPath |> ignore
-        if x.IsOZone then
-            let aid = dst.Query[1..]
-            let idx = Path.Join [| dst.LocalPath; aid |]
-            if File.Exists idx then
-                failwith "Archive already exists"
-            match args.Index with
-            | Some f -> File.Copy (f, idx)
-            | None -> failwith "no index file given"
+        let aid = Guid.Parse dst.Query[1 ..]
+        let store = Dir.newDirectoryStore dst.LocalPath
+        let archive = O3Archive store
+
+        let idxFile = Path.Join [| dst.LocalPath; $"{aid}" |]
+        let idx = args.Index |> Option.map readIndex
+        match idx with
+        | Some meta -> archive.writeMetadata aid meta
+        | None -> failwith "no index file given"
+
+        match args.Grid with
+        | Some src ->
+            let grid = readSourceGrid args.Proj src
+            writeDestGrid args.Archive (toBinGrid args.Proj grid)
+        | None -> ()
+
+        // let obcFile = Path.Join [| dst.LocalPath; if x.IsOZone then $"{dst.Query[1..]}.obc" else "obc.bin" |]
+        // match args.Obc with
+        // | Some src ->
+        //     let obc = readSourceObc src
+        //     writeDestObc args.Archive (toBinObc args.Proj obc)
+        // | None -> failwith "no obc file given"
     | S3 x -> failwith "not implemented"
     | O3 x when x.IsOZone -> failwith "not implemented"
     | O3 _ -> failwith "Not supported"

src/Main.fs

@@ -26,7 +26,7 @@ let executeCommand (ct: System.Threading.CancellationToken) (command: Command *
 
         match fst command with
         | Init args ->
-            Init.initArchvive args
+            Init.initArchive args
             return 0
         | Copy args ->
             Tzar.Copy.copyAction args

src/O3.fs

@@ -1,4 +1,4 @@
-module O3
+module BackingStore.O3
 
 #nowarn "9"
 
@@ -8,6 +8,7 @@ open FSharp.Ceph.Rados
 open FSharp.Compression
 open Serilog
 open Tzar.Cli
+open BackingStore
 
 let toOpt x = if x < 0 then None else Some ()
 
@@ -123,4 +124,14 @@ let o3Args (args: O3Args) =
         o3read o3 aid [ "u"; "v"; "ww"; "salinity"; "temp" ] t
         |> fun props ->
             props |> Map.iter (fun k v -> printfn $"""{k}: %A{v[0..1]} -> %A{v[^2..^1]}""")
-            eprintfn "o3: wrote object"
+            eprintfn "o3: wrote object"
+
+let newO3Store (server: string) (pool: string)  = {
+    new IBackingStore with
+        member this.readText key = failwith "not implemented"
+        member this.writeText (key, data) = failwith "not implemented"
+        member this.readBinary key = failwith "not implemented"
+        member this.writeBinary (key, data) = failwith "not implemented"
+        member this.readXAttrs key = failwith "not implemented"
+        member this.writeXAttrs (key, attrs) = failwith "not implemented"
+}

src/OZone.fs

@@ -1,17 +1,16 @@
-module Tzar.OZone
+module Format.OZone
 
 open System
 open System.IO
 open Serilog
-open Thoth.Json.Net
 open MessagePack
+open Thoth.Json.Net
 open FSharpPlus
-open ProjNet.FSharp
 
 open Oceanbox.GeoJson
 open Oceanbox.FvcomKit
-
 open Types
+open BackingStore
 
 type OzoneData = {
     s: single[][]
@@ -76,7 +75,7 @@ type sec
 [<Measure>]
 type min
 
-type ArchiveMeta = {
+type O3Index = {
     archiveType: string
     modelArea: Guid
     name: string
@@ -107,23 +106,6 @@ type ArchiveMeta = {
         properties = [| "s"; "t"; "u"; "v"; "w"; "z" |]
     }
 
-type XAttr = {
-    frames: int
-    start: int
-    ctime: DateTime
-    atime: DateTime
-    archiveType: string
-    version: byte
-} with
-    static member empty = {
-        frames = 0
-        start = 0
-        ctime = DateTime.UnixEpoch
-        atime = DateTime.UnixEpoch
-        archiveType = ""
-        version = 0uy
-    }
-
 [<MessagePackObject>]
 type PoolTable = {
     [<Key(0)>]
@@ -133,49 +115,6 @@ type PoolTable = {
 } with
     static member empty = { pools = [||]; frames = [||] }
 
-let ozoneWriteMeta (path: string) (aid: Guid) (meta: ArchiveMeta) =
-    let fname = Path.Join [| path; $"{aid}" |]
-    let json = Encode.Auto.toString meta
-    File.WriteAllText (fname, json)
-
-let ozoneReadMeta (path: string) (aid: Guid) =
-    let fname = Path.Join [| path; $"{aid}" |]
-    File.ReadAllText fname
-    |> Decode.Auto.fromString<ArchiveMeta>
-    |> Result.defaultWith (failwith "invalid index")
-
-let ozoneWriteGrid (path: string) (aid: Guid) (grid: BinGrid) =
-    let fname = Path.Join [| path; $"{aid}.grid" |]
-    let bytes = MessagePackSerializer.Serialize grid
-    File.WriteAllBytes (fname, bytes)
-
-let ozoneReadGrid (path: string) (aid: Guid) =
-    let fname = Path.Join [| path; $"{aid}.grid" |]
-    let bytes = File.ReadAllBytes fname
-    let g = MessagePackSerializer.Deserialize<BinGrid> bytes
-    g
-
-let ozoneWriteXAttrs (path: string) (aid: Guid) (attrs: XAttr) =
-    let fname = Path.Join [| path; $"{aid}.xattr" |]
-    let json = Encode.Auto.toString attrs
-    File.WriteAllText (fname, json)
-
-let ozoneReadXAttrs (path: string) (aid: Guid) =
-    let fname = Path.Join [| path; $"{aid}.xattr" |]
-    File.ReadAllText fname
-    |> Decode.Auto.fromString<XAttr>
-    |> Result.defaultWith (fun x -> failwith $"invalid xattr: {x}")
-
-let ozoneWritePoolTable (path: string) (aid: Guid) (tab: PoolTable) =
-    let fname = Path.Join [| path; $"{aid}.pool" |]
-    let bytes = MessagePackSerializer.Serialize tab
-    File.WriteAllBytes (fname, bytes)
-
-let ozoneReadPoolTable (path: string) (aid: Guid) =
-    let fname = Path.Join [| path; $"{aid}.pool" |]
-    let bytes = File.ReadAllBytes fname
-    MessagePackSerializer.Deserialize<PoolTable> bytes
-
 type private NineBall =
     | Head
     | Tail
@@ -212,29 +151,59 @@ let private ckeckDelPoolTable (p0: PoolTable) (p: PoolTable) =
 let private saneInTheMembrane (p: PoolTable) =
     p.frames |> Array.fold (fun a (_, pool) -> a && int pool < p.pools.Length) true
 
-let ozoneAddFrames (path: string) (aid: Guid) (p: PoolTable) =
-    let xattrs = ozoneReadXAttrs path aid
-    let pt0 = ozoneReadPoolTable path aid
-    let n = p.frames.Length
-    if saneInTheMembrane p then
-        let pt =
-            match ckeckAddPoolTable pt0 p with
-            | Head -> { pt0 with frames = Array.append p.frames pt0.frames }
-            | Tail -> { pt0 with frames = Array.append pt0.frames p.frames }
-            | Fail -> failwith "frame mismatch"
-        ozoneWriteXAttrs path aid { xattrs with frames = xattrs.frames + n; start = fst pt.frames[0] }
-        ozoneWritePoolTable path aid pt
-    else
-        failwith "pool index out of bounds"
+type O3Archive(store: IBackingStore) =
+    member this.writeMetadata (aid: Guid) (meta: O3Index) =
+        let json = Encode.Auto.toString meta
+        store.writeText ($"{aid}", json)
 
-let ozoneDelFrames (path: string) (aid: Guid) (p: PoolTable) =
-    let xattrs = ozoneReadXAttrs path aid
-    let pt0 = ozoneReadPoolTable path aid
-    let n = p.frames.Length
-    let pt =
-        match ckeckDelPoolTable pt0 p with
-        | Head -> { pt0 with frames = pt0.frames[n..] }
-        | Tail -> { pt0 with frames = pt0.frames[..^n] }
-        | Fail -> failwith "frame mismatch"
-    ozoneWriteXAttrs path aid { xattrs with frames = xattrs.frames - n; start = fst pt.frames[0] }
-    ozoneWritePoolTable path aid pt
+    member this.readMetadata (aid: Guid) =
+        store.readText $"{aid}"
+        |> Decode.Auto.fromString<O3Index>
+        |> Result.defaultWith (failwith "invalid index")
+
+    member this.writeGrid (aid: Guid) (grid: BinGrid) =
+        let bytes = MessagePackSerializer.Serialize grid
+        store.writeBinary ($"{aid}.grid", bytes)
+
+    member this.readGrid (aid: Guid) =
+        let bytes = store.readBinary $"{aid}.grid"
+        MessagePackSerializer.Deserialize<BinGrid> bytes
+
+    member this.writeXAttrs (aid: Guid) (attrs: XAttrs) = store.writeXAttrs ($"{aid}", attrs)
+
+    member this.readXAttrs (aid: Guid) =  store.readXAttrs $"{aid}.xattr"
+
+    member this.writePoolTable (aid: Guid) (tab: PoolTable) =
+        let bytes = MessagePackSerializer.Serialize tab
+        store.writeBinary ($"{aid}.pool", bytes)
+
+    member this.readPoolTable (aid: Guid) =
+        let bytes = store.readBinary $"{aid}.pool"
+        MessagePackSerializer.Deserialize<PoolTable> bytes
+
+    member this.addFrames (aid: Guid) (p: PoolTable) =
+        let xattrs = this.readXAttrs aid
+        let pt0 = this.readPoolTable aid
+        let n = p.frames.Length
+        if saneInTheMembrane p then
+            let pt =
+                match ckeckAddPoolTable pt0 p with
+                | Head -> { pt0 with frames = Array.append p.frames pt0.frames }
+                | Tail -> { pt0 with frames = Array.append pt0.frames p.frames }
+                | Fail -> failwith "frame mismatch"
+            this.writeXAttrs aid { xattrs with frames = xattrs.frames + n; start = fst pt.frames[0] }
+            this.writePoolTable aid pt
+        else
+            failwith "pool index out of bounds"
+
+    member this.delFrames (aid: Guid) (p: PoolTable) =
+        let xattrs = this.readXAttrs aid
+        let pt0 = this.readPoolTable aid
+        let n = p.frames.Length
+        let pt =
+            match ckeckDelPoolTable pt0 p with
+            | Head -> { pt0 with frames = pt0.frames[n..] }
+            | Tail -> { pt0 with frames = pt0.frames[..^n] }
+            | Fail -> failwith "frame mismatch"
+        this.writeXAttrs aid { xattrs with frames = xattrs.frames - n; start = fst pt.frames[0] }
+        this.writePoolTable aid pt

src/S3.fs

@@ -1,4 +1,4 @@
-module S3
+module BackingStore.S3
 
 open System
 open Amazon.S3
@@ -126,4 +126,14 @@ let putObjectAsync (data: byte[]) (bucket: string) (key: string) =
         // let n = int ob.ResponseStream.Length
         // buf.bytes <- reader.ReadBytes n
         return ()
-    }
+    }
+
+let newS3Store (server: string) (bucket: string)  = {
+    new IBackingStore with
+        member this.readText key = failwith "not implemented"
+        member this.writeText (key, data) = failwith "not implemented"
+        member this.readBinary key = failwith "not implemented"
+        member this.writeBinary (key, data) = failwith "not implemented"
+        member this.readXAttrs key = failwith "not implemented"
+        member this.writeXAttrs (key, attrs) = failwith "not implemented"
+}

src/Types.fs

@@ -84,40 +84,6 @@ let bytesToSingles (buf: UnionArray) =
         res[i] <- buf.singles[i]
     res
 
-type Archive =
-    | OZone of string
-    | Zarr of string
-    | Nc of string
-    member this.Value =
-        match this with
-        | OZone x -> x
-        | Zarr x -> x
-        | Nc x -> x
-
-type Store =
-    | O3 of Archive
-    | S3 of Archive
-    | Dir of Archive
-    | File of Archive
-    | Unknown
-
-let uriToArchive (uri: System.Uri) =
-    if uri.LocalPath.EndsWith ".nc" then Nc uri.LocalPath
-    elif uri.LocalPath.EndsWith ".zarr" then Zarr uri.LocalPath
-    else OZone uri.LocalPath
-
-let uriToArchiveStore (uri: System.Uri) =
-    let archive = uriToArchive uri
-    match uri.Scheme with
-    | "o3" -> O3 archive
-    | "s3" -> S3 archive
-    | "dir" -> Dir archive
-    | "file" ->
-        match archive with
-        | OZone _ -> Unknown
-        | _ -> File archive
-    | _ -> Unknown
-
 let toLonLat proj (coords: (float * float)[]) =
     let coordsys =
         Transformations.stringToTransformation proj

src/Tzar.fsproj

@@ -16,10 +16,11 @@
     <Compile Include="Settings.fs" />
     <Compile Include="Types.fs" />
     <Compile Include="Cli.fs" />
-    <Compile Include="Fvcom.fs" />
-    <Compile Include="OZone.fs" />
+    <Compile Include="BackingStore.fs" />
     <Compile Include="O3.fs" />
     <Compile Include="S3.fs" />
+    <Compile Include="Fvcom.fs" />
+    <Compile Include="OZone.fs" />
     <Compile Include="Zarr.fs" />
     <Compile Include="Init.fs" />
     <Compile Include="Copy.fs" />

src/Zarr.fs

@@ -1,4 +1,4 @@
-module Zarr
+module Format.Zarr
 
 open System
 open Serilog

tests/Tests.fs

@@ -33,7 +33,7 @@ type OZoneTests() =
     member this.``init o3`` () =
         expect {
             snapshot "True"
-            ozoneWriteMeta pool aid ArchiveMeta.empty
+            ozoneWriteMeta pool aid ArchiveIdx.empty
             ozoneWriteGrid pool aid BinGrid.empty
             ozoneWriteXAttrs pool aid {
                     XAttr.empty with