n8r/stack_picker
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Working basic htmx page and endpoint, WIP static file serving and dune test running

Browse Source
This commit is contained in:
Nathan Anderson 2024-10-31 12:10:38 -06:00
commit d18ae43731
21 changed files with 533 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
.direnv/bin/nix-direnv-reload Executable file
View File

@ -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

1
.envrc Normal file
View File

@ -0,0 +1 @@
use flake

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
.direnv/**
_build/**

2
.ocamlformat Normal file
View File

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

26
bin/dune Normal file
View File

@ -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/* ./ ))))

51
bin/main.ml Normal file
View File

@ -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 =
{|
<html>
<script src="https://unpkg.com/htmx.org@2.0.3"></script>
<title>Ocaml</title>
<body>
<p>Hello from ocaml!</p>
<button _hx-get="/shop" _hx-swap="outerHTML">Shop</button>
</body>
</html>|}
in
Stack_picker.Srv.respondHtmlDoc ~body:html_doc ());
get "/shop" (fun _ ->
let%html doc =
{|
<ol>
<li>Bat</li>
<li>Cat</li>
<li>Doggie</li>
</ol>
|}
in
respondHtml ~body:doc ());
]

26
dune-project Normal file
View File

@ -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

116
flake.lock generated Normal file
View File

@ -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
}

52
flake.nix Normal file
View File

@ -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
];
};
});
}

9
lib/db.ml Normal file
View File

@ -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 ()

15
lib/dune Normal file
View File

@ -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)))

145
lib/srv.ml Normal file
View File

@ -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

15
scripts/dune Normal file
View File

@ -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)))

19
scripts/validate_html.ml Executable file
View File

@ -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

31
stack_picker.opam Normal file
View File

@ -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"

0
static/index.html Normal file
View File

0
static/temp/index.html Normal file
View File

0
static/temp/shop/store.html Normal file
View File

0
static/temp/shop/test.txt Normal file
View File

3
test/dune Normal file
View File

@ -0,0 +1,3 @@
(test
(name test_stack_picker)
(libraries eio_main sqlite3 dream))

1
test/test_stack_picker.ml Normal file
View File

@ -0,0 +1 @@