Arrow.ml

module StringMap = Map.Make (String)

(* File system path. *)
module Path = struct
  type t = string
end

module type ACTION = sig
  type 'v t

  val run : 'v t -> 'v
end

module BuildSystem (Action : ACTION) = struct
  (* Artifact definition. *)
  module Artifact = struct
    type _ t =
      | Artifact :
          { check: 'repr Action.t option
          ; make: 'repr Action.t }
          -> 'repr t

    let make ?check make = Artifact {check; make}
  end

  (** Rules define how to build artifacts, they can be chained. *)
  module Rule = struct
    type (_, _) t =
      | Build : {define: 'inp -> 'out Artifact.t} -> ('inp, 'out) t
      | Chain : {left: ('a, 'b) t; right: ('b, 'c) t} -> ('a, 'c) t

    let define define = Build {define}

    let chain left right = Chain {left; right}

    let ( >>> ) = chain
  end

  (* This executes rules. *)
  let executeRule (rule : (unit, 'a) Rule.t) =
    let makeArtifact : type repr. repr Artifact.t -> repr = function
      | Artifact.Artifact {make; _} -> Action.run make
    in
    let rec eval : type a b. (a, b) Rule.t -> a -> b =
     fun rule context ->
      match rule with
      | Rule.Build {define} ->
          let artifact = define context in
          makeArtifact artifact
      | Rule.Chain {left; right} -> context |> eval left |> eval right
    in
    eval rule ()
end

(* This represents I/O. *)
module Action = struct
  type _ t =
    | WriteFile : {path: Path.t; data: string} -> Path.t t
    | ReadFile : {path: Path.t} -> string t
    | Bind : ('a -> 'b t) * 'a t -> 'b t
    | Return : 'a -> 'a t

  let return v = Return v

  let bind f a = Bind (f, a)

  let writeFile path data = WriteFile {path; data}

  let readFile path = ReadFile {path}

  module Let_syntax = struct
    let bind ~f v = bind f v
  end

  (* This executes i/O actions and extracts some "result" out of it. *)
  let rec run : type res. res t -> res = function
    | WriteFile {path; data} ->
        let oc = open_out path in
        Printf.fprintf oc "H: %s\n" data ;
        close_out oc ;
        path
    | ReadFile {path} ->
        let ic = open_in path in
        let rec read acc =
          try
            let acc = input_line ic :: acc in
            read acc
          with End_of_file -> acc
        in
        let data = read [] in
        close_in ic ; String.concat "\n" data
    | Bind (f, action) ->
        let action = run action in
        run (f action)
    | Return v -> v
end

let () =
  let module B = BuildSystem (Action) in
  let open B in
  let createConfig =
    B.Rule.define (fun () ->
        Artifact.make Action.(writeFile "fastpack.conf" "{some: config}") )
  in
  let printConfig =
    Rule.define (fun config ->
        Artifact.make
          Action.(
            let%bind data = readFile config in
            print_endline data ; return ()) )
  in
  executeRule Rule.(createConfig >>> printConfig)