commit d18ae43731c74a77be1fd5d09b35499b46b398e8 Author: Nathan Anderson Date: Thu Oct 31 12:10:38 2024 -0600 Working basic htmx page and endpoint, WIP static file serving and dune test running diff --git a/.direnv/bin/nix-direnv-reload b/.direnv/bin/nix-direnv-reload new file mode 100755 index 0000000..b7fcd74 --- /dev/null +++ b/.direnv/bin/nix-direnv-reload @@ -0,0 +1,19 @@ +#!/usr/bin/env bash +set -e +if [[ ! -d "/home/nate/Games/.source/stack_picker" ]]; then + echo "Cannot find source directory; Did you move it?" + echo "(Looking for "/home/nate/Games/.source/stack_picker")" + echo 'Cannot force reload with this script - use "direnv reload" manually and then try again' + exit 1 +fi + +# rebuild the cache forcefully +_nix_direnv_force_reload=1 direnv exec "/home/nate/Games/.source/stack_picker" true + +# Update the mtime for .envrc. +# This will cause direnv to reload again - but without re-building. +touch "/home/nate/Games/.source/stack_picker/.envrc" + +# Also update the timestamp of whatever profile_rc we have. +# This makes sure that we know we are up to date. +touch -r "/home/nate/Games/.source/stack_picker/.envrc" "/home/nate/Games/.source/stack_picker/.direnv"/*.rc diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..3550a30 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use flake diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..72e11c5 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.direnv/** +_build/** diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..8adea03 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,2 @@ +version=0.26.2 +profile=default diff --git a/bin/dune b/bin/dune new file mode 100644 index 0000000..77e8f32 --- /dev/null +++ b/bin/dune @@ -0,0 +1,26 @@ +(executable + (public_name stack_picker) + (name main) + (libraries + stack_picker + eio_main + caqti-eio.unix + cohttp-eio + tyxml + fmt + unix + logs.fmt + logs.threaded) + (preprocess + (pps tyxml-ppx))) +(rule + (alias deploy) + (deps static) + (action + (chdir %{workspace_root} + (run ./scripts/validate_html.ml )))) +(rule + (alias static) + (action + (chdir %{workspace_root} + (copy static/* ./ )))) diff --git a/bin/main.ml b/bin/main.ml new file mode 100644 index 0000000..157b1b7 --- /dev/null +++ b/bin/main.ml @@ -0,0 +1,51 @@ +open Tyxml +open Stack_picker.Srv + +(* let () = Eio_main.run @@ fun env -> *) +(* let url = "sqlite3://stack.db" |> Uri.of_string in *) +(* Caqti_eio_unix.with_connection ~stdenv:(env :> Caqti_eio.stdenv) url (Stack_picker.Db.test env#stdout) *) +(* |> Caqti_eio.or_fail *) +let () = Logs.set_reporter (Logs_fmt.reporter ()) +and () = Logs.Src.set_level Cohttp_eio.src (Some Debug) + +let () = + let port = ref 8080 in + Arg.parse + [ ("-p", Arg.Set_int port, " Listening port number(8080 by default)") ] + ignore "An HTTP/1.1 server"; + Eio_main.run @@ fun env -> + Eio.Switch.run @@ fun sw -> + run ~env ~sw ~port:!port + [ + get "/ping" (fun _req -> + let num = 1 in + let resp = + Printf.sprintf "Hello this is the num: %d" num + |> Eio.Flow.string_source + in + Stack_picker.Srv.respond ~body:resp ()); + get "/" (fun _ -> + let%html html_doc = + {| + + + Ocaml + +

Hello from ocaml!

+ + + |} + in + Stack_picker.Srv.respondHtmlDoc ~body:html_doc ()); + get "/shop" (fun _ -> + let%html doc = + {| +
    +
  1. Bat
    2. +
  2. Cat
    3. +
  3. Doggie
    4. +
+ |} + in + respondHtml ~body:doc ()); + ] diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..d66add6 --- /dev/null +++ b/dune-project @@ -0,0 +1,26 @@ +(lang dune 3.15) + +(name stack_picker) + +(generate_opam_files true) + +(source + (github username/reponame)) + +(authors "Author Name") + +(maintainers "Maintainer Name") + +(license LICENSE) + +(documentation https://url/to/documentation) + +(package + (name stack_picker) + (synopsis "A short synopsis") + (description "A longer description") + (depends ocaml dune) + (tags + (topics "to describe" your project))) + +; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..ced8fdf --- /dev/null +++ b/flake.lock @@ -0,0 +1,116 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1726560853, + "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_2": { + "inputs": { + "systems": "systems_2" + }, + "locked": { + "lastModified": 1726560853, + "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1727634051, + "narHash": "sha256-S5kVU7U82LfpEukbn/ihcyNt2+EvG7Z5unsKW9H/yFA=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "06cf0e1da4208d3766d898b7fdab6513366d45b9", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "ocaml-overlay": { + "inputs": { + "flake-utils": "flake-utils_2", + "nixpkgs": [ + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1729147101, + "narHash": "sha256-Th67Tza+DSGeKPTHy451EBJ+WZzaCKnAYHacdVLxO4s=", + "owner": "nix-ocaml", + "repo": "nix-overlays", + "rev": "f4430b8e902af054b432c546d9423a254b9bf46f", + "type": "github" + }, + "original": { + "owner": "nix-ocaml", + "repo": "nix-overlays", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs", + "ocaml-overlay": "ocaml-overlay" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + }, + "systems_2": { + "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 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..4ea985b --- /dev/null +++ b/flake.nix @@ -0,0 +1,52 @@ +{ + description = "A very basic flake"; + + inputs = { + nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; + flake-utils.url = "github:numtide/flake-utils"; + # Add support for ocaml package overlay + ocaml-overlay.url = "github:nix-ocaml/nix-overlays"; + ocaml-overlay.inputs.nixpkgs.follows = "nixpkgs"; + }; + + outputs = { self, flake-utils, nixpkgs, ocaml-overlay }: + flake-utils.lib.eachDefaultSystem (system: let + pkgs = import nixpkgs { + inherit system; + overlays = [ + ocaml-overlay.overlays.default + ]; + }; + # set ocaml packages' version + ocamlPackages = pkgs.ocaml-ng.ocamlPackages_5_2; + in { + devShell = + #let + # + #in + pkgs.mkShell { + buildInputs = with pkgs; [ + ocaml + ocamlPackages.ocaml-lsp + ocamlPackages.findlib + ocamlPackages.ocamlformat + ocamlPackages.ocamlformat-rpc-lib + ocamlPackages.utop + dune_3 + # Project deps + ocamlPackages.eio_main + ocamlPackages.caqti-eio + ocamlPackages.caqti-driver-sqlite3 + ocamlPackages.ocaml_sqlite3 + ocamlPackages.dream + ocamlPackages.cohttp-eio + ocamlPackages.tyxml + ocamlPackages.tyxml-ppx + ocamlPackages.ppx_deriving + ocamlPackages.ppx_deriving_yojson + ocamlPackages.ppx_assert + ocamlPackages.ppx_inline_test + ]; + }; + }); +} diff --git a/lib/db.ml b/lib/db.ml new file mode 100644 index 0000000..83b323c --- /dev/null +++ b/lib/db.ml @@ -0,0 +1,9 @@ +open Base + +let%test_unit "rev" = + [%test_eq: int list] (List.rev [ 3; 2; 1 ]) [ 1; 2; 3 ] + +let test stdout db = + let _ = stdout in + let _ = db in + Ok () diff --git a/lib/dune b/lib/dune new file mode 100644 index 0000000..fe57b15 --- /dev/null +++ b/lib/dune @@ -0,0 +1,15 @@ +(library + (name stack_picker) + (inline_tests) + (libraries + eio_main + caqti-eio.unix + caqti-driver-sqlite3 + cohttp-eio + tyxml + fmt + unix + logs.fmt + logs.threaded) + (preprocess + (pps ppx_assert ppx_inline_test tyxml-ppx))) diff --git a/lib/srv.ml b/lib/srv.ml new file mode 100644 index 0000000..f987d94 --- /dev/null +++ b/lib/srv.ml @@ -0,0 +1,145 @@ +open Tyxml + +type endpoint_key = { + path : string; + callback : Http.Request.t -> Http.Response.t; +} + +type opt_route_response = { + headers : Http.Header.t option; + status : Http.Status.t option; + body : Cohttp_eio.Body.t option; +} + +type route_response = { + headers : Http.Header.t; + status : Http.Status.t; + body : Cohttp_eio.Body.t; +} + +type route_callback = Http.Request.t -> route_response + +module Endpath : sig + type t + + val compare : t -> t -> int + val of_tuple : Http.Method.t * string -> t +end = struct + type t = Http.Method.t * string + + let compare (meth_a, path_a) (meth_b, path_b) = + let meth_compare = Http.Method.compare meth_a meth_b in + if meth_compare <> 0 then meth_compare + else String.(compare (lowercase_ascii path_a) (lowercase_ascii path_b)) + + let of_tuple (method_, path) : t = (method_, path) +end + +module EndpointMap = Map.Make (Endpath) + +(* let endpoints: route_callback EndpointMap.t ref = ref EndpointMap.empty *) + +let default_headers = + let headers_strings = [ ("Content-Type", "text/html; charset=UTF-8") ] in + ref (Http.Header.of_list headers_strings) + +let default_body = ref ("" |> Eio.Flow.string_source) +let log_warning ex = Logs.warn (fun f -> f "%a" Eio.Exn.pp ex) + +let get (path : string) (callback : route_callback) = + let key = Endpath.of_tuple (`GET, path) in + (key, callback) + +let post (path : string) (callback : route_callback) = + let key = Endpath.of_tuple (`POST, path) in + (key, callback) +(* endpoints := !endpoints |> EndpointMap.add key callback *) + +let rec find_html_files (static_path : string) = + let files = Sys.readdir static_path in + Array.fold_left + (fun acc file -> + let path = Filename.concat static_path file in + if Sys.is_directory path then acc @ find_html_files path + else if Filename.check_suffix path ".html" then path :: acc + else acc) + [] files + +let respond ?body ?headers ?status () = + { + body = Option.value body ~default:!default_body; + headers = Option.value headers ~default:!default_headers; + status = Option.value status ~default:`OK; + } + +let respondStr ?body ?headers ?status () = + let eio_body = + match body with Some b -> Eio.Flow.string_source b | None -> !default_body + in + { + body = eio_body; + headers = Option.value headers ~default:!default_headers; + status = Option.value status ~default:`OK; + } + +let respondHtmlDoc ?body ?headers ?status () = + let eio_body = + match body with + | Some b -> + let content = Format.asprintf "%a" (Html.pp ()) b in + Eio.Flow.string_source content + | None -> !default_body + in + { + body = eio_body; + headers = Option.value headers ~default:!default_headers; + status = Option.value status ~default:`OK; + } + +let respondHtml ?body ?headers ?status () = + let eio_body = + match body with + | Some b -> + let content = Format.asprintf "%a" (Html.pp_elt ()) b in + Eio.Flow.string_source content + | None -> !default_body + in + { + body = eio_body; + headers = Option.value headers ~default:!default_headers; + status = Option.value status ~default:`OK; + } + +(** TODO not implemented, needs yojson ? *) +let respondJson body ?headers ?status () = + { + body; + headers = Option.value headers ~default:!default_headers; + status = Option.value status ~default:`OK; + } + +let run ~env ~sw ~port endpoint_list = + let endpoints : route_callback EndpointMap.t = + EndpointMap.of_list endpoint_list + in + let socket = + Eio.Net.listen env#net ~sw ~backlog:128 ~reuse_addr:true + (`Tcp (Eio.Net.Ipaddr.V4.loopback, port)) + in + let handler _socket request _body = + (* let req = Http.Request.resource request in *) + let path = Http.Request.resource request in + let end_key = Endpath.of_tuple (request.meth, path) in + let opt_path = EndpointMap.find_opt end_key endpoints in + match opt_path with + | Some route -> + (* NOTE needs an Exn.protect here? try / finally *) + let response = route request in + Cohttp_eio.Server.respond () ~headers:response.headers + ~status:response.status ~body:response.body + | None -> + let not_found_body = "Route not defined\n" |> Eio.Flow.string_source in + Cohttp_eio.Server.respond () ~status:`Not_found ~body:not_found_body + in + let server = Cohttp_eio.Server.make ~callback:handler () in + Cohttp_eio.Server.run socket server ~on_error:log_warning diff --git a/scripts/dune b/scripts/dune new file mode 100644 index 0000000..496441c --- /dev/null +++ b/scripts/dune @@ -0,0 +1,15 @@ +(library + (name stack_picker_scripts) + (inline_tests) + (libraries + eio_main + caqti-eio.unix + caqti-driver-sqlite3 + cohttp-eio + tyxml + fmt + unix + logs.fmt + logs.threaded) + (preprocess + (pps ppx_assert ppx_inline_test tyxml-ppx))) diff --git a/scripts/validate_html.ml b/scripts/validate_html.ml new file mode 100755 index 0000000..7f8d5d6 --- /dev/null +++ b/scripts/validate_html.ml @@ -0,0 +1,19 @@ +#!/usr/bin/env ocaml + +let rec find_html_files (static_path : string) = + let files = Sys.readdir static_path in + Array.fold_left + (fun acc file -> + let path = Filename.concat static_path file in + if Sys.is_directory path then acc @ find_html_files path + else if Filename.check_suffix path ".html" then path :: acc + else acc) + [] files + +let () = + let files = find_html_files "static" in + let _file_names = List.fold_left (fun name acc -> + acc ^ "\n - " ^ name + ) "" files in + (* Printf.printf "Found files:\n%s" file_names; *) + exit 0 diff --git a/stack_picker.opam b/stack_picker.opam new file mode 100644 index 0000000..d500377 --- /dev/null +++ b/stack_picker.opam @@ -0,0 +1,31 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "A short synopsis" +description: "A longer description" +maintainer: ["Maintainer Name"] +authors: ["Author Name"] +license: "LICENSE" +tags: ["topics" "to describe" "your" "project"] +homepage: "https://github.com/username/reponame" +doc: "https://url/to/documentation" +bug-reports: "https://github.com/username/reponame/issues" +depends: [ + "ocaml" + "dune" {>= "3.15"} + "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/username/reponame.git" diff --git a/static/index.html b/static/index.html new file mode 100644 index 0000000..e69de29 diff --git a/static/temp/index.html b/static/temp/index.html new file mode 100644 index 0000000..e69de29 diff --git a/static/temp/shop/store.html b/static/temp/shop/store.html new file mode 100644 index 0000000..e69de29 diff --git a/static/temp/shop/test.txt b/static/temp/shop/test.txt new file mode 100644 index 0000000..e69de29 diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..cabe2ef --- /dev/null +++ b/test/dune @@ -0,0 +1,3 @@ +(test + (name test_stack_picker) + (libraries eio_main sqlite3 dream)) diff --git a/test/test_stack_picker.ml b/test/test_stack_picker.ml new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/test/test_stack_picker.ml @@ -0,0 +1 @@ +