phfroidmont/aoc2023
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
Paul-Henri Froidmont 2023-12-01 10:17:20 +01:00
commit de6ee1b2df
Signed by: phfroidmont
GPG key ID: BE948AFD7E7873BE
26 changed files with 729 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

8
.gitignore vendored Normal file
View file

@ -0,0 +1,8 @@
_build/
_opam/
inputs/
.sl/
.git/
.DS_Store
.envrc
.direnv

2
.ocamlformat Normal file
View file

@ -0,0 +1,2 @@
version = 0.26.1
profile = default

6
.rgignore Normal file
View file

@ -0,0 +1,6 @@
_build/
_opam/
.sl/
.git/
.DS_Store
.envrc

7
CHANGES.md Normal file
View file

@ -0,0 +1,7 @@
___v0.2.0 (2023-11-30)___
* @dmmulroy: Added support for ReasonML
___v0.1.0 (2023-11-26)___
* @sixstring982: Initial release (see README.md for details)

26
LICENSE Normal file
View file

@ -0,0 +1,26 @@
Copyright 2023 Sixstring982
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
3. Neither the name of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this software without
specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

4
bin/dune Normal file
View file

@ -0,0 +1,4 @@
(executable
(public_name tanenbaum)
(name main)
(libraries aoc))

1
bin/main.ml Normal file
View file

@ -0,0 +1 @@
let () = Aoc.Drivers.Cli.main ()

29
dune-project Normal file
View file

@ -0,0 +1,29 @@
(lang dune 3.7)
(name tanenbaum)
(version 0.1.0)
(generate_opam_files true)
(source
(github sixstring982/tanenbaum))
(authors "Sixstring982")
(maintainers "Sixstring982")
(license BSD-3-Clause)
(documentation https://sixstring982.github.io/tanenbaum)
(package
(name tanenbaum)
(synopsis "OCaml Advent of Code starter project")
(depends
ocaml
reason
dune
(cmdliner(>= 1.2.0))
(piaf (>= 0.1.0))
(fmt (>= 0.9.0)))
(tags ("advent-of-code")))

189
flake.lock generated Normal file
View file

@ -0,0 +1,189 @@
{
"nodes": {
"flake-compat": {
"flake": false,
"locked": {
"lastModified": 1627913399,
"narHash": "sha256-hY8g6H2KFL8ownSiFeMOjwPC8P0ueXpCVEbxgda3pko=",
"owner": "edolstra",
"repo": "flake-compat",
"rev": "12c64ca55c1014cdc1b16ed5a804aa8576601ff2",
"type": "github"
},
"original": {
"owner": "edolstra",
"repo": "flake-compat",
"type": "github"
}
},
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1694529238,
"narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"flake-utils_2": {
"locked": {
"lastModified": 1638122382,
"narHash": "sha256-sQzZzAbvKEqN9s0bzWuYmRaA03v40gaJ4+iL1LXjaeI=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "74f7e4319258e287b0f9cb95426c9853b282730b",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"mirage-opam-overlays": {
"flake": false,
"locked": {
"lastModified": 1661959605,
"narHash": "sha256-CPTuhYML3F4J58flfp3ZbMNhkRkVFKmBEYBZY5tnQwA=",
"owner": "dune-universe",
"repo": "mirage-opam-overlays",
"rev": "05f1c1823d891ce4d8adab91f5db3ac51d86dc0b",
"type": "github"
},
"original": {
"owner": "dune-universe",
"repo": "mirage-opam-overlays",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1682362401,
"narHash": "sha256-/UMUHtF2CyYNl4b60Z2y4wwTTdIWGKhj9H301EDcT9M=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "884ac294018409e0d1adc0cae185439a44bd6b0b",
"type": "github"
},
"original": {
"owner": "nixos",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"opam-nix": {
"inputs": {
"flake-compat": "flake-compat",
"flake-utils": "flake-utils_2",
"mirage-opam-overlays": "mirage-opam-overlays",
"nixpkgs": "nixpkgs",
"opam-overlays": "opam-overlays",
"opam-repository": "opam-repository",
"opam2json": "opam2json"
},
"locked": {
"lastModified": 1701258858,
"narHash": "sha256-5v5PFrIz2DdR5zRTez+J7prGUOHFHwM5RsmLspOGoms=",
"owner": "tweag",
"repo": "opam-nix",
"rev": "a547ed060d2409c20902bd5f8a2465adca1bdf4f",
"type": "github"
},
"original": {
"owner": "tweag",
"repo": "opam-nix",
"type": "github"
}
},
"opam-overlays": {
"flake": false,
"locked": {
"lastModified": 1654162756,
"narHash": "sha256-RV68fUK+O3zTx61iiHIoS0LvIk0E4voMp+0SwRg6G6c=",
"owner": "dune-universe",
"repo": "opam-overlays",
"rev": "c8f6ef0fc5272f254df4a971a47de7848cc1c8a4",
"type": "github"
},
"original": {
"owner": "dune-universe",
"repo": "opam-overlays",
"type": "github"
}
},
"opam-repository": {
"flake": false,
"locked": {
"lastModified": 1695894792,
"narHash": "sha256-7Llico807vq14AkqAaDIWogC50xLxU38nuNEH06YNPE=",
"owner": "ocaml",
"repo": "opam-repository",
"rev": "33fcf32f269ee5af70b31e27442397a0cdaf28b2",
"type": "github"
},
"original": {
"owner": "ocaml",
"repo": "opam-repository",
"type": "github"
}
},
"opam2json": {
"inputs": {
"nixpkgs": [
"opam-nix",
"nixpkgs"
]
},
"locked": {
"lastModified": 1671540003,
"narHash": "sha256-5pXfbUfpVABtKbii6aaI2EdAZTjHJ2QntEf0QD2O5AM=",
"owner": "tweag",
"repo": "opam2json",
"rev": "819d291ea95e271b0e6027679de6abb4d4f7f680",
"type": "github"
},
"original": {
"owner": "tweag",
"repo": "opam2json",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": [
"opam-nix",
"nixpkgs"
],
"opam-nix": "opam-nix"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

57
flake.nix Normal file
View file

@ -0,0 +1,57 @@
{
inputs = {
opam-nix.url = "github:tweag/opam-nix";
flake-utils.url = "github:numtide/flake-utils";
nixpkgs.follows = "opam-nix/nixpkgs";
};
outputs = { self, flake-utils, opam-nix, nixpkgs }@inputs:
flake-utils.lib.eachDefaultSystem (system:
let
pkgs = nixpkgs.legacyPackages.${system};
on = opam-nix.lib.${system};
localPackagesQuery = builtins.mapAttrs (_: pkgs.lib.last)
(on.listRepo (on.makeOpamRepo ./.));
devPackagesQuery = {
# You can add "development" packages here. They will get added to the devShell automatically.
ocaml-lsp-server = "*";
ocamlformat = "*";
utop = "*";
dune-release = "*";
};
query = devPackagesQuery // {
## You can force versions of certain packages here, e.g:
## - force the ocaml compiler to be taken from opam-repository:
ocaml-base-compiler = "*";
## - or force the compiler to be taken from nixpkgs and be a certain version:
# ocaml-system = "4.14.0";
## - or force ocamlfind to be a certain version:
# ocamlfind = "1.9.2";
};
scope = on.buildDuneProject { } "tanenbaum" ./. query;
overlay = final: prev:
{
# You can add overrides here
};
scope' = scope.overrideScope' overlay;
# Packages from devPackagesQuery
devPackages = builtins.attrValues
(pkgs.lib.getAttrs (builtins.attrNames devPackagesQuery) scope');
# Packages in this workspace
packages =
pkgs.lib.getAttrs (builtins.attrNames localPackagesQuery) scope';
in {
legacyPackages = scope';
inherit packages;
## If you want to have a "default" package which will be built with just `nix build`, do this instead of `inherit packages;`:
# packages = packages // { default = packages.<your default package>; };
devShells.default = pkgs.mkShell {
inputsFrom = builtins.attrValues packages;
buildInputs = devPackages ++ [
# You can add packages from nixpkgs here
];
};
});
}

84
lib/drivers.ml Normal file
View 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
lib/drivers.mli Normal file
View 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
lib/dune Normal file
View 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
lib/fn.ml Normal file
View 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
lib/import.ml Normal file
View file

@ -0,0 +1,2 @@
include Let
include Fn

4
lib/let.ml Normal file
View file

@ -0,0 +1,4 @@
let (let@) = Result.bind
let (let+) = Lwt.bind
let (let*) = Lwt_result.bind
let (let-) = Option.bind

26
lib/problem.ml Normal file
View 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
lib/problem_runner.ml Normal file
View 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
lib/problem_runner.mli Normal file
View 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
lib/problems/dune Normal file
View 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
lib/problems/generator/dune Normal file
View file

@ -0,0 +1,4 @@
(executable
(name gen)
(modules gen)
(libraries fmt))

21
lib/problems/generator/gen.ml Normal file
View 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

BIN
public/logo.webp Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 507 KiB

35
tanenbaum.opam Normal file
View file

@ -0,0 +1,35 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "0.1.0"
synopsis: "OCaml Advent of Code starter project"
maintainer: ["Sixstring982"]
authors: ["Sixstring982"]
license: "BSD-3-Clause"
tags: ["advent-of-code"]
homepage: "https://github.com/sixstring982/tanenbaum"
doc: "https://sixstring982.github.io/tanenbaum"
bug-reports: "https://github.com/sixstring982/tanenbaum/issues"
depends: [
"ocaml"
"reason"
"dune" {>= "3.7"}
"cmdliner" {>= "1.2.0"}
"piaf" {>= "0.1.0"}
"fmt" {>= "0.9.0"}
"odoc" {with-doc}
]
build: [
["dune" "subst"] {dev}
[
"dune"
"build"
"-p"
name
"-j"
jobs
"@install"
"@runtest" {with-test}
"@doc" {with-doc}
]
]
dev-repo: "git+https://github.com/sixstring982/tanenbaum.git"

3
test/dune Normal file
View file

@ -0,0 +1,3 @@
(test
(name example_test)
(modules example_test))

0
test/example_test.ml Normal file
View file