Skip to content

Commit

Permalink
Add Umarshal.t for most of types used in Remote
Browse files Browse the repository at this point in the history
  • Loading branch information
@glondu
glondu committed Oct 19, 2020
1 parent ee2c2a2 commit 6bccf45
Show file tree
Hide file tree
Showing 32 changed files with 428 additions and 13 deletions.
39 changes: 36 additions & 3 deletions src/.depend
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,7 @@ clroot.cmi :
common.cmo : \
uutil.cmi \
ubase/util.cmi \
ubase/umarshal.cmi \
ubase/safelist.cmi \
props.cmi \
path.cmi \
Expand All @@ -62,6 +63,7 @@ common.cmo : \
common.cmx : \
uutil.cmx \
ubase/util.cmx \
ubase/umarshal.cmx \
ubase/safelist.cmx \
props.cmx \
path.cmx \
Expand All @@ -73,6 +75,7 @@ common.cmx : \
common.cmi
common.cmi : \
uutil.cmi \
ubase/umarshal.cmi \
props.cmi \
path.cmi \
osx.cmi \
Expand All @@ -85,6 +88,7 @@ copy.cmo : \
uutil.cmi \
ubase/util.cmi \
update.cmi \
ubase/umarshal.cmi \
transfer.cmi \
ubase/trace.cmi \
ubase/safelist.cmi \
Expand Down Expand Up @@ -113,6 +117,7 @@ copy.cmx : \
uutil.cmx \
ubase/util.cmx \
update.cmx \
ubase/umarshal.cmx \
transfer.cmx \
ubase/trace.cmx \
ubase/safelist.cmx \
Expand Down Expand Up @@ -392,6 +397,7 @@ fsmonitor/windows/watcher.cmx : \
fspath.cmo : \
uutil.cmi \
ubase/util.cmi \
ubase/umarshal.cmi \
system.cmi \
ubase/rx.cmi \
path.cmi \
Expand All @@ -401,13 +407,15 @@ fspath.cmo : \
fspath.cmx : \
uutil.cmx \
ubase/util.cmx \
ubase/umarshal.cmx \
system.cmx \
ubase/rx.cmx \
path.cmx \
name.cmx \
fileutil.cmx \
fspath.cmi
fspath.cmi : \
ubase/umarshal.cmi \
system.cmi \
path.cmi \
name.cmi
Expand Down Expand Up @@ -610,15 +618,18 @@ main.cmx : \
os.cmx
name.cmo : \
ubase/util.cmi \
ubase/umarshal.cmi \
ubase/rx.cmi \
case.cmi \
name.cmi
name.cmx : \
ubase/util.cmx \
ubase/umarshal.cmx \
ubase/rx.cmx \
case.cmx \
name.cmi
name.cmi :
name.cmi : \
ubase/umarshal.cmi
os.cmo : \
uutil.cmi \
ubase/util.cmi \
Expand Down Expand Up @@ -699,6 +710,7 @@ osx.cmi : \
fingerprint.cmi
path.cmo : \
ubase/util.cmi \
ubase/umarshal.cmi \
ubase/safelist.cmi \
ubase/rx.cmi \
pred.cmi \
Expand All @@ -708,6 +720,7 @@ path.cmo : \
path.cmi
path.cmx : \
ubase/util.cmx \
ubase/umarshal.cmx \
ubase/safelist.cmx \
ubase/rx.cmx \
pred.cmx \
Expand All @@ -716,6 +729,7 @@ path.cmx : \
case.cmx \
path.cmi
path.cmi : \
ubase/umarshal.cmi \
pred.cmi \
name.cmi
pixmaps.cmo :
Expand Down Expand Up @@ -807,6 +821,7 @@ recon.cmi : \
remote.cmo : \
uutil.cmi \
ubase/util.cmi \
ubase/umarshal.cmi \
ubase/trace.cmi \
terminal.cmi \
system.cmi \
Expand All @@ -826,6 +841,7 @@ remote.cmo : \
remote.cmx : \
uutil.cmx \
ubase/util.cmx \
ubase/umarshal.cmx \
ubase/trace.cmx \
terminal.cmx \
system.cmx \
Expand Down Expand Up @@ -970,6 +986,7 @@ test.cmo : \
uutil.cmi \
ubase/util.cmi \
update.cmi \
ubase/umarshal.cmi \
uicommon.cmi \
transport.cmi \
ubase/trace.cmi \
Expand All @@ -993,6 +1010,7 @@ test.cmx : \
uutil.cmx \
ubase/util.cmx \
update.cmx \
ubase/umarshal.cmx \
uicommon.cmx \
transport.cmx \
ubase/trace.cmx \
Expand Down Expand Up @@ -1072,31 +1090,40 @@ transport.cmi : \
lwt/lwt.cmi \
common.cmi
tree.cmo : \
ubase/umarshal.cmi \
ubase/safelist.cmi \
tree.cmi
tree.cmx : \
ubase/umarshal.cmx \
ubase/safelist.cmx \
tree.cmi
tree.cmi :
tree.cmi : \
ubase/umarshal.cmi
ubase/myMap.cmo : \
ubase/umarshal.cmi \
ubase/myMap.cmi
ubase/myMap.cmx : \
ubase/umarshal.cmx \
ubase/myMap.cmi
ubase/myMap.cmi :
ubase/myMap.cmi : \
ubase/umarshal.cmi
ubase/prefs.cmo : \
ubase/util.cmi \
ubase/umarshal.cmi \
ubase/uarg.cmi \
system.cmi \
ubase/safelist.cmi \
ubase/prefs.cmi
ubase/prefs.cmx : \
ubase/util.cmx \
ubase/umarshal.cmx \
ubase/uarg.cmx \
system.cmx \
ubase/safelist.cmx \
ubase/prefs.cmi
ubase/prefs.cmi : \
ubase/util.cmi \
ubase/umarshal.cmi \
system.cmi
ubase/projectInfo.cmo :
ubase/projectInfo.cmx :
Expand All @@ -1119,17 +1146,20 @@ ubase/safelist.cmx : \
ubase/safelist.cmi :
ubase/trace.cmo : \
ubase/util.cmi \
ubase/umarshal.cmi \
system.cmi \
ubase/safelist.cmi \
ubase/prefs.cmi \
ubase/trace.cmi
ubase/trace.cmx : \
ubase/util.cmx \
ubase/umarshal.cmx \
system.cmx \
ubase/safelist.cmx \
ubase/prefs.cmx \
ubase/trace.cmi
ubase/trace.cmi : \
ubase/umarshal.cmi \
ubase/prefs.cmi
ubase/uarg.cmo : \
ubase/util.cmi \
Expand Down Expand Up @@ -1441,6 +1471,7 @@ update.cmo : \
xferhint.cmi \
uutil.cmi \
ubase/util.cmi \
ubase/umarshal.cmi \
tree.cmi \
ubase/trace.cmi \
system.cmi \
Expand Down Expand Up @@ -1472,6 +1503,7 @@ update.cmx : \
xferhint.cmx \
uutil.cmx \
ubase/util.cmx \
ubase/umarshal.cmx \
tree.cmx \
ubase/trace.cmx \
system.cmx \
Expand Down Expand Up @@ -1501,6 +1533,7 @@ update.cmx : \
update.cmi
update.cmi : \
uutil.cmi \
ubase/umarshal.cmi \
tree.cmi \
props.cmi \
path.cmi \
Expand Down
57 changes: 57 additions & 0 deletions src/common.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,12 +72,38 @@ type prevState =
Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp
| New

let mprevState = Umarshal.(sum2
(prod4 Fileinfo.mtyp Props.m Os.mfullfingerprint Osx.mressStamp id id)
unit
(function
| Previous (a, b, c, d) -> I21 (a, b, c, d)
| New -> I22 ())
(function
| I21 (a, b, c, d) -> Previous (a, b, c, d)
| I22 () -> New))

type contentschange =
ContentsSame
| ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp

let mcontentschange = Umarshal.(sum2 unit (prod3 Os.mfullfingerprint Fileinfo.mstamp Osx.mressStamp id id)
(function
| ContentsSame -> I21 ()
| ContentsUpdated (a, b, c) -> I22 (a, b, c))
(function
| I21 () -> ContentsSame
| I22 (a, b, c) -> ContentsUpdated (a, b, c)))

type permchange = PropsSame | PropsUpdated

let mpermchange = Umarshal.(sum2 unit unit
(function
| PropsSame -> I21 ()
| PropsUpdated -> I22 ())
(function
| I21 () -> PropsSame
| I22 () -> PropsUpdated))

type updateItem =
NoUpdates (* Path not changed *)
| Updates (* Path changed in this replica *)
Expand All @@ -100,6 +126,37 @@ and updateContent =
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)

let mupdateItem_rec mupdateContent =
Umarshal.(sum3 unit (prod2 mupdateContent mprevState id id) string
(function
| NoUpdates -> I31 ()
| Updates (a, b) -> I32 (a, b)
| Error a -> I33 a)
(function
| I31 () -> NoUpdates
| I32 (a, b) -> Updates (a, b)
| I33 a -> Error a))

let mupdateContent_rec mupdateItem =
Umarshal.(sum4
unit
(prod2 Props.m mcontentschange id id)
(prod4 Props.m (list (prod2 Name.m mupdateItem id id)) mpermchange bool id id)
string
(function
| Absent -> I41 ()
| File (a, b) -> I42 (a, b)
| Dir (a, b, c, d) -> I43 (a, b, c, d)
| Symlink a -> I44 a)
(function
| I41 () -> Absent
| I42 (a, b) -> File (a, b)
| I43 (a, b, c, d) -> Dir (a, b, c, d)
| I44 a -> Symlink a))

let mupdateContent, mupdateItem =
Umarshal.rec2 mupdateItem_rec mupdateContent_rec

(* ------------------------------------------------------------------------- *)

type status =
Expand Down
2 changes: 2 additions & 0 deletions src/common.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,6 +74,8 @@ and updateContent =
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)

val mupdateItem : updateItem Umarshal.t
val mupdateContent : updateContent Umarshal.t

(*****************************************************************************)
(* COMMON TYPES SHARED BY RECONCILER AND TRANSPORT AGENT *)
Expand Down
13 changes: 13 additions & 0 deletions src/copy.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -173,6 +173,19 @@ type transferStatus =
| TransferNeedsDoubleCheckAgainstCurrentSource of Fileinfo.t * Os.fullfingerprint
| TransferFailed of string

let mtransferStatus = Umarshal.(sum3
Fileinfo.m
(prod2 Fileinfo.m Os.mfullfingerprint id id)
string
(function
| TransferSucceeded a -> I31 a
| TransferNeedsDoubleCheckAgainstCurrentSource (a, b) -> I32 (a, b)
| TransferFailed a -> I33 a)
(function
| I31 a -> TransferSucceeded a
| I32 (a, b) -> TransferNeedsDoubleCheckAgainstCurrentSource (a, b)
| I33 a -> TransferFailed a))

(* Paranoid check: recompute the transferred file's fingerprint to match it
with the archive's. If the old
fingerprint was a pseudo-fingerprint, we can't tell just from looking at the
Expand Down
16 changes: 16 additions & 0 deletions src/fileinfo.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,18 @@ let init b =

type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ]

let mtyp = Umarshal.(sum4 unit unit unit unit
(function
| `ABSENT -> I41 ()
| `FILE -> I42 ()
| `DIRECTORY -> I43 ()
| `SYMLINK -> I44 ())
(function
| I41 () -> `ABSENT
| I42 () -> `FILE
| I43 () -> `DIRECTORY
| I44 () -> `SYMLINK))

let type2string = function
`ABSENT -> "nonexistent"
| `FILE -> "file"
Expand All @@ -48,6 +60,10 @@ let type2string = function

type t = { typ : typ; inode : int; desc : Props.t; osX : Osx.info}

let m = Umarshal.(prod4 mtyp int Props.m Osx.minfo
(fun {typ; inode; desc; osX} -> typ, inode, desc, osX)
(fun (typ, inode, desc, osX) -> {typ; inode; desc; osX}))

(* Stat function that pays attention to pref for following links *)
let statFn fromRoot fspath path =
let fullpath = Fspath.concat fspath path in
Expand Down
3 changes: 3 additions & 0 deletions src/fileinfo.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,10 +2,13 @@
(* Copyright 1999-2020, Benjamin C. Pierce (see COPYING for details) *)

type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK]
val mtyp : typ Umarshal.t
val type2string : typ -> string

type t = { typ : typ; inode : int; desc : Props.t; osX : Osx.info}

val m : t Umarshal.t

val get : bool (* fromRoot *) -> Fspath.t -> Path.local -> t
val set : Fspath.t -> Path.local ->
[`Set of Props.t | `Copy of Path.local | `Update of Props.t] ->
Expand Down
2 changes: 2 additions & 0 deletions src/fspath.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,8 @@ let debugverbose = Util.debug "fsspath+"

type t = Fspath of string

let m = Umarshal.(sum1 string (function Fspath a -> a) (function a -> Fspath a))

let toString (Fspath f) = f
let toPrintString (Fspath f) = f
let toDebugString (Fspath f) = String.escaped f
Expand Down
2 changes: 2 additions & 0 deletions src/fspath.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@

type t

val m : t Umarshal.t

val child : t -> Name.t -> t
val concat : t -> Path.local -> t

Expand Down
Loading

0 comments on commit 6bccf45

Please sign in to comment.