package eio

  1. Overview
  2. Docs
Effect-based direct-style IO API for OCaml

Install 

dune-project
 Dependency

github.com Readme Changelog ISC License Edit opam file Versions (20)

Authors

  1. A
    Anil Madhavapeddy
  2. T
    Thomas Leonard

Maintainers

  1. A
    anil@recoil.org

Sources

eio-1.4.tbz
sha256=ba11ad486f492130dbb486f2b3bdc4905643f10016806ddf86e9a34e4346aaa5
sha512=57ef2c137ccdc26d8029e636b6a4ee92da7c6b2f35954946bd56ca595d6947a8ec42f6f83f8552f73d6719e6ce2314cae2e2fad1686a387522935e6f90e9a8d9

doc/src/eio/file.ml.html

Source file file.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
open Std

module Unix_perm = struct
  type t = int
end

module Stat = struct
  type kind = [
    | `Unknown
    | `Fifo
    | `Character_special
    | `Directory
    | `Block_device
    | `Regular_file
    | `Symbolic_link
    | `Socket
  ]

  let pp_kind ppf = function
    | `Unknown -> Fmt.string ppf "unknown"
    | `Fifo -> Fmt.string ppf "fifo"
    | `Character_special -> Fmt.string ppf "character special file"
    | `Directory -> Fmt.string ppf "directory"
    | `Block_device -> Fmt.string ppf "block device"
    | `Regular_file -> Fmt.string ppf "regular file"
    | `Symbolic_link -> Fmt.string ppf "symbolic link"
    | `Socket -> Fmt.string ppf "socket"

  type t = {
    dev : Int64.t;
    ino : Int64.t;
    kind : kind;
    perm : Unix_perm.t;
    nlink : Int64.t;
    uid : Int64.t;
    gid : Int64.t;
    rdev : Int64.t;
    size : Optint.Int63.t;
    blksize : Int64.t;
    blocks : Int64.t;
    atime : float;
    mtime : float;
    ctime : float;
  }

  let pp ppf t =
    Fmt.record [
      Fmt.field "dev" (fun t -> t.dev) Fmt.int64;
      Fmt.field "ino" (fun t -> t.ino) Fmt.int64;
      Fmt.field "kind" (fun t -> t.kind) pp_kind;
      Fmt.field "perm" (fun t -> t.perm) (fun ppf i -> Fmt.pf ppf "0o%o" i);
      Fmt.field "nlink" (fun t -> t.nlink) Fmt.int64;
      Fmt.field "uid" (fun t -> t.uid) Fmt.int64;
      Fmt.field "gid" (fun t -> t.gid) Fmt.int64;
      Fmt.field "rdev" (fun t -> t.rdev) Fmt.int64;
      Fmt.field "size" (fun t -> t.size) Optint.Int63.pp;
      Fmt.field "blksize" (fun t -> t.blksize) Fmt.int64;
      Fmt.field "blocks" (fun t -> t.blocks) Fmt.int64;
      Fmt.field "atime" (fun t -> t.atime) Fmt.float;
      Fmt.field "mtime" (fun t -> t.mtime) Fmt.float;
      Fmt.field "ctime" (fun t -> t.ctime) Fmt.float;
    ] ppf t 
end

type ro_ty = [`File | Flow.source_ty | Resource.close_ty]

type 'a ro = ([> ro_ty] as 'a) r

type rw_ty = [ro_ty | Flow.sink_ty]

type 'a rw = ([> rw_ty] as 'a) r

module Pi = struct
  module type READ = sig
    include Flow.Pi.SOURCE

    val pread : t -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
    val stat : t -> Stat.t
    val seek : t -> Optint.Int63.t -> [`Set | `Cur | `End] -> Optint.Int63.t
    val close : t -> unit
  end

  module type WRITE = sig
    include Flow.Pi.SINK
    include READ with type t := t

    val pwrite : t -> file_offset:Optint.Int63.t -> Cstruct.t list -> int
    val sync : t -> unit
    val truncate : t -> Optint.Int63.t -> unit
  end

  type (_, _, _) Resource.pi +=
    | Read : ('t, (module READ with type t = 't), [> ro_ty]) Resource.pi
    | Write : ('t, (module WRITE with type t = 't), [> rw_ty]) Resource.pi

  let ro (type t) (module X : READ with type t = t) =
    Resource.handler [
      H (Flow.Pi.Source, (module X));
      H (Read, (module X));
      H (Resource.Close, X.close);
    ]

  let rw (type t) (module X : WRITE with type t = t) =
    Resource.handler (
      H (Flow.Pi.Sink, (module X)) ::
      H (Write, (module X)) ::
      Resource.bindings (ro (module X))
    )
end

let stat (Resource.T (t, ops)) =
  let module X = (val (Resource.get ops Pi.Read)) in
  X.stat t

let size t = (stat t).size

let pread (Resource.T (t, ops)) ~file_offset bufs =
  let module X = (val (Resource.get ops Pi.Read)) in
  let got = X.pread t ~file_offset bufs in
  assert (got > 0 && got <= Cstruct.lenv bufs);
  got

let pread_exact (Resource.T (t, ops)) ~file_offset bufs =
  let module X = (val (Resource.get ops Pi.Read)) in
  let rec aux ~file_offset bufs =
    if Cstruct.lenv bufs > 0 then (
      let got = X.pread t ~file_offset bufs in
      let file_offset = Optint.Int63.add file_offset (Optint.Int63.of_int got) in
      aux ~file_offset (Cstruct.shiftv bufs got)
    )
  in
  aux ~file_offset bufs

let pwrite_single (Resource.T (t, ops)) ~file_offset bufs =
  let module X = (val (Resource.get ops Pi.Write)) in
  let got = X.pwrite t ~file_offset bufs in
  assert (got > 0 && got <= Cstruct.lenv bufs);
  got

let pwrite_all (Resource.T (t, ops)) ~file_offset bufs =
  let module X = (val (Resource.get ops Pi.Write)) in
  let rec aux ~file_offset bufs =
    if Cstruct.lenv bufs > 0 then (
      let got = X.pwrite t ~file_offset bufs in
      let file_offset = Optint.Int63.add file_offset (Optint.Int63.of_int got) in
      aux ~file_offset (Cstruct.shiftv bufs got)
    )
  in
  aux ~file_offset bufs

let seek (Resource.T (t, ops)) off cmd =
  let module X = (val (Resource.get ops Pi.Read)) in
  X.seek t off cmd

let sync (Resource.T (t, ops)) =
  let module X = (val (Resource.get ops Pi.Write)) in
  X.sync t

let truncate (Resource.T (t, ops)) len =
  let module X = (val (Resource.get ops Pi.Write)) in
  X.truncate t len