Skip to content

Instantly share code, notes, and snippets.

View Leonidas-from-XIV's full-sized avatar

Marek Kubica Leonidas-from-XIV

View GitHub Profile
@Leonidas-from-XIV
Leonidas-from-XIV / short_circuit.ml
Last active January 18, 2022 16:23
A way to use the `let` operators to short-circuit a `fold`
(* Some kind of function that needs to be [Some _] for the rest of the body *)
let bigger_than x v = match v > x with true -> Some (v - 1) | false -> None
(* Sample inputs *)
let xs = [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 ]
(* Why `fold` here in the first place? Maybe your data structure doesn't have `filter_map` etc.
* This is an example
*)
~/lua-ml (dunify)> dune clean
~/lua-ml (dunify)> dune build
File "src/luaparser_impl.ml", line 1:
Error: Could not find the .cmi file for interface src/luaparser_impl.mli.
~/lua-ml (dunify) [1]> dune build
# success
@Leonidas-from-XIV
Leonidas-from-XIV / list_set_exn.ml
Created July 16, 2019 12:54
Quick and dirty, non-TR list_set_exn
open Core
let rec list_set_exn index v = function
| [] -> []
| _ :: xs when index = 0 -> v :: xs
| x :: xs -> x :: list_set_exn (Int.pred index) v xs
@Leonidas-from-XIV
Leonidas-from-XIV / ghget.sh
Created March 20, 2019 12:45
OPAMFETCH for private archives
#!/usr/bin/env bash
#
# Adapted and fixed from https://gist.github.com/josh-padnick/fdae42c07e648c798fc27dec2367da21
#
# This is an adaptation of code I wrote to download a private binary from GitHub. Such...pain.
# Why can't GitHub just offer a standardized URL you can download a release binary from and attach
# your Github Personal Access Token as a header?
#
# Since this code is an adaptation it hasn't been directly tested, but the code it was adapted from works
# and hopefully you can get the missing piece you're after by looking here.
@Leonidas-from-XIV
Leonidas-from-XIV / dune-out
Last active March 7, 2019 10:52
dune vs jbuilder
File "lib_helpers/kafka_producer.ml", line 1:
Error: The implementation lib_helpers/kafka_producer.ml
does not match the interface lib_helpers/.kafka_helpers.objs/byte/kafka_helpers__Kafka_producer.cmi:
Values do not match:
val stream_to : ('a, unit) sink -> 'a iterable -> unit
is not included in
val stream_to : ('a, 'b) sink -> 'a iterable -> 'b
File "lib_helpers/kafka_producer.mli", line 9, characters 0-48:
Expected declaration
File "lib_helpers/kafka_producer.ml", line 4, characters 4-13:
open Lwt.Infix
open Cohttp
open Cohttp_lwt_unix
let body () =
Client.get (Uri.of_string "https://hacker-news.firebaseio.com/v0/maxitem.json") >>= fun (resp, body) ->
let code = resp |> Response.status |> Code.code_of_status in
Lwt_io.printf "Response Code: %d\n" code >>= fun () ->
Lwt_io.printf "Headers: %s\n" (resp |> Response.headers |> Header.to_string) >>= fun () ->
body |> Cohttp_lwt.Body.to_string >>= fun body ->
@Leonidas-from-XIV
Leonidas-from-XIV / dune
Created January 28, 2019 18:33
Dune run custom binary
;; probably not how to do it
(executable
(name bench)
(flags (-safe-string))
(libraries yojson core_bench core))
(alias
(name bench)
(deps bench.json)
@Leonidas-from-XIV
Leonidas-from-XIV / lwt_ppx_let.ml
Last active January 2, 2022 15:10
Using Lwt with ppx_let instead of ppx_lwt
module Let_syntax = struct
let return = Lwt.return
let (>>=) = Lwt.Infix.(>>=)
let (>>|) = Lwt.Infix.(>|=)
module Let_syntax = struct
let bind m ~f = Lwt.bind m f
end
end
@Leonidas-from-XIV
Leonidas-from-XIV / compose_handling.ml
Created July 13, 2018 13:35
Looking for a way to handle polymorphic variants
type 'a resp = Handled of unit | Continue of 'a
let handle_x = function Handled () -> Handled () | Continue x -> match x with `X -> Handled () | rest -> Continue rest
let handle_y = function Handled () -> Handled () | Continue x -> match x with `Y -> Handled () | rest -> Continue rest
let handle_xy v = handle_x (handle_y v)
match handle_xy (Continue `X) with
| Handled () -> ()
| Continue v ->
match v with
@Leonidas-from-XIV
Leonidas-from-XIV / foo_broken.ml
Last active June 6, 2018 18:42
Unifying polymorphic variants
type foo = [`Hello | `World | `Other]
type bar = [`Yet | `Another | `Other]
type baz = [foo | bar]
type qux = Foo of foo | Bar of bar | Quux
let transform = function
| Foo x -> x
| Bar x -> x