Source file decoder.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
(** Copyright © Inria 2022

    @author Pierre Lermusiaux <pierre.lermusiaux@inria.fr> *)

open Sexp_decode
open Datatypes

module type S = sig
  type t

  val decoder : t decoder
end

module SetDecoder : S with type t := Set.Make(String).t = struct
  module StringSet = Set.Make (String)

  type t = StringSet.t

  let decoder : t decoder =
    group
    @@ repeat_fold_left ~until:no_more ~init:StringSet.empty
         (atom >>| fun x set -> StringSet.add x set)
end

module ModuleDecoder : S with type t := Module.t = struct
  open Module

  type t = Module.t

  let stringSet_decoder = SetDecoder.decoder

  let decoder : t decoder =
    group
      (let* name = field "name" atom in
       let* impl = field "impl" (group atom) in
       let* intf = field "intf" (group (maybe_with_default "" atom)) in
       let* cmt = field "cmt" (group atom) in
       let* cmti = field "cmti" (group (maybe_with_default "" atom)) in
       field "module_deps"
       @@ group
            (let* intf_deps = field "for_intf" stringSet_decoder in
             let+ impl_deps = field "for_impl" stringSet_decoder in
             { name; impl; intf; cmt; cmti; impl_deps; intf_deps } ) )
end

module LibraryDecoder : S with type t := Compilable.t = struct
  open Compilable

  type t = Compilable.t

  let stringSet_decoder = SetDecoder.decoder
  let module_decoder = ModuleDecoder.decoder

  let decoder : t decoder =
    group
      (let* name = field "name" atom in
       let* uid = field "uid" atom in
       let* local = field "local" bool in
       let* requires = field "requires" stringSet_decoder in
       let* source_dir = field "source_dir" atom in
       let* modules = field "modules" @@ list module_decoder in
       let* include_dirs = field "include_dirs" @@ list atom in
       skip_all
       >>> return
           @@ Lib
                { name;
                  uid;
                  local;
                  requires;
                  source_dir;
                  modules;
                  include_dirs
                } )
end

module ExecutablesDecoder : S with type t := Compilable.t = struct
  open Compilable

  type t = Compilable.t

  let stringSet_decoder = SetDecoder.decoder
  let module_decoder = ModuleDecoder.decoder

  let decoder : t decoder =
    group
      (let* names = field "names" @@ list atom in
       let* requires = field "requires" stringSet_decoder in
       let* modules = field "modules" @@ list module_decoder in
       let* include_dirs = field "include_dirs" @@ list atom in
       skip_all >>> return @@ Exe { names; requires; modules; include_dirs } )
end

module WorkspaceDecoder : S with type t := Workspace.t = struct
  open Workspace

  type t = Workspace.t

  let executables_decoder = ExecutablesDecoder.decoder
  let library_decoder = LibraryDecoder.decoder

  let decoder : t decoder =
    group
    @@ let* root = field "root" atom in
       let* context = field "build_context" atom in
       fields
         ~default:{ root; context; compilables = [] }
         [ ( "executables",
             executables_decoder >>| fun e w ->
             { w with compilables = e :: w.compilables } );
           ( "library",
             library_decoder >>| fun l w ->
             { w with compilables = l :: w.compilables } )
         ]
end

let workspace_decoder = WorkspaceDecoder.decoder