Setup Scala
This commit is contained in:
parent
8dec7591dd
commit
13a8e74189
37 changed files with 290 additions and 187 deletions
84
ocaml/lib/drivers.ml
Normal file
84
ocaml/lib/drivers.ml
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
open Import
|
||||
|
||||
module Cli = struct
|
||||
open Cmdliner
|
||||
|
||||
module Terms = struct
|
||||
let year =
|
||||
let doc = "Run problems from year $(docv)." in
|
||||
Arg.(value & opt (some int) None & info [ "year" ] ~docv:"YEAR" ~doc)
|
||||
|
||||
let day =
|
||||
let doc = {|Run problem number "day" $(docv).|} in
|
||||
Arg.(value & opt (some int) None & info [ "day" ] ~docv:"DAY" ~doc)
|
||||
|
||||
let part =
|
||||
let doc = "Run problem part $(docv)." in
|
||||
Arg.(value & opt (some int) None & info [ "part" ] ~docv:"PART" ~doc)
|
||||
|
||||
let auth_token =
|
||||
let doc =
|
||||
"Some operations require authenticating with adventofcode.com . This \
|
||||
is the token used for authentication."
|
||||
in
|
||||
let env = Cmd.Env.(info "AUTH_TOKEN" ~doc) in
|
||||
Arg.(
|
||||
value
|
||||
& opt (some string) None
|
||||
& info [ "auth_token" ] ~docv:"AUTH_TOKEN" ~doc ~env)
|
||||
|
||||
let submit =
|
||||
let doc =
|
||||
"If set, attempts to submit the problem output to adventofcode.com."
|
||||
in
|
||||
Arg.(value & flag & info [ "submit" ] ~docv:"SUBMIT" ~doc)
|
||||
end
|
||||
|
||||
let run (year : int option) (day : int option) (part : int option)
|
||||
(auth_token : string option) (submit : bool) : unit Cmdliner.Term.ret =
|
||||
match (year, day, part) with
|
||||
| None, _, _ -> `Error (false, {|"year" argument required.|})
|
||||
| _, None, _ -> `Error (false, {|"day" argument required.|})
|
||||
| _, _, None -> `Error (false, {|"part" argument required.|})
|
||||
| Some year, Some day, Some part -> (
|
||||
let output =
|
||||
let@ (run_mode : Problem_runner.Run_mode.t) =
|
||||
match (auth_token, submit) with
|
||||
| None, true ->
|
||||
Error {|Must provide AUTH_TOKEN when using --submit|}
|
||||
| token, false ->
|
||||
Ok
|
||||
(Problem_runner.Run_mode.Test_from_puzzle_input
|
||||
{
|
||||
credentials =
|
||||
Option.map Problem_runner.Credentials.of_auth_token
|
||||
token;
|
||||
})
|
||||
| Some token, true ->
|
||||
Ok
|
||||
(Problem_runner.Run_mode.Submit
|
||||
{
|
||||
credentials =
|
||||
Problem_runner.Credentials.of_auth_token token;
|
||||
})
|
||||
in
|
||||
Problem_runner.(run { year; day; part; run_mode })
|
||||
in
|
||||
|
||||
match output with
|
||||
| Ok output ->
|
||||
print_endline output;
|
||||
`Ok ()
|
||||
| Error error_msg -> `Error (false, error_msg))
|
||||
|
||||
let main () =
|
||||
let info = Cmd.info "tanenbaum" in
|
||||
let cmd =
|
||||
Cmd.v info
|
||||
Term.(
|
||||
ret
|
||||
(const run $ Terms.year $ Terms.day $ Terms.part $ Terms.auth_token
|
||||
$ Terms.submit))
|
||||
in
|
||||
exit @@ Cmdliner.Cmd.eval cmd
|
||||
end
|
||||
5
ocaml/lib/drivers.mli
Normal file
5
ocaml/lib/drivers.mli
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
(** Interfaces with core libraries to provide a command-line interface. *)
|
||||
module Cli : sig
|
||||
val main : unit -> unit
|
||||
(** Runs Advent of Code problem runner, via a command-line interface. *)
|
||||
end
|
||||
14
ocaml/lib/dune
Normal file
14
ocaml/lib/dune
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(library
|
||||
(name aoc)
|
||||
(modules drivers problem_runner)
|
||||
(libraries cmdliner piaf problems import))
|
||||
|
||||
(library
|
||||
(name import)
|
||||
(wrapped false)
|
||||
(modules import let fn)
|
||||
(libraries fmt lwt))
|
||||
|
||||
(library
|
||||
(name problem)
|
||||
(modules problem))
|
||||
5
ocaml/lib/fn.ml
Normal file
5
ocaml/lib/fn.ml
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
(** [f << g] composes [f] with [g] right-to-left -- i.e. [f (g x)] *)
|
||||
let (<<) f g x = f (g x)
|
||||
|
||||
(** [f << g] composes [f] with [g] left-to-right -- i.e. [g (f x)] *)
|
||||
let (>>) f g x = g (f x)
|
||||
2
ocaml/lib/import.ml
Normal file
2
ocaml/lib/import.ml
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
include Let
|
||||
include Fn
|
||||
4
ocaml/lib/let.ml
Normal file
4
ocaml/lib/let.ml
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
let (let@) = Result.bind
|
||||
let (let+) = Lwt.bind
|
||||
let (let*) = Lwt_result.bind
|
||||
let (let-) = Option.bind
|
||||
26
ocaml/lib/problem.ml
Normal file
26
ocaml/lib/problem.ml
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
(** The type of an Advent of Code puzzle which can be run by Tanenbaum. *)
|
||||
module type T = sig
|
||||
val year : int
|
||||
(** The year that this puzzle is from. *)
|
||||
|
||||
val day : int
|
||||
(** The day that this puzzle is from. *)
|
||||
|
||||
(** Contains specific to the first part of the puzzle. *)
|
||||
module Part_1 : sig
|
||||
val run : string -> (string, string) result
|
||||
(** Runs the first part of the puzzle.
|
||||
|
||||
This should return [Error] if something goes wrong during execution -- for example, there
|
||||
was a parsing error. If [Error] was returned, Tanenbaum will ignore the [--submit] flag. *)
|
||||
end
|
||||
|
||||
(** Contains specific to the second part of the puzzle. *)
|
||||
module Part_2 : sig
|
||||
val run : string -> (string, string) result
|
||||
(** Runs the second part of the puzzle.
|
||||
|
||||
This should return [Error] if something goes wrong during execution -- for example, there
|
||||
was a parsing error. If [Error] was returned, Tanenbaum will ignore the [--submit] flag. *)
|
||||
end
|
||||
end
|
||||
142
ocaml/lib/problem_runner.ml
Normal file
142
ocaml/lib/problem_runner.ml
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
open Import
|
||||
|
||||
module Credentials = struct
|
||||
type t = string
|
||||
|
||||
let of_auth_token (x : string) : t = x
|
||||
|
||||
let to_headers (t : t) : (string * string) list =
|
||||
[ ("Cookie", "session=" ^ t) ]
|
||||
end
|
||||
|
||||
module Run_mode = struct
|
||||
type t =
|
||||
| Test_from_puzzle_input of { credentials : Credentials.t option }
|
||||
| Submit of { credentials : Credentials.t }
|
||||
|
||||
let read_file (filename : string) : string =
|
||||
let ch = open_in_bin filename in
|
||||
let s = really_input_string ch (in_channel_length ch) in
|
||||
close_in ch;
|
||||
s
|
||||
|
||||
let write_file (filename : string) (contents : string) : unit =
|
||||
let ch = open_out_bin filename in
|
||||
let () = output_string ch contents in
|
||||
close_out ch
|
||||
|
||||
let get_puzzle_input (year : int) (day : int)
|
||||
(credentials : Credentials.t option) : (string, string) result =
|
||||
(* Create cache directory structure *)
|
||||
let () =
|
||||
if not (Sys.file_exists "inputs") then Sys.mkdir "inputs" 0o777 else ()
|
||||
in
|
||||
let year_dir = Filename.concat "inputs" @@ string_of_int year in
|
||||
let () =
|
||||
if not (Sys.file_exists year_dir) then Sys.mkdir year_dir 0o777 else ()
|
||||
in
|
||||
|
||||
(* Check if cached input exists *)
|
||||
let filename =
|
||||
Filename.concat year_dir @@ Format.sprintf "%02d.txt" day
|
||||
in
|
||||
if Sys.file_exists filename then Ok (read_file filename)
|
||||
(* If not, fetch it from adventofcode.com *)
|
||||
else
|
||||
match credentials with
|
||||
| None ->
|
||||
Error "Cannot fetch input from adventofcode.com: missing credentials."
|
||||
| Some credentials ->
|
||||
Result.map_error Piaf.Error.to_string
|
||||
@@ Lwt_main.run
|
||||
@@
|
||||
let uri =
|
||||
Uri.of_string
|
||||
@@ String.concat "/"
|
||||
[
|
||||
"https://adventofcode.com";
|
||||
string_of_int year;
|
||||
"day";
|
||||
string_of_int day;
|
||||
"input";
|
||||
]
|
||||
in
|
||||
let headers = Credentials.to_headers credentials in
|
||||
let* response = Piaf.Client.Oneshot.get ~headers uri in
|
||||
let* body = Piaf.Body.to_string response.body in
|
||||
write_file filename body;
|
||||
Lwt_result.return body
|
||||
|
||||
let get_input (year : int) (day : int) : t -> (string, string) result =
|
||||
function
|
||||
| Test_from_puzzle_input { credentials } ->
|
||||
get_puzzle_input year day credentials
|
||||
| Submit { credentials } -> get_puzzle_input year day (Some credentials)
|
||||
|
||||
let cleanup (year : int) (day : int) (part : int) (output : string)
|
||||
(run_mode : t) : (string option, string) result =
|
||||
match run_mode with
|
||||
| Test_from_puzzle_input _ -> Ok None
|
||||
| Submit { credentials } ->
|
||||
Result.map_error Piaf.Error.to_string
|
||||
@@ Lwt_main.run
|
||||
@@
|
||||
let uri =
|
||||
Uri.of_string
|
||||
@@ String.concat "/"
|
||||
[
|
||||
"https://adventofcode.com";
|
||||
string_of_int year;
|
||||
"day";
|
||||
string_of_int day;
|
||||
"answer";
|
||||
]
|
||||
in
|
||||
let headers = Credentials.to_headers credentials in
|
||||
let headers =
|
||||
headers @ [ ("Content-Type", "application/x-www-form-urlencoded") ]
|
||||
in
|
||||
let body =
|
||||
Piaf.Body.of_string @@ Fmt.(str "level=%d&answer=%s" part output)
|
||||
in
|
||||
let* response = Piaf.Client.Oneshot.post ~headers ~body uri in
|
||||
let* body = Piaf.Body.to_string response.body in
|
||||
Lwt_result.return (Some body)
|
||||
end
|
||||
|
||||
module Options = struct
|
||||
type t = { year : int; day : int; part : int; run_mode : Run_mode.t }
|
||||
end
|
||||
|
||||
let run_problem (module Problem : Problem.T) (run_mode : Run_mode.t)
|
||||
(year : int) (day : int) (part : int) : (string, string) result =
|
||||
let@ input = Run_mode.get_input year day run_mode in
|
||||
let@ result =
|
||||
match part with
|
||||
| 1 -> Problem.Part_1.run input
|
||||
| 2 -> Problem.Part_2.run input
|
||||
| p -> Error (Format.sprintf {|Invalid part "%d". Expected "1" or "2".|} p)
|
||||
in
|
||||
let@ cleanup_result = Run_mode.cleanup year day part result run_mode in
|
||||
let () =
|
||||
match cleanup_result with None -> () | Some result -> print_endline result
|
||||
in
|
||||
Ok result
|
||||
|
||||
let find_problem (year : int) (day : int) :
|
||||
((module Problem.T), string) result =
|
||||
match
|
||||
List.find_opt
|
||||
(fun (module Problem : Problem.T) ->
|
||||
Problem.year = year && Problem.day = day)
|
||||
Problems.All.all
|
||||
with
|
||||
| Some p -> Ok p
|
||||
| None ->
|
||||
Error
|
||||
(Format.sprintf "Problem (year = %d, day = %d) not implemented."
|
||||
year day)
|
||||
|
||||
let run (options : Options.t) : (string, string) result =
|
||||
let@ problem = find_problem options.year options.day in
|
||||
run_problem problem options.run_mode options.year options.day options.part
|
||||
43
ocaml/lib/problem_runner.mli
Normal file
43
ocaml/lib/problem_runner.mli
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
(** Credentials are used to authenticate with [adventofcode.com], to automate some slightly
|
||||
annoying things that you need to do when working on puzzle solutions. *)
|
||||
module Credentials : sig
|
||||
type t
|
||||
(** A complete set of credentials used to authenticate with [adventofcode.com]. *)
|
||||
|
||||
val of_auth_token : string -> t
|
||||
(** [of_auth_token session_token] constructs a [t] from the session token issued by
|
||||
[adventofcode.com]. *)
|
||||
end
|
||||
|
||||
(** Specifies the way that we'd like our problem runner to run. *)
|
||||
module Run_mode : sig
|
||||
(** Specifies the way that we'd like our problem runner to run. *)
|
||||
type t =
|
||||
| Test_from_puzzle_input of { credentials : Credentials.t option }
|
||||
(** Indicates that we'd like to test the puzzle solution that we're working on, without
|
||||
submitting the answer to [adventofcode.com] *)
|
||||
| Submit of { credentials : Credentials.t }
|
||||
(** Indicates that we'd like to run a puzzle solution, and if successful, submit the answer to
|
||||
[adventofcode.com] *)
|
||||
end
|
||||
|
||||
(** Fully configures an invocation of [run]. *)
|
||||
module Options : sig
|
||||
type t = {
|
||||
year : int;
|
||||
(** The "year" of the puzzle that we'd like to run -- e.g. [2015], or [2022]. *)
|
||||
day : int;
|
||||
(** The "day" of the puzzle that we'd like to run -- e.g. [1], or [18]. *)
|
||||
part : int;
|
||||
(** The "part" of the puzzle that we'd like to run -- i.e. [1], or [2]. *)
|
||||
run_mode : Run_mode.t;
|
||||
(** The "run_mode" of the puzzle that we'd like to run. See [Run_mode] for more details. *)
|
||||
}
|
||||
(** Fully configures an invocation of [run]. *)
|
||||
end
|
||||
|
||||
val run : Options.t -> (string, string) result
|
||||
(** [run options] runs a puzzle solution, configured by [options].
|
||||
|
||||
This may return [Error] for a number of reasons -- the returned [string] should indicate what
|
||||
went wrong. *)
|
||||
12
ocaml/lib/problems/dune
Normal file
12
ocaml/lib/problems/dune
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(rule
|
||||
(target all.ml)
|
||||
(deps
|
||||
(:problem_files
|
||||
(glob_files "./problem*{[!r][!e].ml,.re}"))
|
||||
(:generator generator/gen.exe))
|
||||
(action
|
||||
(run %{generator} %{target} %{problem_files})))
|
||||
|
||||
(library
|
||||
(name problems)
|
||||
(libraries problem import str))
|
||||
4
ocaml/lib/problems/generator/dune
Normal file
4
ocaml/lib/problems/generator/dune
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
(executable
|
||||
(name gen)
|
||||
(modules gen)
|
||||
(libraries fmt))
|
||||
21
ocaml/lib/problems/generator/gen.ml
Normal file
21
ocaml/lib/problems/generator/gen.ml
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
let pp_module_name (f : Format.formatter) (module_name : string) : unit =
|
||||
Fmt.pf f "(module %s: Problem.T)" module_name
|
||||
|
||||
let pp_file (f : Format.formatter) (module_names : string list) : unit =
|
||||
Fmt.(
|
||||
pf f {ocaml|let all: (module Problem.T) list = [%a]|ocaml}
|
||||
(list ~sep:semi pp_module_name)
|
||||
module_names)
|
||||
|
||||
let () =
|
||||
let output_filename = Array.get Sys.argv 1 in
|
||||
let filenames =
|
||||
Sys.argv |> Array.to_list |> List.tl |> List.tl
|
||||
|> List.map
|
||||
(String.mapi (fun i c -> if i = 0 then Char.uppercase_ascii c else c))
|
||||
|> List.map (fun s -> String.sub s 0 (String.length s - 3))
|
||||
in
|
||||
let contents = Fmt.str "%a" pp_file filenames in
|
||||
let c = open_out output_filename in
|
||||
output_string c contents;
|
||||
close_out c
|
||||
78
ocaml/lib/problems/problem_2023_01.ml
Normal file
78
ocaml/lib/problems/problem_2023_01.ml
Normal file
|
|
@ -0,0 +1,78 @@
|
|||
let year = 2023
|
||||
let day = 1
|
||||
|
||||
module Part_1 = struct
|
||||
let run (input : string) : (string, string) result =
|
||||
let string_to_digits s =
|
||||
String.to_seq s |> Seq.map Char.escaped |> Seq.map int_of_string_opt
|
||||
|> Seq.flat_map Option.to_seq |> Seq.map Int.to_string |> List.of_seq
|
||||
in
|
||||
let rec concat_digits = function
|
||||
| [] -> 0
|
||||
| [ x ] -> int_of_string (x ^ x)
|
||||
| [ first; last ] -> int_of_string (first ^ last)
|
||||
| first :: _ :: xs -> concat_digits (first :: xs)
|
||||
in
|
||||
let result =
|
||||
String.split_on_char '\n' input
|
||||
|> List.map string_to_digits |> List.map concat_digits
|
||||
|> List.fold_left ( + ) 0 |> Int.to_string
|
||||
in
|
||||
Ok result
|
||||
end
|
||||
|
||||
module Part_2 = struct
|
||||
let run (input : string) : (string, string) result =
|
||||
let word_to_digit_list =
|
||||
[
|
||||
("one", "1");
|
||||
("two", "2");
|
||||
("three", "3");
|
||||
("four", "4");
|
||||
("five", "5");
|
||||
("six", "6");
|
||||
("seven", "7");
|
||||
("eight", "8");
|
||||
("nine", "9");
|
||||
("1", "1");
|
||||
("2", "2");
|
||||
("3", "3");
|
||||
("4", "4");
|
||||
("5", "5");
|
||||
("6", "6");
|
||||
("7", "7");
|
||||
("8", "8");
|
||||
("9", "9");
|
||||
]
|
||||
in
|
||||
let rec find_first_digit string =
|
||||
match
|
||||
List.find_opt
|
||||
(fun (word, _) -> String.starts_with ~prefix:word string)
|
||||
word_to_digit_list
|
||||
with
|
||||
| Some (_, digit) -> digit
|
||||
| None ->
|
||||
find_first_digit (String.sub string 1 (String.length string - 1))
|
||||
in
|
||||
let rec find_last_digit string =
|
||||
match
|
||||
List.find_opt
|
||||
(fun (word, _) -> String.ends_with ~suffix:word string)
|
||||
word_to_digit_list
|
||||
with
|
||||
| Some (_, digit) -> digit
|
||||
| None -> find_last_digit (String.sub string 0 (String.length string - 1))
|
||||
in
|
||||
let concat_digits s =
|
||||
let first = find_first_digit s in
|
||||
let last = find_last_digit s in
|
||||
int_of_string (first ^ last)
|
||||
in
|
||||
let result =
|
||||
input |> String.split_on_char '\n'
|
||||
|> List.filter (fun s -> String.length s > 0)
|
||||
|> List.map concat_digits |> List.fold_left ( + ) 0 |> Int.to_string
|
||||
in
|
||||
Ok result
|
||||
end
|
||||
46
ocaml/lib/problems/problem_2023_02.ml
Normal file
46
ocaml/lib/problems/problem_2023_02.ml
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
let year = 2023
|
||||
let day = 1
|
||||
|
||||
module Part_1 = struct
|
||||
type color = Red | Blue | Green
|
||||
type set = { count : int; color : color }
|
||||
type game = { number : int; sets : set list }
|
||||
|
||||
let print_game { number ; _ } =
|
||||
Printf.sprintf "%i" number
|
||||
|
||||
let run (input : string) : (string, string) result =
|
||||
let parse_color = function
|
||||
| "red" -> Red
|
||||
| "blue" -> Blue
|
||||
| "green" -> Green
|
||||
| _ -> assert false
|
||||
in
|
||||
let parse_set str =
|
||||
match String.split_on_char ',' str with
|
||||
| [ number; color ] ->
|
||||
{ count = int_of_string number; color = parse_color color }
|
||||
| _ -> assert false
|
||||
in
|
||||
let parse_sets str = String.split_on_char ';' str |> List.map parse_set in
|
||||
let parse_game_number str =
|
||||
match String.trim str |> String.split_on_char ' ' with
|
||||
| [ _; number ] -> int_of_string number
|
||||
| _ -> assert false
|
||||
in
|
||||
let parse_line str =
|
||||
match String.split_on_char ':' str with
|
||||
| [ prefix; suffix ] ->
|
||||
{ number = parse_game_number prefix; sets = parse_sets suffix }
|
||||
| _ -> assert false
|
||||
in
|
||||
let (games : game list) =
|
||||
input |> String.trim |> String.split_on_char '\n' |> List.map parse_line
|
||||
in
|
||||
Ok (List.hd games |> print_game)
|
||||
end
|
||||
|
||||
module Part_2 = struct
|
||||
let run (input : string) : (string, string) result =
|
||||
Ok input
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue