Persistence

One API

The tracker saves tasks without knowing where they go. An effect service names the operations, and code that calls them only says it needs a TaskStore. Saving a task whose id already exists replaces it.

type TaskId = new String

type Title = new String #{
  ensure = fn(valuevalue: String) {
    if valuevalue: String == """": String {
      error :empty_title;
    }
  };
}

type Task = {
  id: TaskId;
  title: Title;
}

effect service TaskStore {
  save: fn(task: Task) -> Unit, exn [ :store(String) ];
  find: fn(id: TaskId) -> Option(Task), exn [ :store(String) ];
  all: fn() -> Vector(Task), exn [ :store(String) ];
}

let trackertracker: Book.YouTube.Persistence.Task = Task {
  id = TaskId("task-tracker""task-tracker": String);
  title = Title("Build the task tracker""Build the task tracker": String);
};

let walkthroughwalkthrough: Book.YouTube.Persistence.Task = Task {
  id = TaskId("youtube-walkthrough""youtube-walkthrough": String);
  title = Title("Write the YouTube walkthrough""Write the YouTube walkthrough": String);
};

let renamedrenamed: Book.YouTube.Persistence.Task = { trackertracker: Book.YouTube.Persistence.Task with title = Title("Ship the task tracker""Ship the task tracker": String); };

plan is the whole app as far as storage goes. Every test below runs it unchanged; only the provide block around it differs.

let planplan: fn() -> (Option(Book.YouTube.Persistence.Task), Int), exn [ :store(String) ], eff TaskStore = fn() {
  TaskStore.savesave: fn(task: Book.YouTube.Persistence.Task) -> Unit, exn [ :store(String) ], eff TaskStore(trackertracker: Book.YouTube.Persistence.Task);
  TaskStore.savesave: fn(task: Book.YouTube.Persistence.Task) -> Unit, exn [ :store(String) ], eff TaskStore(walkthroughwalkthrough: Book.YouTube.Persistence.Task);
  TaskStore.savesave: fn(task: Book.YouTube.Persistence.Task) -> Unit, exn [ :store(String) ], eff TaskStore(renamedrenamed: Book.YouTube.Persistence.Task);
  (TaskStore.findfind: fn(id: Book.YouTube.Persistence.TaskId) -> Option(Book.YouTube.Persistence.Task), exn [ :store(String) ], eff TaskStore(trackertracker: Book.YouTube.Persistence.Task.idid: Book.YouTube.Persistence.TaskId), Vector.lengthlength: pure fn!('a)(items: Vector(Book.YouTube.Persistence.Task)) -> Int(TaskStore.allall: fn() -> Vector(Book.YouTube.Persistence.Task), exn [ :store(String) ], eff TaskStore()))
};

Files

The file store writes each task as <id>.json under root. It is a function returning a provider, so each setup picks its own directory. It talks to disk only through the FileSystem service.

Callers only see store errors. fs_to_store turns any disk failure into one, and each function attaches it with >>. A file that fails to decode also names itself, so read_task adds a second stage that can still see name.

let fs_to_storefs_to_store: Unit = function {
  | error :fs(failure) -> error :store(failure.message)
};

let read_taskread_task: fn(root: String, name: String) -> Book.YouTube.Persistence.Task, exn [ :store(String) ], eff FileSystem = fn(rootroot: String: String, namename: String: String) {
  FileSystem.read_stringread_string: fn(root: String, path: String) -> String, exn [ :fs(FileSystem.Error) ], eff FileSystem(rootroot: String, namename: String)
  |> Bytes.of_stringof_string: pure fn!(string: String) -> Bytes
  |> Json.decodedecode: pure fn('target: Decode)(body: Bytes, target: Struct(Book.YouTube.Persistence.Task), ~max_depth: Int = 128) -> Book.YouTube.Persistence.Task, exn [ :decode(Wire.DecodeError) ](Task)
} >> fs_to_store
  >> | error :decode(failurefailure: Wire.DecodeError) -> error :store("${namename: String}: ${failurefailure: Wire.DecodeError.messagemessage: String}");

let read_allread_all: fn(root: String) -> Vector(Book.YouTube.Persistence.Task), exn [ :store(String) ], eff FileSystem = fn(rootroot: String: String) {
  FileSystem.list_dirlist_dir: fn(root: String, path: String) -> Vector(FileSystem.Entry), exn [ :fs(FileSystem.Error) ], eff FileSystem(rootroot: String, "."".": String)
  |> Vector.mapmap: pure fn!('a, 'b)(items: Vector(FileSystem.Entry) @ 'm, ~f: fn(value: FileSystem.Entry @ 'm) -> Book.YouTube.Persistence.Task) -> Vector(Book.YouTube.Persistence.Task)(f = (entryentry: FileSystem.Entry) => read_taskread_task: fn(root: String, name: String) -> Book.YouTube.Persistence.Task, exn [ :store(String) ], eff FileSystem(rootroot: String, entryentry: FileSystem.Entry.namename: String))
} >> fs_to_store;

let file_storefile_store: fn(root: String) -> Service.Provider(TaskStore) = (rootroot: String: String) =>
  module: Service.Provider(TaskStore) #{
    let service Provider: TaskStore = {
      type t = Unit

      init = () => ()(): Unit;

      drop = fn(selfself: t: t) {};

      save = fn(selfself: t: t, tasktask: Book.YouTube.Persistence.Task: Task) {
        let bodybody: String = must String.of_bytesof_bytes: pure fn(bytes: Bytes) -> String, exn [ :utf8(Int) ](must Json.encodeencode: pure fn('a: Encode)(value: Book.YouTube.Persistence.Task) -> Bytes, exn [ :encode(Wire.EncodeError) ](tasktask: Book.YouTube.Persistence.Task));
        FileSystem.write_stringwrite_string: fn(root: String, path: String, body: String) -> Unit, exn [ :fs(FileSystem.Error) ], eff FileSystem(rootroot: String, "${tasktask: Book.YouTube.Persistence.Task.idid: Book.YouTube.Persistence.TaskId}.json", bodybody: String)
      } >> fs_to_store;

      find = fn(selfself: t: t, idid: Book.YouTube.Persistence.TaskId: TaskId) {
        read_allread_all: fn(root: String) -> Vector(Book.YouTube.Persistence.Task), exn [ :store(String) ], eff FileSystem(rootroot: String) |> Vector.findfind: pure fn!('a)(items: Vector(Book.YouTube.Persistence.Task) @ 'm, ~f: fn(value: Book.YouTube.Persistence.Task @ 'm) -> Bool) -> Option(Book.YouTube.Persistence.Task)(f = (tasktask: Book.YouTube.Persistence.Task) => tasktask: Book.YouTube.Persistence.Task.idid: Book.YouTube.Persistence.TaskId == idid: Book.YouTube.Persistence.TaskId)
      };

      all = fn(selfself: t: t) { read_allread_all: fn(root: String) -> Vector(Book.YouTube.Persistence.Task), exn [ :store(String) ], eff FileSystem(rootroot: String) };
    };
  };

The app hands the file store a real directory through LocalFileSystem:

let on_diskon_disk: fn(root: String) -> (Option(Book.YouTube.Persistence.Task), Int), exn [ :store(String) ] = fn(rootroot: String: String) {
  provide { FileSystem = FileSystem.LocalFileSystemLocalFileSystem: service FileSystem; TaskStore = file_storefile_store: fn(root: String) -> Service.Provider(TaskStore)(rootroot: String); } {
    planplan: fn() -> (Option(Book.YouTube.Persistence.Task), Int), exn [ :store(String) ], eff TaskStore()
  }
};

Tests swap the layer underneath instead. MemoryFileSystem keeps files in a vector, so the file store runs exactly as written without touching disk. The store only reads, writes, and lists, so the rest are stubs.

type MemoryFile = {
  path: String;
  body: String;
}

let not_foundnot_found: fn(path: String) -> 'a, exn [ :fs(FileSystem.Error) ] = (pathpath: String: String) =>
  error :fs(
    FileSystem.Error {
      operation = "read""read": String;
      path = pathpath: String;
      message = "not found""not found": String;
    },
  );

let service MemoryFileSystemMemoryFileSystem: service FileSystem: FileSystem = {
  type t = {
    mut files: Vector(MemoryFile);
  }

  init = () -> t =>
    { files = []; };

  drop = fn(selfself: t: t) {};

  read_string = fn(selfself: t: t, rootroot: String: String, pathpath: String: String) {
    match Vector.findfind: pure fn!('a)(items: Vector(Book.YouTube.Persistence.MemoryFile) @ 'm, ~f: fn(value: Book.YouTube.Persistence.MemoryFile @ 'm) -> Bool) -> Option(Book.YouTube.Persistence.MemoryFile)(selfself: Book.YouTube.Persistence.MemoryFileSystem.filesfiles: Vector(Book.YouTube.Persistence.MemoryFile), f = (filefile: Book.YouTube.Persistence.MemoryFile) => filefile: Book.YouTube.Persistence.MemoryFile.pathpath: String == pathpath: String) {
      | Some(filefile: Book.YouTube.Persistence.MemoryFile) -> filefile: Book.YouTube.Persistence.MemoryFile.bodybody: String
      | None -> not_foundnot_found: fn(path: String) -> String, exn [ :fs(FileSystem.Error) ](pathpath: String)
    }
  };

  write_string = fn(selfself: t: t, rootroot: String: String, pathpath: String: String, bodybody: String: String) {
    let othersothers: Vector(Book.YouTube.Persistence.MemoryFile) = Vector.filterfilter: pure fn!('a)(items: Vector(Book.YouTube.Persistence.MemoryFile) @ 'm, ~f: fn(value: Book.YouTube.Persistence.MemoryFile @ 'm) -> Bool) -> Vector(Book.YouTube.Persistence.MemoryFile)(selfself: Book.YouTube.Persistence.MemoryFileSystem.filesfiles: Vector(Book.YouTube.Persistence.MemoryFile), f = (filefile: Book.YouTube.Persistence.MemoryFile) => filefile: Book.YouTube.Persistence.MemoryFile.pathpath: String != pathpath: String);
    self.files := Vector.pushpush: pure fn!('a)(items: Vector(Book.YouTube.Persistence.MemoryFile), item: Book.YouTube.Persistence.MemoryFile) -> Vector(Book.YouTube.Persistence.MemoryFile)(
      othersothers: Vector(Book.YouTube.Persistence.MemoryFile),
      MemoryFile { path = pathpath: String; body = bodybody: String; },
    );
  };

  list_dir = fn(selfself: t: t, rootroot: String: String, pathpath: String: String) {
    Vector.mapmap: pure fn!('a, 'b)(items: Vector(Book.YouTube.Persistence.MemoryFile) @ 'm, ~f: fn(value: Book.YouTube.Persistence.MemoryFile @ 'm) -> FileSystem.Entry) -> Vector(FileSystem.Entry)(
      selfself: Book.YouTube.Persistence.MemoryFileSystem.filesfiles: Vector(Book.YouTube.Persistence.MemoryFile),
      f = (filefile: Book.YouTube.Persistence.MemoryFile) =>
        FileSystem.Entry {
          name = filefile: Book.YouTube.Persistence.MemoryFile.pathpath: String;
          kind = FileSystem.FileFile: FileSystem.EntryKind;
        },
    )
  };

  metadata = fn(selfself: t: t, rootroot: String: String, pathpath: String: String) { not_foundnot_found: fn(path: String) -> 'a, exn [ :fs(FileSystem.Error) ](pathpath: String) };

  make_dir = fn(selfself: t: t, rootroot: String: String, pathpath: String: String) {};

  remove_file = fn(selfself: t: t, rootroot: String: String, pathpath: String: String) {};
};

  let (foundfound: Option(Book.YouTube.Persistence.Task), countcount: Int) = must provide { FileSystem = MemoryFileSystemMemoryFileSystem: service FileSystem; TaskStore = file_storefile_store: fn(root: String) -> Service.Provider(TaskStore)("tasks""tasks": String); } {
    planplan: fn() -> (Option(Book.YouTube.Persistence.Task), Int), exn [ :store(String) ], eff TaskStore()
  };
  expect ✓foundfound: Option(Book.YouTube.Persistence.Task) == SomeSome: fn(Book.YouTube.Persistence.Task) -> Option(Book.YouTube.Persistence.Task)(renamedrenamed: Book.YouTube.Persistence.Task);
  expect ✓countcount: Int == 22: Int;

A file anyone can edit is untrusted input. Decoding a Title runs its ensure, so a blank title on disk surfaces as a store error instead of an invalid Task:

  let outcomeoutcome: String = must provide { FileSystem = MemoryFileSystemMemoryFileSystem: service FileSystem; TaskStore = file_storefile_store: fn(root: String) -> Service.Provider(TaskStore)("tasks""tasks": String); } {
    must FileSystem.write_stringwrite_string: fn(root: String, path: String, body: String) -> Unit, exn [ :fs(FileSystem.Error) ], eff FileSystem(
      "tasks""tasks": String,
      "blank.json""blank.json": String,
      #"{"id":"blank","title":""}"##"{"id":"blank","title":""}"#: String,
    );
    match TaskStore.findfind: fn(id: Book.YouTube.Persistence.TaskId) -> Option(Book.YouTube.Persistence.Task), exn [ :store(String) ], eff TaskStore(TaskId("blank""blank": String)) {
      | _ -> "loaded""loaded": String
      | error :store(messagemessage: String) -> messagemessage: String
    }
  };
  expect ✓outcomeoutcome: String == "blank.json: `Title` failed validation: :empty_title""blank.json: `Title` failed validation: :empty_title": String;

SQLite

The SQLite store keeps the same promises with a database. The branded TaskId and Title types are the columns, so rows come back as checked values and the generated find only accepts a TaskId.

database TaskDb(Sqlite) {
  table Tasks {
    id: TaskId #{ primary = True; };
    title: Title;
  }
}

let as_taskas_task: fn(row: TaskDb.Tasks.Row) -> Book.YouTube.Persistence.Task = (rowrow: TaskDb.Tasks.Row: TaskDb.Tasks.Row) =>
  Task { id = rowrow: TaskDb.Tasks.Row.idid: Book.YouTube.Persistence.TaskId; title = rowrow: TaskDb.Tasks.Row.titletitle: Book.YouTube.Persistence.Title; };

Every operation runs one transaction. db_to_store plays the part fs_to_store did for files. save also records a trace span, so the test can see which saves succeeded.

let db_to_storedb_to_store: Unit = function {
  | error :db(_) -> error :store("database")
};

let service SqliteStoreSqliteStore: service TaskStore: TaskStore = {
  type t = Unit

  init = () => ()(): Unit;

  drop = fn(selfself: t: t) {};

  save = fn(selfself: t: t, tasktask: Book.YouTube.Persistence.Task: Task) {
    with txtx: Database.Transaction(TaskDb) = TaskDb.transactiontransaction: fn!() -> Database.Transaction(TaskDb), eff TaskDb() {
      TaskDb.Tasks.upsertupsert: fn(tx: Database.Transaction(TaskDb), input: TaskDb.Tasks.Insert) -> TaskDb.Tasks.Row, exn! tx [> :db([ :rejected(String) | :unique(String) ]) ](txtx: Database.Transaction(TaskDb), tasktask: Book.YouTube.Persistence.Task) |> ignoreignore: pure fn!('a)(value: TaskDb.Tasks.Row) -> Unit
    }
  } >> db_to_store
    >> Trace.spanspan: pure fn!(name: String) -> Trace.Span("TaskStore.save""TaskStore.save": String);

  find = fn(selfself: t: t, idid: Book.YouTube.Persistence.TaskId: TaskId) {
    with txtx: Database.Transaction(TaskDb) = TaskDb.transactiontransaction: fn!() -> Database.Transaction(TaskDb), eff TaskDb() {
      TaskDb.Tasks.findfind: fn(tx: Database.Transaction(TaskDb), id: Book.YouTube.Persistence.TaskId) -> Option(TaskDb.Tasks.Row), exn! tx [> :db.rejected(String) ](txtx: Database.Transaction(TaskDb), idid: Book.YouTube.Persistence.TaskId) |> Option.mapmap: pure fn!('a, 'b)(option: Option(TaskDb.Tasks.Row) @ 'm, ~f: fn(value: TaskDb.Tasks.Row @ 'm) -> Book.YouTube.Persistence.Task) -> Option(Book.YouTube.Persistence.Task)(f = as_taskas_task: fn(row: TaskDb.Tasks.Row) -> Book.YouTube.Persistence.Task)
    }
  } >> db_to_store;

  all = fn(selfself: t: t) {
    with txtx: Database.Transaction(TaskDb) = TaskDb.transactiontransaction: fn!() -> Database.Transaction(TaskDb), eff TaskDb() {
      TaskDb.Tasks.allall: fn(tx: Database.Transaction(TaskDb)) -> Vector(TaskDb.Tasks.Row), exn! tx [> :db.rejected(String) ](txtx: Database.Transaction(TaskDb)) |> Vector.mapmap: pure fn!('a, 'b)(items: Vector(TaskDb.Tasks.Row) @ 'm, ~f: fn(value: TaskDb.Tasks.Row @ 'm) -> Book.YouTube.Persistence.Task) -> Vector(Book.YouTube.Persistence.Task)(f = as_taskas_task: fn(row: TaskDb.Tasks.Row) -> Book.YouTube.Persistence.Task)
    }
  } >> db_to_store;
};

Same plan, same answers. The setup is the only difference: SQLite needs a database where the file store needed a file system, and Trace.collect() keeps the spans save finishes.

  let (foundfound: Option(Book.YouTube.Persistence.Task), countcount: Int, spansspans: Vector(Trace.Finished)) = must provide { TaskDb = TaskDb.test_databasetest_database: pure fn!() -> Service.Provider(TaskDb)(); Trace = Trace.collectcollect: pure fn!() -> Service.Provider(Trace)(); TaskStore = SqliteStoreSqliteStore: service TaskStore; } {
    let (foundfound: Option(Book.YouTube.Persistence.Task), countcount: Int) = planplan: fn() -> (Option(Book.YouTube.Persistence.Task), Int), exn [ :store(String) ], eff TaskStore();
    (foundfound: Option(Book.YouTube.Persistence.Task), countcount: Int, Trace.finishedfinished: fn!() -> Vector(Trace.Finished), eff Trace())
  };
  expect ✓foundfound: Option(Book.YouTube.Persistence.Task) == SomeSome: fn(Book.YouTube.Persistence.Task) -> Option(Book.YouTube.Persistence.Task)(renamedrenamed: Book.YouTube.Persistence.Task);
  expect ✓countcount: Int == 22: Int;
  expect ✓Vector.lengthlength: pure fn!('a)(items: Vector(Trace.Finished)) -> Int(spansspans: Vector(Trace.Finished)) == 33: Int;
  expect ✓Vector.for_allfor_all: pure fn!('a)(items: Vector(Trace.Finished) @ 'm, ~f: fn(value: Trace.Finished @ 'm) -> Bool) -> Bool(
    spansspans: Vector(Trace.Finished),
    f = (spanspan: Trace.Finished) => spanspan: Trace.Finished.namename: String == "TaskStore.save""TaskStore.save": String && spanspan: Trace.Finished.okok: Bool,
  );