diff options
Diffstat (limited to 'users/grfn')
369 files changed, 37081 insertions, 0 deletions
diff --git a/users/grfn/OWNERS b/users/grfn/OWNERS new file mode 100644 index 000000000000..da7ac5cb9ef9 --- /dev/null +++ b/users/grfn/OWNERS @@ -0,0 +1,3 @@ +inherited: false +owners: + - grfn diff --git a/users/grfn/achilles/.envrc b/users/grfn/achilles/.envrc new file mode 100644 index 000000000000..051d09d292a8 --- /dev/null +++ b/users/grfn/achilles/.envrc @@ -0,0 +1 @@ +eval "$(lorri direnv)" diff --git a/users/grfn/achilles/.gitignore b/users/grfn/achilles/.gitignore new file mode 100644 index 000000000000..ea8c4bf7f35f --- /dev/null +++ b/users/grfn/achilles/.gitignore @@ -0,0 +1 @@ +/target diff --git a/users/grfn/achilles/Cargo.lock b/users/grfn/achilles/Cargo.lock new file mode 100644 index 000000000000..30e5e021f147 --- /dev/null +++ b/users/grfn/achilles/Cargo.lock @@ -0,0 +1,868 @@ +# This file is automatically @generated by Cargo. +# It is not intended for manual editing. +[[package]] +name = "achilles" +version = "0.1.0" +dependencies = [ + "anyhow", + "bimap", + "clap", + "crate-root", + "derive_more", + "inkwell", + "itertools", + "lazy_static", + "llvm-sys", + "nom", + "nom-trace", + "pratt", + "pretty_assertions", + "proptest", + "test-strategy", + "thiserror", + "void", +] + +[[package]] +name = "aho-corasick" +version = "0.7.15" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7404febffaa47dac81aa44dba71523c9d069b1bdc50a77db41195149e17f68e5" +dependencies = [ + "memchr", +] + +[[package]] +name = "ansi_term" +version = "0.12.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d52a9bb7ec0cf484c551830a7ce27bd20d67eac647e1befb56b0be4ee39a55d2" +dependencies = [ + "winapi", +] + +[[package]] +name = "anyhow" +version = "1.0.38" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "afddf7f520a80dbf76e6f50a35bca42a2331ef227a28b3b6dc5c2e2338d114b1" + +[[package]] +name = "arrayvec" +version = "0.5.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "23b62fc65de8e4e7f52534fb52b0f3ed04746ae267519eef2a83941e8085068b" + +[[package]] +name = "atty" +version = "0.2.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d9b39be18770d11421cdb1b9947a45dd3f37e93092cbf377614828a319d5fee8" +dependencies = [ + "hermit-abi", + "libc", + "winapi", +] + +[[package]] +name = "autocfg" +version = "1.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cdb031dd78e28731d87d56cc8ffef4a8f36ca26c38fe2de700543e627f8a464a" + +[[package]] +name = "bimap" +version = "0.6.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f92b72b8f03128773278bf74418b9205f3d2a12c39a61f92395f47af390c32bf" + +[[package]] +name = "bit-set" +version = "0.5.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6e11e16035ea35e4e5997b393eacbf6f63983188f7a2ad25bfb13465f5ad59de" +dependencies = [ + "bit-vec", +] + +[[package]] +name = "bit-vec" +version = "0.6.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "349f9b6a179ed607305526ca489b34ad0a41aed5f7980fa90eb03160b69598fb" + +[[package]] +name = "bitflags" +version = "1.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cf1de2fe8c75bc145a2f577add951f8134889b4795d47466a54a5c846d691693" + +[[package]] +name = "bitvec" +version = "0.19.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8942c8d352ae1838c9dda0b0ca2ab657696ef2232a20147cf1b30ae1a9cb4321" +dependencies = [ + "funty", + "radium", + "tap", + "wyz", +] + +[[package]] +name = "byteorder" +version = "1.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ae44d1a3d5a19df61dd0c8beb138458ac2a53a7ac09eba97d55592540004306b" + +[[package]] +name = "cc" +version = "1.0.67" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e3c69b077ad434294d3ce9f1f6143a2a4b89a8a2d54ef813d85003a4fd1137fd" + +[[package]] +name = "cfg-if" +version = "1.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd" + +[[package]] +name = "clap" +version = "3.0.0-beta.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4bd1061998a501ee7d4b6d449020df3266ca3124b941ec56cf2005c3779ca142" +dependencies = [ + "atty", + "bitflags", + "clap_derive", + "indexmap", + "lazy_static", + "os_str_bytes", + "strsim", + "termcolor", + "textwrap", + "unicode-width", + "vec_map", +] + +[[package]] +name = "clap_derive" +version = "3.0.0-beta.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "370f715b81112975b1b69db93e0b56ea4cd4e5002ac43b2da8474106a54096a1" +dependencies = [ + "heck", + "proc-macro-error", + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "crate-root" +version = "0.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "59c6fe4622b269032d2c5140a592d67a9c409031d286174fcde172fbed86f0d3" + +[[package]] +name = "ctor" +version = "0.1.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e8f45d9ad417bcef4817d614a501ab55cdd96a6fdb24f49aab89a54acfd66b19" +dependencies = [ + "quote", + "syn", +] + +[[package]] +name = "derive_more" +version = "0.99.11" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "41cb0e6161ad61ed084a36ba71fbba9e3ac5aee3606fb607fe08da6acbcf3d8c" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "diff" +version = "0.1.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0e25ea47919b1560c4e3b7fe0aaab9becf5b84a10325ddf7db0f0ba5e1026499" + +[[package]] +name = "either" +version = "1.6.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e78d4f1cc4ae33bbfc157ed5d5a5ef3bc29227303d595861deb238fcec4e9457" + +[[package]] +name = "fnv" +version = "1.0.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1" + +[[package]] +name = "funty" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fed34cd105917e91daa4da6b3728c47b068749d6a62c59811f06ed2ac71d9da7" + +[[package]] +name = "getrandom" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c9495705279e7140bf035dde1f6e750c162df8b625267cd52cc44e0b156732c8" +dependencies = [ + "cfg-if", + "libc", + "wasi", +] + +[[package]] +name = "hashbrown" +version = "0.9.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d7afe4a420e3fe79967a00898cc1f4db7c8a49a9333a29f8a4bd76a253d5cd04" + +[[package]] +name = "heck" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "87cbf45460356b7deeb5e3415b5563308c0a9b057c85e12b06ad551f98d0a6ac" +dependencies = [ + "unicode-segmentation", +] + +[[package]] +name = "hermit-abi" +version = "0.1.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "322f4de77956e22ed0e5032c359a0f1273f1f7f0d79bfa3b8ffbc730d7fbcc5c" +dependencies = [ + "libc", +] + +[[package]] +name = "indexmap" +version = "1.6.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "824845a0bf897a9042383849b02c1bc219c2383772efcd5c6f9766fa4b81aef3" +dependencies = [ + "autocfg", + "hashbrown", +] + +[[package]] +name = "inkwell" +version = "0.1.0" +source = "git+https://github.com/TheDan64/inkwell?branch=master#a2db15b0bd1c06d71763585ae10d9ea4e775da0c" +dependencies = [ + "either", + "inkwell_internals", + "libc", + "llvm-sys", + "once_cell", + "parking_lot", + "regex", +] + +[[package]] +name = "inkwell_internals" +version = "0.3.0" +source = "git+https://github.com/TheDan64/inkwell?branch=master#a2db15b0bd1c06d71763585ae10d9ea4e775da0c" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "instant" +version = "0.1.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "61124eeebbd69b8190558df225adf7e4caafce0d743919e5d6b19652314ec5ec" +dependencies = [ + "cfg-if", +] + +[[package]] +name = "itertools" +version = "0.10.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "37d572918e350e82412fe766d24b15e6682fb2ed2bbe018280caa810397cb319" +dependencies = [ + "either", +] + +[[package]] +name = "lazy_static" +version = "1.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e2abad23fbc42b3700f2f279844dc832adb2b2eb069b2df918f455c4e18cc646" + +[[package]] +name = "lexical-core" +version = "0.7.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "21f866863575d0e1d654fbeeabdc927292fdf862873dc3c96c6f753357e13374" +dependencies = [ + "arrayvec", + "bitflags", + "cfg-if", + "ryu", + "static_assertions", +] + +[[package]] +name = "libc" +version = "0.2.88" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "03b07a082330a35e43f63177cc01689da34fbffa0105e1246cf0311472cac73a" + +[[package]] +name = "llvm-sys" +version = "110.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "21ede189444b8c78907e5d36da5dabcf153170fcff9c1dba48afc4b33c7e19f0" +dependencies = [ + "cc", + "lazy_static", + "libc", + "regex", + "semver", +] + +[[package]] +name = "lock_api" +version = "0.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dd96ffd135b2fd7b973ac026d28085defbe8983df057ced3eb4f2130b0831312" +dependencies = [ + "scopeguard", +] + +[[package]] +name = "memchr" +version = "2.3.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0ee1c47aaa256ecabcaea351eae4a9b01ef39ed810004e298d2511ed284b1525" + +[[package]] +name = "nom" +version = "6.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e7413f999671bd4745a7b624bd370a569fb6bc574b23c83a3c5ed2e453f3d5e2" +dependencies = [ + "bitvec", + "funty", + "lexical-core", + "memchr", + "version_check", +] + +[[package]] +name = "nom-trace" +version = "0.2.1" +source = "git+https://github.com/glittershark/nom-trace?branch=nom-6#6168d2e15cc51efd12d80260159b76a764dba138" +dependencies = [ + "nom", +] + +[[package]] +name = "num-traits" +version = "0.2.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9a64b1ec5cda2586e284722486d802acf1f7dbdc623e2bfc57e65ca1cd099290" +dependencies = [ + "autocfg", +] + +[[package]] +name = "once_cell" +version = "1.7.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "af8b08b04175473088b46763e51ee54da5f9a164bc162f615b91bc179dbf15a3" + +[[package]] +name = "os_str_bytes" +version = "2.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "afb2e1c3ee07430c2cf76151675e583e0f19985fa6efae47d6848a3e2c824f85" + +[[package]] +name = "output_vt100" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "53cdc5b785b7a58c5aad8216b3dfa114df64b0b06ae6e1501cef91df2fbdf8f9" +dependencies = [ + "winapi", +] + +[[package]] +name = "parking_lot" +version = "0.11.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6d7744ac029df22dca6284efe4e898991d28e3085c706c972bcd7da4a27a15eb" +dependencies = [ + "instant", + "lock_api", + "parking_lot_core", +] + +[[package]] +name = "parking_lot_core" +version = "0.8.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fa7a782938e745763fe6907fc6ba86946d72f49fe7e21de074e08128a99fb018" +dependencies = [ + "cfg-if", + "instant", + "libc", + "redox_syscall", + "smallvec", + "winapi", +] + +[[package]] +name = "pest" +version = "2.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "10f4872ae94d7b90ae48754df22fd42ad52ce740b8f370b03da4835417403e53" +dependencies = [ + "ucd-trie", +] + +[[package]] +name = "ppv-lite86" +version = "0.2.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ac74c624d6b2d21f425f752262f42188365d7b8ff1aff74c82e45136510a4857" + +[[package]] +name = "pratt" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e31bbc12f7936a7b195790dd6d9b982b66c54f45ff6766decf25c44cac302dce" + +[[package]] +name = "pretty_assertions" +version = "0.7.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f297542c27a7df8d45de2b0e620308ab883ad232d06c14b76ac3e144bda50184" +dependencies = [ + "ansi_term", + "ctor", + "diff", + "output_vt100", +] + +[[package]] +name = "proc-macro-error" +version = "1.0.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "da25490ff9892aab3fcf7c36f08cfb902dd3e71ca0f9f9517bea02a73a5ce38c" +dependencies = [ + "proc-macro-error-attr", + "proc-macro2", + "quote", + "syn", + "version_check", +] + +[[package]] +name = "proc-macro-error-attr" +version = "1.0.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a1be40180e52ecc98ad80b184934baf3d0d29f979574e439af5a55274b35f869" +dependencies = [ + "proc-macro2", + "quote", + "version_check", +] + +[[package]] +name = "proc-macro2" +version = "1.0.24" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1e0704ee1a7e00d7bb417d0770ea303c1bccbabf0ef1667dae92b5967f5f8a71" +dependencies = [ + "unicode-xid", +] + +[[package]] +name = "proptest" +version = "1.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1e0d9cc07f18492d879586c92b485def06bc850da3118075cd45d50e9c95b0e5" +dependencies = [ + "bit-set", + "bitflags", + "byteorder", + "lazy_static", + "num-traits", + "quick-error 2.0.0", + "rand", + "rand_chacha", + "rand_xorshift", + "regex-syntax", + "rusty-fork", + "tempfile", +] + +[[package]] +name = "quick-error" +version = "1.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a1d01941d82fa2ab50be1e79e6714289dd7cde78eba4c074bc5a4374f650dfe0" + +[[package]] +name = "quick-error" +version = "2.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3ac73b1112776fc109b2e61909bc46c7e1bf0d7f690ffb1676553acce16d5cda" + +[[package]] +name = "quote" +version = "1.0.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c3d0b9745dc2debf507c8422de05d7226cc1f0644216dfdfead988f9b1ab32a7" +dependencies = [ + "proc-macro2", +] + +[[package]] +name = "radium" +version = "0.5.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "941ba9d78d8e2f7ce474c015eea4d9c6d25b6a3327f9832ee29a4de27f91bbb8" + +[[package]] +name = "rand" +version = "0.8.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0ef9e7e66b4468674bfcb0c81af8b7fa0bb154fa9f28eb840da5c447baeb8d7e" +dependencies = [ + "libc", + "rand_chacha", + "rand_core", + "rand_hc", +] + +[[package]] +name = "rand_chacha" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e12735cf05c9e10bf21534da50a147b924d555dc7a547c42e6bb2d5b6017ae0d" +dependencies = [ + "ppv-lite86", + "rand_core", +] + +[[package]] +name = "rand_core" +version = "0.6.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "34cf66eb183df1c5876e2dcf6b13d57340741e8dc255b48e40a26de954d06ae7" +dependencies = [ + "getrandom", +] + +[[package]] +name = "rand_hc" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3190ef7066a446f2e7f42e239d161e905420ccab01eb967c9eb27d21b2322a73" +dependencies = [ + "rand_core", +] + +[[package]] +name = "rand_xorshift" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d25bf25ec5ae4a3f1b92f929810509a2f53d7dca2f50b794ff57e3face536c8f" +dependencies = [ + "rand_core", +] + +[[package]] +name = "redox_syscall" +version = "0.2.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "94341e4e44e24f6b591b59e47a8a027df12e008d73fd5672dbea9cc22f4507d9" +dependencies = [ + "bitflags", +] + +[[package]] +name = "regex" +version = "1.4.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d9251239e129e16308e70d853559389de218ac275b515068abc96829d05b948a" +dependencies = [ + "aho-corasick", + "memchr", + "regex-syntax", + "thread_local", +] + +[[package]] +name = "regex-syntax" +version = "0.6.22" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b5eb417147ba9860a96cfe72a0b93bf88fee1744b5636ec99ab20c1aa9376581" + +[[package]] +name = "remove_dir_all" +version = "0.5.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3acd125665422973a33ac9d3dd2df85edad0f4ae9b00dafb1a05e43a9f5ef8e7" +dependencies = [ + "winapi", +] + +[[package]] +name = "rusty-fork" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cb3dcc6e454c328bb824492db107ab7c0ae8fcffe4ad210136ef014458c1bc4f" +dependencies = [ + "fnv", + "quick-error 1.2.3", + "tempfile", + "wait-timeout", +] + +[[package]] +name = "ryu" +version = "1.0.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "71d301d4193d031abdd79ff7e3dd721168a9572ef3fe51a1517aba235bd8f86e" + +[[package]] +name = "scopeguard" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d29ab0c6d3fc0ee92fe66e2d99f700eab17a8d57d1c1d3b748380fb20baa78cd" + +[[package]] +name = "semver" +version = "0.11.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f301af10236f6df4160f7c3f04eec6dbc70ace82d23326abad5edee88801c6b6" +dependencies = [ + "semver-parser", +] + +[[package]] +name = "semver-parser" +version = "0.10.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "00b0bef5b7f9e0df16536d3961cfb6e84331c065b4066afb39768d0e319411f7" +dependencies = [ + "pest", +] + +[[package]] +name = "smallvec" +version = "1.6.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fe0f37c9e8f3c5a4a66ad655a93c74daac4ad00c441533bf5c6e7990bb42604e" + +[[package]] +name = "static_assertions" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a2eb9349b6444b326872e140eb1cf5e7c522154d69e7a0ffb0fb81c06b37543f" + +[[package]] +name = "strsim" +version = "0.10.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "73473c0e59e6d5812c5dfe2a064a6444949f089e20eec9a2e5506596494e4623" + +[[package]] +name = "syn" +version = "1.0.61" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ed22b90a0e734a23a7610f4283ac9e5acfb96cbb30dfefa540d66f866f1c09c5" +dependencies = [ + "proc-macro2", + "quote", + "unicode-xid", +] + +[[package]] +name = "tap" +version = "1.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "55937e1799185b12863d447f42597ed69d9928686b8d88a1df17376a097d8369" + +[[package]] +name = "tempfile" +version = "3.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dac1c663cfc93810f88aed9b8941d48cabf856a1b111c29a40439018d870eb22" +dependencies = [ + "cfg-if", + "libc", + "rand", + "redox_syscall", + "remove_dir_all", + "winapi", +] + +[[package]] +name = "termcolor" +version = "1.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2dfed899f0eb03f32ee8c6a0aabdb8a7949659e3466561fc0adf54e26d88c5f4" +dependencies = [ + "winapi-util", +] + +[[package]] +name = "test-strategy" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2328963c69243416e811c88066d18f670792b2e36e17fa57f4b1a124f85d18a8" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "textwrap" +version = "0.12.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "203008d98caf094106cfaba70acfed15e18ed3ddb7d94e49baec153a2b462789" +dependencies = [ + "unicode-width", +] + +[[package]] +name = "thiserror" +version = "1.0.24" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e0f4a65597094d4483ddaed134f409b2cb7c1beccf25201a9f73c719254fa98e" +dependencies = [ + "thiserror-impl", +] + +[[package]] +name = "thiserror-impl" +version = "1.0.24" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7765189610d8241a44529806d6fd1f2e0a08734313a35d5b3a556f92b381f3c0" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "thread_local" +version = "1.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8018d24e04c95ac8790716a5987d0fec4f8b27249ffa0f7d33f1369bdfb88cbd" +dependencies = [ + "once_cell", +] + +[[package]] +name = "ucd-trie" +version = "0.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "56dee185309b50d1f11bfedef0fe6d036842e3fb77413abef29f8f8d1c5d4c1c" + +[[package]] +name = "unicode-segmentation" +version = "1.7.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bb0d2e7be6ae3a5fa87eed5fb451aff96f2573d2694942e40543ae0bbe19c796" + +[[package]] +name = "unicode-width" +version = "0.1.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9337591893a19b88d8d87f2cec1e73fad5cdfd10e5a6f349f498ad6ea2ffb1e3" + +[[package]] +name = "unicode-xid" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f7fe0bb3479651439c9112f72b6c505038574c9fbb575ed1bf3b797fa39dd564" + +[[package]] +name = "vec_map" +version = "0.8.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f1bddf1187be692e79c5ffeab891132dfb0f236ed36a43c7ed39f1165ee20191" + +[[package]] +name = "version_check" +version = "0.9.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b5a972e5669d67ba988ce3dc826706fb0a8b01471c088cb0b6110b805cc36aed" + +[[package]] +name = "void" +version = "1.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6a02e4885ed3bc0f2de90ea6dd45ebcbb66dacffe03547fadbb0eeae2770887d" + +[[package]] +name = "wait-timeout" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9f200f5b12eb75f8c1ed65abd4b2db8a6e1b138a20de009dacee265a2498f3f6" +dependencies = [ + "libc", +] + +[[package]] +name = "wasi" +version = "0.10.2+wasi-snapshot-preview1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fd6fbd9a79829dd1ad0cc20627bf1ed606756a7f77edff7b66b7064f9cb327c6" + +[[package]] +name = "winapi" +version = "0.3.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5c839a674fcd7a98952e593242ea400abe93992746761e38641405d28b00f419" +dependencies = [ + "winapi-i686-pc-windows-gnu", + "winapi-x86_64-pc-windows-gnu", +] + +[[package]] +name = "winapi-i686-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6" + +[[package]] +name = "winapi-util" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "70ec6ce85bb158151cae5e5c87f95a8e97d2c0c4b001223f33a334e3ce5de178" +dependencies = [ + "winapi", +] + +[[package]] +name = "winapi-x86_64-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f" + +[[package]] +name = "wyz" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "85e60b0d1b5f99db2556934e21937020776a5d31520bf169e851ac44e6420214" diff --git a/users/grfn/achilles/Cargo.toml b/users/grfn/achilles/Cargo.toml new file mode 100644 index 000000000000..f091399a0dd4 --- /dev/null +++ b/users/grfn/achilles/Cargo.toml @@ -0,0 +1,26 @@ +[package] +name = "achilles" +version = "0.1.0" +authors = ["Griffin Smith <root@gws.fyi>"] +edition = "2018" + +[dependencies] +anyhow = "1.0.38" +bimap = "0.6.0" +clap = "3.0.0-beta.2" +derive_more = "0.99.11" +inkwell = { git = "https://github.com/TheDan64/inkwell", branch = "master", features = ["llvm11-0"] } +itertools = "0.10.0" +lazy_static = "1.4.0" +llvm-sys = "110.0.1" +nom = "6.1.2" +nom-trace = { git = "https://github.com/glittershark/nom-trace", branch = "nom-6" } +pratt = "0.3.0" +proptest = "1.0.0" +test-strategy = "0.1.1" +thiserror = "1.0.24" +void = "1.0.2" + +[dev-dependencies] +crate-root = "0.1.3" +pretty_assertions = "0.7.1" diff --git a/users/grfn/achilles/ach/.gitignore b/users/grfn/achilles/ach/.gitignore new file mode 100644 index 000000000000..ac5296ebbd74 --- /dev/null +++ b/users/grfn/achilles/ach/.gitignore @@ -0,0 +1,7 @@ +*.ll +*.o + +functions +simple +externs +units diff --git a/users/grfn/achilles/ach/Makefile b/users/grfn/achilles/ach/Makefile new file mode 100644 index 000000000000..3a8cd2865e87 --- /dev/null +++ b/users/grfn/achilles/ach/Makefile @@ -0,0 +1,15 @@ +default: simple + +%.ll: %.ach + cargo run -- compile $< -o $@ -f llvm + +%.o: %.ll + llc $< -o $@ -filetype=obj + +%: %.o + clang $< -o $@ + +.PHONY: clean + +clean: + @rm -f *.ll *.o simple functions diff --git a/users/grfn/achilles/ach/externs.ach b/users/grfn/achilles/ach/externs.ach new file mode 100644 index 000000000000..faf8ce90e353 --- /dev/null +++ b/users/grfn/achilles/ach/externs.ach @@ -0,0 +1,5 @@ +extern puts : fn cstring -> int + +fn main = + let _ = puts "foobar" + in 0 diff --git a/users/grfn/achilles/ach/functions.ach b/users/grfn/achilles/ach/functions.ach new file mode 100644 index 000000000000..dc6e7a1f3e34 --- /dev/null +++ b/users/grfn/achilles/ach/functions.ach @@ -0,0 +1,8 @@ +ty id : fn a -> a +fn id x = x + +ty plus : fn int -> int +fn plus (x: int) (y: int) = x + y + +ty main : fn -> int +fn main = plus (id 2) 7 diff --git a/users/grfn/achilles/ach/simple.ach b/users/grfn/achilles/ach/simple.ach new file mode 100644 index 000000000000..20f1677235c0 --- /dev/null +++ b/users/grfn/achilles/ach/simple.ach @@ -0,0 +1 @@ +fn main = let x = 2; y = 3 in x + y diff --git a/users/grfn/achilles/ach/units.ach b/users/grfn/achilles/ach/units.ach new file mode 100644 index 000000000000..70635d978c7c --- /dev/null +++ b/users/grfn/achilles/ach/units.ach @@ -0,0 +1,7 @@ +extern puts : fn cstring -> int + +ty print : fn cstring -> () +fn print x = let _ = puts x in () + +ty main : fn -> int +fn main = let _ = print "hi" in 0 diff --git a/users/grfn/achilles/default.nix b/users/grfn/achilles/default.nix new file mode 100644 index 000000000000..5245049d4a32 --- /dev/null +++ b/users/grfn/achilles/default.nix @@ -0,0 +1,24 @@ +{ depot, pkgs, ... }: + +let + llvmPackages = pkgs.llvmPackages_11; +in + +depot.third_party.naersk.buildPackage { + src = ./.; + + buildInputs = [ + llvmPackages.clang + llvmPackages.llvm + llvmPackages.bintools + llvmPackages.libclang.lib + ] ++ (with pkgs; [ + zlib + ncurses + libxml2 + libffi + pkgconfig + ]); + + doCheck = true; +} diff --git a/users/grfn/achilles/shell.nix b/users/grfn/achilles/shell.nix new file mode 100644 index 000000000000..f32dce3ba39d --- /dev/null +++ b/users/grfn/achilles/shell.nix @@ -0,0 +1,18 @@ +with (import ../../.. {}).third_party.nixpkgs; + +mkShell { + buildInputs = [ + clang_11 + llvm_11.lib + llvmPackages_11.bintools + llvmPackages_11.clang + llvmPackages_11.libclang.lib + zlib + ncurses + libxml2 + libffi + pkg-config + ]; + + LLVM_SYS_110_PREFIX = llvmPackages_11.bintools; +} diff --git a/users/grfn/achilles/src/ast/hir.rs b/users/grfn/achilles/src/ast/hir.rs new file mode 100644 index 000000000000..cdfaef567d7a --- /dev/null +++ b/users/grfn/achilles/src/ast/hir.rs @@ -0,0 +1,364 @@ +use std::collections::HashMap; + +use itertools::Itertools; + +use super::{BinaryOperator, Ident, Literal, UnaryOperator}; + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum Pattern<'a, T> { + Id(Ident<'a>, T), + Tuple(Vec<Pattern<'a, T>>), +} + +impl<'a, T> Pattern<'a, T> { + pub fn to_owned(&self) -> Pattern<'static, T> + where + T: Clone, + { + match self { + Pattern::Id(id, t) => Pattern::Id(id.to_owned(), t.clone()), + Pattern::Tuple(pats) => { + Pattern::Tuple(pats.into_iter().map(Pattern::to_owned).collect()) + } + } + } + + pub fn traverse_type<F, U, E>(self, f: F) -> Result<Pattern<'a, U>, E> + where + F: Fn(T) -> Result<U, E> + Clone, + { + match self { + Pattern::Id(id, t) => Ok(Pattern::Id(id, f(t)?)), + Pattern::Tuple(pats) => Ok(Pattern::Tuple( + pats.into_iter() + .map(|pat| pat.traverse_type(f.clone())) + .collect::<Result<Vec<_>, _>>()?, + )), + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub struct Binding<'a, T> { + pub pat: Pattern<'a, T>, + pub body: Expr<'a, T>, +} + +impl<'a, T> Binding<'a, T> { + fn to_owned(&self) -> Binding<'static, T> + where + T: Clone, + { + Binding { + pat: self.pat.to_owned(), + body: self.body.to_owned(), + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum Expr<'a, T> { + Ident(Ident<'a>, T), + + Literal(Literal<'a>, T), + + Tuple(Vec<Expr<'a, T>>, T), + + UnaryOp { + op: UnaryOperator, + rhs: Box<Expr<'a, T>>, + type_: T, + }, + + BinaryOp { + lhs: Box<Expr<'a, T>>, + op: BinaryOperator, + rhs: Box<Expr<'a, T>>, + type_: T, + }, + + Let { + bindings: Vec<Binding<'a, T>>, + body: Box<Expr<'a, T>>, + type_: T, + }, + + If { + condition: Box<Expr<'a, T>>, + then: Box<Expr<'a, T>>, + else_: Box<Expr<'a, T>>, + type_: T, + }, + + Fun { + type_args: Vec<Ident<'a>>, + args: Vec<(Ident<'a>, T)>, + body: Box<Expr<'a, T>>, + type_: T, + }, + + Call { + fun: Box<Expr<'a, T>>, + type_args: HashMap<Ident<'a>, T>, + args: Vec<Expr<'a, T>>, + type_: T, + }, +} + +impl<'a, T> Expr<'a, T> { + pub fn type_(&self) -> &T { + match self { + Expr::Ident(_, t) => t, + Expr::Literal(_, t) => t, + Expr::Tuple(_, t) => t, + Expr::UnaryOp { type_, .. } => type_, + Expr::BinaryOp { type_, .. } => type_, + Expr::Let { type_, .. } => type_, + Expr::If { type_, .. } => type_, + Expr::Fun { type_, .. } => type_, + Expr::Call { type_, .. } => type_, + } + } + + pub fn traverse_type<F, U, E>(self, f: F) -> Result<Expr<'a, U>, E> + where + F: Fn(T) -> Result<U, E> + Clone, + { + match self { + Expr::Ident(id, t) => Ok(Expr::Ident(id, f(t)?)), + Expr::Literal(lit, t) => Ok(Expr::Literal(lit, f(t)?)), + Expr::UnaryOp { op, rhs, type_ } => Ok(Expr::UnaryOp { + op, + rhs: Box::new(rhs.traverse_type(f.clone())?), + type_: f(type_)?, + }), + Expr::BinaryOp { + lhs, + op, + rhs, + type_, + } => Ok(Expr::BinaryOp { + lhs: Box::new(lhs.traverse_type(f.clone())?), + op, + rhs: Box::new(rhs.traverse_type(f.clone())?), + type_: f(type_)?, + }), + Expr::Let { + bindings, + body, + type_, + } => Ok(Expr::Let { + bindings: bindings + .into_iter() + .map(|Binding { pat, body }| { + Ok(Binding { + pat: pat.traverse_type(f.clone())?, + body: body.traverse_type(f.clone())?, + }) + }) + .collect::<Result<Vec<_>, E>>()?, + body: Box::new(body.traverse_type(f.clone())?), + type_: f(type_)?, + }), + Expr::If { + condition, + then, + else_, + type_, + } => Ok(Expr::If { + condition: Box::new(condition.traverse_type(f.clone())?), + then: Box::new(then.traverse_type(f.clone())?), + else_: Box::new(else_.traverse_type(f.clone())?), + type_: f(type_)?, + }), + Expr::Fun { + args, + type_args, + body, + type_, + } => Ok(Expr::Fun { + args: args + .into_iter() + .map(|(id, t)| Ok((id, f.clone()(t)?))) + .collect::<Result<Vec<_>, E>>()?, + type_args, + body: Box::new(body.traverse_type(f.clone())?), + type_: f(type_)?, + }), + Expr::Call { + fun, + type_args, + args, + type_, + } => Ok(Expr::Call { + fun: Box::new(fun.traverse_type(f.clone())?), + type_args: type_args + .into_iter() + .map(|(id, ty)| Ok((id, f.clone()(ty)?))) + .collect::<Result<HashMap<_, _>, E>>()?, + args: args + .into_iter() + .map(|e| e.traverse_type(f.clone())) + .collect::<Result<Vec<_>, E>>()?, + type_: f(type_)?, + }), + Expr::Tuple(members, t) => Ok(Expr::Tuple( + members + .into_iter() + .map(|t| t.traverse_type(f.clone())) + .try_collect()?, + f(t)?, + )), + } + } + + pub fn to_owned(&self) -> Expr<'static, T> + where + T: Clone, + { + match self { + Expr::Ident(id, t) => Expr::Ident(id.to_owned(), t.clone()), + Expr::Literal(lit, t) => Expr::Literal(lit.to_owned(), t.clone()), + Expr::UnaryOp { op, rhs, type_ } => Expr::UnaryOp { + op: *op, + rhs: Box::new((**rhs).to_owned()), + type_: type_.clone(), + }, + Expr::BinaryOp { + lhs, + op, + rhs, + type_, + } => Expr::BinaryOp { + lhs: Box::new((**lhs).to_owned()), + op: *op, + rhs: Box::new((**rhs).to_owned()), + type_: type_.clone(), + }, + Expr::Let { + bindings, + body, + type_, + } => Expr::Let { + bindings: bindings.iter().map(|b| b.to_owned()).collect(), + body: Box::new((**body).to_owned()), + type_: type_.clone(), + }, + Expr::If { + condition, + then, + else_, + type_, + } => Expr::If { + condition: Box::new((**condition).to_owned()), + then: Box::new((**then).to_owned()), + else_: Box::new((**else_).to_owned()), + type_: type_.clone(), + }, + Expr::Fun { + args, + type_args, + body, + type_, + } => Expr::Fun { + args: args + .iter() + .map(|(id, t)| (id.to_owned(), t.clone())) + .collect(), + type_args: type_args.iter().map(|arg| arg.to_owned()).collect(), + body: Box::new((**body).to_owned()), + type_: type_.clone(), + }, + Expr::Call { + fun, + type_args, + args, + type_, + } => Expr::Call { + fun: Box::new((**fun).to_owned()), + type_args: type_args + .iter() + .map(|(id, t)| (id.to_owned(), t.clone())) + .collect(), + args: args.iter().map(|e| e.to_owned()).collect(), + type_: type_.clone(), + }, + Expr::Tuple(members, t) => { + Expr::Tuple(members.into_iter().map(Expr::to_owned).collect(), t.clone()) + } + } + } +} + +#[derive(Debug, Clone, PartialEq, Eq)] +pub enum Decl<'a, T> { + Fun { + name: Ident<'a>, + type_args: Vec<Ident<'a>>, + args: Vec<(Ident<'a>, T)>, + body: Box<Expr<'a, T>>, + type_: T, + }, + + Extern { + name: Ident<'a>, + arg_types: Vec<T>, + ret_type: T, + }, +} + +impl<'a, T> Decl<'a, T> { + pub fn name(&self) -> &Ident<'a> { + match self { + Decl::Fun { name, .. } => name, + Decl::Extern { name, .. } => name, + } + } + + pub fn set_name(&mut self, new_name: Ident<'a>) { + match self { + Decl::Fun { name, .. } => *name = new_name, + Decl::Extern { name, .. } => *name = new_name, + } + } + + pub fn type_(&self) -> Option<&T> { + match self { + Decl::Fun { type_, .. } => Some(type_), + Decl::Extern { .. } => None, + } + } + + pub fn traverse_type<F, U, E>(self, f: F) -> Result<Decl<'a, U>, E> + where + F: Fn(T) -> Result<U, E> + Clone, + { + match self { + Decl::Fun { + name, + type_args, + args, + body, + type_, + } => Ok(Decl::Fun { + name, + type_args, + args: args + .into_iter() + .map(|(id, t)| Ok((id, f(t)?))) + .try_collect()?, + body: Box::new(body.traverse_type(f.clone())?), + type_: f(type_)?, + }), + Decl::Extern { + name, + arg_types, + ret_type, + } => Ok(Decl::Extern { + name, + arg_types: arg_types.into_iter().map(f.clone()).try_collect()?, + ret_type: f(ret_type)?, + }), + } + } +} diff --git a/users/grfn/achilles/src/ast/mod.rs b/users/grfn/achilles/src/ast/mod.rs new file mode 100644 index 000000000000..5438d29d2cf7 --- /dev/null +++ b/users/grfn/achilles/src/ast/mod.rs @@ -0,0 +1,484 @@ +pub(crate) mod hir; + +use std::borrow::Cow; +use std::collections::HashMap; +use std::convert::TryFrom; +use std::fmt::{self, Display, Formatter}; + +use itertools::Itertools; + +#[derive(Debug, PartialEq, Eq)] +pub struct InvalidIdentifier<'a>(Cow<'a, str>); + +#[derive(Debug, PartialEq, Eq, Hash, Clone)] +pub struct Ident<'a>(pub Cow<'a, str>); + +impl<'a> From<&'a Ident<'a>> for &'a str { + fn from(id: &'a Ident<'a>) -> Self { + id.0.as_ref() + } +} + +impl<'a> Display for Ident<'a> { + fn fmt(&self, f: &mut Formatter<'_>) -> fmt::Result { + write!(f, "{}", self.0) + } +} + +impl<'a> Ident<'a> { + pub fn to_owned(&self) -> Ident<'static> { + Ident(Cow::Owned(self.0.clone().into_owned())) + } + + /// Construct an identifier from a &str without checking that it's a valid identifier + pub fn from_str_unchecked(s: &'a str) -> Self { + debug_assert!(is_valid_identifier(s)); + Self(Cow::Borrowed(s)) + } + + pub fn from_string_unchecked(s: String) -> Self { + debug_assert!(is_valid_identifier(&s)); + Self(Cow::Owned(s)) + } +} + +pub fn is_valid_identifier<S>(s: &S) -> bool +where + S: AsRef<str> + ?Sized, +{ + s.as_ref() + .chars() + .any(|c| !c.is_alphanumeric() || !"_".contains(c)) +} + +impl<'a> TryFrom<&'a str> for Ident<'a> { + type Error = InvalidIdentifier<'a>; + + fn try_from(s: &'a str) -> Result<Self, Self::Error> { + if is_valid_identifier(s) { + Ok(Ident(Cow::Borrowed(s))) + } else { + Err(InvalidIdentifier(Cow::Borrowed(s))) + } + } +} + +impl<'a> TryFrom<String> for Ident<'a> { + type Error = InvalidIdentifier<'static>; + + fn try_from(s: String) -> Result<Self, Self::Error> { + if is_valid_identifier(&s) { + Ok(Ident(Cow::Owned(s))) + } else { + Err(InvalidIdentifier(Cow::Owned(s))) + } + } +} + +#[derive(Debug, PartialEq, Eq, Copy, Clone)] +pub enum BinaryOperator { + /// `+` + Add, + + /// `-` + Sub, + + /// `*` + Mul, + + /// `/` + Div, + + /// `^` + Pow, + + /// `==` + Equ, + + /// `!=` + Neq, +} + +#[derive(Debug, PartialEq, Eq, Copy, Clone)] +pub enum UnaryOperator { + /// ! + Not, + + /// - + Neg, +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum Literal<'a> { + Unit, + Int(u64), + Bool(bool), + String(Cow<'a, str>), +} + +impl<'a> Literal<'a> { + pub fn to_owned(&self) -> Literal<'static> { + match self { + Literal::Int(i) => Literal::Int(*i), + Literal::Bool(b) => Literal::Bool(*b), + Literal::String(s) => Literal::String(Cow::Owned(s.clone().into_owned())), + Literal::Unit => Literal::Unit, + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum Pattern<'a> { + Id(Ident<'a>), + Tuple(Vec<Pattern<'a>>), +} + +impl<'a> Pattern<'a> { + pub fn to_owned(&self) -> Pattern<'static> { + match self { + Pattern::Id(id) => Pattern::Id(id.to_owned()), + Pattern::Tuple(pats) => Pattern::Tuple(pats.iter().map(Pattern::to_owned).collect()), + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub struct Binding<'a> { + pub pat: Pattern<'a>, + pub type_: Option<Type<'a>>, + pub body: Expr<'a>, +} + +impl<'a> Binding<'a> { + fn to_owned(&self) -> Binding<'static> { + Binding { + pat: self.pat.to_owned(), + type_: self.type_.as_ref().map(|t| t.to_owned()), + body: self.body.to_owned(), + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum Expr<'a> { + Ident(Ident<'a>), + + Literal(Literal<'a>), + + UnaryOp { + op: UnaryOperator, + rhs: Box<Expr<'a>>, + }, + + BinaryOp { + lhs: Box<Expr<'a>>, + op: BinaryOperator, + rhs: Box<Expr<'a>>, + }, + + Let { + bindings: Vec<Binding<'a>>, + body: Box<Expr<'a>>, + }, + + If { + condition: Box<Expr<'a>>, + then: Box<Expr<'a>>, + else_: Box<Expr<'a>>, + }, + + Fun(Box<Fun<'a>>), + + Call { + fun: Box<Expr<'a>>, + args: Vec<Expr<'a>>, + }, + + Tuple(Vec<Expr<'a>>), + + Ascription { + expr: Box<Expr<'a>>, + type_: Type<'a>, + }, +} + +impl<'a> Expr<'a> { + pub fn to_owned(&self) -> Expr<'static> { + match self { + Expr::Ident(ref id) => Expr::Ident(id.to_owned()), + Expr::Literal(ref lit) => Expr::Literal(lit.to_owned()), + Expr::Tuple(ref members) => { + Expr::Tuple(members.into_iter().map(Expr::to_owned).collect()) + } + Expr::UnaryOp { op, rhs } => Expr::UnaryOp { + op: *op, + rhs: Box::new((**rhs).to_owned()), + }, + Expr::BinaryOp { lhs, op, rhs } => Expr::BinaryOp { + lhs: Box::new((**lhs).to_owned()), + op: *op, + rhs: Box::new((**rhs).to_owned()), + }, + Expr::Let { bindings, body } => Expr::Let { + bindings: bindings.iter().map(|binding| binding.to_owned()).collect(), + body: Box::new((**body).to_owned()), + }, + Expr::If { + condition, + then, + else_, + } => Expr::If { + condition: Box::new((**condition).to_owned()), + then: Box::new((**then).to_owned()), + else_: Box::new((**else_).to_owned()), + }, + Expr::Fun(fun) => Expr::Fun(Box::new((**fun).to_owned())), + Expr::Call { fun, args } => Expr::Call { + fun: Box::new((**fun).to_owned()), + args: args.iter().map(|arg| arg.to_owned()).collect(), + }, + Expr::Ascription { expr, type_ } => Expr::Ascription { + expr: Box::new((**expr).to_owned()), + type_: type_.to_owned(), + }, + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub struct Arg<'a> { + pub ident: Ident<'a>, + pub type_: Option<Type<'a>>, +} + +impl<'a> Arg<'a> { + pub fn to_owned(&self) -> Arg<'static> { + Arg { + ident: self.ident.to_owned(), + type_: self.type_.as_ref().map(Type::to_owned), + } + } +} + +impl<'a> TryFrom<&'a str> for Arg<'a> { + type Error = <Ident<'a> as TryFrom<&'a str>>::Error; + + fn try_from(value: &'a str) -> Result<Self, Self::Error> { + Ok(Arg { + ident: Ident::try_from(value)?, + type_: None, + }) + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub struct Fun<'a> { + pub args: Vec<Arg<'a>>, + pub body: Expr<'a>, +} + +impl<'a> Fun<'a> { + pub fn to_owned(&self) -> Fun<'static> { + Fun { + args: self.args.iter().map(|arg| arg.to_owned()).collect(), + body: self.body.to_owned(), + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum Decl<'a> { + Fun { + name: Ident<'a>, + body: Fun<'a>, + }, + Ascription { + name: Ident<'a>, + type_: Type<'a>, + }, + Extern { + name: Ident<'a>, + type_: FunctionType<'a>, + }, +} + +//// + +#[derive(Debug, PartialEq, Eq, Clone)] +pub struct FunctionType<'a> { + pub args: Vec<Type<'a>>, + pub ret: Box<Type<'a>>, +} + +impl<'a> FunctionType<'a> { + pub fn to_owned(&self) -> FunctionType<'static> { + FunctionType { + args: self.args.iter().map(|a| a.to_owned()).collect(), + ret: Box::new((*self.ret).to_owned()), + } + } +} + +impl<'a> Display for FunctionType<'a> { + fn fmt(&self, f: &mut Formatter<'_>) -> fmt::Result { + write!(f, "fn {} -> {}", self.args.iter().join(", "), self.ret) + } +} + +#[derive(Debug, PartialEq, Eq, Clone)] +pub enum Type<'a> { + Int, + Float, + Bool, + CString, + Unit, + Tuple(Vec<Type<'a>>), + Var(Ident<'a>), + Function(FunctionType<'a>), +} + +impl<'a> Type<'a> { + pub fn to_owned(&self) -> Type<'static> { + match self { + Type::Int => Type::Int, + Type::Float => Type::Float, + Type::Bool => Type::Bool, + Type::CString => Type::CString, + Type::Unit => Type::Unit, + Type::Var(v) => Type::Var(v.to_owned()), + Type::Function(f) => Type::Function(f.to_owned()), + Type::Tuple(members) => Type::Tuple(members.iter().map(Type::to_owned).collect()), + } + } + + pub fn alpha_equiv(&self, other: &Self) -> bool { + fn do_alpha_equiv<'a>( + substs: &mut HashMap<&'a Ident<'a>, &'a Ident<'a>>, + lhs: &'a Type, + rhs: &'a Type, + ) -> bool { + match (lhs, rhs) { + (Type::Var(v1), Type::Var(v2)) => substs.entry(v1).or_insert(v2) == &v2, + ( + Type::Function(FunctionType { + args: args1, + ret: ret1, + }), + Type::Function(FunctionType { + args: args2, + ret: ret2, + }), + ) => { + args1.len() == args2.len() + && args1 + .iter() + .zip(args2) + .all(|(a1, a2)| do_alpha_equiv(substs, a1, a2)) + && do_alpha_equiv(substs, ret1, ret2) + } + _ => lhs == rhs, + } + } + + let mut substs = HashMap::new(); + do_alpha_equiv(&mut substs, self, other) + } + + pub fn traverse_type_vars<'b, F>(self, mut f: F) -> Type<'b> + where + F: FnMut(Ident<'a>) -> Type<'b> + Clone, + { + match self { + Type::Var(tv) => f(tv), + Type::Function(FunctionType { args, ret }) => Type::Function(FunctionType { + args: args + .into_iter() + .map(|t| t.traverse_type_vars(f.clone())) + .collect(), + ret: Box::new(ret.traverse_type_vars(f)), + }), + Type::Int => Type::Int, + Type::Float => Type::Float, + Type::Bool => Type::Bool, + Type::CString => Type::CString, + Type::Tuple(members) => Type::Tuple( + members + .into_iter() + .map(|t| t.traverse_type_vars(f.clone())) + .collect(), + ), + Type::Unit => Type::Unit, + } + } + + pub fn as_tuple(&self) -> Option<&Vec<Type<'a>>> { + if let Self::Tuple(v) = self { + Some(v) + } else { + None + } + } +} + +impl<'a> Display for Type<'a> { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self { + Type::Int => f.write_str("int"), + Type::Float => f.write_str("float"), + Type::Bool => f.write_str("bool"), + Type::CString => f.write_str("cstring"), + Type::Unit => f.write_str("()"), + Type::Var(v) => v.fmt(f), + Type::Function(ft) => ft.fmt(f), + Type::Tuple(ms) => write!(f, "({})", ms.iter().join(", ")), + } + } +} + +#[cfg(test)] +mod tests { + use super::*; + + fn type_var(n: &str) -> Type<'static> { + Type::Var(Ident::try_from(n.to_owned()).unwrap()) + } + + mod alpha_equiv { + use super::*; + + #[test] + fn trivial() { + assert!(Type::Int.alpha_equiv(&Type::Int)); + assert!(!Type::Int.alpha_equiv(&Type::Bool)); + } + + #[test] + fn simple_type_var() { + assert!(type_var("a").alpha_equiv(&type_var("b"))); + } + + #[test] + fn function_with_type_vars_equiv() { + assert!(Type::Function(FunctionType { + args: vec![type_var("a")], + ret: Box::new(type_var("b")), + }) + .alpha_equiv(&Type::Function(FunctionType { + args: vec![type_var("b")], + ret: Box::new(type_var("a")), + }))) + } + + #[test] + fn function_with_type_vars_non_equiv() { + assert!(!Type::Function(FunctionType { + args: vec![type_var("a")], + ret: Box::new(type_var("a")), + }) + .alpha_equiv(&Type::Function(FunctionType { + args: vec![type_var("b")], + ret: Box::new(type_var("a")), + }))) + } + } +} diff --git a/users/grfn/achilles/src/codegen/llvm.rs b/users/grfn/achilles/src/codegen/llvm.rs new file mode 100644 index 000000000000..9a71ac954e00 --- /dev/null +++ b/users/grfn/achilles/src/codegen/llvm.rs @@ -0,0 +1,486 @@ +use std::convert::{TryFrom, TryInto}; +use std::path::Path; +use std::result; + +use inkwell::basic_block::BasicBlock; +use inkwell::builder::Builder; +pub use inkwell::context::Context; +use inkwell::module::Module; +use inkwell::support::LLVMString; +use inkwell::types::{BasicType, BasicTypeEnum, FunctionType, IntType, StructType}; +use inkwell::values::{AnyValueEnum, BasicValueEnum, FunctionValue, StructValue}; +use inkwell::{AddressSpace, IntPredicate}; +use itertools::Itertools; +use thiserror::Error; + +use crate::ast::hir::{Binding, Decl, Expr, Pattern}; +use crate::ast::{BinaryOperator, Ident, Literal, Type, UnaryOperator}; +use crate::common::env::Env; + +#[derive(Debug, PartialEq, Eq, Error)] +pub enum Error { + #[error("Undefined variable {0}")] + UndefinedVariable(Ident<'static>), + + #[error("LLVM Error: {0}")] + LLVMError(String), +} + +impl From<LLVMString> for Error { + fn from(s: LLVMString) -> Self { + Self::LLVMError(s.to_string()) + } +} + +pub type Result<T> = result::Result<T, Error>; + +pub struct Codegen<'ctx, 'ast> { + context: &'ctx Context, + pub module: Module<'ctx>, + builder: Builder<'ctx>, + env: Env<&'ast Ident<'ast>, AnyValueEnum<'ctx>>, + function_stack: Vec<FunctionValue<'ctx>>, + identifier_counter: u32, +} + +impl<'ctx, 'ast> Codegen<'ctx, 'ast> { + pub fn new(context: &'ctx Context, module_name: &str) -> Self { + let module = context.create_module(module_name); + let builder = context.create_builder(); + Self { + context, + module, + builder, + env: Default::default(), + function_stack: Default::default(), + identifier_counter: 0, + } + } + + pub fn new_function<'a>( + &'a mut self, + name: &str, + ty: FunctionType<'ctx>, + ) -> &'a FunctionValue<'ctx> { + self.function_stack + .push(self.module.add_function(name, ty, None)); + let basic_block = self.append_basic_block("entry"); + self.builder.position_at_end(basic_block); + self.function_stack.last().unwrap() + } + + pub fn finish_function(&mut self, res: Option<&BasicValueEnum<'ctx>>) -> FunctionValue<'ctx> { + self.builder.build_return(match res { + // lol + Some(val) => Some(val), + None => None, + }); + self.function_stack.pop().unwrap() + } + + pub fn append_basic_block(&self, name: &str) -> BasicBlock<'ctx> { + self.context + .append_basic_block(*self.function_stack.last().unwrap(), name) + } + + fn bind_pattern(&mut self, pat: &'ast Pattern<'ast, Type>, val: AnyValueEnum<'ctx>) { + match pat { + Pattern::Id(id, _) => self.env.set(id, val), + Pattern::Tuple(pats) => { + for (i, pat) in pats.iter().enumerate() { + let member = self + .builder + .build_extract_value( + StructValue::try_from(val).unwrap(), + i as _, + "pat_bind", + ) + .unwrap(); + self.bind_pattern(pat, member.into()); + } + } + } + } + + pub fn codegen_expr( + &mut self, + expr: &'ast Expr<'ast, Type>, + ) -> Result<Option<AnyValueEnum<'ctx>>> { + match expr { + Expr::Ident(id, _) => self + .env + .resolve(id) + .cloned() + .ok_or_else(|| Error::UndefinedVariable(id.to_owned())) + .map(Some), + Expr::Literal(lit, ty) => { + let ty = self.codegen_int_type(ty); + match lit { + Literal::Int(i) => Ok(Some(AnyValueEnum::IntValue(ty.const_int(*i, false)))), + Literal::Bool(b) => Ok(Some(AnyValueEnum::IntValue( + ty.const_int(if *b { 1 } else { 0 }, false), + ))), + Literal::String(s) => Ok(Some( + self.builder + .build_global_string_ptr(s, "s") + .as_pointer_value() + .into(), + )), + Literal::Unit => Ok(None), + } + } + Expr::UnaryOp { op, rhs, .. } => { + let rhs = self.codegen_expr(rhs)?.unwrap(); + match op { + UnaryOperator::Not => unimplemented!(), + UnaryOperator::Neg => Ok(Some(AnyValueEnum::IntValue( + self.builder.build_int_neg(rhs.into_int_value(), "neg"), + ))), + } + } + Expr::BinaryOp { lhs, op, rhs, .. } => { + let lhs = self.codegen_expr(lhs)?.unwrap(); + let rhs = self.codegen_expr(rhs)?.unwrap(); + match op { + BinaryOperator::Add => { + Ok(Some(AnyValueEnum::IntValue(self.builder.build_int_add( + lhs.into_int_value(), + rhs.into_int_value(), + "add", + )))) + } + BinaryOperator::Sub => { + Ok(Some(AnyValueEnum::IntValue(self.builder.build_int_sub( + lhs.into_int_value(), + rhs.into_int_value(), + "add", + )))) + } + BinaryOperator::Mul => { + Ok(Some(AnyValueEnum::IntValue(self.builder.build_int_sub( + lhs.into_int_value(), + rhs.into_int_value(), + "add", + )))) + } + BinaryOperator::Div => Ok(Some(AnyValueEnum::IntValue( + self.builder.build_int_signed_div( + lhs.into_int_value(), + rhs.into_int_value(), + "add", + ), + ))), + BinaryOperator::Pow => unimplemented!(), + BinaryOperator::Equ => Ok(Some(AnyValueEnum::IntValue( + self.builder.build_int_compare( + IntPredicate::EQ, + lhs.into_int_value(), + rhs.into_int_value(), + "eq", + ), + ))), + BinaryOperator::Neq => todo!(), + } + } + Expr::Let { bindings, body, .. } => { + self.env.push(); + for Binding { pat, body, .. } in bindings { + if let Some(val) = self.codegen_expr(body)? { + self.bind_pattern(pat, val); + } + } + let res = self.codegen_expr(body); + self.env.pop(); + res + } + Expr::If { + condition, + then, + else_, + type_, + } => { + let then_block = self.append_basic_block("then"); + let else_block = self.append_basic_block("else"); + let join_block = self.append_basic_block("join"); + let condition = self.codegen_expr(condition)?.unwrap(); + self.builder.build_conditional_branch( + condition.into_int_value(), + then_block, + else_block, + ); + self.builder.position_at_end(then_block); + let then_res = self.codegen_expr(then)?; + self.builder.build_unconditional_branch(join_block); + + self.builder.position_at_end(else_block); + let else_res = self.codegen_expr(else_)?; + self.builder.build_unconditional_branch(join_block); + + self.builder.position_at_end(join_block); + if let Some(phi_type) = self.codegen_type(type_) { + let phi = self.builder.build_phi(phi_type, "join"); + phi.add_incoming(&[ + ( + &BasicValueEnum::try_from(then_res.unwrap()).unwrap(), + then_block, + ), + ( + &BasicValueEnum::try_from(else_res.unwrap()).unwrap(), + else_block, + ), + ]); + Ok(Some(phi.as_basic_value().into())) + } else { + Ok(None) + } + } + Expr::Call { fun, args, .. } => { + if let Expr::Ident(id, _) = &**fun { + let function = self + .module + .get_function(id.into()) + .or_else(|| self.env.resolve(id)?.clone().try_into().ok()) + .ok_or_else(|| Error::UndefinedVariable(id.to_owned()))?; + let args = args + .iter() + .map(|arg| Ok(self.codegen_expr(arg)?.unwrap().try_into().unwrap())) + .collect::<Result<Vec<_>>>()?; + Ok(self + .builder + .build_call(function, &args, "call") + .try_as_basic_value() + .left() + .map(|val| val.into())) + } else { + todo!() + } + } + Expr::Fun { args, body, .. } => { + let fname = self.fresh_ident("f"); + let cur_block = self.builder.get_insert_block().unwrap(); + let env = self.env.save(); // TODO: closures + let function = self.codegen_function(&fname, args, body)?; + self.builder.position_at_end(cur_block); + self.env.restore(env); + Ok(Some(function.into())) + } + Expr::Tuple(members, ty) => { + let values = members + .into_iter() + .map(|expr| self.codegen_expr(expr)) + .collect::<Result<Vec<_>>>()? + .into_iter() + .filter_map(|x| x) + .map(|x| x.try_into().unwrap()) + .collect_vec(); + let field_types = ty.as_tuple().unwrap(); + let tuple_type = self.codegen_tuple_type(field_types); + Ok(Some(tuple_type.const_named_struct(&values).into())) + } + } + } + + pub fn codegen_function( + &mut self, + name: &str, + args: &'ast [(Ident<'ast>, Type)], + body: &'ast Expr<'ast, Type>, + ) -> Result<FunctionValue<'ctx>> { + let arg_types = args + .iter() + .filter_map(|(_, at)| self.codegen_type(at)) + .collect::<Vec<_>>(); + + self.new_function( + name, + match self.codegen_type(body.type_()) { + Some(ret_ty) => ret_ty.fn_type(&arg_types, false), + None => self.context.void_type().fn_type(&arg_types, false), + }, + ); + self.env.push(); + for (i, (arg, _)) in args.iter().enumerate() { + self.env.set( + arg, + self.cur_function().get_nth_param(i as u32).unwrap().into(), + ); + } + let res = self.codegen_expr(body)?; + self.env.pop(); + Ok(self.finish_function(res.map(|av| av.try_into().unwrap()).as_ref())) + } + + pub fn codegen_extern( + &mut self, + name: &str, + args: &'ast [Type], + ret: &'ast Type, + ) -> Result<()> { + let arg_types = args + .iter() + .map(|t| self.codegen_type(t).unwrap()) + .collect::<Vec<_>>(); + self.module.add_function( + name, + match self.codegen_type(ret) { + Some(ret_ty) => ret_ty.fn_type(&arg_types, false), + None => self.context.void_type().fn_type(&arg_types, false), + }, + None, + ); + Ok(()) + } + + pub fn codegen_decl(&mut self, decl: &'ast Decl<'ast, Type>) -> Result<()> { + match decl { + Decl::Fun { + name, args, body, .. + } => { + self.codegen_function(name.into(), args, body)?; + Ok(()) + } + Decl::Extern { + name, + arg_types, + ret_type, + } => self.codegen_extern(name.into(), arg_types, ret_type), + } + } + + pub fn codegen_main(&mut self, expr: &'ast Expr<'ast, Type>) -> Result<()> { + self.new_function("main", self.context.i64_type().fn_type(&[], false)); + let res = self.codegen_expr(expr)?; + if *expr.type_() != Type::Int { + self.builder + .build_return(Some(&self.context.i64_type().const_int(0, false))); + } else { + self.finish_function(res.map(|r| r.try_into().unwrap()).as_ref()); + } + Ok(()) + } + + fn codegen_type(&self, type_: &'ast Type) -> Option<BasicTypeEnum<'ctx>> { + // TODO + match type_ { + Type::Int => Some(self.context.i64_type().into()), + Type::Float => Some(self.context.f64_type().into()), + Type::Bool => Some(self.context.bool_type().into()), + Type::CString => Some( + self.context + .i8_type() + .ptr_type(AddressSpace::Generic) + .into(), + ), + Type::Function(_) => todo!(), + Type::Var(_) => unreachable!(), + Type::Unit => None, + Type::Tuple(ts) => Some(self.codegen_tuple_type(ts).into()), + } + } + + fn codegen_tuple_type(&self, ts: &'ast [Type]) -> StructType<'ctx> { + self.context.struct_type( + ts.iter() + .filter_map(|t| self.codegen_type(t)) + .collect_vec() + .as_slice(), + false, + ) + } + + fn codegen_int_type(&self, type_: &'ast Type) -> IntType<'ctx> { + // TODO + self.context.i64_type() + } + + pub fn print_to_file<P>(&self, path: P) -> Result<()> + where + P: AsRef<Path>, + { + Ok(self.module.print_to_file(path)?) + } + + pub fn binary_to_file<P>(&self, path: P) -> Result<()> + where + P: AsRef<Path>, + { + if self.module.write_bitcode_to_path(path.as_ref()) { + Ok(()) + } else { + Err(Error::LLVMError( + "Error writing bitcode to output path".to_owned(), + )) + } + } + + fn fresh_ident(&mut self, prefix: &str) -> String { + self.identifier_counter += 1; + format!("{}{}", prefix, self.identifier_counter) + } + + fn cur_function(&self) -> &FunctionValue<'ctx> { + self.function_stack.last().unwrap() + } +} + +#[cfg(test)] +mod tests { + use inkwell::execution_engine::JitFunction; + use inkwell::OptimizationLevel; + + use super::*; + + fn jit_eval<T>(expr: &str) -> anyhow::Result<T> { + let expr = crate::parser::expr(expr).unwrap().1; + + let expr = crate::tc::typecheck_expr(expr).unwrap(); + + let context = Context::create(); + let mut codegen = Codegen::new(&context, "test"); + let execution_engine = codegen + .module + .create_jit_execution_engine(OptimizationLevel::None) + .unwrap(); + + codegen.codegen_function("test", &[], &expr)?; + + unsafe { + let fun: JitFunction<unsafe extern "C" fn() -> T> = + execution_engine.get_function("test")?; + Ok(fun.call()) + } + } + + #[test] + fn add_literals() { + assert_eq!(jit_eval::<i64>("1 + 2").unwrap(), 3); + } + + #[test] + fn variable_shadowing() { + assert_eq!( + jit_eval::<i64>("let x = 1 in (let x = 2 in x) + x").unwrap(), + 3 + ); + } + + #[test] + fn eq() { + assert_eq!( + jit_eval::<i64>("let x = 1 in if x == 1 then 2 else 4").unwrap(), + 2 + ); + } + + #[test] + fn function_call() { + let res = jit_eval::<i64>("let id = fn x = x in id 1").unwrap(); + assert_eq!(res, 1); + } + + #[test] + fn bind_tuple_pattern() { + let res = jit_eval::<i64>("let (x, y) = (1, 2) in x + y").unwrap(); + assert_eq!(res, 3); + } +} diff --git a/users/grfn/achilles/src/codegen/mod.rs b/users/grfn/achilles/src/codegen/mod.rs new file mode 100644 index 000000000000..8ef057dba04f --- /dev/null +++ b/users/grfn/achilles/src/codegen/mod.rs @@ -0,0 +1,25 @@ +pub mod llvm; + +use inkwell::execution_engine::JitFunction; +use inkwell::OptimizationLevel; +pub use llvm::*; + +use crate::ast::hir::Expr; +use crate::ast::Type; +use crate::common::Result; + +pub fn jit_eval<T>(expr: &Expr<Type>) -> Result<T> { + let context = Context::create(); + let mut codegen = Codegen::new(&context, "eval"); + let execution_engine = codegen + .module + .create_jit_execution_engine(OptimizationLevel::None) + .map_err(Error::from)?; + codegen.codegen_function("test", &[], &expr)?; + + unsafe { + let fun: JitFunction<unsafe extern "C" fn() -> T> = + execution_engine.get_function("eval").unwrap(); + Ok(fun.call()) + } +} diff --git a/users/grfn/achilles/src/commands/check.rs b/users/grfn/achilles/src/commands/check.rs new file mode 100644 index 000000000000..0bea482c1478 --- /dev/null +++ b/users/grfn/achilles/src/commands/check.rs @@ -0,0 +1,39 @@ +use clap::Clap; +use std::path::PathBuf; + +use crate::ast::Type; +use crate::{parser, tc, Result}; + +/// Typecheck a file or expression +#[derive(Clap)] +pub struct Check { + /// File to check + path: Option<PathBuf>, + + /// Expression to check + #[clap(long, short = 'e')] + expr: Option<String>, +} + +fn run_expr(expr: String) -> Result<Type<'static>> { + let (_, parsed) = parser::expr(&expr)?; + let hir_expr = tc::typecheck_expr(parsed)?; + Ok(hir_expr.type_().to_owned()) +} + +fn run_path(path: PathBuf) -> Result<Type<'static>> { + todo!() +} + +impl Check { + pub fn run(self) -> Result<()> { + let type_ = match (self.path, self.expr) { + (None, None) => Err("Must specify either a file or expression to check".into()), + (Some(_), Some(_)) => Err("Cannot specify both a file and expression to check".into()), + (None, Some(expr)) => run_expr(expr), + (Some(path), None) => run_path(path), + }?; + println!("type: {}", type_); + Ok(()) + } +} diff --git a/users/grfn/achilles/src/commands/compile.rs b/users/grfn/achilles/src/commands/compile.rs new file mode 100644 index 000000000000..be8767575ab5 --- /dev/null +++ b/users/grfn/achilles/src/commands/compile.rs @@ -0,0 +1,31 @@ +use std::path::PathBuf; + +use clap::Clap; + +use crate::common::Result; +use crate::compiler::{self, CompilerOptions}; + +/// Compile a source file +#[derive(Clap)] +pub struct Compile { + /// File to compile + file: PathBuf, + + /// Output file + #[clap(short = 'o')] + out_file: PathBuf, + + #[clap(flatten)] + options: CompilerOptions, +} + +impl Compile { + pub fn run(self) -> Result<()> { + eprintln!( + ">>> {} -> {}", + &self.file.to_string_lossy(), + self.out_file.to_string_lossy() + ); + compiler::compile_file(&self.file, &self.out_file, &self.options) + } +} diff --git a/users/grfn/achilles/src/commands/eval.rs b/users/grfn/achilles/src/commands/eval.rs new file mode 100644 index 000000000000..61a712c08a8e --- /dev/null +++ b/users/grfn/achilles/src/commands/eval.rs @@ -0,0 +1,32 @@ +use clap::Clap; + +use crate::codegen; +use crate::interpreter; +use crate::parser; +use crate::tc; +use crate::Result; + +/// Evaluate an expression and print its result +#[derive(Clap)] +pub struct Eval { + /// JIT-compile with LLVM instead of interpreting + #[clap(long)] + jit: bool, + + /// Expression to evaluate + expr: String, +} + +impl Eval { + pub fn run(self) -> Result<()> { + let (_, parsed) = parser::expr(&self.expr)?; + let hir = tc::typecheck_expr(parsed)?; + let result = if self.jit { + codegen::jit_eval::<i64>(&hir)?.into() + } else { + interpreter::eval(&hir)? + }; + println!("{}", result); + Ok(()) + } +} diff --git a/users/grfn/achilles/src/commands/mod.rs b/users/grfn/achilles/src/commands/mod.rs new file mode 100644 index 000000000000..fd0a822708c2 --- /dev/null +++ b/users/grfn/achilles/src/commands/mod.rs @@ -0,0 +1,7 @@ +pub mod check; +pub mod compile; +pub mod eval; + +pub use check::Check; +pub use compile::Compile; +pub use eval::Eval; diff --git a/users/grfn/achilles/src/common/env.rs b/users/grfn/achilles/src/common/env.rs new file mode 100644 index 000000000000..59a5e46c466f --- /dev/null +++ b/users/grfn/achilles/src/common/env.rs @@ -0,0 +1,59 @@ +use std::borrow::Borrow; +use std::collections::HashMap; +use std::hash::Hash; +use std::mem; + +/// A lexical environment +#[derive(Debug, PartialEq, Eq)] +pub struct Env<K: Eq + Hash, V>(Vec<HashMap<K, V>>); + +impl<K, V> Default for Env<K, V> +where + K: Eq + Hash, +{ + fn default() -> Self { + Self::new() + } +} + +impl<K, V> Env<K, V> +where + K: Eq + Hash, +{ + pub fn new() -> Self { + Self(vec![Default::default()]) + } + + pub fn push(&mut self) { + self.0.push(Default::default()); + } + + pub fn pop(&mut self) { + self.0.pop(); + } + + pub fn save(&mut self) -> Self { + mem::take(self) + } + + pub fn restore(&mut self, saved: Self) { + *self = saved; + } + + pub fn set(&mut self, k: K, v: V) { + self.0.last_mut().unwrap().insert(k, v); + } + + pub fn resolve<'a, Q>(&'a self, k: &Q) -> Option<&'a V> + where + K: Borrow<Q>, + Q: Hash + Eq + ?Sized, + { + for ctx in self.0.iter().rev() { + if let Some(res) = ctx.get(k) { + return Some(res); + } + } + None + } +} diff --git a/users/grfn/achilles/src/common/error.rs b/users/grfn/achilles/src/common/error.rs new file mode 100644 index 000000000000..51575a895e91 --- /dev/null +++ b/users/grfn/achilles/src/common/error.rs @@ -0,0 +1,59 @@ +use std::{io, result}; + +use thiserror::Error; + +use crate::{codegen, interpreter, parser, tc}; + +#[derive(Error, Debug)] +pub enum Error { + #[error(transparent)] + IOError(#[from] io::Error), + + #[error("Error parsing input: {0}")] + ParseError(#[from] parser::Error), + + #[error("Error evaluating expression: {0}")] + EvalError(#[from] interpreter::Error), + + #[error("Compile error: {0}")] + CodegenError(#[from] codegen::Error), + + #[error("Type error: {0}")] + TypeError(#[from] tc::Error), + + #[error("{0}")] + Message(String), +} + +impl From<String> for Error { + fn from(s: String) -> Self { + Self::Message(s) + } +} + +impl<'a> From<&'a str> for Error { + fn from(s: &'a str) -> Self { + Self::Message(s.to_owned()) + } +} + +impl<'a> From<nom::Err<nom::error::Error<&'a str>>> for Error { + fn from(e: nom::Err<nom::error::Error<&'a str>>) -> Self { + use nom::error::Error as NomError; + use nom::Err::*; + + Self::ParseError(match e { + Incomplete(i) => Incomplete(i), + Error(NomError { input, code }) => Error(NomError { + input: input.to_owned(), + code, + }), + Failure(NomError { input, code }) => Failure(NomError { + input: input.to_owned(), + code, + }), + }) + } +} + +pub type Result<T> = result::Result<T, Error>; diff --git a/users/grfn/achilles/src/common/mod.rs b/users/grfn/achilles/src/common/mod.rs new file mode 100644 index 000000000000..8368a6dd180f --- /dev/null +++ b/users/grfn/achilles/src/common/mod.rs @@ -0,0 +1,6 @@ +pub(crate) mod env; +pub(crate) mod error; +pub(crate) mod namer; + +pub use error::{Error, Result}; +pub use namer::{Namer, NamerOf}; diff --git a/users/grfn/achilles/src/common/namer.rs b/users/grfn/achilles/src/common/namer.rs new file mode 100644 index 000000000000..016e9f6ed99a --- /dev/null +++ b/users/grfn/achilles/src/common/namer.rs @@ -0,0 +1,122 @@ +use std::fmt::Display; +use std::marker::PhantomData; + +pub struct Namer<T, F> { + make_name: F, + counter: u64, + _phantom: PhantomData<T>, +} + +impl<T, F> Namer<T, F> { + pub fn new(make_name: F) -> Self { + Namer { + make_name, + counter: 0, + _phantom: PhantomData, + } + } +} + +impl Namer<String, Box<dyn Fn(u64) -> String>> { + pub fn with_prefix<T>(prefix: T) -> Self + where + T: Display + 'static, + { + Namer::new(move |i| format!("{}{}", prefix, i)).boxed() + } + + pub fn with_suffix<T>(suffix: T) -> Self + where + T: Display + 'static, + { + Namer::new(move |i| format!("{}{}", i, suffix)).boxed() + } + + pub fn alphabetic() -> Self { + Namer::new(|i| { + if i <= 26 { + std::char::from_u32((i + 96) as u32).unwrap().to_string() + } else { + format!( + "{}{}", + std::char::from_u32(((i % 26) + 96) as u32).unwrap(), + i - 26 + ) + } + }) + .boxed() + } +} + +impl<T, F> Namer<T, F> +where + F: Fn(u64) -> T, +{ + pub fn make_name(&mut self) -> T { + self.counter += 1; + (self.make_name)(self.counter) + } + + pub fn boxed(self) -> NamerOf<T> + where + F: 'static, + { + Namer { + make_name: Box::new(self.make_name), + counter: self.counter, + _phantom: self._phantom, + } + } + + pub fn map<G, U>(self, f: G) -> NamerOf<U> + where + G: Fn(T) -> U + 'static, + T: 'static, + F: 'static, + { + Namer { + counter: self.counter, + make_name: Box::new(move |x| f((self.make_name)(x))), + _phantom: PhantomData, + } + } +} + +pub type NamerOf<T> = Namer<T, Box<dyn Fn(u64) -> T>>; + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn prefix() { + let mut namer = Namer::with_prefix("t"); + assert_eq!(namer.make_name(), "t1"); + assert_eq!(namer.make_name(), "t2"); + } + + #[test] + fn suffix() { + let mut namer = Namer::with_suffix("t"); + assert_eq!(namer.make_name(), "1t"); + assert_eq!(namer.make_name(), "2t"); + } + + #[test] + fn alphabetic() { + let mut namer = Namer::alphabetic(); + assert_eq!(namer.make_name(), "a"); + assert_eq!(namer.make_name(), "b"); + (0..25).for_each(|_| { + namer.make_name(); + }); + assert_eq!(namer.make_name(), "b2"); + } + + #[test] + fn custom_callback() { + let mut namer = Namer::new(|n| n + 1); + assert_eq!(namer.make_name(), 2); + assert_eq!(namer.make_name(), 3); + } +} diff --git a/users/grfn/achilles/src/compiler.rs b/users/grfn/achilles/src/compiler.rs new file mode 100644 index 000000000000..45b215473d7f --- /dev/null +++ b/users/grfn/achilles/src/compiler.rs @@ -0,0 +1,89 @@ +use std::fmt::{self, Display}; +use std::path::Path; +use std::str::FromStr; +use std::{fs, result}; + +use clap::Clap; +use test_strategy::Arbitrary; + +use crate::codegen::{self, Codegen}; +use crate::common::Result; +use crate::passes::hir::{monomorphize, strip_positive_units}; +use crate::{parser, tc}; + +#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash, Arbitrary)] +pub enum OutputFormat { + LLVM, + Bitcode, +} + +impl Default for OutputFormat { + fn default() -> Self { + Self::Bitcode + } +} + +impl FromStr for OutputFormat { + type Err = String; + + fn from_str(s: &str) -> result::Result<Self, Self::Err> { + match s { + "llvm" => Ok(Self::LLVM), + "binary" => Ok(Self::Bitcode), + _ => Err(format!( + "Invalid output format {}, expected one of {{llvm, binary}}", + s + )), + } + } +} + +impl Display for OutputFormat { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self { + OutputFormat::LLVM => f.write_str("llvm"), + OutputFormat::Bitcode => f.write_str("binary"), + } + } +} + +#[derive(Clap, Debug, PartialEq, Eq, Default)] +pub struct CompilerOptions { + #[clap(long, short = 'f', default_value)] + format: OutputFormat, +} + +pub fn compile_file(input: &Path, output: &Path, options: &CompilerOptions) -> Result<()> { + let src = fs::read_to_string(input)?; + let (_, decls) = parser::toplevel(&src)?; + let mut decls = tc::typecheck_toplevel(decls)?; + monomorphize::run_toplevel(&mut decls); + strip_positive_units::run_toplevel(&mut decls); + + let context = codegen::Context::create(); + let mut codegen = Codegen::new( + &context, + &input + .file_stem() + .map_or("UNKNOWN".to_owned(), |s| s.to_string_lossy().into_owned()), + ); + for decl in &decls { + codegen.codegen_decl(decl)?; + } + match options.format { + OutputFormat::LLVM => codegen.print_to_file(output)?, + OutputFormat::Bitcode => codegen.binary_to_file(output)?, + } + Ok(()) +} + +#[cfg(test)] +mod tests { + use super::*; + use test_strategy::proptest; + + #[proptest] + fn output_format_display_from_str_round_trip(of: OutputFormat) { + assert_eq!(OutputFormat::from_str(&of.to_string()), Ok(of)); + } +} diff --git a/users/grfn/achilles/src/interpreter/error.rs b/users/grfn/achilles/src/interpreter/error.rs new file mode 100644 index 000000000000..268d6f479a1e --- /dev/null +++ b/users/grfn/achilles/src/interpreter/error.rs @@ -0,0 +1,19 @@ +use std::result; + +use thiserror::Error; + +use crate::ast::{Ident, Type}; + +#[derive(Debug, PartialEq, Eq, Error)] +pub enum Error { + #[error("Undefined variable {0}")] + UndefinedVariable(Ident<'static>), + + #[error("Unexpected type {actual}, expected type {expected}")] + InvalidType { + actual: Type<'static>, + expected: Type<'static>, + }, +} + +pub type Result<T> = result::Result<T, Error>; diff --git a/users/grfn/achilles/src/interpreter/mod.rs b/users/grfn/achilles/src/interpreter/mod.rs new file mode 100644 index 000000000000..70df7a0724a5 --- /dev/null +++ b/users/grfn/achilles/src/interpreter/mod.rs @@ -0,0 +1,203 @@ +mod error; +mod value; + +use itertools::Itertools; +use value::Val; + +pub use self::error::{Error, Result}; +pub use self::value::{Function, Value}; +use crate::ast::hir::{Binding, Expr, Pattern}; +use crate::ast::{BinaryOperator, FunctionType, Ident, Literal, Type, UnaryOperator}; +use crate::common::env::Env; + +#[derive(Debug, Default)] +pub struct Interpreter<'a> { + env: Env<&'a Ident<'a>, Value<'a>>, +} + +impl<'a> Interpreter<'a> { + pub fn new() -> Self { + Self::default() + } + + fn resolve(&self, var: &'a Ident<'a>) -> Result<Value<'a>> { + self.env + .resolve(var) + .cloned() + .ok_or_else(|| Error::UndefinedVariable(var.to_owned())) + } + + fn bind_pattern(&mut self, pattern: &'a Pattern<'a, Type>, value: Value<'a>) { + match pattern { + Pattern::Id(id, _) => self.env.set(id, value), + Pattern::Tuple(pats) => { + for (pat, val) in pats.iter().zip(value.as_tuple().unwrap().clone()) { + self.bind_pattern(pat, val); + } + } + } + } + + pub fn eval(&mut self, expr: &'a Expr<'a, Type>) -> Result<Value<'a>> { + let res = match expr { + Expr::Ident(id, _) => self.resolve(id), + Expr::Literal(Literal::Int(i), _) => Ok((*i).into()), + Expr::Literal(Literal::Bool(b), _) => Ok((*b).into()), + Expr::Literal(Literal::String(s), _) => Ok(s.clone().into()), + Expr::Literal(Literal::Unit, _) => unreachable!(), + Expr::UnaryOp { op, rhs, .. } => { + let rhs = self.eval(rhs)?; + match op { + UnaryOperator::Neg => -rhs, + _ => unimplemented!(), + } + } + Expr::BinaryOp { lhs, op, rhs, .. } => { + let lhs = self.eval(lhs)?; + let rhs = self.eval(rhs)?; + match op { + BinaryOperator::Add => lhs + rhs, + BinaryOperator::Sub => lhs - rhs, + BinaryOperator::Mul => lhs * rhs, + BinaryOperator::Div => lhs / rhs, + BinaryOperator::Pow => todo!(), + BinaryOperator::Equ => Ok(lhs.eq(&rhs).into()), + BinaryOperator::Neq => todo!(), + } + } + Expr::Let { bindings, body, .. } => { + self.env.push(); + for Binding { pat, body, .. } in bindings { + let val = self.eval(body)?; + self.bind_pattern(pat, val); + } + let res = self.eval(body)?; + self.env.pop(); + Ok(res) + } + Expr::If { + condition, + then, + else_, + .. + } => { + let condition = self.eval(condition)?; + if *(condition.as_type::<bool>()?) { + self.eval(then) + } else { + self.eval(else_) + } + } + Expr::Call { ref fun, args, .. } => { + let fun = self.eval(fun)?; + let expected_type = FunctionType { + args: args.iter().map(|_| Type::Int).collect(), + ret: Box::new(Type::Int), + }; + + let Function { + args: function_args, + body, + .. + } = fun.as_function(expected_type)?; + let arg_values = function_args.iter().zip( + args.iter() + .map(|v| self.eval(v)) + .collect::<Result<Vec<_>>>()?, + ); + let mut interpreter = Interpreter::new(); + for (arg_name, arg_value) in arg_values { + interpreter.env.set(arg_name, arg_value); + } + Ok(Value::from(*interpreter.eval(body)?.as_type::<i64>()?)) + } + Expr::Fun { + type_args: _, + args, + body, + type_, + } => { + let type_ = match type_ { + Type::Function(ft) => ft.clone(), + _ => unreachable!("Function expression without function type"), + }; + + Ok(Value::from(value::Function { + // TODO + type_, + args: args.iter().map(|(arg, _)| arg.to_owned()).collect(), + body: (**body).to_owned(), + })) + } + Expr::Tuple(members, _) => Ok(Val::Tuple( + members + .into_iter() + .map(|expr| self.eval(expr)) + .try_collect()?, + ) + .into()), + }?; + debug_assert_eq!(&res.type_(), expr.type_()); + Ok(res) + } +} + +pub fn eval<'a>(expr: &'a Expr<'a, Type>) -> Result<Value<'a>> { + let mut interpreter = Interpreter::new(); + interpreter.eval(expr) +} + +#[cfg(test)] +mod tests { + use std::convert::TryFrom; + + use super::value::{TypeOf, Val}; + use super::*; + use BinaryOperator::*; + + fn int_lit(i: u64) -> Box<Expr<'static, Type<'static>>> { + Box::new(Expr::Literal(Literal::Int(i), Type::Int)) + } + + fn do_eval<T>(src: &str) -> T + where + for<'a> &'a T: TryFrom<&'a Val<'a>>, + T: Clone + TypeOf, + { + let expr = crate::parser::expr(src).unwrap().1; + let hir = crate::tc::typecheck_expr(expr).unwrap(); + let res = eval(&hir).unwrap(); + res.as_type::<T>().unwrap().clone() + } + + #[test] + fn simple_addition() { + let expr = Expr::BinaryOp { + lhs: int_lit(1), + op: Mul, + rhs: int_lit(2), + type_: Type::Int, + }; + let res = eval(&expr).unwrap(); + assert_eq!(*res.as_type::<i64>().unwrap(), 2); + } + + #[test] + fn variable_shadowing() { + let res = do_eval::<i64>("let x = 1 in (let x = 2 in x) + x"); + assert_eq!(res, 3); + } + + #[test] + fn conditional_with_equals() { + let res = do_eval::<i64>("let x = 1 in if x == 1 then 2 else 4"); + assert_eq!(res, 2); + } + + #[test] + #[ignore] + fn function_call() { + let res = do_eval::<i64>("let id = fn x = x in id 1"); + assert_eq!(res, 1); + } +} diff --git a/users/grfn/achilles/src/interpreter/value.rs b/users/grfn/achilles/src/interpreter/value.rs new file mode 100644 index 000000000000..272d1167a33c --- /dev/null +++ b/users/grfn/achilles/src/interpreter/value.rs @@ -0,0 +1,224 @@ +use std::borrow::Cow; +use std::convert::TryFrom; +use std::fmt::{self, Display}; +use std::ops::{Add, Div, Mul, Neg, Sub}; +use std::rc::Rc; +use std::result; + +use derive_more::{Deref, From, TryInto}; +use itertools::Itertools; + +use super::{Error, Result}; +use crate::ast::hir::Expr; +use crate::ast::{FunctionType, Ident, Type}; + +#[derive(Debug, Clone)] +pub struct Function<'a> { + pub type_: FunctionType<'a>, + pub args: Vec<Ident<'a>>, + pub body: Expr<'a, Type<'a>>, +} + +#[derive(From, TryInto)] +#[try_into(owned, ref)] +pub enum Val<'a> { + Int(i64), + Float(f64), + Bool(bool), + String(Cow<'a, str>), + Tuple(Vec<Value<'a>>), + Function(Function<'a>), +} + +impl<'a> TryFrom<Val<'a>> for String { + type Error = (); + + fn try_from(value: Val<'a>) -> result::Result<Self, Self::Error> { + match value { + Val::String(s) => Ok(s.into_owned()), + _ => Err(()), + } + } +} + +impl<'a> fmt::Debug for Val<'a> { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self { + Val::Int(x) => f.debug_tuple("Int").field(x).finish(), + Val::Float(x) => f.debug_tuple("Float").field(x).finish(), + Val::Bool(x) => f.debug_tuple("Bool").field(x).finish(), + Val::String(s) => f.debug_tuple("String").field(s).finish(), + Val::Function(Function { type_, .. }) => { + f.debug_struct("Function").field("type_", type_).finish() + } + Val::Tuple(members) => f.debug_tuple("Tuple").field(members).finish(), + } + } +} + +impl<'a> PartialEq for Val<'a> { + fn eq(&self, other: &Self) -> bool { + match (self, other) { + (Val::Int(x), Val::Int(y)) => x == y, + (Val::Float(x), Val::Float(y)) => x == y, + (Val::Bool(x), Val::Bool(y)) => x == y, + (Val::Function(_), Val::Function(_)) => false, + (_, _) => false, + } + } +} + +impl<'a> From<u64> for Val<'a> { + fn from(i: u64) -> Self { + Self::from(i as i64) + } +} + +impl<'a> Display for Val<'a> { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self { + Val::Int(x) => x.fmt(f), + Val::Float(x) => x.fmt(f), + Val::Bool(x) => x.fmt(f), + Val::String(s) => write!(f, "{:?}", s), + Val::Function(Function { type_, .. }) => write!(f, "<{}>", type_), + Val::Tuple(members) => write!(f, "({})", members.iter().join(", ")), + } + } +} + +impl<'a> Val<'a> { + pub fn type_(&self) -> Type { + match self { + Val::Int(_) => Type::Int, + Val::Float(_) => Type::Float, + Val::Bool(_) => Type::Bool, + Val::String(_) => Type::CString, + Val::Function(Function { type_, .. }) => Type::Function(type_.clone()), + Val::Tuple(members) => Type::Tuple(members.iter().map(|expr| expr.type_()).collect()), + } + } + + pub fn as_type<'b, T>(&'b self) -> Result<&'b T> + where + T: TypeOf + 'b + Clone, + &'b T: TryFrom<&'b Self>, + { + <&T>::try_from(self).map_err(|_| Error::InvalidType { + actual: self.type_().to_owned(), + expected: <T as TypeOf>::type_of(), + }) + } + + pub fn as_function<'b>(&'b self, function_type: FunctionType) -> Result<&'b Function<'a>> { + match self { + Val::Function(f) if f.type_ == function_type => Ok(&f), + _ => Err(Error::InvalidType { + actual: self.type_().to_owned(), + expected: Type::Function(function_type.to_owned()), + }), + } + } + + pub fn as_tuple(&self) -> Option<&Vec<Value<'a>>> { + if let Self::Tuple(v) = self { + Some(v) + } else { + None + } + } + + pub fn try_into_tuple(self) -> result::Result<Vec<Value<'a>>, Self> { + if let Self::Tuple(v) = self { + Ok(v) + } else { + Err(self) + } + } +} + +#[derive(Debug, PartialEq, Clone, Deref)] +pub struct Value<'a>(Rc<Val<'a>>); + +impl<'a> Display for Value<'a> { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + self.0.fmt(f) + } +} + +impl<'a, T> From<T> for Value<'a> +where + Val<'a>: From<T>, +{ + fn from(x: T) -> Self { + Self(Rc::new(x.into())) + } +} + +impl<'a> Neg for Value<'a> { + type Output = Result<Value<'a>>; + + fn neg(self) -> Self::Output { + Ok((-self.as_type::<i64>()?).into()) + } +} + +impl<'a> Add for Value<'a> { + type Output = Result<Value<'a>>; + + fn add(self, rhs: Self) -> Self::Output { + Ok((self.as_type::<i64>()? + rhs.as_type::<i64>()?).into()) + } +} + +impl<'a> Sub for Value<'a> { + type Output = Result<Value<'a>>; + + fn sub(self, rhs: Self) -> Self::Output { + Ok((self.as_type::<i64>()? - rhs.as_type::<i64>()?).into()) + } +} + +impl<'a> Mul for Value<'a> { + type Output = Result<Value<'a>>; + + fn mul(self, rhs: Self) -> Self::Output { + Ok((self.as_type::<i64>()? * rhs.as_type::<i64>()?).into()) + } +} + +impl<'a> Div for Value<'a> { + type Output = Result<Value<'a>>; + + fn div(self, rhs: Self) -> Self::Output { + Ok((self.as_type::<f64>()? / rhs.as_type::<f64>()?).into()) + } +} + +pub trait TypeOf { + fn type_of() -> Type<'static>; +} + +impl TypeOf for i64 { + fn type_of() -> Type<'static> { + Type::Int + } +} + +impl TypeOf for bool { + fn type_of() -> Type<'static> { + Type::Bool + } +} + +impl TypeOf for f64 { + fn type_of() -> Type<'static> { + Type::Float + } +} + +impl TypeOf for String { + fn type_of() -> Type<'static> { + Type::CString + } +} diff --git a/users/grfn/achilles/src/main.rs b/users/grfn/achilles/src/main.rs new file mode 100644 index 000000000000..5ae1b59b3a8e --- /dev/null +++ b/users/grfn/achilles/src/main.rs @@ -0,0 +1,36 @@ +use clap::Clap; + +pub mod ast; +pub mod codegen; +pub(crate) mod commands; +pub(crate) mod common; +pub mod compiler; +pub mod interpreter; +pub(crate) mod passes; +#[macro_use] +pub mod parser; +pub mod tc; + +pub use common::{Error, Result}; + +#[derive(Clap)] +struct Opts { + #[clap(subcommand)] + subcommand: Command, +} + +#[derive(Clap)] +enum Command { + Eval(commands::Eval), + Compile(commands::Compile), + Check(commands::Check), +} + +fn main() -> anyhow::Result<()> { + let opts = Opts::parse(); + match opts.subcommand { + Command::Eval(eval) => Ok(eval.run()?), + Command::Compile(compile) => Ok(compile.run()?), + Command::Check(check) => Ok(check.run()?), + } +} diff --git a/users/grfn/achilles/src/parser/expr.rs b/users/grfn/achilles/src/parser/expr.rs new file mode 100644 index 000000000000..f596b18970aa --- /dev/null +++ b/users/grfn/achilles/src/parser/expr.rs @@ -0,0 +1,718 @@ +use std::borrow::Cow; + +use nom::alt; +use nom::character::complete::{digit1, multispace0, multispace1}; +use nom::{ + call, char, complete, delimited, do_parse, flat_map, many0, map, named, opt, parse_to, + preceded, separated_list0, separated_list1, tag, tuple, +}; +use pratt::{Affix, Associativity, PrattParser, Precedence}; + +use super::util::comma; +use crate::ast::{BinaryOperator, Binding, Expr, Fun, Literal, Pattern, UnaryOperator}; +use crate::parser::{arg, ident, type_}; + +#[derive(Debug)] +enum TokenTree<'a> { + Prefix(UnaryOperator), + // Postfix(char), + Infix(BinaryOperator), + Primary(Expr<'a>), + Group(Vec<TokenTree<'a>>), +} + +named!(prefix(&str) -> TokenTree, map!(alt!( + complete!(char!('-')) => { |_| UnaryOperator::Neg } | + complete!(char!('!')) => { |_| UnaryOperator::Not } +), TokenTree::Prefix)); + +named!(infix(&str) -> TokenTree, map!(alt!( + complete!(tag!("==")) => { |_| BinaryOperator::Equ } | + complete!(tag!("!=")) => { |_| BinaryOperator::Neq } | + complete!(char!('+')) => { |_| BinaryOperator::Add } | + complete!(char!('-')) => { |_| BinaryOperator::Sub } | + complete!(char!('*')) => { |_| BinaryOperator::Mul } | + complete!(char!('/')) => { |_| BinaryOperator::Div } | + complete!(char!('^')) => { |_| BinaryOperator::Pow } +), TokenTree::Infix)); + +named!(primary(&str) -> TokenTree, alt!( + do_parse!( + multispace0 >> + char!('(') >> + multispace0 >> + group: group >> + multispace0 >> + char!(')') >> + multispace0 >> + (TokenTree::Group(group)) + ) | + delimited!(multispace0, simple_expr, multispace0) => { |s| TokenTree::Primary(s) } +)); + +named!( + rest(&str) -> Vec<(TokenTree, Vec<TokenTree>, TokenTree)>, + many0!(tuple!( + infix, + delimited!(multispace0, many0!(prefix), multispace0), + primary + // many0!(postfix) + )) +); + +named!(group(&str) -> Vec<TokenTree>, do_parse!( + prefix: many0!(prefix) + >> primary: primary + // >> postfix: many0!(postfix) + >> rest: rest + >> ({ + let mut res = prefix; + res.push(primary); + // res.append(&mut postfix); + for (infix, mut prefix, primary/*, mut postfix*/) in rest { + res.push(infix); + res.append(&mut prefix); + res.push(primary); + // res.append(&mut postfix); + } + res + }) +)); + +fn token_tree(i: &str) -> nom::IResult<&str, Vec<TokenTree>> { + group(i) +} + +struct ExprParser; + +impl<'a, I> PrattParser<I> for ExprParser +where + I: Iterator<Item = TokenTree<'a>>, +{ + type Error = pratt::NoError; + type Input = TokenTree<'a>; + type Output = Expr<'a>; + + fn query(&mut self, input: &Self::Input) -> Result<Affix, Self::Error> { + use BinaryOperator::*; + use UnaryOperator::*; + + Ok(match input { + TokenTree::Infix(Add) => Affix::Infix(Precedence(6), Associativity::Left), + TokenTree::Infix(Sub) => Affix::Infix(Precedence(6), Associativity::Left), + TokenTree::Infix(Mul) => Affix::Infix(Precedence(7), Associativity::Left), + TokenTree::Infix(Div) => Affix::Infix(Precedence(7), Associativity::Left), + TokenTree::Infix(Pow) => Affix::Infix(Precedence(8), Associativity::Right), + TokenTree::Infix(Equ) => Affix::Infix(Precedence(4), Associativity::Right), + TokenTree::Infix(Neq) => Affix::Infix(Precedence(4), Associativity::Right), + TokenTree::Prefix(Neg) => Affix::Prefix(Precedence(6)), + TokenTree::Prefix(Not) => Affix::Prefix(Precedence(6)), + TokenTree::Primary(_) => Affix::Nilfix, + TokenTree::Group(_) => Affix::Nilfix, + }) + } + + fn primary(&mut self, input: Self::Input) -> Result<Self::Output, Self::Error> { + Ok(match input { + TokenTree::Primary(expr) => expr, + TokenTree::Group(group) => self.parse(&mut group.into_iter()).unwrap(), + _ => unreachable!(), + }) + } + + fn infix( + &mut self, + lhs: Self::Output, + op: Self::Input, + rhs: Self::Output, + ) -> Result<Self::Output, Self::Error> { + let op = match op { + TokenTree::Infix(op) => op, + _ => unreachable!(), + }; + Ok(Expr::BinaryOp { + lhs: Box::new(lhs), + op, + rhs: Box::new(rhs), + }) + } + + fn prefix(&mut self, op: Self::Input, rhs: Self::Output) -> Result<Self::Output, Self::Error> { + let op = match op { + TokenTree::Prefix(op) => op, + _ => unreachable!(), + }; + + Ok(Expr::UnaryOp { + op, + rhs: Box::new(rhs), + }) + } + + fn postfix( + &mut self, + _lhs: Self::Output, + _op: Self::Input, + ) -> Result<Self::Output, Self::Error> { + unreachable!() + } +} + +named!(int(&str) -> Literal, map!(flat_map!(digit1, parse_to!(u64)), Literal::Int)); + +named!(bool_(&str) -> Literal, alt!( + complete!(tag!("true")) => { |_| Literal::Bool(true) } | + complete!(tag!("false")) => { |_| Literal::Bool(false) } +)); + +fn string_internal(i: &str) -> nom::IResult<&str, Cow<'_, str>, nom::error::Error<&str>> { + // TODO(grfn): use String::split_once when that's stable + let (s, rem) = if let Some(pos) = i.find('"') { + (&i[..pos], &i[(pos + 1)..]) + } else { + return Err(nom::Err::Error(nom::error::Error::new( + i, + nom::error::ErrorKind::Tag, + ))); + }; + + Ok((rem, Cow::Borrowed(s))) +} + +named!(string(&str) -> Literal, preceded!( + complete!(char!('"')), + map!( + string_internal, + |s| Literal::String(s) + ) +)); + +named!(unit(&str) -> Literal, map!(complete!(tag!("()")), |_| Literal::Unit)); + +named!(literal(&str) -> Literal, alt!(int | bool_ | string | unit)); + +named!(literal_expr(&str) -> Expr, map!(literal, Expr::Literal)); + +named!(tuple(&str) -> Expr, do_parse!( + complete!(tag!("(")) + >> multispace0 + >> fst: expr + >> comma + >> rest: separated_list0!( + comma, + expr + ) + >> multispace0 + >> tag!(")") + >> ({ + let mut members = Vec::with_capacity(rest.len() + 1); + members.push(fst); + members.append(&mut rest.clone()); + Expr::Tuple(members) + }) +)); + +named!(tuple_pattern(&str) -> Pattern, do_parse!( + complete!(tag!("(")) + >> multispace0 + >> pats: separated_list0!( + comma, + pattern + ) + >> multispace0 + >> tag!(")") + >> (Pattern::Tuple(pats)) +)); + +named!(pattern(&str) -> Pattern, alt!( + ident => { |id| Pattern::Id(id) } | + tuple_pattern +)); + +named!(binding(&str) -> Binding, do_parse!( + multispace0 + >> pat: pattern + >> multispace0 + >> type_: opt!(preceded!(tuple!(tag!(":"), multispace0), type_)) + >> multispace0 + >> char!('=') + >> multispace0 + >> body: expr + >> (Binding { + pat, + type_, + body + }) +)); + +named!(let_(&str) -> Expr, do_parse!( + tag!("let") + >> multispace0 + >> bindings: separated_list1!(alt!(char!(';') | char!('\n')), binding) + >> multispace0 + >> tag!("in") + >> multispace0 + >> body: expr + >> (Expr::Let { + bindings, + body: Box::new(body) + }) +)); + +named!(if_(&str) -> Expr, do_parse! ( + tag!("if") + >> multispace0 + >> condition: expr + >> multispace0 + >> tag!("then") + >> multispace0 + >> then: expr + >> multispace0 + >> tag!("else") + >> multispace0 + >> else_: expr + >> (Expr::If { + condition: Box::new(condition), + then: Box::new(then), + else_: Box::new(else_) + }) +)); + +named!(ident_expr(&str) -> Expr, map!(ident, Expr::Ident)); + +fn ascripted<'a>( + p: impl Fn(&'a str) -> nom::IResult<&'a str, Expr, nom::error::Error<&'a str>> + 'a, +) -> impl Fn(&'a str) -> nom::IResult<&str, Expr, nom::error::Error<&'a str>> { + move |i| { + do_parse!( + i, + expr: p + >> multispace0 + >> complete!(tag!(":")) + >> multispace0 + >> type_: type_ + >> (Expr::Ascription { + expr: Box::new(expr), + type_ + }) + ) + } +} + +named!(paren_expr(&str) -> Expr, + delimited!(complete!(tag!("(")), expr, complete!(tag!(")")))); + +named!(funcref(&str) -> Expr, alt!( + ident_expr | + tuple | + paren_expr +)); + +named!(no_arg_call(&str) -> Expr, do_parse!( + fun: funcref + >> complete!(tag!("()")) + >> (Expr::Call { + fun: Box::new(fun), + args: vec![], + }) +)); + +named!(fun_expr(&str) -> Expr, do_parse!( + tag!("fn") + >> multispace1 + >> args: separated_list0!(multispace1, arg) + >> multispace0 + >> char!('=') + >> multispace0 + >> body: expr + >> (Expr::Fun(Box::new(Fun { + args, + body + }))) +)); + +named!(fn_arg(&str) -> Expr, alt!( + ident_expr | + literal_expr | + tuple | + paren_expr +)); + +named!(call_with_args(&str) -> Expr, do_parse!( + fun: funcref + >> multispace1 + >> args: separated_list1!(multispace1, fn_arg) + >> (Expr::Call { + fun: Box::new(fun), + args + }) +)); + +named!(simple_expr_unascripted(&str) -> Expr, alt!( + let_ | + if_ | + fun_expr | + literal_expr | + ident_expr | + tuple +)); + +named!(simple_expr(&str) -> Expr, alt!( + call!(ascripted(simple_expr_unascripted)) | + simple_expr_unascripted +)); + +named!(pub expr(&str) -> Expr, alt!( + no_arg_call | + call_with_args | + map!(token_tree, |tt| { + ExprParser.parse(&mut tt.into_iter()).unwrap() + }) | + simple_expr +)); + +#[cfg(test)] +pub(crate) mod tests { + use super::*; + use crate::ast::{Arg, Ident, Pattern, Type}; + use std::convert::TryFrom; + use BinaryOperator::*; + use Expr::{BinaryOp, If, Let, UnaryOp}; + use UnaryOperator::*; + + pub(crate) fn ident_expr(s: &str) -> Box<Expr> { + Box::new(Expr::Ident(Ident::try_from(s).unwrap())) + } + + mod operators { + use super::*; + + #[test] + fn mul_plus() { + let (rem, res) = expr("x*y+z").unwrap(); + assert!(rem.is_empty()); + assert_eq!( + res, + BinaryOp { + lhs: Box::new(BinaryOp { + lhs: ident_expr("x"), + op: Mul, + rhs: ident_expr("y") + }), + op: Add, + rhs: ident_expr("z") + } + ) + } + + #[test] + fn mul_plus_ws() { + let (rem, res) = expr("x * y + z").unwrap(); + assert!(rem.is_empty(), "non-empty remainder: \"{}\"", rem); + assert_eq!( + res, + BinaryOp { + lhs: Box::new(BinaryOp { + lhs: ident_expr("x"), + op: Mul, + rhs: ident_expr("y") + }), + op: Add, + rhs: ident_expr("z") + } + ) + } + + #[test] + fn unary() { + let (rem, res) = expr("x * -z").unwrap(); + assert!(rem.is_empty(), "non-empty remainder: \"{}\"", rem); + assert_eq!( + res, + BinaryOp { + lhs: ident_expr("x"), + op: Mul, + rhs: Box::new(UnaryOp { + op: Neg, + rhs: ident_expr("z"), + }) + } + ) + } + + #[test] + fn mul_literal() { + let (rem, res) = expr("x * 3").unwrap(); + assert!(rem.is_empty()); + assert_eq!( + res, + BinaryOp { + lhs: ident_expr("x"), + op: Mul, + rhs: Box::new(Expr::Literal(Literal::Int(3))), + } + ) + } + + #[test] + fn equ() { + let res = test_parse!(expr, "x * 7 == 7"); + assert_eq!( + res, + BinaryOp { + lhs: Box::new(BinaryOp { + lhs: ident_expr("x"), + op: Mul, + rhs: Box::new(Expr::Literal(Literal::Int(7))) + }), + op: Equ, + rhs: Box::new(Expr::Literal(Literal::Int(7))) + } + ) + } + } + + #[test] + fn unit() { + assert_eq!(test_parse!(expr, "()"), Expr::Literal(Literal::Unit)); + } + + #[test] + fn bools() { + assert_eq!( + test_parse!(expr, "true"), + Expr::Literal(Literal::Bool(true)) + ); + assert_eq!( + test_parse!(expr, "false"), + Expr::Literal(Literal::Bool(false)) + ); + } + + #[test] + fn tuple() { + assert_eq!( + test_parse!(expr, "(1, \"seven\")"), + Expr::Tuple(vec![ + Expr::Literal(Literal::Int(1)), + Expr::Literal(Literal::String(Cow::Borrowed("seven"))) + ]) + ) + } + + #[test] + fn simple_string_lit() { + assert_eq!( + test_parse!(expr, "\"foobar\""), + Expr::Literal(Literal::String(Cow::Borrowed("foobar"))) + ) + } + + #[test] + fn let_complex() { + let res = test_parse!(expr, "let x = 1; y = x * 7 in (x + y) * 4"); + assert_eq!( + res, + Let { + bindings: vec![ + Binding { + pat: Pattern::Id(Ident::try_from("x").unwrap()), + type_: None, + body: Expr::Literal(Literal::Int(1)) + }, + Binding { + pat: Pattern::Id(Ident::try_from("y").unwrap()), + type_: None, + body: Expr::BinaryOp { + lhs: ident_expr("x"), + op: Mul, + rhs: Box::new(Expr::Literal(Literal::Int(7))) + } + } + ], + body: Box::new(Expr::BinaryOp { + lhs: Box::new(Expr::BinaryOp { + lhs: ident_expr("x"), + op: Add, + rhs: ident_expr("y"), + }), + op: Mul, + rhs: Box::new(Expr::Literal(Literal::Int(4))), + }) + } + ) + } + + #[test] + fn if_simple() { + let res = test_parse!(expr, "if x == 8 then 9 else 20"); + assert_eq!( + res, + If { + condition: Box::new(BinaryOp { + lhs: ident_expr("x"), + op: Equ, + rhs: Box::new(Expr::Literal(Literal::Int(8))), + }), + then: Box::new(Expr::Literal(Literal::Int(9))), + else_: Box::new(Expr::Literal(Literal::Int(20))) + } + ) + } + + #[test] + fn no_arg_call() { + let res = test_parse!(expr, "f()"); + assert_eq!( + res, + Expr::Call { + fun: ident_expr("f"), + args: vec![] + } + ); + } + + #[test] + fn unit_call() { + let res = test_parse!(expr, "f ()"); + assert_eq!( + res, + Expr::Call { + fun: ident_expr("f"), + args: vec![Expr::Literal(Literal::Unit)] + } + ) + } + + #[test] + fn call_with_args() { + let res = test_parse!(expr, "f x 1"); + assert_eq!( + res, + Expr::Call { + fun: ident_expr("f"), + args: vec![*ident_expr("x"), Expr::Literal(Literal::Int(1))] + } + ) + } + + #[test] + fn call_funcref() { + let res = test_parse!(expr, "(let x = 1 in x) 2"); + assert_eq!( + res, + Expr::Call { + fun: Box::new(Expr::Let { + bindings: vec![Binding { + pat: Pattern::Id(Ident::try_from("x").unwrap()), + type_: None, + body: Expr::Literal(Literal::Int(1)) + }], + body: ident_expr("x") + }), + args: vec![Expr::Literal(Literal::Int(2))] + } + ) + } + + #[test] + fn anon_function() { + let res = test_parse!(expr, "let id = fn x = x in id 1"); + assert_eq!( + res, + Expr::Let { + bindings: vec![Binding { + pat: Pattern::Id(Ident::try_from("id").unwrap()), + type_: None, + body: Expr::Fun(Box::new(Fun { + args: vec![Arg::try_from("x").unwrap()], + body: *ident_expr("x") + })) + }], + body: Box::new(Expr::Call { + fun: ident_expr("id"), + args: vec![Expr::Literal(Literal::Int(1))], + }) + } + ); + } + + #[test] + fn tuple_binding() { + let res = test_parse!(expr, "let (x, y) = (1, 2) in x"); + assert_eq!( + res, + Expr::Let { + bindings: vec![Binding { + pat: Pattern::Tuple(vec![ + Pattern::Id(Ident::from_str_unchecked("x")), + Pattern::Id(Ident::from_str_unchecked("y")) + ]), + body: Expr::Tuple(vec![ + Expr::Literal(Literal::Int(1)), + Expr::Literal(Literal::Int(2)) + ]), + type_: None + }], + body: Box::new(Expr::Ident(Ident::from_str_unchecked("x"))) + } + ) + } + + mod ascriptions { + use super::*; + + #[test] + fn bare_ascription() { + let res = test_parse!(expr, "1: float"); + assert_eq!( + res, + Expr::Ascription { + expr: Box::new(Expr::Literal(Literal::Int(1))), + type_: Type::Float + } + ) + } + + #[test] + fn fn_body_ascription() { + let res = test_parse!(expr, "let const_1 = fn x = 1: int in const_1 2"); + assert_eq!( + res, + Expr::Let { + bindings: vec![Binding { + pat: Pattern::Id(Ident::try_from("const_1").unwrap()), + type_: None, + body: Expr::Fun(Box::new(Fun { + args: vec![Arg::try_from("x").unwrap()], + body: Expr::Ascription { + expr: Box::new(Expr::Literal(Literal::Int(1))), + type_: Type::Int, + } + })) + }], + body: Box::new(Expr::Call { + fun: ident_expr("const_1"), + args: vec![Expr::Literal(Literal::Int(2))] + }) + } + ) + } + + #[test] + fn let_binding_ascripted() { + let res = test_parse!(expr, "let x: int = 1 in x"); + assert_eq!( + res, + Expr::Let { + bindings: vec![Binding { + pat: Pattern::Id(Ident::try_from("x").unwrap()), + type_: Some(Type::Int), + body: Expr::Literal(Literal::Int(1)) + }], + body: ident_expr("x") + } + ) + } + } +} diff --git a/users/grfn/achilles/src/parser/macros.rs b/users/grfn/achilles/src/parser/macros.rs new file mode 100644 index 000000000000..406e5c0e699e --- /dev/null +++ b/users/grfn/achilles/src/parser/macros.rs @@ -0,0 +1,16 @@ +#[cfg(test)] +#[macro_use] +macro_rules! test_parse { + ($parser: ident, $src: expr) => {{ + let res = $parser($src); + nom_trace::print_trace!(); + let (rem, res) = res.unwrap(); + assert!( + rem.is_empty(), + "non-empty remainder: \"{}\", parsed: {:?}", + rem, + res + ); + res + }}; +} diff --git a/users/grfn/achilles/src/parser/mod.rs b/users/grfn/achilles/src/parser/mod.rs new file mode 100644 index 000000000000..e088cbca10a5 --- /dev/null +++ b/users/grfn/achilles/src/parser/mod.rs @@ -0,0 +1,240 @@ +use nom::character::complete::{multispace0, multispace1}; +use nom::error::{ErrorKind, ParseError}; +use nom::{alt, char, complete, do_parse, eof, many0, named, separated_list0, tag, terminated}; + +#[macro_use] +pub(crate) mod macros; +mod expr; +mod type_; +mod util; + +use crate::ast::{Arg, Decl, Fun, Ident}; +pub use expr::expr; +use type_::function_type; +pub use type_::type_; + +pub type Error = nom::Err<nom::error::Error<String>>; + +pub(crate) fn is_reserved(s: &str) -> bool { + matches!( + s, + "if" | "then" + | "else" + | "let" + | "in" + | "fn" + | "ty" + | "int" + | "float" + | "bool" + | "true" + | "false" + | "cstring" + ) +} + +pub(crate) fn ident<'a, E>(i: &'a str) -> nom::IResult<&'a str, Ident, E> +where + E: ParseError<&'a str>, +{ + let mut chars = i.chars(); + if let Some(f) = chars.next() { + if f.is_alphabetic() || f == '_' { + let mut idx = 1; + for c in chars { + if !(c.is_alphanumeric() || c == '_') { + break; + } + idx += 1; + } + let id = &i[..idx]; + if is_reserved(id) { + Err(nom::Err::Error(E::from_error_kind(i, ErrorKind::Satisfy))) + } else { + Ok((&i[idx..], Ident::from_str_unchecked(id))) + } + } else { + Err(nom::Err::Error(E::from_error_kind(i, ErrorKind::Satisfy))) + } + } else { + Err(nom::Err::Error(E::from_error_kind(i, ErrorKind::Eof))) + } +} + +named!(ascripted_arg(&str) -> Arg, do_parse!( + complete!(char!('(')) >> + multispace0 >> + ident: ident >> + multispace0 >> + complete!(char!(':')) >> + multispace0 >> + type_: type_ >> + multispace0 >> + complete!(char!(')')) >> + (Arg { + ident, + type_: Some(type_) + }) +)); + +named!(arg(&str) -> Arg, alt!( + ident => { |ident| Arg {ident, type_: None}} | + ascripted_arg +)); + +named!(extern_decl(&str) -> Decl, do_parse!( + complete!(tag!("extern")) + >> multispace1 + >> name: ident + >> multispace0 + >> char!(':') + >> multispace0 + >> type_: function_type + >> multispace0 + >> (Decl::Extern { + name, + type_ + }) +)); + +named!(fun_decl(&str) -> Decl, do_parse!( + complete!(tag!("fn")) + >> multispace1 + >> name: ident + >> multispace1 + >> args: separated_list0!(multispace1, arg) + >> multispace0 + >> char!('=') + >> multispace0 + >> body: expr + >> (Decl::Fun { + name, + body: Fun { + args, + body + } + }) +)); + +named!(ascription_decl(&str) -> Decl, do_parse!( + complete!(tag!("ty")) + >> multispace1 + >> name: ident + >> multispace0 + >> complete!(char!(':')) + >> multispace0 + >> type_: type_ + >> multispace0 + >> (Decl::Ascription { + name, + type_ + }) +)); + +named!(pub decl(&str) -> Decl, alt!( + ascription_decl | + fun_decl | + extern_decl +)); + +named!(pub toplevel(&str) -> Vec<Decl>, do_parse!( + decls: many0!(decl) + >> multispace0 + >> eof!() + >> (decls))); + +#[cfg(test)] +mod tests { + use std::convert::TryInto; + + use crate::ast::{BinaryOperator, Expr, FunctionType, Literal, Type}; + + use super::*; + use expr::tests::ident_expr; + + #[test] + fn fn_decl() { + let res = test_parse!(decl, "fn id x = x"); + assert_eq!( + res, + Decl::Fun { + name: "id".try_into().unwrap(), + body: Fun { + args: vec!["x".try_into().unwrap()], + body: *ident_expr("x"), + } + } + ) + } + + #[test] + fn ascripted_fn_args() { + test_parse!(ascripted_arg, "(x : int)"); + let res = test_parse!(decl, "fn plus1 (x : int) = x + 1"); + assert_eq!( + res, + Decl::Fun { + name: "plus1".try_into().unwrap(), + body: Fun { + args: vec![Arg { + ident: "x".try_into().unwrap(), + type_: Some(Type::Int), + }], + body: Expr::BinaryOp { + lhs: ident_expr("x"), + op: BinaryOperator::Add, + rhs: Box::new(Expr::Literal(Literal::Int(1))), + } + } + } + ); + } + + #[test] + fn multiple_decls() { + let res = test_parse!( + toplevel, + "fn id x = x + fn plus x y = x + y + fn main = plus (id 2) 7" + ); + assert_eq!(res.len(), 3); + let res = test_parse!( + toplevel, + "fn id x = x\nfn plus x y = x + y\nfn main = plus (id 2) 7\n" + ); + assert_eq!(res.len(), 3); + } + + #[test] + fn top_level_ascription() { + let res = test_parse!(toplevel, "ty id : fn a -> a"); + assert_eq!( + res, + vec![Decl::Ascription { + name: "id".try_into().unwrap(), + type_: Type::Function(FunctionType { + args: vec![Type::Var("a".try_into().unwrap())], + ret: Box::new(Type::Var("a".try_into().unwrap())) + }) + }] + ) + } + + #[test] + fn return_unit() { + assert_eq!( + test_parse!(decl, "fn g _ = ()"), + Decl::Fun { + name: "g".try_into().unwrap(), + body: Fun { + args: vec![Arg { + ident: "_".try_into().unwrap(), + type_: None, + }], + body: Expr::Literal(Literal::Unit), + }, + } + ) + } +} diff --git a/users/grfn/achilles/src/parser/type_.rs b/users/grfn/achilles/src/parser/type_.rs new file mode 100644 index 000000000000..b80f0e0860a1 --- /dev/null +++ b/users/grfn/achilles/src/parser/type_.rs @@ -0,0 +1,152 @@ +use nom::character::complete::{multispace0, multispace1}; +use nom::{alt, delimited, do_parse, map, named, opt, separated_list0, tag, terminated, tuple}; + +use super::ident; +use super::util::comma; +use crate::ast::{FunctionType, Type}; + +named!(pub function_type(&str) -> FunctionType, do_parse!( + tag!("fn") + >> multispace1 + >> args: map!(opt!(terminated!(separated_list0!( + comma, + type_ + ), multispace1)), |args| args.unwrap_or_default()) + >> tag!("->") + >> multispace1 + >> ret: type_ + >> (FunctionType { + args, + ret: Box::new(ret) + }) +)); + +named!(tuple_type(&str) -> Type, do_parse!( + tag!("(") + >> multispace0 + >> fst: type_ + >> comma + >> rest: separated_list0!( + comma, + type_ + ) + >> multispace0 + >> tag!(")") + >> ({ + let mut members = Vec::with_capacity(rest.len() + 1); + members.push(fst); + members.append(&mut rest.clone()); + Type::Tuple(members) + }) +)); + +named!(pub type_(&str) -> Type, alt!( + tag!("int") => { |_| Type::Int } | + tag!("float") => { |_| Type::Float } | + tag!("bool") => { |_| Type::Bool } | + tag!("cstring") => { |_| Type::CString } | + tag!("()") => { |_| Type::Unit } | + tuple_type | + function_type => { |ft| Type::Function(ft) }| + ident => { |id| Type::Var(id) } | + delimited!( + tuple!(tag!("("), multispace0), + type_, + tuple!(tag!(")"), multispace0) + ) +)); + +#[cfg(test)] +mod tests { + use std::convert::TryFrom; + + use super::*; + use crate::ast::Ident; + + #[test] + fn simple_types() { + assert_eq!(test_parse!(type_, "int"), Type::Int); + assert_eq!(test_parse!(type_, "float"), Type::Float); + assert_eq!(test_parse!(type_, "bool"), Type::Bool); + assert_eq!(test_parse!(type_, "cstring"), Type::CString); + assert_eq!(test_parse!(type_, "()"), Type::Unit); + } + + #[test] + fn no_arg_fn_type() { + assert_eq!( + test_parse!(type_, "fn -> int"), + Type::Function(FunctionType { + args: vec![], + ret: Box::new(Type::Int) + }) + ); + } + + #[test] + fn fn_type_with_args() { + assert_eq!( + test_parse!(type_, "fn int, bool -> int"), + Type::Function(FunctionType { + args: vec![Type::Int, Type::Bool], + ret: Box::new(Type::Int) + }) + ); + } + + #[test] + fn fn_taking_fn() { + assert_eq!( + test_parse!(type_, "fn fn int, bool -> bool, float -> float"), + Type::Function(FunctionType { + args: vec![ + Type::Function(FunctionType { + args: vec![Type::Int, Type::Bool], + ret: Box::new(Type::Bool) + }), + Type::Float + ], + ret: Box::new(Type::Float) + }) + ) + } + + #[test] + fn parenthesized() { + assert_eq!( + test_parse!(type_, "fn (fn int, bool -> bool), float -> float"), + Type::Function(FunctionType { + args: vec![ + Type::Function(FunctionType { + args: vec![Type::Int, Type::Bool], + ret: Box::new(Type::Bool) + }), + Type::Float + ], + ret: Box::new(Type::Float) + }) + ) + } + + #[test] + fn tuple() { + assert_eq!( + test_parse!(type_, "(int, int)"), + Type::Tuple(vec![Type::Int, Type::Int]) + ) + } + + #[test] + fn type_vars() { + assert_eq!( + test_parse!(type_, "fn x, y -> x"), + Type::Function(FunctionType { + args: vec![ + Type::Var(Ident::try_from("x").unwrap()), + Type::Var(Ident::try_from("y").unwrap()), + ], + ret: Box::new(Type::Var(Ident::try_from("x").unwrap())), + }) + ) + } +} diff --git a/users/grfn/achilles/src/parser/util.rs b/users/grfn/achilles/src/parser/util.rs new file mode 100644 index 000000000000..bb53fb7fff50 --- /dev/null +++ b/users/grfn/achilles/src/parser/util.rs @@ -0,0 +1,8 @@ +use nom::character::complete::multispace0; +use nom::{complete, map, named, tag, tuple}; + +named!(pub(crate) comma(&str) -> (), map!(tuple!( + multispace0, + complete!(tag!(",")), + multispace0 +) ,|_| ())); diff --git a/users/grfn/achilles/src/passes/hir/mod.rs b/users/grfn/achilles/src/passes/hir/mod.rs new file mode 100644 index 000000000000..872c449eb020 --- /dev/null +++ b/users/grfn/achilles/src/passes/hir/mod.rs @@ -0,0 +1,211 @@ +use std::collections::HashMap; + +use crate::ast::hir::{Binding, Decl, Expr, Pattern}; +use crate::ast::{BinaryOperator, Ident, Literal, UnaryOperator}; + +pub(crate) mod monomorphize; +pub(crate) mod strip_positive_units; + +pub(crate) trait Visitor<'a, 'ast, T: 'ast>: Sized + 'a { + type Error; + + fn visit_type(&mut self, _type: &mut T) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_ident(&mut self, _ident: &mut Ident<'ast>) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_literal(&mut self, _literal: &mut Literal<'ast>) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_unary_operator(&mut self, _op: &mut UnaryOperator) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_binary_operator(&mut self, _op: &mut BinaryOperator) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_pattern(&mut self, _pat: &mut Pattern<'ast, T>) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_binding(&mut self, binding: &mut Binding<'ast, T>) -> Result<(), Self::Error> { + self.visit_pattern(&mut binding.pat)?; + self.visit_expr(&mut binding.body)?; + Ok(()) + } + + fn post_visit_call( + &mut self, + _fun: &mut Expr<'ast, T>, + _type_args: &mut HashMap<Ident<'ast>, T>, + _args: &mut Vec<Expr<'ast, T>>, + ) -> Result<(), Self::Error> { + Ok(()) + } + + fn pre_visit_call( + &mut self, + _fun: &mut Expr<'ast, T>, + _type_args: &mut HashMap<Ident<'ast>, T>, + _args: &mut Vec<Expr<'ast, T>>, + ) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_tuple(&mut self, members: &mut Vec<Expr<'ast, T>>) -> Result<(), Self::Error> { + for expr in members { + self.visit_expr(expr)?; + } + Ok(()) + } + + fn pre_visit_expr(&mut self, _expr: &mut Expr<'ast, T>) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_expr(&mut self, expr: &mut Expr<'ast, T>) -> Result<(), Self::Error> { + self.pre_visit_expr(expr)?; + match expr { + Expr::Ident(id, t) => { + self.visit_ident(id)?; + self.visit_type(t)?; + } + Expr::Literal(lit, t) => { + self.visit_literal(lit)?; + self.visit_type(t)?; + } + Expr::UnaryOp { op, rhs, type_ } => { + self.visit_unary_operator(op)?; + self.visit_expr(rhs)?; + self.visit_type(type_)?; + } + Expr::BinaryOp { + lhs, + op, + rhs, + type_, + } => { + self.visit_expr(lhs)?; + self.visit_binary_operator(op)?; + self.visit_expr(rhs)?; + self.visit_type(type_)?; + } + Expr::Let { + bindings, + body, + type_, + } => { + for binding in bindings.iter_mut() { + self.visit_binding(binding)?; + } + self.visit_expr(body)?; + self.visit_type(type_)?; + } + Expr::If { + condition, + then, + else_, + type_, + } => { + self.visit_expr(condition)?; + self.visit_expr(then)?; + self.visit_expr(else_)?; + self.visit_type(type_)?; + } + Expr::Fun { + args, + body, + type_args, + type_, + } => { + for (ident, t) in args { + self.visit_ident(ident)?; + self.visit_type(t)?; + } + for ta in type_args { + self.visit_ident(ta)?; + } + self.visit_expr(body)?; + self.visit_type(type_)?; + } + Expr::Call { + fun, + args, + type_args, + type_, + } => { + self.pre_visit_call(fun, type_args, args)?; + self.visit_expr(fun)?; + for arg in args.iter_mut() { + self.visit_expr(arg)?; + } + self.visit_type(type_)?; + self.post_visit_call(fun, type_args, args)?; + } + Expr::Tuple(tup, type_) => { + self.visit_tuple(tup)?; + self.visit_type(type_)?; + } + } + + Ok(()) + } + + fn post_visit_decl(&mut self, _decl: &'a Decl<'ast, T>) -> Result<(), Self::Error> { + Ok(()) + } + + fn post_visit_fun_decl( + &mut self, + _name: &mut Ident<'ast>, + _type_args: &mut Vec<Ident>, + _args: &mut Vec<(Ident, T)>, + _body: &mut Box<Expr<T>>, + _type_: &mut T, + ) -> Result<(), Self::Error> { + Ok(()) + } + + fn visit_decl(&mut self, decl: &'a mut Decl<'ast, T>) -> Result<(), Self::Error> { + match decl { + Decl::Fun { + name, + type_args, + args, + body, + type_, + } => { + self.visit_ident(name)?; + for type_arg in type_args.iter_mut() { + self.visit_ident(type_arg)?; + } + for (arg, t) in args.iter_mut() { + self.visit_ident(arg)?; + self.visit_type(t)?; + } + self.visit_expr(body)?; + self.visit_type(type_)?; + self.post_visit_fun_decl(name, type_args, args, body, type_)?; + } + Decl::Extern { + name, + arg_types, + ret_type, + } => { + self.visit_ident(name)?; + for arg_t in arg_types { + self.visit_type(arg_t)?; + } + self.visit_type(ret_type)?; + } + } + + self.post_visit_decl(decl)?; + Ok(()) + } +} diff --git a/users/grfn/achilles/src/passes/hir/monomorphize.rs b/users/grfn/achilles/src/passes/hir/monomorphize.rs new file mode 100644 index 000000000000..251a988f4f6f --- /dev/null +++ b/users/grfn/achilles/src/passes/hir/monomorphize.rs @@ -0,0 +1,139 @@ +use std::cell::RefCell; +use std::collections::{HashMap, HashSet}; +use std::convert::TryInto; +use std::mem; + +use void::{ResultVoidExt, Void}; + +use crate::ast::hir::{Decl, Expr}; +use crate::ast::{self, Ident}; + +use super::Visitor; + +#[derive(Default)] +pub(crate) struct Monomorphize<'a, 'ast> { + decls: HashMap<&'a Ident<'ast>, &'a Decl<'ast, ast::Type<'ast>>>, + extra_decls: Vec<Decl<'ast, ast::Type<'ast>>>, + remove_decls: HashSet<Ident<'ast>>, +} + +impl<'a, 'ast> Monomorphize<'a, 'ast> { + pub(crate) fn new() -> Self { + Default::default() + } +} + +impl<'a, 'ast> Visitor<'a, 'ast, ast::Type<'ast>> for Monomorphize<'a, 'ast> { + type Error = Void; + + fn post_visit_call( + &mut self, + fun: &mut Expr<'ast, ast::Type<'ast>>, + type_args: &mut HashMap<Ident<'ast>, ast::Type<'ast>>, + args: &mut Vec<Expr<'ast, ast::Type<'ast>>>, + ) -> Result<(), Self::Error> { + let new_fun = match fun { + Expr::Ident(id, _) => { + let decl: Decl<_> = (**self.decls.get(id).unwrap()).clone(); + let name = RefCell::new(id.to_string()); + let type_args = mem::take(type_args); + let mut monomorphized = decl + .traverse_type(|ty| -> Result<_, Void> { + Ok(ty.clone().traverse_type_vars(|v| { + let concrete = type_args.get(&v).unwrap(); + name.borrow_mut().push_str(&concrete.to_string()); + concrete.clone() + })) + }) + .void_unwrap(); + let name: Ident = name.into_inner().try_into().unwrap(); + if name != *id { + self.remove_decls.insert(id.clone()); + monomorphized.set_name(name.clone()); + let type_ = monomorphized.type_().unwrap().clone(); + self.extra_decls.push(monomorphized); + Some(Expr::Ident(name, type_)) + } else { + None + } + } + _ => todo!(), + }; + if let Some(new_fun) = new_fun { + *fun = new_fun; + } + Ok(()) + } + + fn post_visit_decl( + &mut self, + decl: &'a Decl<'ast, ast::Type<'ast>>, + ) -> Result<(), Self::Error> { + self.decls.insert(decl.name(), decl); + Ok(()) + } +} + +pub(crate) fn run_toplevel<'a>(toplevel: &mut Vec<Decl<'a, ast::Type<'a>>>) { + let mut pass = Monomorphize::new(); + for decl in toplevel.iter_mut() { + pass.visit_decl(decl).void_unwrap(); + } + let remove_decls = mem::take(&mut pass.remove_decls); + let mut extra_decls = mem::take(&mut pass.extra_decls); + toplevel.retain(|decl| !remove_decls.contains(decl.name())); + extra_decls.append(toplevel); + *toplevel = extra_decls; +} + +#[cfg(test)] +mod tests { + use std::convert::TryFrom; + + use super::*; + use crate::parser::toplevel; + use crate::tc::typecheck_toplevel; + + #[test] + fn call_id_decl() { + let (_, program) = toplevel( + "ty id : fn a -> a + fn id x = x + + ty main : fn -> int + fn main = id 0", + ) + .unwrap(); + let mut program = typecheck_toplevel(program).unwrap(); + run_toplevel(&mut program); + + let find_decl = |ident: &str| { + program.iter().find(|decl| { + matches!(decl, Decl::Fun {name, ..} if name == &Ident::try_from(ident).unwrap()) + }).unwrap() + }; + + let main = find_decl("main"); + let body = match main { + Decl::Fun { body, .. } => body, + _ => unreachable!(), + }; + + let expected_type = ast::Type::Function(ast::FunctionType { + args: vec![ast::Type::Int], + ret: Box::new(ast::Type::Int), + }); + + match &**body { + Expr::Call { fun, .. } => { + let fun = match &**fun { + Expr::Ident(fun, _) => fun, + _ => unreachable!(), + }; + let called_decl = find_decl(fun.into()); + assert_eq!(called_decl.type_().unwrap(), &expected_type); + } + _ => unreachable!(), + } + } +} diff --git a/users/grfn/achilles/src/passes/hir/strip_positive_units.rs b/users/grfn/achilles/src/passes/hir/strip_positive_units.rs new file mode 100644 index 000000000000..85ee1cce4859 --- /dev/null +++ b/users/grfn/achilles/src/passes/hir/strip_positive_units.rs @@ -0,0 +1,191 @@ +use std::collections::HashMap; +use std::mem; + +use ast::hir::{Binding, Pattern}; +use ast::Literal; +use void::{ResultVoidExt, Void}; + +use crate::ast::hir::{Decl, Expr}; +use crate::ast::{self, Ident}; + +use super::Visitor; + +/// Strip all values with a unit type in positive (non-return) position +pub(crate) struct StripPositiveUnits {} + +impl<'a, 'ast> Visitor<'a, 'ast, ast::Type<'ast>> for StripPositiveUnits { + type Error = Void; + + fn pre_visit_expr( + &mut self, + expr: &mut Expr<'ast, ast::Type<'ast>>, + ) -> Result<(), Self::Error> { + let mut extracted = vec![]; + if let Expr::Call { args, .. } = expr { + // TODO(grfn): replace with drain_filter once it's stabilized + let mut i = 0; + while i != args.len() { + if args[i].type_() == &ast::Type::Unit { + let expr = args.remove(i); + if !matches!(expr, Expr::Literal(Literal::Unit, _)) { + extracted.push(expr) + }; + } else { + i += 1 + } + } + } + + if !extracted.is_empty() { + let body = mem::replace(expr, Expr::Literal(Literal::Unit, ast::Type::Unit)); + *expr = Expr::Let { + bindings: extracted + .into_iter() + .map(|expr| Binding { + pat: Pattern::Id( + Ident::from_str_unchecked("___discarded"), + expr.type_().clone(), + ), + body: expr, + }) + .collect(), + type_: body.type_().clone(), + body: Box::new(body), + }; + } + + Ok(()) + } + + fn post_visit_call( + &mut self, + _fun: &mut Expr<'ast, ast::Type<'ast>>, + _type_args: &mut HashMap<Ident<'ast>, ast::Type<'ast>>, + args: &mut Vec<Expr<'ast, ast::Type<'ast>>>, + ) -> Result<(), Self::Error> { + args.retain(|arg| arg.type_() != &ast::Type::Unit); + Ok(()) + } + + fn visit_type(&mut self, type_: &mut ast::Type<'ast>) -> Result<(), Self::Error> { + if let ast::Type::Function(ft) = type_ { + ft.args.retain(|a| a != &ast::Type::Unit); + } + Ok(()) + } + + fn post_visit_fun_decl( + &mut self, + _name: &mut Ident<'ast>, + _type_args: &mut Vec<Ident>, + args: &mut Vec<(Ident, ast::Type<'ast>)>, + _body: &mut Box<Expr<ast::Type<'ast>>>, + _type_: &mut ast::Type<'ast>, + ) -> Result<(), Self::Error> { + args.retain(|(_, ty)| ty != &ast::Type::Unit); + Ok(()) + } +} + +pub(crate) fn run_toplevel<'a>(toplevel: &mut Vec<Decl<'a, ast::Type<'a>>>) { + let mut pass = StripPositiveUnits {}; + for decl in toplevel.iter_mut() { + pass.visit_decl(decl).void_unwrap(); + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::parser::toplevel; + use crate::tc::typecheck_toplevel; + use pretty_assertions::assert_eq; + + #[test] + fn unit_only_arg() { + let (_, program) = toplevel( + "ty f : fn () -> int + fn f _ = 1 + + ty main : fn -> int + fn main = f ()", + ) + .unwrap(); + + let (_, expected) = toplevel( + "ty f : fn -> int + fn f = 1 + + ty main : fn -> int + fn main = f()", + ) + .unwrap(); + let expected = typecheck_toplevel(expected).unwrap(); + + let mut program = typecheck_toplevel(program).unwrap(); + run_toplevel(&mut program); + + assert_eq!(program, expected); + } + + #[test] + fn unit_and_other_arg() { + let (_, program) = toplevel( + "ty f : fn (), int -> int + fn f _ x = x + + ty main : fn -> int + fn main = f () 1", + ) + .unwrap(); + + let (_, expected) = toplevel( + "ty f : fn int -> int + fn f x = x + + ty main : fn -> int + fn main = f 1", + ) + .unwrap(); + let expected = typecheck_toplevel(expected).unwrap(); + + let mut program = typecheck_toplevel(program).unwrap(); + run_toplevel(&mut program); + + assert_eq!(program, expected); + } + + #[test] + fn unit_expr_and_other_arg() { + let (_, program) = toplevel( + "ty f : fn (), int -> int + fn f _ x = x + + ty g : fn int -> () + fn g _ = () + + ty main : fn -> int + fn main = f (g 2) 1", + ) + .unwrap(); + + let (_, expected) = toplevel( + "ty f : fn int -> int + fn f x = x + + ty g : fn int -> () + fn g _ = () + + ty main : fn -> int + fn main = let ___discarded = g 2 in f 1", + ) + .unwrap(); + assert_eq!(expected.len(), 6); + let expected = typecheck_toplevel(expected).unwrap(); + + let mut program = typecheck_toplevel(program).unwrap(); + run_toplevel(&mut program); + + assert_eq!(program, expected); + } +} diff --git a/users/grfn/achilles/src/passes/mod.rs b/users/grfn/achilles/src/passes/mod.rs new file mode 100644 index 000000000000..306869bef1d5 --- /dev/null +++ b/users/grfn/achilles/src/passes/mod.rs @@ -0,0 +1 @@ +pub(crate) mod hir; diff --git a/users/grfn/achilles/src/tc/mod.rs b/users/grfn/achilles/src/tc/mod.rs new file mode 100644 index 000000000000..5825bab1fbe9 --- /dev/null +++ b/users/grfn/achilles/src/tc/mod.rs @@ -0,0 +1,808 @@ +use bimap::BiMap; +use derive_more::From; +use itertools::Itertools; +use std::cell::RefCell; +use std::collections::HashMap; +use std::convert::{TryFrom, TryInto}; +use std::fmt::{self, Display}; +use std::{mem, result}; +use thiserror::Error; + +use crate::ast::{self, hir, Arg, BinaryOperator, Ident, Literal, Pattern}; +use crate::common::env::Env; +use crate::common::{Namer, NamerOf}; + +#[derive(Debug, Error)] +pub enum Error { + #[error("Undefined variable {0}")] + UndefinedVariable(Ident<'static>), + + #[error("Mismatched types: expected {expected}, but got {actual}")] + TypeMismatch { expected: Type, actual: Type }, + + #[error("Mismatched types, expected numeric type, but got {0}")] + NonNumeric(Type), + + #[error("Ambiguous type {0}")] + AmbiguousType(TyVar), +} + +pub type Result<T> = result::Result<T, Error>; + +#[derive(Debug, PartialEq, Eq, Clone, Copy, Hash)] +pub struct TyVar(u64); + +impl Display for TyVar { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + write!(f, "t{}", self.0) + } +} + +#[derive(Debug, PartialEq, Eq, Clone, Hash)] +pub struct NullaryType(String); + +impl Display for NullaryType { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + f.write_str(&self.0) + } +} + +#[derive(Debug, PartialEq, Eq, Clone, Copy)] +pub enum PrimType { + Int, + Float, + Bool, + CString, +} + +impl<'a> From<PrimType> for ast::Type<'a> { + fn from(pr: PrimType) -> Self { + match pr { + PrimType::Int => ast::Type::Int, + PrimType::Float => ast::Type::Float, + PrimType::Bool => ast::Type::Bool, + PrimType::CString => ast::Type::CString, + } + } +} + +impl Display for PrimType { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self { + PrimType::Int => f.write_str("int"), + PrimType::Float => f.write_str("float"), + PrimType::Bool => f.write_str("bool"), + PrimType::CString => f.write_str("cstring"), + } + } +} + +#[derive(Debug, PartialEq, Eq, Clone, From)] +pub enum Type { + #[from(ignore)] + Univ(TyVar), + #[from(ignore)] + Exist(TyVar), + Nullary(NullaryType), + Prim(PrimType), + Tuple(Vec<Type>), + Unit, + Fun { + args: Vec<Type>, + ret: Box<Type>, + }, +} + +impl<'a> TryFrom<Type> for ast::Type<'a> { + type Error = Type; + + fn try_from(value: Type) -> result::Result<Self, Self::Error> { + match value { + Type::Unit => Ok(ast::Type::Unit), + Type::Univ(_) => todo!(), + Type::Exist(_) => Err(value), + Type::Nullary(_) => todo!(), + Type::Prim(p) => Ok(p.into()), + Type::Tuple(members) => Ok(ast::Type::Tuple( + members.into_iter().map(|ty| ty.try_into()).try_collect()?, + )), + Type::Fun { ref args, ref ret } => Ok(ast::Type::Function(ast::FunctionType { + args: args + .clone() + .into_iter() + .map(Self::try_from) + .try_collect() + .map_err(|_| value.clone())?, + ret: Box::new((*ret.clone()).try_into().map_err(|_| value.clone())?), + })), + } + } +} + +const INT: Type = Type::Prim(PrimType::Int); +const FLOAT: Type = Type::Prim(PrimType::Float); +const BOOL: Type = Type::Prim(PrimType::Bool); +const CSTRING: Type = Type::Prim(PrimType::CString); + +impl Display for Type { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self { + Type::Nullary(nt) => nt.fmt(f), + Type::Prim(p) => p.fmt(f), + Type::Univ(TyVar(n)) => write!(f, "∀{}", n), + Type::Exist(TyVar(n)) => write!(f, "∃{}", n), + Type::Fun { args, ret } => write!(f, "fn {} -> {}", args.iter().join(", "), ret), + Type::Tuple(members) => write!(f, "({})", members.iter().join(", ")), + Type::Unit => write!(f, "()"), + } + } +} + +struct Typechecker<'ast> { + ty_var_namer: NamerOf<TyVar>, + ctx: HashMap<TyVar, Type>, + env: Env<Ident<'ast>, Type>, + + /// AST type var -> type + instantiations: Env<Ident<'ast>, Type>, + + /// AST type-var -> universal TyVar + type_vars: RefCell<(BiMap<Ident<'ast>, TyVar>, NamerOf<Ident<'static>>)>, +} + +impl<'ast> Typechecker<'ast> { + fn new() -> Self { + Self { + ty_var_namer: Namer::new(TyVar).boxed(), + type_vars: RefCell::new(( + Default::default(), + Namer::alphabetic().map(|n| Ident::try_from(n).unwrap()), + )), + ctx: Default::default(), + env: Default::default(), + instantiations: Default::default(), + } + } + + fn bind_pattern( + &mut self, + pat: Pattern<'ast>, + type_: Type, + ) -> Result<hir::Pattern<'ast, Type>> { + match pat { + Pattern::Id(ident) => { + self.env.set(ident.clone(), type_.clone()); + Ok(hir::Pattern::Id(ident, type_)) + } + Pattern::Tuple(members) => { + let mut tys = Vec::with_capacity(members.len()); + let mut hir_members = Vec::with_capacity(members.len()); + for pat in members { + let ty = self.fresh_ex(); + hir_members.push(self.bind_pattern(pat, ty.clone())?); + tys.push(ty); + } + let tuple_type = Type::Tuple(tys); + self.unify(&tuple_type, &type_)?; + Ok(hir::Pattern::Tuple(hir_members)) + } + } + } + + pub(crate) fn tc_expr(&mut self, expr: ast::Expr<'ast>) -> Result<hir::Expr<'ast, Type>> { + match expr { + ast::Expr::Ident(ident) => { + let type_ = self + .env + .resolve(&ident) + .ok_or_else(|| Error::UndefinedVariable(ident.to_owned()))? + .clone(); + Ok(hir::Expr::Ident(ident, type_)) + } + ast::Expr::Literal(lit) => { + let type_ = match lit { + Literal::Int(_) => Type::Prim(PrimType::Int), + Literal::Bool(_) => Type::Prim(PrimType::Bool), + Literal::String(_) => Type::Prim(PrimType::CString), + Literal::Unit => Type::Unit, + }; + Ok(hir::Expr::Literal(lit.to_owned(), type_)) + } + ast::Expr::Tuple(members) => { + let members = members + .into_iter() + .map(|expr| self.tc_expr(expr)) + .collect::<Result<Vec<_>>>()?; + let type_ = Type::Tuple(members.iter().map(|expr| expr.type_().clone()).collect()); + Ok(hir::Expr::Tuple(members, type_)) + } + ast::Expr::UnaryOp { op, rhs } => todo!(), + ast::Expr::BinaryOp { lhs, op, rhs } => { + let lhs = self.tc_expr(*lhs)?; + let rhs = self.tc_expr(*rhs)?; + let type_ = match op { + BinaryOperator::Equ | BinaryOperator::Neq => { + self.unify(lhs.type_(), rhs.type_())?; + Type::Prim(PrimType::Bool) + } + BinaryOperator::Add | BinaryOperator::Sub | BinaryOperator::Mul => { + let ty = self.unify(lhs.type_(), rhs.type_())?; + // if !matches!(ty, Type::Int | Type::Float) { + // return Err(Error::NonNumeric(ty)); + // } + ty + } + BinaryOperator::Div => todo!(), + BinaryOperator::Pow => todo!(), + }; + Ok(hir::Expr::BinaryOp { + lhs: Box::new(lhs), + op, + rhs: Box::new(rhs), + type_, + }) + } + ast::Expr::Let { bindings, body } => { + self.env.push(); + let bindings = bindings + .into_iter() + .map( + |ast::Binding { pat, type_, body }| -> Result<hir::Binding<Type>> { + let body = self.tc_expr(body)?; + if let Some(type_) = type_ { + let type_ = self.type_from_ast_type(type_); + self.unify(body.type_(), &type_)?; + } + let pat = self.bind_pattern(pat, body.type_().clone())?; + Ok(hir::Binding { pat, body }) + }, + ) + .collect::<Result<Vec<hir::Binding<Type>>>>()?; + let body = self.tc_expr(*body)?; + self.env.pop(); + Ok(hir::Expr::Let { + bindings, + type_: body.type_().clone(), + body: Box::new(body), + }) + } + ast::Expr::If { + condition, + then, + else_, + } => { + let condition = self.tc_expr(*condition)?; + self.unify(&Type::Prim(PrimType::Bool), condition.type_())?; + let then = self.tc_expr(*then)?; + let else_ = self.tc_expr(*else_)?; + let type_ = self.unify(then.type_(), else_.type_())?; + Ok(hir::Expr::If { + condition: Box::new(condition), + then: Box::new(then), + else_: Box::new(else_), + type_, + }) + } + ast::Expr::Fun(f) => { + let ast::Fun { args, body } = *f; + self.env.push(); + let args: Vec<_> = args + .into_iter() + .map(|Arg { ident, type_ }| { + let ty = match type_ { + Some(t) => self.type_from_ast_type(t), + None => self.fresh_ex(), + }; + self.env.set(ident.clone(), ty.clone()); + (ident, ty) + }) + .collect(); + let body = self.tc_expr(body)?; + self.env.pop(); + Ok(hir::Expr::Fun { + type_: Type::Fun { + args: args.iter().map(|(_, ty)| ty.clone()).collect(), + ret: Box::new(body.type_().clone()), + }, + type_args: vec![], // TODO fill in once we do let generalization + args, + body: Box::new(body), + }) + } + ast::Expr::Call { fun, args } => { + let ret_ty = self.fresh_ex(); + let arg_tys = args.iter().map(|_| self.fresh_ex()).collect::<Vec<_>>(); + let ft = Type::Fun { + args: arg_tys.clone(), + ret: Box::new(ret_ty.clone()), + }; + let fun = self.tc_expr(*fun)?; + self.instantiations.push(); + self.unify(&ft, fun.type_())?; + let args = args + .into_iter() + .zip(arg_tys) + .map(|(arg, ty)| { + let arg = self.tc_expr(arg)?; + self.unify(&ty, arg.type_())?; + Ok(arg) + }) + .try_collect()?; + let type_args = self.commit_instantiations(); + Ok(hir::Expr::Call { + fun: Box::new(fun), + type_args, + args, + type_: ret_ty, + }) + } + ast::Expr::Ascription { expr, type_ } => { + let expr = self.tc_expr(*expr)?; + let type_ = self.type_from_ast_type(type_); + self.unify(expr.type_(), &type_)?; + Ok(expr) + } + } + } + + pub(crate) fn tc_decl( + &mut self, + decl: ast::Decl<'ast>, + ) -> Result<Option<hir::Decl<'ast, Type>>> { + match decl { + ast::Decl::Fun { name, body } => { + let mut expr = ast::Expr::Fun(Box::new(body)); + if let Some(type_) = self.env.resolve(&name) { + expr = ast::Expr::Ascription { + expr: Box::new(expr), + type_: self.finalize_type(type_.clone())?, + }; + } + + self.env.push(); + let body = self.tc_expr(expr)?; + let type_ = body.type_().clone(); + self.env.set(name.clone(), type_); + self.env.pop(); + match body { + hir::Expr::Fun { + type_args, + args, + body, + type_, + } => Ok(Some(hir::Decl::Fun { + name, + type_args, + args, + body, + type_, + })), + _ => unreachable!(), + } + } + ast::Decl::Ascription { name, type_ } => { + let type_ = self.type_from_ast_type(type_); + self.env.set(name.clone(), type_); + Ok(None) + } + ast::Decl::Extern { name, type_ } => { + let type_ = self.type_from_ast_type(ast::Type::Function(type_)); + self.env.set(name.clone(), type_.clone()); + let (arg_types, ret_type) = match type_ { + Type::Fun { args, ret } => (args, *ret), + _ => unreachable!(), + }; + Ok(Some(hir::Decl::Extern { + name, + arg_types, + ret_type, + })) + } + } + } + + fn fresh_tv(&mut self) -> TyVar { + self.ty_var_namer.make_name() + } + + fn fresh_ex(&mut self) -> Type { + Type::Exist(self.fresh_tv()) + } + + fn fresh_univ(&mut self) -> Type { + Type::Univ(self.fresh_tv()) + } + + fn unify(&mut self, ty1: &Type, ty2: &Type) -> Result<Type> { + match (ty1, ty2) { + (Type::Unit, Type::Unit) => Ok(Type::Unit), + (Type::Exist(tv), ty) | (ty, Type::Exist(tv)) => match self.resolve_tv(*tv)? { + Some(existing_ty) if self.types_match(ty, &existing_ty) => Ok(ty.clone()), + Some(var @ ast::Type::Var(_)) => { + let var = self.type_from_ast_type(var); + self.unify(&var, ty) + } + Some(existing_ty) => match ty { + Type::Exist(_) => { + let rhs = self.type_from_ast_type(existing_ty); + self.unify(ty, &rhs) + } + _ => Err(Error::TypeMismatch { + expected: ty.clone(), + actual: self.type_from_ast_type(existing_ty), + }), + }, + None => match self.ctx.insert(*tv, ty.clone()) { + Some(existing) => self.unify(&existing, ty), + None => Ok(ty.clone()), + }, + }, + (Type::Univ(u1), Type::Univ(u2)) if u1 == u2 => Ok(ty2.clone()), + (Type::Univ(u), ty) | (ty, Type::Univ(u)) => { + let ident = self.name_univ(*u); + match self.instantiations.resolve(&ident) { + Some(existing_ty) if ty == existing_ty => Ok(ty.clone()), + Some(existing_ty) => Err(Error::TypeMismatch { + expected: ty.clone(), + actual: existing_ty.clone(), + }), + None => { + self.instantiations.set(ident, ty.clone()); + Ok(ty.clone()) + } + } + } + (Type::Prim(p1), Type::Prim(p2)) if p1 == p2 => Ok(ty2.clone()), + (Type::Tuple(t1), Type::Tuple(t2)) if t1.len() == t2.len() => { + let ts = t1 + .iter() + .zip(t2.iter()) + .map(|(t1, t2)| self.unify(t1, t2)) + .try_collect()?; + Ok(Type::Tuple(ts)) + } + ( + Type::Fun { + args: args1, + ret: ret1, + }, + Type::Fun { + args: args2, + ret: ret2, + }, + ) => { + let args = args1 + .iter() + .zip(args2) + .map(|(t1, t2)| self.unify(t1, t2)) + .try_collect()?; + let ret = self.unify(ret1, ret2)?; + Ok(Type::Fun { + args, + ret: Box::new(ret), + }) + } + (Type::Nullary(_), _) | (_, Type::Nullary(_)) => todo!(), + _ => Err(Error::TypeMismatch { + expected: ty1.clone(), + actual: ty2.clone(), + }), + } + } + + fn finalize_expr( + &self, + expr: hir::Expr<'ast, Type>, + ) -> Result<hir::Expr<'ast, ast::Type<'ast>>> { + expr.traverse_type(|ty| self.finalize_type(ty)) + } + + fn finalize_decl( + &mut self, + decl: hir::Decl<'ast, Type>, + ) -> Result<hir::Decl<'ast, ast::Type<'ast>>> { + let res = decl.traverse_type(|ty| self.finalize_type(ty))?; + if let Some(type_) = res.type_() { + let ty = self.type_from_ast_type(type_.clone()); + self.env.set(res.name().clone(), ty); + } + Ok(res) + } + + fn finalize_type(&self, ty: Type) -> Result<ast::Type<'static>> { + let ret = match ty { + Type::Exist(tv) => self.resolve_tv(tv)?.ok_or(Error::AmbiguousType(tv)), + Type::Univ(tv) => Ok(ast::Type::Var(self.name_univ(tv))), + Type::Unit => Ok(ast::Type::Unit), + Type::Nullary(_) => todo!(), + Type::Prim(pr) => Ok(pr.into()), + Type::Tuple(members) => Ok(ast::Type::Tuple( + members + .into_iter() + .map(|ty| self.finalize_type(ty)) + .try_collect()?, + )), + Type::Fun { args, ret } => Ok(ast::Type::Function(ast::FunctionType { + args: args + .into_iter() + .map(|ty| self.finalize_type(ty)) + .try_collect()?, + ret: Box::new(self.finalize_type(*ret)?), + })), + }; + ret + } + + fn resolve_tv(&self, tv: TyVar) -> Result<Option<ast::Type<'static>>> { + let mut res = &Type::Exist(tv); + Ok(loop { + match res { + Type::Exist(tv) => { + res = match self.ctx.get(tv) { + Some(r) => r, + None => return Ok(None), + }; + } + Type::Univ(tv) => { + let ident = self.name_univ(*tv); + if let Some(r) = self.instantiations.resolve(&ident) { + res = r; + } else { + break Some(ast::Type::Var(ident)); + } + } + Type::Nullary(_) => todo!(), + Type::Prim(pr) => break Some((*pr).into()), + Type::Unit => break Some(ast::Type::Unit), + Type::Fun { args, ret } => todo!(), + Type::Tuple(_) => break Some(self.finalize_type(res.clone())?), + } + }) + } + + fn type_from_ast_type(&mut self, ast_type: ast::Type<'ast>) -> Type { + match ast_type { + ast::Type::Unit => Type::Unit, + ast::Type::Int => INT, + ast::Type::Float => FLOAT, + ast::Type::Bool => BOOL, + ast::Type::CString => CSTRING, + ast::Type::Tuple(members) => Type::Tuple( + members + .into_iter() + .map(|ty| self.type_from_ast_type(ty)) + .collect(), + ), + ast::Type::Function(ast::FunctionType { args, ret }) => Type::Fun { + args: args + .into_iter() + .map(|t| self.type_from_ast_type(t)) + .collect(), + ret: Box::new(self.type_from_ast_type(*ret)), + }, + ast::Type::Var(id) => Type::Univ({ + let opt_tv = { self.type_vars.borrow_mut().0.get_by_left(&id).copied() }; + opt_tv.unwrap_or_else(|| { + let tv = self.fresh_tv(); + self.type_vars + .borrow_mut() + .0 + .insert_no_overwrite(id, tv) + .unwrap(); + tv + }) + }), + } + } + + fn name_univ(&self, tv: TyVar) -> Ident<'static> { + let mut vars = self.type_vars.borrow_mut(); + vars.0 + .get_by_right(&tv) + .map(Ident::to_owned) + .unwrap_or_else(|| { + let name = loop { + let name = vars.1.make_name(); + if !vars.0.contains_left(&name) { + break name; + } + }; + vars.0.insert_no_overwrite(name.clone(), tv).unwrap(); + name + }) + } + + fn commit_instantiations(&mut self) -> HashMap<Ident<'ast>, Type> { + let mut res = HashMap::new(); + let mut ctx = mem::take(&mut self.ctx); + for (_, v) in ctx.iter_mut() { + if let Type::Univ(tv) = v { + let tv_name = self.name_univ(*tv); + if let Some(concrete) = self.instantiations.resolve(&tv_name) { + res.insert(tv_name, concrete.clone()); + *v = concrete.clone(); + } + } + } + self.ctx = ctx; + self.instantiations.pop(); + res + } + + fn types_match(&self, type_: &Type, ast_type: &ast::Type<'ast>) -> bool { + match (type_, ast_type) { + (Type::Univ(u), ast::Type::Var(v)) => { + Some(u) == self.type_vars.borrow().0.get_by_left(v) + } + (Type::Univ(_), _) => false, + (Type::Exist(_), _) => false, + (Type::Unit, ast::Type::Unit) => true, + (Type::Unit, _) => false, + (Type::Nullary(_), _) => todo!(), + (Type::Prim(pr), ty) => ast::Type::from(*pr) == *ty, + (Type::Tuple(members), ast::Type::Tuple(members2)) => members + .iter() + .zip(members2.iter()) + .all(|(t1, t2)| self.types_match(t1, t2)), + (Type::Tuple(members), _) => false, + (Type::Fun { args, ret }, ast::Type::Function(ft)) => { + args.len() == ft.args.len() + && args + .iter() + .zip(&ft.args) + .all(|(a1, a2)| self.types_match(a1, &a2)) + && self.types_match(&*ret, &*ft.ret) + } + (Type::Fun { .. }, _) => false, + } + } +} + +pub fn typecheck_expr(expr: ast::Expr) -> Result<hir::Expr<ast::Type>> { + let mut typechecker = Typechecker::new(); + let typechecked = typechecker.tc_expr(expr)?; + typechecker.finalize_expr(typechecked) +} + +pub fn typecheck_toplevel(decls: Vec<ast::Decl>) -> Result<Vec<hir::Decl<ast::Type>>> { + let mut typechecker = Typechecker::new(); + let mut res = Vec::with_capacity(decls.len()); + for decl in decls { + if let Some(hir_decl) = typechecker.tc_decl(decl)? { + let hir_decl = typechecker.finalize_decl(hir_decl)?; + res.push(hir_decl); + } + typechecker.ctx.clear(); + } + Ok(res) +} + +#[cfg(test)] +mod tests { + use super::*; + + macro_rules! assert_type { + ($expr: expr, $type: expr) => { + use crate::parser::{expr, type_}; + let parsed_expr = test_parse!(expr, $expr); + let parsed_type = test_parse!(type_, $type); + let res = typecheck_expr(parsed_expr).unwrap_or_else(|e| panic!("{}", e)); + assert!( + res.type_().alpha_equiv(&parsed_type), + "{} inferred type {}, but expected {}", + $expr, + res.type_(), + $type + ); + }; + + (toplevel($program: expr), $($decl: ident => $type: expr),+ $(,)?) => {{ + use crate::parser::{toplevel, type_}; + let program = test_parse!(toplevel, $program); + let res = typecheck_toplevel(program).unwrap_or_else(|e| panic!("{}", e)); + $( + let parsed_type = test_parse!(type_, $type); + let ident = Ident::try_from(::std::stringify!($decl)).unwrap(); + let decl = res.iter().find(|decl| { + matches!(decl, crate::ast::hir::Decl::Fun { name, .. } if name == &ident) + }).unwrap_or_else(|| panic!("Could not find declaration for {}", ident)); + assert!( + decl.type_().unwrap().alpha_equiv(&parsed_type), + "inferred type {} for {}, but expected {}", + decl.type_().unwrap(), + ident, + $type + ); + )+ + }}; + } + + macro_rules! assert_type_error { + ($expr: expr) => { + use crate::parser::expr; + let parsed_expr = test_parse!(expr, $expr); + let res = typecheck_expr(parsed_expr); + assert!( + res.is_err(), + "Expected type error, but got type: {}", + res.unwrap().type_() + ); + }; + } + + #[test] + fn literal_int() { + assert_type!("1", "int"); + } + + #[test] + fn conditional() { + assert_type!("if 1 == 2 then 3 else 4", "int"); + } + + #[test] + #[ignore] + fn add_bools() { + assert_type_error!("true + false"); + } + + #[test] + fn call_generic_function() { + assert_type!("(fn x = x) 1", "int"); + } + + #[test] + fn call_let_bound_generic() { + assert_type!("let id = fn x = x in id 1", "int"); + } + + #[test] + fn universal_ascripted_let() { + assert_type!("let id: fn a -> a = fn x = x in id 1", "int"); + } + + #[test] + fn call_generic_function_toplevel() { + assert_type!( + toplevel( + "ty id : fn a -> a + fn id x = x + + fn main = id 0" + ), + main => "fn -> int", + id => "fn a -> a", + ); + } + + #[test] + #[ignore] + fn let_generalization() { + assert_type!("let id = fn x = x in if id true then id 1 else 2", "int"); + } + + #[test] + fn concrete_function() { + assert_type!("fn x = x + 1", "fn int -> int"); + } + + #[test] + fn arg_ascriptions() { + assert_type!("fn (x: int) = x", "fn int -> int"); + } + + #[test] + fn call_concrete_function() { + assert_type!("(fn x = x + 1) 2", "int"); + } + + #[test] + fn conditional_non_bool() { + assert_type_error!("if 3 then true else false"); + } + + #[test] + fn let_int() { + assert_type!("let x = 1 in x", "int"); + } +} diff --git a/users/grfn/achilles/tests/compile.rs b/users/grfn/achilles/tests/compile.rs new file mode 100644 index 000000000000..0f1086bfd8e1 --- /dev/null +++ b/users/grfn/achilles/tests/compile.rs @@ -0,0 +1,79 @@ +use std::process::Command; + +use crate_root::root; + +struct Fixture { + name: &'static str, + exit_code: i32, + expected_output: &'static str, +} + +const FIXTURES: &[Fixture] = &[ + Fixture { + name: "simple", + exit_code: 5, + expected_output: "", + }, + Fixture { + name: "functions", + exit_code: 9, + expected_output: "", + }, + Fixture { + name: "externs", + exit_code: 0, + expected_output: "foobar\n", + }, + Fixture { + name: "units", + exit_code: 0, + expected_output: "hi\n", + }, +]; + +#[test] +fn compile_and_run_files() { + let ach = root().unwrap().join("ach"); + + println!("Running: `make clean`"); + assert!( + Command::new("make") + .arg("clean") + .current_dir(&ach) + .spawn() + .unwrap() + .wait() + .unwrap() + .success(), + "make clean failed" + ); + + for Fixture { + name, + exit_code, + expected_output, + } in FIXTURES + { + println!(">>> Testing: {}", name); + + println!(" Running: `make {}`", name); + assert!( + Command::new("make") + .arg(name) + .current_dir(&ach) + .spawn() + .unwrap() + .wait() + .unwrap() + .success(), + "make failed" + ); + + let out_path = ach.join(name); + println!(" Running: `{}`", out_path.to_str().unwrap()); + let output = Command::new(out_path).output().unwrap(); + assert_eq!(output.status.code().unwrap(), *exit_code,); + assert_eq!(output.stdout, expected_output.as_bytes()); + println!(" OK"); + } +} diff --git a/users/grfn/emacs.d/+bindings.el b/users/grfn/emacs.d/+bindings.el new file mode 100644 index 000000000000..05c83435a596 --- /dev/null +++ b/users/grfn/emacs.d/+bindings.el @@ -0,0 +1,1427 @@ +;; -*- lexical-binding: t; -*- + +(load! "utils") +(require 'f) +(require 'predd) + +(undefine-key! :keymaps 'doom-leader-map "/") + +(defmacro find-file-in! (path &optional project-p) + "Returns an interactive function for searching files." + `(lambda () (interactive) + (let ((default-directory ,path)) + (call-interactively + ',(command-remapping + (if project-p + #'projectile-find-file + #'find-file)))))) + +(defun dired-mode-p () (eq 'dired-mode major-mode)) + +(defun grfn/dired-minus () + (interactive) + (if (dired-mode-p) + (dired-up-directory) + (when buffer-file-name + (-> (buffer-file-name) + (f-dirname) + (dired))))) + +(defmacro define-move-and-insert + (name &rest body) + `(defun ,name (count &optional vcount skip-empty-lines) + ;; Following interactive form taken from the source for `evil-insert' + (interactive + (list (prefix-numeric-value current-prefix-arg) + (and (evil-visual-state-p) + (memq (evil-visual-type) '(line block)) + (save-excursion + (let ((m (mark))) + ;; go to upper-left corner temporarily so + ;; `count-lines' yields accurate results + (evil-visual-rotate 'upper-left) + (prog1 (count-lines evil-visual-beginning evil-visual-end) + (set-mark m))))) + (evil-visual-state-p))) + (atomic-change-group + ,@body + (evil-insert count vcount skip-empty-lines)))) + +(define-move-and-insert grfn/insert-at-sexp-end + (when (not (equal (get-char) "(")) + (backward-up-list)) + (forward-sexp) + (backward-char)) + +(define-move-and-insert grfn/insert-at-sexp-start + (backward-up-list) + (forward-char)) + +(define-move-and-insert grfn/insert-at-form-start + (backward-sexp) + (backward-char) + (insert " ")) + +(define-move-and-insert grfn/insert-at-form-end + (forward-sexp) + (insert " ")) + +(load! "splitjoin") + +(defun +hlissner/install-snippets () + "Install my snippets from https://github.com/hlissner/emacs-snippets into +private/hlissner/snippets." + (interactive) + (doom-fetch :github "hlissner/emacs-snippets" + (expand-file-name "snippets" (doom-module-path :private 'hlissner)))) + +(defun +hlissner/yank-buffer-filename () + "Copy the current buffer's path to the kill ring." + (interactive) + (if-let* ((filename (or buffer-file-name (bound-and-true-p list-buffers-directory)))) + (message (kill-new (abbreviate-file-name filename))) + (error "Couldn't find filename in current buffer"))) + +(defmacro +def-finder! (name dir) + "Define a pair of find-file and browse functions." + `(progn + (defun ,(intern (format "+find-in-%s" name)) () + (interactive) + (let ((default-directory ,dir) + projectile-project-name + projectile-require-project-root + projectile-cached-buffer-file-name + projectile-cached-project-root) + (call-interactively #'projectile-find-file))) + (defun ,(intern (format "+hlissner/browse-%s" name)) () + (interactive) + (let ((default-directory ,dir)) + (call-interactively (command-remapping #'find-file)))))) + +(+def-finder! templates +file-templates-dir) +(+def-finder! snippets +grfn-snippets-dir) +(+def-finder! dotfiles (expand-file-name ".dotfiles" "~")) +(+def-finder! doomd (expand-file-name ".doom.d" "~")) +(+def-finder! notes +org-dir) +(+def-finder! home-config (expand-file-name "code/system/home" "~")) +(+def-finder! system-config (expand-file-name "code/system/system" "~")) + +(defun +grfn/paxedit-kill (&optional n) + (interactive "p") + (or (paxedit-comment-kill) + (when (paxedit-symbol-cursor-within?) + (paxedit-symbol-kill)) + (paxedit-implicit-sexp-kill n) + (paxedit-sexp-kill n) + (message paxedit-message-kill))) + +;;; + +(evil-set-command-property 'flycheck-next-error :repeat nil) +(evil-set-command-property 'flycheck-prev-error :repeat nil) + +;;; + +(map! + [remap evil-jump-to-tag] #'projectile-find-tag + [remap find-tag] #'projectile-find-tag + ;; ensure there are no conflicts + :nmvo doom-leader-key nil + :nmvo doom-localleader-key nil) + +(undefine-key! :keymaps 'doom-leader-map "/") + +(map! + ;; --- Global keybindings --------------------------- + ;; Make M-x available everywhere + :gnvime "M-x" #'execute-extended-command + :gnvime "A-x" #'execute-extended-command + ;; Emacs debug utilities + :gnvime "M-;" #'eval-expression + :gnvime "M-:" #'doom/open-scratch-buffer + ;; Text-scaling + "M-+" (λ! (text-scale-set 0)) + "M-=" #'text-scale-increase + "M--" #'text-scale-decrease + ;; Simple window navigation/manipulation + "C-`" #'doom/popup-toggle + "C-~" #'doom/popup-raise + "M-t" #'+workspace/new + "M-T" #'+workspace/display + "M-w" #'delete-window + "M-W" #'+workspace/close-workspace-or-frame + "M-n" #'evil-buffer-new + "M-N" #'make-frame + "M-1" (λ! (+workspace/switch-to 0)) + "M-2" (λ! (+workspace/switch-to 1)) + "M-3" (λ! (+workspace/switch-to 2)) + "M-4" (λ! (+workspace/switch-to 3)) + "M-5" (λ! (+workspace/switch-to 4)) + "M-6" (λ! (+workspace/switch-to 5)) + "M-7" (λ! (+workspace/switch-to 6)) + "M-8" (λ! (+workspace/switch-to 7)) + "M-9" (λ! (+workspace/switch-to 8)) + "M-0" #'+workspace/switch-to-last + ;; Other sensible, textmate-esque global bindings + :ne "M-r" #'+eval/buffer + :ne "M-R" #'+eval/region-and-replace + :ne "M-b" #'+eval/build + :ne "M-a" #'mark-whole-buffer + :ne "M-c" #'evil-yank + :ne "M-q" (if (daemonp) #'delete-frame #'save-buffers-kill-emacs) + :ne "M-f" #'swiper + :ne "C-M-f" #'doom/toggle-fullscreen + :n "M-s" #'save-buffer + :m "A-j" #'+hlissner:multi-next-line + :m "A-k" #'+hlissner:multi-previous-line + :nv "C-SPC" #'+evil:fold-toggle + :gnvimer "M-v" #'clipboard-yank + ;; Easier window navigation + :en "C-h" #'evil-window-left + :en "C-j" #'evil-window-down + :en "C-k" #'evil-window-up + :en "C-l" #'evil-window-right + :n "U" #'undo-tree-visualize + + "C-x p" #'doom/other-popup + + :n "K" #'+lookup/documentation + :n "g d" #'+lookup/definition + + + ;; --- <leader> ------------------------------------- + (:leader + :desc "Ex command" :nv ";" #'evil-ex + :desc "M-x" :nv ":" #'execute-extended-command + :desc "Pop up scratch buffer" :nv "x" #'doom/open-scratch-buffer + :desc "Org Capture" :nv "X" #'org-capture + :desc "Org Capture" :nv "a" #'org-capture + + ;; Most commonly used + :desc "Find file in project" :n "SPC" #'projectile-find-file + :desc "Switch workspace buffer" :n "," #'persp-switch-to-buffer + :desc "Switch buffer" :n "<" #'switch-to-buffer + :desc "Browse files" :n "." #'find-file + :desc "Toggle last popup" :n "~" #'doom/popup-toggle + :desc "Eval expression" :n "`" #'eval-expression + :desc "Blink cursor line" :n "DEL" #'+doom/blink-cursor + :desc "Jump to bookmark" :n "RET" #'bookmark-jump + + ;; C-u is used by evil + :desc "Universal argument" :n "u" #'universal-argument + :desc "window" :n "w" evil-window-map + + (:desc "previous..." :prefix "[" + :desc "Text size" :nv "[" #'text-scale-decrease + :desc "Buffer" :nv "b" #'doom/previous-buffer + :desc "Diff Hunk" :nv "d" #'git-gutter:previous-hunk + :desc "Todo" :nv "t" #'hl-todo-previous + :desc "Error" :nv "e" #'flycheck-previous-error + :desc "Workspace" :nv "w" #'+workspace/switch-left + :desc "Smart jump" :nv "h" #'smart-backward + :desc "Spelling error" :nv "s" #'evil-prev-flyspell-error + :desc "Spelling correction" :n "S" #'flyspell-correct-previous-word-generic + :desc "Git conflict" :n "n" #'smerge-prev) + + (:desc "next..." :prefix "]" + :desc "Text size" :nv "]" #'text-scale-increase + :desc "Buffer" :nv "b" #'doom/next-buffer + :desc "Diff Hunk" :nv "d" #'git-gutter:next-hunk + :desc "Todo" :nv "t" #'hl-todo-next + :desc "Error" :nv "e" #'flycheck-next-error + :desc "Workspace" :nv "w" #'+workspace/switch-right + :desc "Smart jump" :nv "l" #'smart-forward + :desc "Spelling error" :nv "s" #'evil-next-flyspell-error + :desc "Spelling correction" :n "S" #'flyspell-correct-word-generic + :desc "Git conflict" :n "n" #'smerge-next) + + (:desc "search" :prefix "/" + :desc "Swiper" :nv "/" #'swiper + :desc "Imenu" :nv "i" #'imenu + :desc "Imenu across buffers" :nv "I" #'imenu-anywhere + :desc "Online providers" :nv "o" #'+lookup/online-select) + + (:desc "workspace" :prefix "TAB" + :desc "Display tab bar" :n "TAB" #'+workspace/display + :desc "New workspace" :n "n" #'+workspace/new + :desc "Load workspace from file" :n "l" #'+workspace/load + :desc "Load last session" :n "L" (λ! (+workspace/load-session)) + :desc "Save workspace to file" :n "s" #'+workspace/save + :desc "Autosave current session" :n "S" #'+workspace/save-session + :desc "Switch workspace" :n "." #'+workspace/switch-to + :desc "Kill all buffers" :n "x" #'doom/kill-all-buffers + :desc "Delete session" :n "X" #'+workspace/kill-session + :desc "Delete this workspace" :n "d" #'+workspace/delete + :desc "Load session" :n "L" #'+workspace/load-session + :desc "Next workspace" :n "]" #'+workspace/switch-right + :desc "Previous workspace" :n "[" #'+workspace/switch-left + :desc "Switch to 1st workspace" :n "1" (λ! (+workspace/switch-to 0)) + :desc "Switch to 2nd workspace" :n "2" (λ! (+workspace/switch-to 1)) + :desc "Switch to 3rd workspace" :n "3" (λ! (+workspace/switch-to 2)) + :desc "Switch to 4th workspace" :n "4" (λ! (+workspace/switch-to 3)) + :desc "Switch to 5th workspace" :n "5" (λ! (+workspace/switch-to 4)) + :desc "Switch to 6th workspace" :n "6" (λ! (+workspace/switch-to 5)) + :desc "Switch to 7th workspace" :n "7" (λ! (+workspace/switch-to 6)) + :desc "Switch to 8th workspace" :n "8" (λ! (+workspace/switch-to 7)) + :desc "Switch to 9th workspace" :n "9" (λ! (+workspace/switch-to 8)) + :desc "Switch to last workspace" :n "0" #'+workspace/switch-to-last) + + (:desc "buffer" :prefix "b" + :desc "New empty buffer" :n "n" #'evil-buffer-new + :desc "Switch workspace buffer" :n "b" #'switch-to-buffer + :desc "Switch buffer" :n "B" #'switch-to-buffer + :desc "Kill buffer" :n "k" #'doom/kill-this-buffer + :desc "Kill other buffers" :n "o" #'doom/kill-other-buffers + :desc "Save buffer" :n "s" #'save-buffer + :desc "Pop scratch buffer" :n "x" #'doom/open-scratch-buffer + :desc "Bury buffer" :n "z" #'bury-buffer + :desc "Next buffer" :n "]" #'doom/next-buffer + :desc "Previous buffer" :n "[" #'doom/previous-buffer + :desc "Sudo edit this file" :n "S" #'doom/sudo-this-file) + + (:desc "code" :prefix "c" + :desc "List errors" :n "x" #'flycheck-list-errors + :desc "Evaluate buffer/region" :n "e" #'+eval/buffer + :v "e" #'+eval/region + :desc "Evaluate & replace region" :nv "E" #'+eval:replace-region + :desc "Build tasks" :nv "b" #'+eval/build + :desc "Jump to definition" :n "d" #'+lookup/definition + :desc "Jump to references" :n "D" #'+lookup/references + :desc "Open REPL" :n "r" #'+eval/open-repl + :v "r" #'+eval:repl) + + (:desc "file" :prefix "f" + :desc "Find file" :n "." #'find-file + :desc "Sudo find file" :n ">" #'doom/sudo-find-file + :desc "Find file in project" :n "/" #'projectile-find-file + :desc "Find file from here" :n "?" #'counsel-file-jump + :desc "Find other file" :n "a" #'projectile-find-other-file + :desc "Open project editorconfig" :n "c" #'editorconfig-find-current-editorconfig + :desc "Find file in dotfiles" :n "d" #'+find-in-dotfiles + :desc "Find file in system config" :n "s" #'+find-in-system-config + :desc "Find file in home config" :n "h" #'+find-in-home-config + :desc "Browse dotfiles" :n "D" #'+hlissner/browse-dotfiles + :desc "Find file in emacs.d" :n "e" #'+find-in-doomd + :desc "Browse emacs.d" :n "E" #'+hlissner/browse-doomd + :desc "Recent files" :n "r" #'recentf-open-files + :desc "Recent project files" :n "R" #'projectile-recentf + :desc "Yank filename" :n "y" #'+hlissner/yank-buffer-filename) + + (:desc "git" :prefix "g" + :desc "Git status" :n "S" #'magit-status + :desc "Git blame" :n "b" #'magit-blame + :desc "Git time machine" :n "t" #'git-timemachine-toggle + :desc "Git stage hunk" :n "s" #'git-gutter:stage-hunk + :desc "Git revert hunk" :n "r" #'git-gutter:revert-hunk + :desc "Git revert buffer" :n "R" #'vc-revert + ;; :desc "List gists" :n "g" #'+gist:list + :desc "Git grep" :n "g" #'counsel-projectile-rg + :desc "Checkout Branch" :n "c" #'counsel-git-checkout + :desc "Next hunk" :nv "]" #'git-gutter:next-hunk + :desc "Previous hunk" :nv "[" #'git-gutter:previous-hunk + + (:desc "smerge" :prefix "m" + :desc "Keep Current" :n "SPC" #'smerge-keep-current + :desc "Keep All" :n "a" #'smerge-keep-all + :desc "Keep Upper" :n "u" #'smerge-keep-upper + :desc "Keep Lower" :n "l" #'smerge-keep-lower)) + + (:desc "help" :prefix "h" + :n "h" help-map + :desc "Apropos" :n "a" #'apropos + :desc "Reload theme" :n "R" #'doom//reload-theme + :desc "Find library" :n "l" #'find-library + :desc "Toggle Emacs log" :n "m" #'doom/popup-toggle-messages + :desc "Command log" :n "L" #'global-command-log-mode + :desc "Describe function" :n "f" #'describe-function + :desc "Describe key" :n "k" #'describe-key + :desc "Describe char" :n "c" #'describe-char + :desc "Describe mode" :n "M" #'describe-mode + :desc "Describe variable" :n "v" #'describe-variable + :desc "Describe face" :n "F" #'describe-face + :desc "Describe DOOM setting" :n "s" #'doom/describe-setting + :desc "Describe DOOM module" :n "d" #'doom/describe-module + :desc "Find definition" :n "." #'+lookup/definition + :desc "Find references" :n "/" #'+lookup/references + :desc "Find documentation" :n "h" #'+lookup/documentation + :desc "What face" :n "'" #'doom/what-face + :desc "What minor modes" :n ";" #'doom/what-minor-mode + :desc "Info" :n "i" #'info + :desc "Toggle profiler" :n "p" #'doom/toggle-profiler) + + (:desc "insert" :prefix "i" + :desc "From kill-ring" :nv "y" #'counsel-yank-pop + :desc "From snippet" :nv "s" #'yas-insert-snippet) + + (:desc "notes" :prefix "n" + :desc "Agenda" :n "a" #'org-agenda + :desc "Find file in notes" :n "n" #'+find-in-notes + :desc "Store link" :n "l" #'org-store-link + :desc "Browse notes" :n "N" #'+hlissner/browse-notes + :desc "Org capture" :n "x" #'+org-capture/open + :desc "Create clubhouse story" :n "c" #'org-tracker-create-issue + :desc "Archive subtree" :n "k" #'org-archive-subtree + :desc "Goto clocked-in note" :n "g" #'org-clock-goto + :desc "Clock Out" :n "o" #'org-clock-out) + + + (:desc "open" :prefix "o" + :desc "Default browser" :n "b" #'browse-url-of-file + :desc "Debugger" :n "d" #'+debug/open + :desc "Terminal in project" :n "T" #'+term/open-popup-in-project + + :desc "Slack IM" :n "i" #'slack-im-select + :desc "Slack Channel" :n "c" #'slack-channel-select + :desc "Slack Group" :n "g" #'slack-group-select + :desc "Slack Unreads" :n "u" #'slack-select-unread-rooms + :desc "Slack Threads" :n "r" #'slack-all-threads + + :desc "Email" :n "m" #'notmuch-tree-jump-search + + (:desc "ERC" :prefix "e" + :desc "Channel" :n "c" #'erc-switch-to-buffer) + + ;; applications + :desc "APP: elfeed" :n "E" #'=rss + :desc "APP: twitter" :n "T" #'=twitter + + (:desc "spotify" :prefix "s" + :desc "Search track" :n "t" #'counsel-spotify-search-track + :desc "Search album" :n "a" #'counsel-spotify-search-album + :desc "Search artist" :n "A" #'counsel-spotify-search-artist) + + ;; macos + (:when IS-MAC + :desc "Reveal in Finder" :n "o" #'+macos/reveal-in-finder + :desc "Reveal project in Finder" :n "O" #'+macos/reveal-project-in-finder + :desc "Send to Transmit" :n "u" #'+macos/send-to-transmit + :desc "Send project to Transmit" :n "U" #'+macos/send-project-to-transmit + :desc "Send to Launchbar" :n "l" #'+macos/send-to-launchbar + :desc "Send project to Launchbar" :n "L" #'+macos/send-project-to-launchbar)) + + (:desc "Email" :prefix "M" + :desc "Compose" :n "m" #'+notmuch/compose) + + (:desc "project" :prefix "p" + :desc "Browse project" :n "." (find-file-in! (doom-project-root)) + :desc "Find file in project" :n "/" #'projectile-find-file + :desc "Run cmd in project root" :nv "!" #'projectile-run-shell-command-in-root + :desc "Switch project" :n "p" #'projectile-switch-project + :desc "Recent project files" :n "r" #'projectile-recentf + :desc "List project tasks" :n "t" #'+ivy/tasks + :desc "Pop term in project" :n "o" #'+term/open-popup-in-project + :desc "Invalidate cache" :n "x" #'projectile-invalidate-cache) + + (:desc "quit" :prefix "q" + :desc "Quit" :n "q" #'evil-save-and-quit + :desc "Quit (forget session)" :n "Q" #'+workspace/kill-session-and-quit) + + (:desc "remote" :prefix "r" + :desc "Upload local" :n "u" #'+upload/local + :desc "Upload local (force)" :n "U" (λ! (+upload/local t)) + :desc "Download remote" :n "d" #'+upload/remote-download + :desc "Diff local & remote" :n "D" #'+upload/diff + :desc "Browse remote files" :n "." #'+upload/browse + :desc "Detect remote changes" :n ">" #'+upload/check-remote) + + (:desc "snippets" :prefix "s" + :desc "New snippet" :n "n" #'yas-new-snippet + :desc "Insert snippet" :nv "i" #'yas-insert-snippet + :desc "Find snippet for mode" :n "s" #'yas-visit-snippet-file + :desc "Find snippet" :n "S" #'+find-in-snippets) + + (:desc "toggle" :prefix "t" + :desc "Flyspell" :n "s" #'flyspell-mode + :desc "Flycheck" :n "f" #'flycheck-mode + :desc "Line numbers" :n "l" #'doom/toggle-line-numbers + :desc "Fullscreen" :n "f" #'doom/toggle-fullscreen + :desc "Indent guides" :n "i" #'highlight-indentation-mode + :desc "Indent guides (column)" :n "I" #'highlight-indentation-current-column-mode + :desc "Impatient mode" :n "h" #'+impatient-mode/toggle + :desc "Big mode" :n "b" #'doom-big-font-mode + :desc "Evil goggles" :n "g" #'+evil-goggles/toggle)) + + + ;; --- vim-vinegar + :n "-" #'grfn/dired-minus + (:after dired-mode + (:map dired-mode-map + "-" #'grfn/dired-minus)) + + (:map smartparens-mode-map + :n "g o" #'sp-raise-sexp) + + ;; --- vim-sexp-mappings-for-regular-people + (:after paxedit + (:map paxedit-mode-map + :i ";" #'paxedit-insert-semicolon + :i "(" #'paxedit-open-round + :i "[" #'paxedit-open-bracket + :i "{" #'paxedit-open-curly + :n [remap evil-yank-line] #'paxedit-copy + :n [remap evil-delete-line] #'+grfn/paxedit-kill + :n "g o" #'paxedit-sexp-raise + :n [remap evil-join-whitespace] #'paxedit-compress + :n "g S" #'paxedit-format-1 + :n "g k" #'paxedit-backward-up + :n "g j" #'paxedit-backward-end)) + + ;; --- vim-splitjoin + :n [remap evil-join-whitespace] #'+splitjoin/join + :n "gS" #'+splitjoin/split + + ;; --- Personal vim-esque bindings ------------------ + :n "zx" #'doom/kill-this-buffer + :n "ZX" #'bury-buffer + :n "]b" #'doom/next-buffer + :n "[b" #'doom/previous-buffer + :n "]w" #'+workspace/switch-right + :n "[w" #'+workspace/switch-left + :m "gt" #'+workspace/switch-right + :m "gT" #'+workspace/switch-left + :m "gd" #'+lookup/definition + :m "gD" #'+lookup/references + :m "K" #'+lookup/documentation + :n "gp" #'+evil/reselect-paste + :n "gr" #'+eval:region + :n "gR" #'+eval/buffer + :v "gR" #'+eval:replace-region + :v "@" #'+evil:macro-on-all-lines + :n "g@" #'+evil:macro-on-all-lines + ;; repeat in visual mode (FIXME buggy) + :v "." #'evil-repeat + ;; don't leave visual mode after shifting + ;; :v "<" #'+evil/visual-dedent ; vnoremap < <gv + ;; :v ">" #'+evil/visual-indent ; vnoremap > >gv + ;; paste from recent yank register (which isn't overwritten) + :v "C-p" "\"0p" + + (:map evil-window-map ; prefix "C-w" + ;; Navigation + "C-h" #'evil-window-left + "C-j" #'evil-window-down + "C-k" #'evil-window-up + "C-l" #'evil-window-right + "C-w" #'ace-window + ;; Swapping windows + "H" #'+evil/window-move-left + "J" #'+evil/window-move-down + "K" #'+evil/window-move-up + "L" #'+evil/window-move-right + "C-S-w" #'ace-swap-window + ;; Window undo/redo + "u" #'winner-undo + "C-u" #'winner-undo + "C-r" #'winner-redo + "o" #'doom/window-enlargen + ;; Delete window + "c" #'+workspace/close-window-or-workspace + "C-C" #'ace-delete-window + ;; Popups + "p" #'doom/popup-toggle + "m" #'doom/popup-toggle-messages + "P" #'doom/popup-close-all) + + + ;; --- Plugin bindings ------------------------------ + ;; auto-yasnippet + :i [C-tab] #'aya-expand + :nv [C-tab] #'aya-create + + ;; company-mode (vim-like omnicompletion) + :i "C-SPC" #'+company/complete + (:prefix "C-x" + :i "C-l" #'+company/whole-lines + :i "C-k" #'+company/dict-or-keywords + :i "C-f" #'company-files + :i "C-]" #'company-etags + :i "s" #'company-ispell + :i "C-s" #'company-yasnippet + :i "C-o" #'company-capf + :i "C-n" #'company-dabbrev-code + :i "C-p" #'+company/dabbrev-code-previous) + (:after company + (:map company-active-map + ;; Don't interfere with `evil-delete-backward-word' in insert mode + "C-w" nil + "C-o" #'company-search-kill-others + "C-n" #'company-select-next + "C-p" #'company-select-previous + "C-h" #'company-quickhelp-manual-begin + "C-S-h" #'company-show-doc-buffer + "C-S-s" #'company-search-candidates + "C-s" #'company-filter-candidates + "C-SPC" #'company-complete-common + "C-h" #'company-quickhelp-manual-begin + [tab] #'company-complete-common-or-cycle + [backtab] #'company-select-previous + [escape] (λ! (company-abort) (evil-normal-state 1))) + ;; Automatically applies to `company-filter-map' + (:map company-search-map + "C-n" #'company-search-repeat-forward + "C-p" #'company-search-repeat-backward + "C-s" (λ! (company-search-abort) (company-filter-candidates)) + [escape] #'company-search-abort)) + + ;; counsel +; (:after counsel +; (:map counsel-ag-map +; [backtab] #'+ivy/wgrep-occur ; search/replace on results +; "C-SPC" #'ivy-call-and-recenter ; preview)) + + ;; evil-commentary + ;; :n "gc" #'evil-commentary + + ;; evil-exchange + :n "gx" #'evil-exchange + + ;; evil-magit + (:after evil-magit + :map (magit-status-mode-map magit-revision-mode-map) + :n "C-j" nil + :n "C-k" nil) + + ;; Smerge + :n "]n" #'smerge-next + :n "[n" #'smerge-prev + + ;; evil-mc + (:prefix "gz" + :nv "m" #'evil-mc-make-all-cursors + :nv "u" #'evil-mc-undo-all-cursors + :nv "z" #'+evil/mc-make-cursor-here + :nv "t" #'+evil/mc-toggle-cursors + :nv "n" #'evil-mc-make-and-goto-next-cursor + :nv "p" #'evil-mc-make-and-goto-prev-cursor + :nv "N" #'evil-mc-make-and-goto-last-cursor + :nv "P" #'evil-mc-make-and-goto-first-cursor + :nv "d" #'evil-mc-make-and-goto-next-match + :nv "D" #'evil-mc-make-and-goto-prev-match) + (:after evil-mc + :map evil-mc-key-map + :nv "C-n" #'evil-mc-make-and-goto-next-cursor + :nv "C-N" #'evil-mc-make-and-goto-last-cursor + :nv "C-p" #'evil-mc-make-and-goto-prev-cursor + :nv "C-P" #'evil-mc-make-and-goto-first-cursor) + + ;; evil-multiedit + :v "R" #'evil-multiedit-match-all + :n "M-d" #'evil-multiedit-match-symbol-and-next + :n "M-D" #'evil-multiedit-match-symbol-and-prev + :v "M-d" #'evil-multiedit-match-and-next + :v "M-D" #'evil-multiedit-match-and-prev + :nv "C-M-d" #'evil-multiedit-restore + (:after evil-multiedit + (:map evil-multiedit-state-map + "M-d" #'evil-multiedit-match-and-next + "M-D" #'evil-multiedit-match-and-prev + "RET" #'evil-multiedit-toggle-or-restrict-region) + (:map (evil-multiedit-state-map evil-multiedit-insert-state-map) + "C-n" #'evil-multiedit-next + "C-p" #'evil-multiedit-prev)) + + ;; evil-snipe + (:after evil-snipe + ;; Binding to switch to evil-easymotion/avy after a snipe + :map evil-snipe-parent-transient-map + "C-;" (λ! (require 'evil-easymotion) + (call-interactively + (evilem-create #'evil-snipe-repeat + :bind ((evil-snipe-scope 'whole-buffer) + (evil-snipe-enable-highlight) + (evil-snipe-enable-incremental-highlight)))))) + + ;; evil-surround + :v "S" #'evil-surround-region + :o "s" #'evil-surround-edit + :o "S" #'evil-Surround-edit + + ;; expand-region + :v "v" #'er/expand-region + :v "V" #'er/contract-region + + ;; flycheck + :m "]e" #'flycheck-next-error + :m "[e" #'flycheck-previous-error + (:after flycheck + :map flycheck-error-list-mode-map + :n "C-n" #'flycheck-error-list-next-error + :n "C-p" #'flycheck-error-list-previous-error + :n "j" #'flycheck-error-list-next-error + :n "k" #'flycheck-error-list-previous-error + :n "RET" #'flycheck-error-list-goto-error) + + ;; flyspell + :m "]S" #'flyspell-correct-word-generic + :m "[S" #'flyspell-correct-previous-word-generic + + ;; git-gutter + :m "]d" #'git-gutter:next-hunk + :m "[d" #'git-gutter:previous-hunk + + ;; git-timemachine + (:after git-timemachine + (:map git-timemachine-mode-map + :n "C-p" #'git-timemachine-show-previous-revision + :n "C-n" #'git-timemachine-show-next-revision + :n "[[" #'git-timemachine-show-previous-revision + :n "]]" #'git-timemachine-show-next-revision + :n "q" #'git-timemachine-quit + :n "gb" #'git-timemachine-blame)) + + ;; gist + (:after gist + :map gist-list-menu-mode-map + :n "RET" #'+gist/open-current + :n "b" #'gist-browse-current-url + :n "c" #'gist-add-buffer + :n "d" #'gist-kill-current + :n "f" #'gist-fork + :n "q" #'quit-window + :n "r" #'gist-list-reload + :n "s" #'gist-star + :n "S" #'gist-unstar + :n "y" #'gist-print-current-url) + + ;; helm + (:after helm + (:map helm-map + "ESC" nil + "C-S-n" #'helm-next-source + "C-S-p" #'helm-previous-source + "C-u" #'helm-delete-minibuffer-contents + "C-w" #'backward-kill-word + "C-r" #'evil-paste-from-register ; Evil registers in helm! Glorious! + "C-b" #'backward-word + [left] #'backward-char + [right] #'forward-char + [escape] #'helm-keyboard-quit + [tab] #'helm-execute-persistent-action) + + (:after helm-files + (:map helm-generic-files-map + :e "ESC" #'helm-keyboard-quit) + (:map helm-find-files-map + "C-w" #'helm-find-files-up-one-level + "TAB" #'helm-execute-persistent-action)) + + (:after helm-ag + (:map helm-ag-map + "<backtab>" #'helm-ag-edit))) + + ;; hl-todo + :m "]t" #'hl-todo-next + :m "[t" #'hl-todo-previous + + ;; ivy + (:after ivy + :map ivy-minibuffer-map + [escape] #'keyboard-escape-quit + "C-SPC" #'ivy-call-and-recenter + "TAB" #'ivy-partial + "M-v" #'yank + "M-z" #'undo + "C-r" #'evil-paste-from-register + "C-k" #'ivy-previous-line + "C-j" #'ivy-next-line + "C-l" #'ivy-alt-done + "C-w" #'ivy-backward-kill-word + "C-u" #'ivy-kill-line + "C-b" #'backward-word + "C-f" #'forward-word) + + ;; neotree + (:after neotree + :map neotree-mode-map + :n "g" nil + :n [tab] #'neotree-quick-look + :n "RET" #'neotree-enter + :n [backspace] #'evil-window-prev + :n "c" #'neotree-create-node + :n "r" #'neotree-rename-node + :n "d" #'neotree-delete-node + :n "j" #'neotree-next-line + :n "k" #'neotree-previous-line + :n "n" #'neotree-next-line + :n "p" #'neotree-previous-line + :n "h" #'+neotree/collapse-or-up + :n "l" #'+neotree/expand-or-open + :n "J" #'neotree-select-next-sibling-node + :n "K" #'neotree-select-previous-sibling-node + :n "H" #'neotree-select-up-node + :n "L" #'neotree-select-down-node + :n "G" #'evil-goto-line + :n "gg" #'evil-goto-first-line + :n "v" #'neotree-enter-vertical-split + :n "s" #'neotree-enter-horizontal-split + :n "q" #'neotree-hide + :n "R" #'neotree-refresh) + + ;; realgud + (:after realgud + :map realgud:shortkey-mode-map + :n "j" #'evil-next-line + :n "k" #'evil-previous-line + :n "h" #'evil-backward-char + :n "l" #'evil-forward-char + :m "n" #'realgud:cmd-next + :m "b" #'realgud:cmd-break + :m "B" #'realgud:cmd-clear + :n "c" #'realgud:cmd-continue) + + ;; rotate-text + :n "gs" #'rotate-text + + ;; smart-forward + :m "g]" #'smart-forward + :m "g[" #'smart-backward + + ;; undo-tree -- undo/redo for visual regions + :v "C-u" #'undo-tree-undo + :v "C-r" #'undo-tree-redo + + ;; yasnippet + (:after yasnippet + (:map yas-keymap + "C-e" #'+snippets/goto-end-of-field + "C-a" #'+snippets/goto-start-of-field + "<M-right>" #'+snippets/goto-end-of-field + "<M-left>" #'+snippets/goto-start-of-field + "<M-backspace>" #'+snippets/delete-to-start-of-field + [escape] #'evil-normal-state + [backspace] #'+snippets/delete-backward-char + [delete] #'+snippets/delete-forward-char-or-field) + (:map yas-minor-mode-map + :i "<tab>" yas-maybe-expand + :v "<tab>" #'+snippets/expand-on-region)) + + + ;; --- Major mode bindings -------------------------- + + ;; Markdown + (:after markdown-mode + (:map markdown-mode-map + ;; fix conflicts with private bindings + "<backspace>" nil + "<M-left>" nil + "<M-right>" nil)) + + ;; Rust + (:after rust + (:map rust-mode-map + "K" #'racer-describe + "g RET" #'cargo-process-test)) + + ;; Elixir + (:after alchemist + (:map elixir-mode-map + :n "K" #'alchemist-help-search-at-point + :n "g RET" #'alchemist-project-run-tests-for-current-file + :n "g \\" #'alchemist-mix-test-at-point + :n "g SPC" #'alchemist-mix-compile)) + + ;; Haskell + (:after haskell-mode + (:map haskell-mode-map + ;; :n "K" #'intero-info + :n "K" #'lsp-describe-thing-at-point + ;; :n "g d" #'lsp-ui-peek-find-definitions + :n "g d" #'lsp-ui-peek-find-definitions + :n "g R" #'lsp-find-references + ;; :n "g SPC" #'intero-repl-load + ;; :n "g y" #'lsp-ui- + )) + + ;; Javascript + ;; (:after rjsx-mode + ;; (:map rjsx-mode-map + ;; :n "g d" #'flow-minor-jump-to-definition + ;; :n "K" #'flow-minor-type-at-pos)) + + (:after js2-mode + (:map js2-mode-map + :n "g d" #'flow-minor-jump-to-definition + :n "K" #'flow-minor-type-at-pos)) + + ;; Elisp + (:map emacs-lisp-mode-map + :n "g SPC" #'eval-buffer + :n "g RET" (λ! () (ert t))) + + + ;; --- Custom evil text-objects --------------------- + :textobj "a" #'evil-inner-arg #'evil-outer-arg + :textobj "B" #'evil-textobj-anyblock-inner-block #'evil-textobj-anyblock-a-block + :textobj "i" #'evil-indent-plus-i-indent #'evil-indent-plus-a-indent + :textobj "I" #'evil-indent-plus-i-indent-up #'evil-indent-plus-a-indent-up + :textobj "J" #'evil-indent-plus-i-indent-up-down #'evil-indent-plus-a-indent-up-down + + + ;; --- Built-in plugins ----------------------------- + (:after comint + ;; TAB auto-completion in term buffers + :map comint-mode-map [tab] #'company-complete) + + (:after debug + ;; For elisp debugging + :map debugger-mode-map + :n "RET" #'debug-help-follow + :n "e" #'debugger-eval-expression + :n "n" #'debugger-step-through + :n "c" #'debugger-continue) + + (:map help-mode-map + :n "[[" #'help-go-back + :n "]]" #'help-go-forward + :n "o" #'ace-link-help + :n "q" #'quit-window + :n "Q" #'+ivy-quit-and-resume) + + (:after vc-annotate + :map vc-annotate-mode-map + :n "q" #'kill-this-buffer + :n "d" #'vc-annotate-show-diff-revision-at-line + :n "D" #'vc-annotate-show-changeset-diff-revision-at-line + :n "SPC" #'vc-annotate-show-log-revision-at-line + :n "]]" #'vc-annotate-next-revision + :n "[[" #'vc-annotate-prev-revision + :n "TAB" #'vc-annotate-toggle-annotation-visibility + :n "RET" #'vc-annotate-find-revision-at-line)) + +;; evil-easymotion +(after! evil-easymotion + (let ((prefix (concat doom-leader-key " /"))) + ;; NOTE `evilem-default-keybinds' unsets all other keys on the prefix (in + ;; motion state) + (evilem-default-keybindings prefix) + (evilem-define (kbd (concat prefix " n")) #'evil-ex-search-next) + (evilem-define (kbd (concat prefix " N")) #'evil-ex-search-previous) + (evilem-define (kbd (concat prefix " s")) #'evil-snipe-repeat + :pre-hook (save-excursion (call-interactively #'evil-snipe-s)) + :bind ((evil-snipe-scope 'buffer) + (evil-snipe-enable-highlight) + (evil-snipe-enable-incremental-highlight))) + (evilem-define (kbd (concat prefix " S")) #'evil-snipe-repeat-reverse + :pre-hook (save-excursion (call-interactively #'evil-snipe-s)) + :bind ((evil-snipe-scope 'buffer) + (evil-snipe-enable-highlight) + (evil-snipe-enable-incremental-highlight))))) + + +;; +;; Keybinding fixes +;; + +;; This section is dedicated to "fixing" certain keys so that they behave +;; properly, more like vim, or how I like it. + +(map! (:map input-decode-map + [S-iso-lefttab] [backtab] + (:unless window-system "TAB" [tab])) ; Fix TAB in terminal + + ;; I want C-a and C-e to be a little smarter. C-a will jump to + ;; indentation. Pressing it again will send you to the true bol. Same goes + ;; for C-e, except it will ignore comments and trailing whitespace before + ;; jumping to eol. + :i "C-a" #'doom/backward-to-bol-or-indent + :i "C-e" #'doom/forward-to-last-non-comment-or-eol + :i "C-u" #'doom/backward-kill-to-bol-and-indent + + ;; Emacsien motions for insert mode + :i "C-b" #'backward-word + :i "C-f" #'forward-word + + ;; Highjacks space/backspace to: + ;; a) balance spaces inside brackets/parentheses ( | ) -> (|) + ;; b) delete space-indented blocks intelligently + ;; c) do none of this when inside a string + ;; :i "SPC" #'doom/inflate-space-maybe + ;; :i [remap delete-backward-char] #'doom/deflate-space-maybe + ;; :i [remap newline] #'doom/newline-and-indent + + (:map org-mode-map + :i [remap doom/inflate-space-maybe] #'org-self-insert-command + "C-c C-x C-i" #'org-clock-in + "C-c C-x <C-i>" #'org-clock-in) + + (:map org-agenda-mode-map + "C-c C-x C-i" #'org-agenda-clock-in + "C-c C-x <C-i>" #'org-agenda-clock-in) + + ;; Restore common editing keys (and ESC) in minibuffer + (:map (minibuffer-local-map + minibuffer-local-ns-map + minibuffer-local-completion-map + minibuffer-local-must-match-map + minibuffer-local-isearch-map + evil-ex-completion-map + evil-ex-search-keymap + read-expression-map) + ;; [escape] #'abort-recursive-edit + "C-r" #'evil-paste-from-register + "C-a" #'move-beginning-of-line + "C-w" #'doom/minibuffer-kill-word + "C-u" #'doom/minibuffer-kill-line + "C-b" #'backward-word + "C-f" #'forward-word + "M-z" #'doom/minibuffer-undo) + + (:map messages-buffer-mode-map + "M-;" #'eval-expression + "A-;" #'eval-expression) + + (:map tabulated-list-mode-map + [remap evil-record-macro] #'doom/popup-close-maybe) + + (:after view + (:map view-mode-map "<escape>" #'View-quit-all))) + +(defun +sexp-transpose () + (interactive) + (case evil-this-operator + ('evil-shift-right (paxedit-transpose-forward)) + ('evil-shift-left (paxedit-transpose-backward)))) + +;; (defun nmap (&rest keys-and-ops) +;; (->> +;; (seq-partition keys-and-ops 2) +;; (seq-map +;; (lambda (k-op) +;; (let* ((k (car k-op)) +;; (op (cadr k-op)) +;; (prefix (substring k 0 1)) +;; (prefix-sym (lookup-key evil-normal-state-map prefix)) +;; (keyseq (substring k 1))) +;; (list keyseq prefix-sym op)))) +;; (seq-group-by #'car) +;; (seq-map +;; (lambda (k-ops) +;; (let* ((keyseq (car k-ops)) +;; (ops (cdr k-ops)) +;; (existing-binding (lookup-key evil-operator-state-map keyseq)) +;; (handler (λ! () +;; (if-let +;; ((oplist +;; (seq-find (lambda (op) +;; (equal (nth 1 op) +;; evil-this-operator)) +;; ops))) +;; (message "calling oplist") +;; (->> oplist (nth 2) funcall) +;; (when existing-binding +;; (funcall existing-binding)))))) +;; (if existing-binding +;; (progn +;; (define-key evil-operator-state-map +;; (vector 'remap existing-binding) +;; handler) +;; (define-key evil-motion-state-map +;; (vector 'remap existing-binding) +;; handler)) +;; (define-key evil-operator-state-map keyseq handler))))))) + +;; (nmap +;; ">e" #'paxedit-transpose-forward +;; "<e" #'paxedit-transpose-backward) + +(require 'paxedit) +(require 'general) +(general-evil-setup t) + +(nmap + ">" (general-key-dispatch 'evil-shift-right + "e" 'paxedit-transpose-forward + ")" 'sp-forward-slurp-sexp + "(" 'sp-backward-barf-sexp + "I" 'grfn/insert-at-sexp-end + ;; "a" 'grfn/insert-at-form-end + )) + +(nmap + "<" (general-key-dispatch 'evil-shift-left + "e" 'paxedit-transpose-backward + ")" 'sp-forward-barf-sexp + "(" 'sp-backward-slurp-sexp + "I" 'grfn/insert-at-sexp-start + ;; "a" 'grfn/insert-at-form-start + )) + + +(defmacro saving-excursion (&rest body) + `(λ! () (save-excursion ,@body))) + +(nmap "c" (general-key-dispatch 'evil-change + "r c" (saving-excursion (string-inflection-lower-camelcase)) + "r C" (saving-excursion (string-inflection-camelcase)) + "r m" (saving-excursion (string-inflection-camelcase)) + "r s" (saving-excursion (string-inflection-underscore)) + "r u" (saving-excursion (string-inflection-upcase)) + "r -" (saving-excursion (string-inflection-kebab-case)) + "r k" (saving-excursion (string-inflection-kebab-case)) + ;; "r ." (saving-excursion (string-inflection-dot-case)) + ;; "r ." (saving-excursion (string-inflection-space-case)) + ;; "r ." (saving-excursion (string-inflection-title-case)) + )) + + +(predd-defmulti eval-sexp (lambda (form) major-mode)) + +(predd-defmethod eval-sexp 'clojure-mode (form) + (cider-interactive-eval form)) + +(predd-defmethod eval-sexp 'emacs-lisp-mode (form) + (pp-eval-expression form)) + +(predd-defmulti eval-sexp-region (lambda (_beg _end) major-mode)) + +(predd-defmethod eval-sexp-region 'clojure-mode (beg end) + (cider-interactive-eval nil nil (list beg end))) + +(predd-defmethod eval-sexp-region 'emacs-lisp-mode (beg end) + (pp-eval-expression (read (buffer-substring beg end)))) + +(predd-defmulti eval-sexp-region-context (lambda (_beg _end _context) major-mode)) + +(predd-defmethod eval-sexp-region-context 'clojure-mode (beg end context) + (cider--eval-in-context (buffer-substring beg end))) + +(defun pp-eval-context-region (beg end context) + (interactive "r\nxContext: ") + (let* ((inner-expr (read (buffer-substring beg end))) + (full-expr (list 'let* context inner-expr))) + (pp-eval-expression full-expr))) + +(predd-defmethod eval-sexp-region-context 'emacs-lisp-mode (beg end context) + (pp-eval-context-region beg end context)) + +(predd-defmulti preceding-sexp (lambda () major-mode)) + +(predd-defmethod preceding-sexp 'clojure-mode () + (cider-last-sexp)) + +(predd-defmethod preceding-sexp 'emacs-lisp-mode () + (elisp--preceding-sexp)) + +(defun eval-sexp-at-point () + (interactive) + (let ((bounds (bounds-of-thing-at-point 'sexp))) + (eval-sexp-region (car bounds) + (cdr bounds)))) + +(defun eval-last-sexp (_) + (interactive) + (eval-sexp (preceding-sexp))) + +;;; + +(defun cider-insert-current-sexp-in-repl (&optional arg) + "Insert the expression at point in the REPL buffer. +If invoked with a prefix ARG eval the expression after inserting it" + (interactive "P") + (cider-insert-in-repl (cider-sexp-at-point) arg)) + +(evil-define-operator fireplace-send (beg end) + (cider-insert-current-sexp-in-repl nil nil (list beg end))) + +(defun +clojure-pprint-expr (form) + (format "(with-out-str (clojure.pprint/pprint %s))" + form)) + +(defun cider-eval-read-and-print-handler (&optional buffer) + "Make a handler for evaluating and reading then printing result in BUFFER." + (nrepl-make-response-handler + (or buffer (current-buffer)) + (lambda (buffer value) + (let ((value* (read value))) + (with-current-buffer buffer + (insert + (if (derived-mode-p 'cider-clojure-interaction-mode) + (format "\n%s\n" value*) + value*))))) + (lambda (_buffer out) (cider-emit-interactive-eval-output out)) + (lambda (_buffer err) (cider-emit-interactive-eval-err-output err)) + '())) + +(defun cider-eval-and-replace (beg end) + "Evaluate the expression in region and replace it with its result" + (interactive "r") + (let ((form (buffer-substring beg end))) + (cider-nrepl-sync-request:eval form) + (kill-region beg end) + (cider-interactive-eval + (+clojure-pprint-expr form) + (cider-eval-read-and-print-handler)))) + +(defun cider-eval-current-sexp-and-replace () + "Evaluate the expression at point and replace it with its result" + (interactive) + (apply #'cider-eval-and-replace (cider-sexp-at-point 'bounds))) + +;;; + +(evil-define-operator fireplace-eval (beg end) + (eval-sexp-region beg end)) + +(evil-define-operator fireplace-replace (beg end) + (cider-eval-and-replace beg end)) + +(evil-define-operator fireplace-eval-context (beg end) + (eval-sexp-region-context beg end)) + +;;; fireplace-esque eval binding +(nmap :keymaps 'cider-mode-map + "c" (general-key-dispatch 'evil-change + "p" (general-key-dispatch 'fireplace-eval + "p" 'cider-eval-sexp-at-point + "c" 'cider-eval-last-sexp + "d" 'cider-eval-defun-at-point + "r" 'cider-test-run-test) + "q" (general-key-dispatch 'fireplace-send + "q" 'cider-insert-current-sexp-in-repl + "c" 'cider-insert-last-sexp-in-repl) + "x" (general-key-dispatch 'fireplace-eval-context + "x" 'cider-eval-sexp-at-point-in-context + "c" 'cider-eval-last-sexp-in-context) + "!" (general-key-dispatch 'fireplace-replace + "!" 'cider-eval-current-sexp-and-replace + "c" 'cider-eval-last-sexp-and-replace) + "y" 'cider-copy-last-result)) + +;;; + +(nmap :keymaps 'emacs-lisp-mode-map + "c" (general-key-dispatch 'evil-change + "p" (general-key-dispatch 'fireplace-eval + "p" 'eval-sexp-at-point + "c" 'eval-last-sexp + "d" 'eval-defun + "r" 'cider-test-run-test) + "x" (general-key-dispatch 'fireplace-eval-context + "x" 'cider-eval-sexp-at-point-in-context + "c" 'cider-eval-last-sexp-in-context) + "!" (general-key-dispatch 'fireplace-replace + "!" 'cider-eval-current-sexp-and-replace + "c" 'cider-eval-last-sexp-and-replace) + "y" 'cider-copy-last-result)) + +(nmap :keymaps 'sly-mode-map + "c" (general-key-dispatch 'evil-change + "p" (general-key-dispatch 'sly-eval + ;; "p" 'eval-sexp-at-point + "c" 'sly-eval-last-expression + "d" 'sly-eval-defun + ;; "r" 'cider-test-run-test + ) + ;; "x" (general-key-dispatch 'fireplace-eval-context + ;; "x" 'cider-eval-sexp-at-point-in-context + ;; "c" 'cider-eval-last-sexp-in-context + ;; ) + ;; "!" (general-key-dispatch 'fireplace-replace + ;; "!" 'cider-eval-current-sexp-and-replace + ;; "c" 'cider-eval-last-sexp-and-replace) + ;; "y" 'cider-copy-last-result + )) + + +;; >) ; slurp forward +;; <) ; barf forward +;; <( ; slurp backward +;; >( ; slurp backward + +;; (require 'doom-themes) +(defun grfn/haskell-test-file-p () + (string-match-p (rx (and "Spec.hs" eol)) + (buffer-file-name))) + +(require 'haskell) + +(defun grfn/intero-run-main () + (interactive) + (intero-repl-load) + (intero-with-repl-buffer nil + (comint-simple-send + (get-buffer-process (current-buffer)) + "main"))) + +(defun grfn/run-clj-or-cljs-test () + (interactive) + (message "Running tests...") + (cl-case (cider-repl-type-for-buffer) + ('cljs + (cider-interactive-eval + "(with-out-str (cljs.test/run-tests))" + (nrepl-make-response-handler + (current-buffer) + (lambda (_ value) + (with-output-to-temp-buffer "*cljs-test-results*" + (print + (->> value + (s-replace "\"" "") + (s-replace "\\n" "\n"))))) + nil nil nil))) + (('clj 'multi) + (funcall-interactively + #'cider-test-run-ns-tests + nil)))) + +(defun cider-copy-last-result () + (interactive) + (cider-interactive-eval + "*1" + (nrepl-make-response-handler + (current-buffer) + (lambda (_ value) + (kill-new value) + (message "Copied last result (%s) to clipboard" + (if (= (length value) 1) "1 char" + (format "%d chars" (length value))))) + nil nil nil))) + + +(defun grfn/insert-new-src-block () + (interactive) + (let* ((current-src-block (org-element-at-point)) + (src-block-head (save-excursion + (goto-char (org-element-property + :begin current-src-block)) + (let ((line (thing-at-point 'line t))) + (if (not (s-starts-with? "#+NAME:" (s-trim line))) + line + (forward-line) + (thing-at-point 'line t))))) + (point-to-insert + (if-let (results-loc (org-babel-where-is-src-block-result)) + (save-excursion + (goto-char results-loc) + (org-element-property + :end + (org-element-at-point))) + (org-element-property :end (org-element-at-point))))) + (goto-char point-to-insert) + (insert "\n") + (insert src-block-head) + (let ((contents (point-marker))) + (insert "\n#+END_SRC\n") + (goto-char contents)))) + +(defun grfn/+org-insert-item (orig direction) + (interactive) + (if (and (org-in-src-block-p) + (equal direction 'below)) + (grfn/insert-new-src-block) + (funcall orig direction))) + +(advice-add #'+org--insert-item :around #'grfn/+org-insert-item) +;; (advice-add #'+org/insert-item-below :around +;; (lambda (orig) (grfn/+org-insert-item orig 'below))) + +(defun set-pdb-trace () + (interactive) + (end-of-line) + (insert (format "\n%simport pdb;pdb.set_trace()" + (make-string (python-indent-calculate-indentation) + ?\s))) + (evil-indent (line-beginning-position) + (line-end-position))) + +(map! + + (:map magit-mode-map + :n "#" 'forge-dispatch) + + (:map haskell-mode-map + :n "K" 'lsp-info-under-point + :n "g d" 'lsp-ui-peek-find-definitions + :n "g r" 'lsp-ui-peek-find-references + :n "g \\" '+haskell/repl + ;; :n "K" 'intero-info + ;; :n "g d" 'intero-goto-definition + ;; :n "g SPC" 'intero-repl-load + ;; :n "g \\" 'intero-repl + ;; :n "g y" 'intero-type-at + ;; :n "g RET" 'grfn/run-sputnik-test-for-file + + (:localleader + :desc "Apply action" :n "e" 'intero-repl-eval-region + :desc "Rename symbol" :n "r" 'intero-apply-suggestions)) + + (:map python-mode-map + :n "K" #'anaconda-mode-show-doc + :n "g SPC" #'+eval/buffer + :n "g RET" #'python-pytest-file + :n "g \\" #'+python/open-ipython-repl + [remap evil-commentary-yank] #'set-pdb-trace) + + (:after agda2-mode + (:map agda2-mode-map + :n "g SPC" 'agda2-load + :n "g d" 'agda2-goto-definition-keyboard + :n "] g" 'agda2-next-goal + :n "[ g" 'agda2-previous-goal + + (:localleader + :desc "Give" :n "SPC" 'agda2-give + :desc "Case Split" :n "c" 'agda2-make-case + :desc "Make Helper" :n "h" 'agda2-helper-function-type + :desc "Refine" :n "r" 'agda2-refine + :desc "Auto" :n "a" 'agda2-auto-maybe-all + :desc "Goal type and context" :n "t" 'agda2-goal-and-context + :desc "Goal type and context and inferred" :n ";" 'agda2-goal-and-context-and-inferred))) + + (:after clojure-mode + (:map clojure-mode-map + :n "] f" 'forward-sexp + :n "[ f" 'backward-sexp)) + + (:after cider-mode + (:map cider-mode-map + :n "g SPC" 'cider-eval-buffer + :n "g \\" 'cider-switch-to-repl-buffer + :n "K" 'cider-doc + :n "g K" 'cider-grimoire + :n "g d" 'cider-find-dwim + :n "C-w ]" 'cider-find-dwim-other-window + ;; :n "g RET" 'cider-test-run-ns-tests + :n "g RET" 'grfn/run-clj-or-cljs-test + + "C-c C-r r" 'cljr-add-require-to-ns + "C-c C-r i" 'cljr-add-import-to-ns + + (:localleader + ;; :desc "Inspect last result" :n "i" 'cider-inspect-last-result + ;; :desc "Search for documentation" :n "h s" 'cider-apropos-doc + :desc "Add require to ns" :n "n r" 'cljr-add-require-to-ns + :desc "Add import to ns" :n "n i" 'cljr-add-import-to-ns)) + (:map cider-repl-mode-map + :n "g \\" 'cider-switch-to-last-clojure-buffer)) + + (:after w3m + (:map w3m-mode-map + "/" #'evil-search-forward + "?" #'evil-search-backward + "r" #'w3m-reload-this-page)) + + (:after slack + (:map slack-message-buffer-mode-map + :i "<up>" #'slack-message-edit)) + + (:after org + :n "C-c C-x C-o" #'org-clock-out + (:map org-mode-map + [remap counsel-imenu] #'counsel-org-goto + "M-k" #'org-move-subtree-up + "M-j" #'org-move-subtree-down + (:localleader + :n "g" #'counsel-org-goto)) + + (:map org-capture-mode-map + :n "g RET" #'org-capture-finalize + :n "g \\" #'org-captue-refile)) + + (:map lsp-mode-map + :n "K" #'lsp-describe-thing-at-point + :n "g r" #'lsp-rename + (:localleader + :n "a" #'lsp-execute-code-action)) + + ) diff --git a/users/grfn/emacs.d/+commands.el b/users/grfn/emacs.d/+commands.el new file mode 100644 index 000000000000..518f185cb9c2 --- /dev/null +++ b/users/grfn/emacs.d/+commands.el @@ -0,0 +1,149 @@ +;; -*- lexical-binding: t; -*- + +(defalias 'ex! 'evil-ex-define-cmd) + +(defun delete-file-and-buffer () + "Kill the current buffer and deletes the file it is visiting." + (interactive) + (let ((filename (buffer-file-name))) + (when filename + (if (vc-backend filename) + (vc-delete-file filename) + (progn + (delete-file filename) + (message "Deleted file %s" filename) + (kill-buffer)))))) + +;;; Commands defined elsewhere +;;(ex! "al[ign]" #'+evil:align) +;;(ex! "g[lobal]" #'+evil:global) + +;;; Custom commands +;; Editing +(ex! "@" #'+evil:macro-on-all-lines) ; TODO Test me +(ex! "al[ign]" #'+evil:align) +(ex! "enhtml" #'+web:encode-html-entities) +(ex! "dehtml" #'+web:decode-html-entities) +(ex! "mc" #'+evil:mc) +(ex! "iedit" #'evil-multiedit-ex-match) +(ex! "na[rrow]" #'+evil:narrow-buffer) +(ex! "retab" #'+evil:retab) + +(ex! "glog" #'magit-log-buffer-file) + +;; External resources +;; TODO (ex! "db" #'doom:db) +;; TODO (ex! "dbu[se]" #'doom:db-select) +;; TODO (ex! "go[ogle]" #'doom:google-search) +(ex! "lo[okup]" #'+jump:online) +(ex! "dash" #'+lookup:dash) +(ex! "dd" #'+lookup:devdocs) +(ex! "http" #'httpd-start) ; start http server +(ex! "repl" #'+eval:repl) ; invoke or send to repl +;; TODO (ex! "rx" 'doom:regex) ; open re-builder +(ex! "sh[ell]" #'+eshell:run) +(ex! "t[mux]" #'+tmux:run) ; send to tmux +(ex! "tcd" #'+tmux:cd-here) ; cd to default-directory in tmux +(ex! "x" #'doom/open-project-scratch-buffer) + +;; GIT +(ex! "gist" #'+gist:send) ; send current buffer/region to gist +(ex! "gistl" #'+gist:list) ; list gists by user +(ex! "gbrowse" #'+vcs/git-browse) ; show file in github/gitlab +(ex! "gissues" #'+vcs/git-browse-issues) ; show github issues +(ex! "git" #'magit-status) ; open magit status window +(ex! "gstage" #'magit-stage) +(ex! "gunstage" #'magit-unstage) +(ex! "gblame" #'magit-blame) +(ex! "grevert" #'git-gutter:revert-hunk) + +;; Dealing with buffers +(ex! "clean[up]" #'doom/cleanup-buffers) +(ex! "k[ill]" #'doom/kill-this-buffer) +(ex! "k[ill]all" #'+hlissner:kill-all-buffers) +(ex! "k[ill]m" #'+hlissner:kill-matching-buffers) +(ex! "k[ill]o" #'doom/kill-other-buffers) +(ex! "l[ast]" #'doom/popup-restore) +(ex! "m[sg]" #'view-echo-area-messages) +(ex! "pop[up]" #'doom/popup-this-buffer) + +;; Project navigation +(ex! "a" #'projectile-toggle-between-implementation-and-test) +(ex! "as" #'projectile-find-implementation-or-test-other-window) +(ex! "av" #'projectile-find-implementation-or-test-other-window) +(ex! "cd" #'+hlissner:cd) +(cond ((featurep! :completion ivy) + (ex! "ag" #'+ivy:ag) + (ex! "agc[wd]" #'+ivy:ag-cwd) + (ex! "rg" #'+ivy:rg) + (ex! "rgc[wd]" #'+ivy:rg-cwd) + (ex! "sw[iper]" #'+ivy:swiper) + (ex! "todo" #'+ivy:todo)) + ((featurep! :completion helm) + (ex! "ag" #'+helm:ag) + (ex! "agc[wd]" #'+helm:ag-cwd) + (ex! "rg" #'+helm:rg) + (ex! "rgc[wd]" #'+helm:rg-cwd) + (ex! "sw[oop]" #'+helm:swoop) + (ex! "todo" #'+helm:todo))) + +;; Project tools +(ex! "build" #'+eval/build) +(ex! "debug" #'+debug/run) +(ex! "er[rors]" #'flycheck-list-errors) + +;; File operations +(ex! "cp" #'+evil:copy-this-file) +(ex! "mv" #'+evil:move-this-file) +(ex! "rm" #'+evil:delete-this-file) + +;; Sessions/tabs +(ex! "sclear" #'+workspace/kill-session) +(ex! "sl[oad]" #'+workspace:load-session) +(ex! "ss[ave]" #'+workspace:save-session) +(ex! "tabcl[ose]" #'+workspace:delete) +(ex! "tabclear" #'doom/kill-all-buffers) +(ex! "tabl[ast]" #'+workspace/switch-to-last) +(ex! "tabload" #'+workspace:load) +(ex! "tabn[ew]" #'+workspace:new) +(ex! "tabn[ext]" #'+workspace:switch-next) +(ex! "tabp[rev]" #'+workspace:switch-previous) +(ex! "tabr[ename]" #'+workspace:rename) +(ex! "tabs" #'+workspace/display) +(ex! "tabsave" #'+workspace:save) + +(ex! "scr[atch]" #'cider-scratch) + +;; Org-mode +(ex! "cap" #'+org-capture/dwim) + +(evil-define-command evil-alembic-revision (args) + (interactive "<a>") + (apply + #'generate-alembic-migration + (read-string "Message: ") + (s-split "\\s+" (or args "")))) +(ex! "arev[ision]" #'evil-alembic-revision) + +(evil-define-command evil-alembic-upgrade (&optional revision) + (interactive "<a>") + (alembic-upgrade (or revision "head"))) + +(ex! "aup[grade]" #'evil-alembic-upgrade) + +(evil-define-command evil-alembic-downgrade (&optional revision) + (interactive "<a>") + (alembic-downgrade revision)) + +(ex! "adown[grade]" #'evil-alembic-downgrade) + +(evil-define-command evil-alembic (args) + (interactive "<a>") + (run-alembic args)) + +(ex! "alemb[ic]" #'evil-alembic) + +;; Elixir +(add-hook! elixir-mode + (ex! "AV" #'alchemist-project-toggle-file-and-tests-other-window) + (ex! "A" #'alchemist-project-toggle-file-and-tests)) diff --git a/users/grfn/emacs.d/+private.el.gpg b/users/grfn/emacs.d/+private.el.gpg new file mode 100644 index 000000000000..6273c67d6ecd --- /dev/null +++ b/users/grfn/emacs.d/+private.el.gpg Binary files differdiff --git a/users/grfn/emacs.d/.gitignore b/users/grfn/emacs.d/.gitignore new file mode 100644 index 000000000000..1fd0e3988771 --- /dev/null +++ b/users/grfn/emacs.d/.gitignore @@ -0,0 +1,2 @@ +.authinfo.gpg ++private.el diff --git a/users/grfn/emacs.d/autoload/evil.el b/users/grfn/emacs.d/autoload/evil.el new file mode 100644 index 000000000000..319c93c05e47 --- /dev/null +++ b/users/grfn/emacs.d/autoload/evil.el @@ -0,0 +1,37 @@ +;;; /autoload/evil.el -*- lexical-binding: t; -*- +;;;###if (featurep! :feature evil) + +;;;###autoload (autoload '+hlissner:multi-next-line "/autoload/evil" nil t) +(evil-define-motion +hlissner:multi-next-line (count) + "Move down 6 lines." + :type line + (let ((line-move-visual (or visual-line-mode (derived-mode-p 'text-mode)))) + (evil-line-move (* 6 (or count 1))))) + +;;;###autoload (autoload '+hlissner:multi-previous-line "/autoload/evil" nil t) +(evil-define-motion +hlissner:multi-previous-line (count) + "Move up 6 lines." + :type line + (let ((line-move-visual (or visual-line-mode (derived-mode-p 'text-mode)))) + (evil-line-move (- (* 6 (or count 1)))))) + +;;;###autoload (autoload '+hlissner:cd "/autoload/evil" nil t) +(evil-define-command +hlissner:cd () + "Change `default-directory' with `cd'." + (interactive "<f>") + (cd input)) + +;;;###autoload (autoload '+hlissner:kill-all-buffers "/autoload/evil" nil t) +(evil-define-command +hlissner:kill-all-buffers (&optional bang) + "Kill all buffers. If BANG, kill current session too." + (interactive "<!>") + (if bang + (+workspace/kill-session) + (doom/kill-all-buffers))) + +;;;###autoload (autoload '+hlissner:kill-matching-buffers "/autoload/evil" nil t) +(evil-define-command +hlissner:kill-matching-buffers (&optional bang pattern) + "Kill all buffers matching PATTERN regexp. If BANG, only match project +buffers." + (interactive "<a>") + (doom/kill-matching-buffers pattern bang)) diff --git a/users/grfn/emacs.d/autoload/hlissner.el b/users/grfn/emacs.d/autoload/hlissner.el new file mode 100644 index 000000000000..87b2236d12c7 --- /dev/null +++ b/users/grfn/emacs.d/autoload/hlissner.el @@ -0,0 +1,53 @@ +;;; autoload/hlissner.el -*- lexical-binding: t; -*- + +;;;###autoload +(defun +hlissner/install-snippets () + "Install my snippets from https://github.com/hlissner/emacs-snippets into +private/hlissner/snippets." + (interactive) + (doom-fetch :github "hlissner/emacs-snippets" + (expand-file-name "snippets" (doom-module-path :private 'hlissner)))) + +;;;###autoload +(defun +hlissner/yank-buffer-filename () + "Copy the current buffer's path to the kill ring." + (interactive) + (if-let* ((filename (or buffer-file-name (bound-and-true-p list-buffers-directory)))) + (message (kill-new (abbreviate-file-name filename))) + (error "Couldn't find filename in current buffer"))) + +(defmacro +hlissner-def-finder! (name dir) + "Define a pair of find-file and browse functions." + `(progn + (defun ,(intern (format "+hlissner/find-in-%s" name)) () + (interactive) + (let ((default-directory ,dir) + projectile-project-name + projectile-require-project-root + projectile-cached-buffer-file-name + projectile-cached-project-root) + (call-interactively (command-remapping #'projectile-find-file)))) + (defun ,(intern (format "+hlissner/browse-%s" name)) () + (interactive) + (let ((default-directory ,dir)) + (call-interactively (command-remapping #'find-file)))))) + +;;;###autoload (autoload '+hlissner/find-in-templates "autoload/hlissner" nil t) +;;;###autoload (autoload '+hlissner/browse-templates "autoload/hlissner" nil t) +(+hlissner-def-finder! templates +file-templates-dir) + +;;;###autoload (autoload '+hlissner/find-in-snippets "autoload/hlissner" nil t) +;;;###autoload (autoload '+hlissner/browse-snippets "autoload/hlissner" nil t) +(+hlissner-def-finder! snippets +hlissner-snippets-dir) + +;;;###autoload (autoload '+hlissner/find-in-dotfiles "autoload/hlissner" nil t) +;;;###autoload (autoload '+hlissner/browse-dotfiles "autoload/hlissner" nil t) +(+hlissner-def-finder! dotfiles (expand-file-name ".dotfiles" "~")) + +;;;###autoload (autoload '+hlissner/find-in-emacsd "autoload/hlissner" nil t) +;;;###autoload (autoload '+hlissner/browse-emacsd "autoload/hlissner" nil t) +(+hlissner-def-finder! emacsd doom-emacs-dir) + +;;;###autoload (autoload '+hlissner/find-in-notes "autoload/hlissner" nil t) +;;;###autoload (autoload '+hlissner/browse-notes "autoload/hlissner" nil t) +(+hlissner-def-finder! notes +org-dir) diff --git a/users/grfn/emacs.d/clocked-in-elt.el b/users/grfn/emacs.d/clocked-in-elt.el new file mode 100644 index 000000000000..be4161441dce --- /dev/null +++ b/users/grfn/emacs.d/clocked-in-elt.el @@ -0,0 +1,17 @@ +;;; -*- lexical-binding: t; -*- +(load (expand-file-name "init" (or (getenv "EMACSDIR") + (expand-file-name + "../.emacs.d" + (file-name-directory (file-truename load-file-name)))))) + +(require 'org-clock) +(require 'org-element) + +(let ((item (or org-clock-marker + (car org-clock-history)))) + (when item + (with-current-buffer (marker-buffer item) + (goto-char (marker-position item)) + (let ((element (org-element-at-point))) + (when (eq 'headline (car element)) + (message "%s" (plist-get (cadr element) :raw-value))))))) diff --git a/users/grfn/emacs.d/clojure.el b/users/grfn/emacs.d/clojure.el new file mode 100644 index 000000000000..f001a3e12b68 --- /dev/null +++ b/users/grfn/emacs.d/clojure.el @@ -0,0 +1,53 @@ +;;; -*- lexical-binding: t; -*- + +(defun clojure-thing-at-point-setup () + (interactive) + ;; Used by cider-find-dwim to parse the symbol at point + (setq-local + thing-at-point-file-name-chars + (concat thing-at-point-file-name-chars + "><!?"))) + +(defun +grfn/clojure-setup () + ;; (flycheck-select-checker 'clj-kondo) + (require 'flycheck) + (push 'clojure-cider-kibit flycheck-disabled-checkers) + (push 'clojure-cider-eastwood flycheck-disabled-checkers) + (push 'clojure-cider-typed flycheck-disabled-checkers) + ) + +(after! clojure-mode + (define-clojure-indent + (PUT 2) + (POST 2) + (GET 2) + (PATCH 2) + (DELETE 2) + (context 2) + (checking 3) + (match 1) + (domonad 0) + (describe 1) + (before 1) + (it 2)) + + (add-hook 'clojure-mode-hook #'clojure-thing-at-point-setup) + (add-hook 'clojure-mode-hook #'+grfn/clojure-setup)) + +(use-package! flycheck-clojure + ;; :disabled t + :after (flycheck cider) + :config + (flycheck-clojure-setup)) + +(after! clj-refactor + (setq cljr-magic-requires :prompt + cljr-clojure-test-declaration "[clojure.test :refer :all]" + cljr-cljc-clojure-test-declaration"#?(:clj [clojure.test :refer :all] +:cljs [cljs.test :refer-macros [deftest is testing]])" + ) + (add-to-list + 'cljr-magic-require-namespaces + '("s" . "clojure.spec.alpha"))) + +(set-popup-rule! "^\\*cider-test-report" :size 0.4) diff --git a/users/grfn/emacs.d/company-sql.el b/users/grfn/emacs.d/company-sql.el new file mode 100644 index 000000000000..e623aa2de131 --- /dev/null +++ b/users/grfn/emacs.d/company-sql.el @@ -0,0 +1,299 @@ +;;; Commentary: +;;; TODO + +;;; Code: + +(require 'emacsql) +(require 'emacsql-psql) +(require 'dash) +(require 's) +(require 'cl-lib) + +;;; Config + +(defvar-local company-sql-db-host "localhost" + "Host of the postgresql database to query for autocomplete information") + +(defvar-local company-sql-db-port 5432 + "Port of the postgresql database to query for autocomplete information") + +(defvar-local company-sql-db-user "postgres" + "Username of the postgresql database to query for autocomplete information") + +(defvar-local company-sql-db-name nil + "PostgreSQL database name to query for autocomplete information") + +;;; DB Connection + +(defvar-local company-sql/connection nil) + +(defun company-sql/connect () + (unless company-sql/connection + (setq-local company-sql/connection + (emacsql-psql company-sql-db-name + :hostname company-sql-db-host + :username company-sql-db-user + :port (number-to-string company-sql-db-port)))) + company-sql/connection) + +;;; Utils + +(defmacro comment (&rest _)) + +(defun ->string (x) + (cond + ((stringp x) x) + ((symbolp x) (symbol-name x)))) + +(defun alist-get-equal (key alist) + "Like `alist-get', but uses `equal' instead of `eq' for comparing keys" + (->> alist + (-find (lambda (pair) (equal key (car pair)))) + (cdr))) + +;;; Listing relations + +(cl-defun company-sql/list-tables (conn) + (with-timeout (3) + (-map (-compose 'symbol-name 'car) + (emacsql conn + [:select [tablename] + :from pg_catalog:pg_tables + :where (and (!= schemaname '"information_schema") + (!= schemaname '"pg_catalog"))])))) + +(cl-defun company-sql/list-columns (conn) + (with-timeout (3) + (-map + (lambda (row) + (propertize (symbol-name (nth 0 row)) + 'table-name (nth 1 row) + 'data-type (nth 2 row))) + (emacsql conn + [:select [column_name + table_name + data_type] + :from information_schema:columns])))) + +;;; Keywords + +(defvar company-postgresql/keywords + (list +"a" "abort" "abs" "absent" "absolute" "access" "according" "action" "ada" "add" +"admin" "after" "aggregate" "all" "allocate" "also" "alter" "always" "analyse" +"analyze" "and" "any" "are" "array" "array_agg" "array_max_cardinality" "as" +"asc" "asensitive" "assertion" "assignment" "asymmetric" "at" "atomic" "attach" +"attribute" "attributes" "authorization" "avg" "backward" "base64" "before" +"begin" "begin_frame" "begin_partition" "bernoulli" "between" "bigint" "binary" +"bit" "bit_length" "blob" "blocked" "bom" "boolean" "both" "breadth" "by" "c" +"cache" "call" "called" "cardinality" "cascade" "cascaded" "case" "cast" +"catalog" "catalog_name" "ceil" "ceiling" "chain" "char" "character" +"characteristics" "characters" "character_length" "character_set_catalog" +"character_set_name" "character_set_schema" "char_length" "check" "checkpoint" +"class" "class_origin" "clob" "close" "cluster" "coalesce" "cobol" "collate" +"collation" "collation_catalog" "collation_name" "collation_schema" "collect" +"column" "columns" "column_name" "command_function" "command_function_code" +"comment" "comments" "commit" "committed" "concurrently" "condition" +"condition_number" "configuration" "conflict" "connect" "connection" +"connection_name" "constraint" "constraints" "constraint_catalog" +"constraint_name" "constraint_schema" "constructor" "contains" "content" +"continue" "control" "conversion" "convert" "copy" "corr" "corresponding" "cost" +"count" "covar_pop" "covar_samp" "create" "cross" "csv" "cube" "cume_dist" +"current" "current_catalog" "current_date" "current_default_transform_group" +"current_path" "current_role" "current_row" "current_schema" "current_time" +"current_timestamp" "current_transform_group_for_type" "current_user" "cursor" +"cursor_name" "cycle" "data" "database" "datalink" "date" +"datetime_interval_code" "datetime_interval_precision" "day" "db" "deallocate" +"dec" "decimal" "declare" "default" "defaults" "deferrable" "deferred" "defined" +"definer" "degree" "delete" "delimiter" "delimiters" "dense_rank" "depends" +"depth" "deref" "derived" "desc" "describe" "descriptor" "detach" +"deterministic" "diagnostics" "dictionary" "disable" "discard" "disconnect" +"dispatch" "distinct" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete" +"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly" +"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "do" "document" "domain" +"double" "drop" "dynamic" "dynamic_function" "dynamic_function_code" "each" +"element" "else" "empty" "enable" "encoding" "encrypted" "end" "end-exec" +"end_frame" "end_partition" "enforced" "enum" "equals" "escape" "event" "every" +"except" "exception" "exclude" "excluding" "exclusive" "exec" "execute" "exists" +"exp" "explain" "expression" "extension" "external" "extract" "false" "family" +"fetch" "file" "filter" "final" "first" "first_value" "flag" "float" "floor" +"following" "for" "force" "foreign" "fortran" "forward" "found" "frame_row" +"free" "freeze" "from" "fs" "full" "function" "functions" "fusion" "g" "general" +"generated" "get" "global" "go" "goto" "grant" "granted" "greatest" "group" +"grouping" "groups" "handler" "having" "header" "hex" "hierarchy" "hold" "hour" +"id" "identity" "if" "ignore" "ilike" "immediate" "immediately" "immutable" +"implementation" "implicit" "import" "in" "include" "including" "increment" +"indent" "index" "indexes" "indicator" "inherit" "inherits" "initially" "inline" +"inner" "inout" "input" "insensitive" "insert" "instance" "instantiable" +"instead" "int" "integer" "integrity" "intersect" "intersection" "interval" +"into" "invoker" "is" "isnull" "isolation" "join" "k" "key" "key_member" +"key_type" "label" "lag" "language" "large" "last" "last_value" "lateral" "lead" +"leading" "leakproof" "least" "left" "length" "level" "library" "like" +"like_regex" "limit" "link" "listen" "ln" "load" "local" "localtime" +"localtimestamp" "location" "locator" "lock" "locked" "logged" "lower" "m" "map" +"mapping" "match" "matched" "materialized" "max" "maxvalue" "max_cardinality" +"member" "merge" "message_length" "message_octet_length" "message_text" "method" +"min" "minute" "minvalue" "mod" "mode" "modifies" "module" "month" "more" "move" +"multiset" "mumps" "name" "names" "namespace" "national" "natural" "nchar" +"nclob" "nesting" "new" "next" "nfc" "nfd" "nfkc" "nfkd" "nil" "no" "none" +"normalize" "normalized" "not" "nothing" "notify" "notnull" "nowait" "nth_value" +"ntile" "null" "nullable" "nullif" "nulls" "number" "numeric" "object" +"occurrences_regex" "octets" "octet_length" "of" "off" "offset" "oids" "old" +"on" "only" "open" "operator" "option" "options" "or" "order" "ordering" +"ordinality" "others" "out" "outer" "output" "over" "overlaps" "overlay" +"overriding" "owned" "owner" "p" "pad" "parallel" "parameter" "parameter_mode" +"parameter_name" "parameter_ordinal_position" "parameter_specific_catalog" +"parameter_specific_name" "parameter_specific_schema" "parser" "partial" +"partition" "pascal" "passing" "passthrough" "password" "path" "percent" +"percentile_cont" "percentile_disc" "percent_rank" "period" "permission" +"placing" "plans" "pli" "policy" "portion" "position" "position_regex" "power" +"precedes" "preceding" "precision" "prepare" "prepared" "preserve" "primary" +"prior" "privileges" "procedural" "procedure" "procedures" "program" "public" +"publication" "quote" "range" "rank" "read" "reads" "real" "reassign" "recheck" +"recovery" "recursive" "ref" "references" "referencing" "refresh" "regr_avgx" +"regr_avgy" "regr_count" "regr_intercept" "regr_r2" "regr_slope" "regr_sxx" +"regr_sxy" "regr_syy" "reindex" "relative" "release" "rename" "repeatable" +"replace" "replica" "requiring" "reset" "respect" "restart" "restore" "restrict" +"result" "return" "returned_cardinality" "returned_length" +"returned_octet_length" "returned_sqlstate" "returning" "returns" "revoke" +"right" "role" "rollback" "rollup" "routine" "routines" "routine_catalog" +"routine_name" "routine_schema" "row" "rows" "row_count" "row_number" "rule" +"savepoint" "scale" "schema" "schemas" "schema_name" "scope" "scope_catalog" +"scope_name" "scope_schema" "scroll" "search" "second" "section" "security" +"select" "selective" "self" "sensitive" "sequence" "sequences" "serializable" +"server" "server_name" "session" "session_user" "set" "setof" "sets" "share" +"show" "similar" "simple" "size" "skip" "smallint" "snapshot" "some" "source" +"space" "specific" "specifictype" "specific_name" "sql" "sqlcode" "sqlerror" +"sqlexception" "sqlstate" "sqlwarning" "sqrt" "stable" "standalone" "start" +"state" "statement" "static" "statistics" "stddev_pop" "stddev_samp" "stdin" +"stdout" "storage" "strict" "strip" "structure" "style" "subclass_origin" +"submultiset" "subscription" "substring" "substring_regex" "succeeds" "sum" +"symmetric" "sysid" "system" "system_time" "system_user" "t" "table" "tables" +"tablesample" "tablespace" "table_name" "temp" "template" "temporary" "text" +"then" "ties" "time" "timestamp" "timezone_hour" "timezone_minute" "to" "token" +"top_level_count" "trailing" "transaction" "transactions_committed" +"transactions_rolled_back" "transaction_active" "transform" "transforms" +"translate" "translate_regex" "translation" "treat" "trigger" "trigger_catalog" +"trigger_name" "trigger_schema" "trim" "trim_array" "true" "truncate" "trusted" +"type" "types" "uescape" "unbounded" "uncommitted" "under" "unencrypted" "union" +"unique" "unknown" "unlink" "unlisten" "unlogged" "unnamed" "unnest" "until" +"untyped" "update" "upper" "uri" "usage" "user" "user_defined_type_catalog" +"user_defined_type_code" "user_defined_type_name" "user_defined_type_schema" +"using" "vacuum" "valid" "validate" "validator" "value" "values" "value_of" +"varbinary" "varchar" "variadic" "varying" "var_pop" "var_samp" "verbose" +"version" "versioning" "view" "views" "volatile" "when" "whenever" "where" +"whitespace" "width_bucket" "window" "with" "within" "without" "work" "wrapper" +"write" "xml" "xmlagg" "xmlattributes" "xmlbinary" "xmlcast" "xmlcomment" +"xmlconcat" "xmldeclaration" "xmldocument" "xmlelement" "xmlexists" "xmlforest" +"xmliterate" "xmlnamespaces" "xmlparse" "xmlpi" "xmlquery" "xmlroot" "xmlschema" +"xmlserialize" "xmltable" "xmltext" "xmlvalidate" "year" "yes" "zone")) + +;;; Company backend + +(cl-defun company-postgresql/candidates (prefix conn) + (-filter + (apply-partially #'s-starts-with? prefix) + (append (-map (lambda (s) + (propertize s 'company-postgresql-annotation "table")) + + (-map (lambda (s) + (propertize s 'company-postgresql-annotation + (format "%s.%s %s" + (get-text-property 0 'table-name s) + s + (-> + (get-text-property 0 'data-type s) + (->string) + (upcase))))) + (company-sql/list-columns conn)) + (-map (lambda (s) + (propertize s 'company-postgresql-annotation "keyword")) + company-postgresql/keywords))))) + +(defun company-postgresql (command &optional arg &rest _) + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'company-postgresql)) + (init (company-sql/connect)) + (prefix (company-grab-symbol)) + (annotation + (get-text-property 0 'company-postgresql-annotation arg)) + (candidates (company-postgresql/candidates + arg + (company-sql/connect))) + (duplicates t) + (ignore-case t))) + +;;; org-babel company sql + +(defvar-local org-company-sql/connections + ()) + +(defun org-company-sql/connect (conn-params) + (or (alist-get-equal conn-params org-company-sql/connections) + (let ((conn (apply 'emacsql-psql conn-params))) + (add-to-list 'org-company-sql/connections (cons conn-params conn)) + conn))) + +(defun org-company-sql/in-sql-source-block-p () + (let ((org-elt (org-element-at-point))) + (and (eq 'src-block (car org-elt)) + (equal "sql" (plist-get (cadr org-elt) + :language))))) + +(defun org-company-sql/parse-cmdline (cmdline) + (let* ((lexed (s-split (rx (one-or-more blank)) cmdline)) + (go (lambda (state tokens) + (if (null tokens) () + (let ((token (car tokens)) + (tokens (cdr tokens))) + (if (null state) + (if (s-starts-with? "-" token) + (funcall go token tokens) + (cons token (funcall go state tokens))) + (cons (cons state token) ; ("-h" . "localhost") + (funcall go nil tokens))))))) + (opts (funcall go nil lexed))) + opts)) + +(defun org-company-sql/source-block-conn-params () + (let* ((block-info (org-babel-get-src-block-info)) + (params (caddr block-info)) + (cmdline (alist-get :cmdline params)) + (parsed (org-company-sql/parse-cmdline cmdline)) + (opts (-filter #'listp parsed)) + (positional (-filter #'stringp parsed)) + (host (alist-get-equal "-h" opts)) + (port (or (alist-get-equal "-p" opts) + "5432")) + (dbname (or (alist-get-equal "-d" opts) + (car positional))) + (username (or (alist-get-equal "-U" opts) + (cadr positional)))) + (list dbname + :hostname host + :username username + :port port))) + +(defun org-company-sql/connection-for-source-block () + (org-company-sql/connect + (org-company-sql/source-block-conn-params))) + + +(defun company-ob-postgresql (command &optional arg &rest _) + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'company-ob-postgresql)) + (prefix (and (org-company-sql/in-sql-source-block-p) + (company-grab-symbol))) + (annotation (get-text-property 0 'company-postgresql-annotation arg)) + (candidates + (company-postgresql/candidates + arg + (org-company-sql/connection-for-source-block))) + (duplicates t) + (ignore-case t))) + +;;; + +(provide 'company-sql) diff --git a/users/grfn/emacs.d/config.el b/users/grfn/emacs.d/config.el new file mode 100644 index 000000000000..5312fd92b119 --- /dev/null +++ b/users/grfn/emacs.d/config.el @@ -0,0 +1,1083 @@ +;;; -*- lexical-binding: t; -*- + +;; I've swapped these keys on my keyboard +(setq x-super-keysym 'alt + x-alt-keysym 'meta) + +(setq user-mail-address "root@gws.fyi" + user-full-name "Griffin Smith") + +(let ((font-family (pcase system-type + ('darwin "MesloLGSDZ NF") + ('gnu/linux "Meslo LGSDZ Nerd Font")))) + (setq doom-font (font-spec :family font-family :size 14) + doom-big-font (font-spec :family font-family :size 24) + doom-big-font-increment 5 + doom-variable-pitch-font (font-spec :family "DejaVu Sans") + doom-unicode-font (font-spec :family font-family))) + +(require 's) + +(undefine-key! :keymaps 'doom-leader-map "/") + +(load! "utils") +(load! "company-sql") +(load! "show-matching-paren") +(load! "irc") +(load! "github-org") +(load! "org-gcal") +(load! "grid") +(load! "nix") +(load! "email") +(load! "cpp") +(load! "lisp") +(load! "clojure") +(load! "rust") +(load! "terraform") + +(require 'tvl) + +(add-hook! elixir-mode + (require 'flycheck-credo) + (setq flycheck-elixir-credo-strict t) + (flycheck-credo-setup) + + (require 'flycheck-mix) (flycheck-mix-setup) + + (require 'flycheck-dialyxir) (flycheck-dialyxir-setup) + + (flycheck-mode)) + +(setq +solarized-s-base03 "#002b36" + +solarized-s-base02 "#073642" + ;; emphasized content + +solarized-s-base01 "#586e75" + ;; primary content + +solarized-s-base00 "#657b83" + +solarized-s-base0 "#839496" + ;; comments + +solarized-s-base1 "#93a1a1" + ;; background highlight light + +solarized-s-base2 "#eee8d5" + ;; background light + +solarized-s-base3 "#fdf6e3" + + ;; Solarized accented colors + +solarized-yellow "#b58900" + +solarized-orange "#cb4b16" + +solarized-red "#dc322f" + +solarized-magenta "#d33682" + +solarized-violet "#6c71c4" + +solarized-blue "#268bd2" + +solarized-cyan "#2aa198" + +solarized-green "#859900" + + ;; Darker and lighter accented colors + ;; Only use these in exceptional circumstances! + +solarized-yellow-d "#7B6000" + +solarized-yellow-l "#DEB542" + +solarized-orange-d "#8B2C02" + +solarized-orange-l "#F2804F" + +solarized-red-d "#990A1B" + +solarized-red-l "#FF6E64" + +solarized-magenta-d "#93115C" + +solarized-magenta-l "#F771AC" + +solarized-violet-d "#3F4D91" + +solarized-violet-l "#9EA0E5" + +solarized-blue-d "#00629D" + +solarized-blue-l "#69B7F0" + +solarized-cyan-d "#00736F" + +solarized-cyan-l "#69CABF" + +solarized-green-d "#546E00" + +solarized-green-l "#B4C342") + +(defcustom theme-overrides nil + "Association list of override faces to set for different custom themes.") + +(defadvice load-theme (after theme-set-overrides activate) + (dolist (theme-settings theme-overrides) + (let ((theme (car theme-settings)) + (faces (cadr theme-settings))) + (if (member theme custom-enabled-themes) + (progn + (dolist (face faces) + (custom-theme-set-faces theme face))))))) + +(defun alist-set (alist-symbol key value) + "Set VALUE of a KEY in ALIST-SYMBOL." + (set alist-symbol (cons (list key value) (assq-delete-all key (eval alist-symbol))))) + +(comment + (custom-theme-set-faces 'grfn-solarized-light + `(font-lock-doc-face + ((t (:foreground ,+solarized-s-base1))))) + ++solarized-s-base1 +(custom-theme-) + (custom-face-get-current-spec 'font-lock-doc-face) + + ) + +(alist-set 'theme-overrides 'grfn-solarized-light + `((font-lock-doc-face ((t (:foreground ,+solarized-s-base1)))) + (font-lock-preprocessor-face ((t (:foreground ,+solarized-red)))) + (font-lock-keyword-face ((t (:foreground ,+solarized-green :bold nil)))) + (font-lock-builtin-face ((t (:foreground ,+solarized-s-base01 + :bold t)))) + + (elixir-attribute-face ((t (:foreground ,+solarized-blue)))) + (elixir-atom-face ((t (:foreground ,+solarized-cyan)))) + (linum ((t (:background ,+solarized-s-base2 :foreground ,+solarized-s-base1)))) + (line-number ((t (:background ,+solarized-s-base2 :foreground ,+solarized-s-base1)))) + (line-number-current-line ((t (:background ,+solarized-s-base2 :foreground ,+solarized-s-base1)))) + + (haskell-operator-face ((t (:foreground ,+solarized-green)))) + (haskell-keyword-face ((t (:foreground ,+solarized-cyan)))) + + (org-drawer ((t (:foreground ,+solarized-s-base1 + :bold t)))))) + +(setq solarized-use-variable-pitch nil + solarized-scale-org-headlines nil + solarized-use-less-bold t) + +(add-to-list 'custom-theme-load-path "~/.doom.d/themes") +(load-theme 'grfn-solarized-light t) + +(defface haskell-import-face `((t (:foreground ,+solarized-magenta))) "") + +(setq doom-theme 'grfn-solarized-light) +; (setq doom-theme 'doom-solarized-light) + +(add-hook! doom-post-init + (set-face-attribute 'bold nil :weight 'ultra-light) + (set-face-bold 'bold nil) + (enable-theme 'grfn-solarized-light)) + +(defun rx-words (&rest words) + (rx-to-string + `(and symbol-start (group (or ,@words)) symbol-end))) + +(font-lock-add-keywords + 'elixir-mode + `((,(rx-words "def" + "defp" + "test" + "describe" + "property" + "defrecord" + "defmodule" + "defstruct" + "defdelegate" + "defprotocol" + "defimpl" + "use" + "import" + "alias" + "require" + "assert" + "refute" + "assert_raise") + . + 'font-lock-preprocessor-face))) + +(font-lock-add-keywords + 'elixir-mode + `((,(rx-words "def" + "defp" + "test" + "describe" + "property" + "defrecord" + "defmodule" + "defstruct" + "defdelegate" + "use" + "import" + "alias" + "require" + "assert" + "refute" + "assert_raise") + . + 'font-lock-preprocessor-face))) + +(font-lock-add-keywords + 'haskell-mode + `((,(rx-words "import") . 'haskell-import-face))) + +;; (font-lock-add-keywords +;; 'haskell-mode +;; `((,(rx "-- |") . 'haskell-keyword-face))) + + +;; (load-file (let ((coding-system-for-read 'utf-8)) +;; (shell-command-to-string "agda-mode locate"))) + +(defvar +grfn-dir (file-name-directory load-file-name)) +(defvar +grfn-snippets-dir (expand-file-name "snippets/" +grfn-dir)) + +;; +(load! "+bindings") +(load! "+commands") +(load! "cpp") + + +(add-to-list 'load-path "/home/grfn/code/org-tracker") +(require 'org-tracker) +(use-package! org-tracker + :hook (org-mode . org-tracker-mode) + :config + (setq org-tracker-state-alist '(("INBOX" . "Inbox") + ("BACKLOG" . "Backlog") + ("TODO" . "Selected for Development") + ("ACTIVE" . "In Progress") + ("PR" . "Code Review") + ("DONE" . "Done")) + org-tracker-username "griffin@readyset.io" + org-tracker-claim-ticket-on-status-update '("ACTIVE" "PR" "DONE") + org-tracker-create-stories-with-labels 'existing) + + (defun org-tracker-headlines-from-assigned-to-me (level) + (interactive "*nLevel: ") + (funcall-interactively + #'org-tracker-headlines-from-search + level + "assignee = currentUser() and statusCategory = 2"))) + +(load! "+private") + +(require 'dash) + +(use-package! predd) + + +;; +;; Global config +;; + +(setq doom-modeline-buffer-file-name-style 'relative-to-project + doom-modeline-modal-icon nil + doom-modeline-github t) + +;; +;; Modules +;; + +(after! smartparens + ;; Auto-close more conservatively and expand braces on RET + (let ((unless-list '(sp-point-before-word-p + sp-point-after-word-p + sp-point-before-same-p))) + (sp-pair "'" nil :unless unless-list) + (sp-pair "\"" nil :unless unless-list)) + (sp-pair "{" nil :post-handlers '(("||\n[i]" "RET") ("| " " ")) + :unless '(sp-point-before-word-p sp-point-before-same-p)) + (sp-pair "(" nil :post-handlers '(("||\n[i]" "RET") ("| " " ")) + :unless '(sp-point-before-word-p sp-point-before-same-p)) + (sp-pair "[" nil :post-handlers '(("| " " ")) + :unless '(sp-point-before-word-p sp-point-before-same-p))) + +;; feature/snippets +(after! yasnippet + ;; Don't use default snippets, use mine. + (setq yas-snippet-dirs + (append (list '+grfn-snippets-dir) + (delq 'yas-installed-snippets-dir yas-snippet-dirs)))) + +(after! company + (setq company-idle-delay 0.2 + company-minimum-prefix-length 1)) + +(setq doom-modeline-height 12) + + + +;; Should really figure out which of these is correct, eventually + +(setq +solarized-s-base03 "#002b36" + +solarized-s-base02 "#073642" + ;; emphasized content + +solarized-s-base01 "#586e75" + ;; primary content + +solarized-s-base00 "#657b83" + +solarized-s-base0 "#839496" + ;; comments + +solarized-s-base1 "#93a1a1" + ;; background highlight light + +solarized-s-base2 "#eee8d5" + ;; background light + +solarized-s-base3 "#fdf6e3" + + ;; Solarized accented colors + +solarized-yellow "#b58900" + +solarized-orange "#cb4b16" + +solarized-red "#dc322f" + +solarized-magenta "#d33682" + +solarized-violet "#6c71c4" + +solarized-blue "#268bd2" + +solarized-cyan "#2aa198" + +solarized-green "#859900" + + ;; Darker and lighter accented colors + ;; Only use these in exceptional circumstances! + +solarized-yellow-d "#7B6000" + +solarized-yellow-l "#DEB542" + +solarized-orange-d "#8B2C02" + +solarized-orange-l "#F2804F" + +solarized-red-d "#990A1B" + +solarized-red-l "#FF6E64" + +solarized-magenta-d "#93115C" + +solarized-magenta-l "#F771AC" + +solarized-violet-d "#3F4D91" + +solarized-violet-l "#9EA0E5" + +solarized-blue-d "#00629D" + +solarized-blue-l "#69B7F0" + +solarized-cyan-d "#00736F" + +solarized-cyan-l "#69CABF" + +solarized-green-d "#546E00" + +solarized-green-l "#B4C342") + +(set-cursor-color +solarized-s-base02) + +(after! doom-theme + (set-face-foreground 'font-lock-doc-face +solarized-s-base1) + (set-face-foreground 'org-block +solarized-s-base00) + (set-face-foreground 'slack-message-output-header +solarized-s-base01) + (set-face-attribute 'slack-message-output-header nil :underline nil) + (set-face-attribute 'slack-message-output-text nil :height 1.0) + ) + +(after! solarized-theme + (set-face-foreground 'font-lock-doc-face +solarized-s-base1) + (set-face-foreground 'org-block +solarized-s-base00) + + (set-face-foreground 'slack-message-output-header +solarized-s-base01) + (set-face-attribute 'slack-message-output-header nil :underline nil) + (set-face-attribute 'slack-message-output-text nil :height 1.0) + ) + +(after! evil + (setq evil-shift-width 2)) + +(after! org + (load! "org-query") + (load! "org-config")) + +(after! magit + (setq git-commit-summary-max-length 50)) + +(after! ivy + ;; (setq ivy-re-builders-alist + ;; '((t . ivy--regex-fuzzy))) + ) + +(add-hook 'before-save-hook 'delete-trailing-whitespace) + +(after! paxedit + (add-hook! emacs-lisp-mode #'paxedit-mode) + (add-hook! clojure-mode #'paxedit-mode) + (add-hook! common-lisp-mode #'paxedit-mode)) + +(require 'haskell) + +(let ((m-symbols + '(("`mappend`" . "⊕") + ("<>" . "⊕") + ("`elem`" . "∈") + ("`notElem`" . "∉")))) + (dolist (item m-symbols) (add-to-list 'haskell-font-lock-symbols-alist item))) + +(setq haskell-font-lock-symbols t) + + +(add-hook! haskell-mode + ;; (intero-mode) + (lsp-mode) + ;; (flycheck-add-next-checker + ;; 'intero + ;; 'haskell-hlint) + (set-fill-column 80) + (setq evil-shift-width 2)) + +(auth-source-pass-enable) + +(require 'fill-column-indicator) +;;; * Column Marker +(defun sanityinc/fci-enabled-p () (symbol-value 'fci-mode)) + +(defvar sanityinc/fci-mode-suppressed nil) +(make-variable-buffer-local 'sanityinc/fci-mode-suppressed) + +(defadvice popup-create (before suppress-fci-mode activate) + "Suspend fci-mode while popups are visible" + (let ((fci-enabled (sanityinc/fci-enabled-p))) + (when fci-enabled + (setq sanityinc/fci-mode-suppressed fci-enabled) + (turn-off-fci-mode)))) + +(defadvice popup-delete (after restore-fci-mode activate) + "Restore fci-mode when all popups have closed" + (when (and sanityinc/fci-mode-suppressed + (null popup-instances)) + (setq sanityinc/fci-mode-suppressed nil) + (turn-on-fci-mode))) + + +;;; Javascript + +(require 'smartparens) + +(setq js-indent-level 2) + +(require 'prettier-js) +(after! prettier-js + (add-hook! rjsx-mode #'prettier-js-mode) + (add-hook! js2-mode #'prettier-js-mode) + (add-hook! json-mode #'prettier-js-mode) + (add-hook! css-mode #'prettier-js-mode)) + +(remove-hook 'js2-mode-hook 'tide-setup t) + +;; Set this to the mode you use, I use rjsx-mode +(add-hook 'rjsx-mode-hook #'flow/set-flow-executable t) + + +;; Auto-format Haskell on save, with a combination of hindent + brittany + +; (define-minor-mode brittany-haskell-mode +; :init-value nil +; :group 'haskell +; :lighter "Brittany-Haskell" +; :keymap '() +; ) + + +(require 'alert) +(setq alert-default-style 'libnotify) + +;; (setq slack-buffer-function #'switch-to-buffer) + +(setq projectile-test-suffix-function + (lambda (project-type) + (case project-type + ('haskell-stack "Test") + ('npm ".test") + (otherwise (projectile-test-suffix project-type))))) + +(setq projectile-create-missing-test-files 't) + +(after! magit + (map! :map magit-mode-map + ;; :n "] ]" #'magit-section-forward + ;; :n "[ [" #'magit-section-backward + ) + + (define-suffix-command magit-commit-wip () + (interactive) + (magit-commit-create '("-m" "wip"))) + + (transient-append-suffix + #'magit-commit + ["c"] + (list "W" "Commit WIP" #'magit-commit-wip)) + + (define-suffix-command magit-reset-head-back () + (interactive) + (magit-reset-mixed "HEAD~")) + + (define-suffix-command magit-reset-head-previous () + (interactive) + (magit-reset-mixed "HEAD@{1}")) + + (transient-append-suffix + #'magit-reset + ["f"] + (list "b" "Reset HEAD~" #'magit-reset-head-back)) + (transient-append-suffix + #'magit-reset + ["f"] + (list "o" "Reset HEAD@{1}" #'magit-reset-head-previous)) + + (defun magit-read-org-tracker-branch-name () + (when-let ((issue-id (org-tracker-clocked-in-issue-id))) + (let ((desc + (magit-read-string-ns + (format "Issue description (to go after gs/%s/)" + issue-id)))) + (format "gs/%s/%s" issue-id desc)))) + + (defun magit-read-org-tracker-branch-args () + (if-let ((issue-id (org-tracker-clocked-in-issue-id))) + (let ((start-point (magit-read-starting-point + "Create and checkout branch for Tracker issue" + nil + "origin/master"))) + (if (magit-rev-verify start-point) + (when-let ((desc (magit-read-org-tracker-branch-name))) + (list desc start-point)) + (user-error "Not a valid starting point: %s" choice))) + (user-error "No currently clocked-in tracker issue"))) + + (transient-define-suffix magit-checkout-org-tracker-branch (branch start-point) + (interactive (magit-read-org-tracker-branch-args)) + (magit-branch-and-checkout branch start-point)) + + (transient-define-suffix magit-rename-org-tracker-branch (old new) + (interactive + (let ((branch (magit-read-local-branch "Rename branch"))) + (list branch (magit-read-org-tracker-branch-name)))) + (when (and old new) + (magit-branch-rename old new))) + + (transient-append-suffix + #'magit-branch + ["c"] + (list "C" "Checkout Tracker branch" #'magit-checkout-org-tracker-branch)) + (transient-append-suffix + #'magit-branch + ["c"] + (list "M" "Rename branch to Tracker ticket" #'magit-rename-org-tracker-branch))) + +;; (defun grfn/split-window-more-sensibly (&optional window) +;; (let ((window (or window (selected-window)))) +;; (or (and (window-splittable-p window) +;; ;; Split window vertically. +;; (with-selected-window window +;; (split-window-right))) +;; (and (window-splittable-p window t) +;; ;; Split window horizontally. +;; (with-selected-window window +;; (split-window-right))) +;; (and (eq window (frame-root-window (window-frame window))) +;; (not (window-minibuffer-p window)) +;; ;; If WINDOW is the only window on its frame and is not the +;; ;; minibuffer window, try to split it vertically disregarding +;; ;; the value of `split-height-threshold'. +;; (let ((split-height-threshold 0)) +;; (when (window-splittable-p window) +;; (with-selected-window window +;; (split-window-below)))))))) + +(use-package! lsp-mode + :after (:any haskell-mode) + :config + (setq lsp-response-timeout 60) + :hook + (haskell-mode . lsp-mode)) + +(use-package! lsp-ui + :after lsp-mode + :config + (defun +grfn/lsp-ui-doc-frame-hook (frame window) + (set-frame-font (if doom-big-font-mode doom-big-font doom-font) + nil (list frame))) + (setq lsp-ui-flycheck-enable t + lsp-ui-doc-header nil + lsp-ui-doc-position 'top + lsp-ui-doc-alignment 'window + lsp-ui-doc-frame-hook '+grfn/lsp-ui-doc-frame-hook + lsp-ui-doc-max-width 150 + lsp-ui-doc-max-height 13) + (setq imenu-auto-rescan t) + (set-face-background 'lsp-ui-doc-background +solarized-s-base2) + (set-face-background 'lsp-face-highlight-read +solarized-s-base2) + (set-face-background 'lsp-face-highlight-write +solarized-s-base2) + :hook + (lsp-mode . lsp-ui-mode) + (lsp-ui-mode . flycheck-mode)) + +(use-package! company-lsp + :after (lsp-mode lsp-ui) + :config + (add-to-list #'company-backends #'company-lsp) + (setq company-lsp-async t)) + +(defun +grfn/haskell-mode-setup () + (interactive) + (flymake-mode -1) + (add-to-list 'flycheck-disabled-checkers 'haskell-ghc) + + (flycheck-remove-next-checker 'lsp 'haskell-ghc) + (flycheck-add-next-checker 'lsp '(warning . haskell-hlint)) + + ;; If there’s a 'hie.sh' defined locally by a project + ;; (e.g. to run HIE in a nix-shell), use it… + (when-let ((project-dir (locate-dominating-file default-directory "hie.sh"))) + (cl-flet + ((which (cmd) + (s-trim + (shell-command-to-string + (concat + "nix-shell " + (expand-file-name "shell.nix" project-dir) + " --run \"which " cmd "\" 2>/dev/null"))))) + (setq-local + lsp-haskell-process-path-hie (expand-file-name "hie.sh" project-dir) + haskell-hoogle-command (which "hoogle")))) + ;; … and only then setup the LSP. + (lsp)) + +(defun never-flymake-mode (orig &rest args) + (when (and (bound-and-true-p flymake-mode)) + (funcall orig 0) + (message "disabled flymake-mode"))) +(advice-add #'flymake-mode :around #'never-flymake-mode) + +(defun +grfn/wrap-lsp-haskell-process (argv) + (let* ((project-dir (locate-dominating-file + (buffer-file-name) + "hie.yaml")) + (shell-dot-nix (expand-file-name "shell.nix" project-dir))) + ;; (when (string-equal default-directory "/home/grfn/code/depot") + ;; (debug)) + (message "%s %s %s %s" + (buffer-file-name) + default-directory + project-dir + shell-dot-nix) + (if (file-exists-p shell-dot-nix) + `("bash" "-c" + ,(format "cd %s && nix-shell %s --run '%s'" + project-dir + shell-dot-nix + (s-join " " argv))) + argv))) + +(use-package! lsp-haskell + :after (lsp-mode lsp-ui haskell-mode) + ;; :hook + ;; (haskell-mode . lsp-haskell-enable) + :config + (setq lsp-haskell-process-path-hie "haskell-language-server-wrapper" + lsp-haskell-process-args-hie + '("-d" "-l" "/tmp/hie.log" "+RTS" "-M4G" "-H1G" "-K4G" "-A16M" "-RTS") + lsp-haskell-process-wrapper-function + #'+grfn/wrap-lsp-haskell-process) + (add-hook 'haskell-mode-hook #'+grfn/haskell-mode-setup 't)) + +(use-package! lsp-imenu + :after (lsp-mode lsp-ui) + :hook + (lsp-after-open . lsp-enable-imenu)) + +;; (use-package! counsel-etags +;; :ensure t +;; :init +;; (add-hook 'haskell-mode-hook +;; (lambda () +;; (add-hook 'after-save-hook +;; 'counsel-etags-virtual-update-tags 'append 'local))) +;; :config +;; (setq counsel-etags-update-interval 60) +;; ;; (push "build" counsel-etags-ignore-directories) +;; ) + +;; (use-package! evil-magit +;; :after (magit)) + +(use-package! writeroom-mode) + +(use-package! graphql-mode) + + +(require 'whitespace) +(setq whitespace-style '(face lines-tail)) +(global-whitespace-mode t) +(add-hook 'org-mode-hook (lambda () (whitespace-mode -1)) t) + +(set-face-foreground 'whitespace-line +solarized-red) +(set-face-attribute 'whitespace-line nil :underline 't) + +;; (set-face-background 'ivy-posframe +solarized-s-base3) +;; (set-face-foreground 'ivy-posframe +solarized-s-base01) + +(let ((base03 "#002b36") + (base02 "#073642") + (base01 "#586e75") + (base00 "#657b83") + (base0 "#839496") + (base1 "#93a1a1") + (base2 "#eee8d5") + (base3 "#fdf6e3") + (yellow "#b58900") + (orange "#cb4b16") + (red "#dc322f") + (magenta "#d33682") + (violet "#6c71c4") + (blue "#268bd2") + (cyan "#2aa198") + (green "#859900")) + (custom-set-faces + `(agda2-highlight-keyword-face ((t (:foreground ,green)))) + `(agda2-highlight-string-face ((t (:foreground ,cyan)))) + `(agda2-highlight-number-face ((t (:foreground ,violet)))) + `(agda2-highlight-symbol-face ((((background ,base3)) (:foreground ,base01)))) + `(agda2-highlight-primitive-type-face ((t (:foreground ,blue)))) + `(agda2-highlight-bound-variable-face ((t nil))) + `(agda2-highlight-inductive-constructor-face ((t (:foreground ,green)))) + `(agda2-highlight-coinductive-constructor-face ((t (:foreground ,yellow)))) + `(agda2-highlight-datatype-face ((t (:foreground ,blue)))) + `(agda2-highlight-field-face ((t (:foreground ,red)))) + `(agda2-highlight-function-face ((t (:foreground ,blue)))) + `(agda2-highlight-module-face ((t (:foreground ,yellow)))) + `(agda2-highlight-postulate-face ((t (:foreground ,blue)))) + `(agda2-highlight-primitive-face ((t (:foreground ,blue)))) + `(agda2-highlight-record-face ((t (:foreground ,blue)))) + `(agda2-highlight-dotted-face ((t nil))) + `(agda2-highlight-operator-face ((t nil))) + `(agda2-highlight-error-face ((t (:foreground ,red :underline t)))) + `(agda2-highlight-unsolved-meta-face ((t (:background ,base2)))) + `(agda2-highlight-unsolved-constraint-face ((t (:background ,base2)))) + `(agda2-highlight-termination-problem-face ((t (:background ,orange :foreground ,base03)))) + `(agda2-highlight-incomplete-pattern-face ((t (:background ,orange :foreground ,base03)))) + `(agda2-highlight-typechecks-face ((t (:background ,cyan :foreground ,base03)))))) + + +(after! cider + (setq cider-prompt-for-symbol nil + cider-font-lock-dynamically 't + cider-save-file-on-load 't) + ) + +(defun +org-clocked-in-element () + (when-let ((item (car org-clock-history))) + (save-mark-and-excursion + (with-current-buffer (marker-buffer item) + (goto-char (marker-position item)) + (org-element-at-point))))) + +(comment + (setq elt (+org-clocked-in-item)) + + (eq 'headline (car elt)) + (plist-get (cadr elt) :raw-value) + ) + +(defun +org-headline-title (headline) + (when (eq 'headline (car elt)) + (plist-get (cadr elt) :raw-value))) + +(setq +ligatures-extra-symbols + (append +ligatures-extra-symbols + '(:equal "≡" + :not-equal "≠" + :is "≣" + :isnt "≢" + :lte "≤" + :gte "≥" + :subseteq "⊆" + ))) + +(after! python + (set-pretty-symbols! 'python-mode :merge t + :equal "==" + :not-equal "!=" + :lte "<=" + :gte ">=" + :is "is" + :isnt "is not" + :subseteq "issubset" + + ;; doom builtins + + ;; Functional + :def "def" + :lambda "lambda" + ;; Types + :null "None" + :true "True" :false "False" + :int "int" :str "str" + :float "float" + :bool "bool" + :tuple "tuple" + ;; Flow + :not "not" + :in "in" :not-in "not in" + :and "and" :or "or" + :for "for" + :return "return" :yield "yield")) + +(use-package! sqlup-mode + :hook + (sql-mode-hook . sqlup-mode) + (sql-interactive-mode-hook . sqlup-mode)) + +(use-package! emacsql) +(use-package! emacsql-psql + :after (emacsql)) + +(use-package! pyimport + :after (python)) + +(use-package! blacken + :after (python) + :init + (add-hook #'python-mode-hook #'blacken-mode) + :config + (setq blacken-only-if-project-is-blackened t + blacken-allow-py36 t + blacken-line-length 100)) + +(after! python + (defun +python-setup () + (setq-local fill-column 100 + whitespace-line-column 100 + flycheck-disabled-checkers '(python-flake8) + flycheck-checker 'python-pylint)) + + (add-hook #'python-mode-hook #'+python-setup) + (add-hook #'python-mode-hook #'lsp) + (remove-hook #'python-mode-hook #'pipenv-mode)) + +; (use-package! w3m +; :config +; (setq browse-url-browser-function +; `(("^https://app.clubhouse.io.*" . browse-url-firefox) +; ("^https://github.com.*" . browse-url-firefox) +; (".*" . browse-url-firefox)))) + +(use-package! ob-http + :config + (add-to-list 'org-babel-load-languages '(http . t))) + +;; (use-package! ob-ipython +;; :after (pyimport) +;; :config +;; (add-to-list 'org-babel-load-languages '(ipython . t)) +;; (setq ob-ipython-command + ;; "/home/griffin/code/urb/ciml-video-classifier/bin/jupyter")) + +(use-package! counsel-spotify) + +(after! counsel + (map! [remap counsel-org-capture] #'org-capture + [remap org-capture] #'org-capture)) + +(use-package! evil-snipe :disabled t) +(evil-snipe-mode -1) + +(use-package! rainbow-mode) + +(use-package! org-alert + :disabled t + :config + (org-alert-enable) + (setq alert-default-style 'libnotify + org-alert-headline-title "org")) + +(use-package! ob-async) + +(use-package! org-recent-headings + :config + (map! :n "SPC n r" #'org-recent-headings-ivy)) + +(use-package! org-sticky-header + :after (org) + :hook (org-mode-hook . org-sticky-header-mode) + :config + (setq-default org-sticky-header-heading-star "●")) + +(enable-theme 'grfn-solarized-light) + +;;; this needs to be *after the theme*, or else I get no agenda items. +;;; whuuu?? +(load! "org-config") + + +;;; word-char +(add-hook! prog-mode + (modify-syntax-entry ?_ "w")) + +(add-hook! lisp-mode + (modify-syntax-entry ?- "w")) + +(after! flycheck + (put 'flycheck-python-pylint-executable 'safe-local-variable (lambda (_) t)) + (setq flycheck-error-list-minimum-level 'warn + flycheck-navigation-minimum-level 'warn)) + +(defvar alembic-command "alembic" + "Command to execute when running alembic") + +(defvar alembic-dir-fun (lambda () default-directory) + "Reference to a function whose return value will be used as the directory to + run Alembic in") + +(put 'alembic-command 'safe-local-variable (lambda (_) t)) +(put 'alembic-dir-fun 'safe-local-variable (lambda (_) t)) + +(defun make-alembic-command (args) + (if (functionp alembic-command) + (funcall alembic-command args) + (concat alembic-command " " args))) + +(defun +grfn/extract-alembic-migration-name (output) + (unless (string-match (rx (0+ anything) "Generating " + (group (one-or-more (not (syntax whitespace)))) + " ..." (one-or-more (syntax whitespace)) "done" + (0+ anything)) + output) + (user-error "Error: %s" output)) + (match-string-no-properties 1 output)) + +(defun -run-alembic (args) + (let* ((default-directory (funcall alembic-dir-fun)) + (command (make-alembic-command args)) + ;; (format "nix-shell --run 'alembic %s'" args) + ;; (format "%s %s" alembic-command args) + (res + (with-temp-buffer + (cons + (shell-command command t) + (s-replace-regexp + "^.*Nix search path entry.*$" "" + (buffer-string))))) + (exit-code (car res)) + (out (cdr res))) + ;; (if (= 0 exit-code) + ;; out + ;; (error "Error running %s: %s" command out)) + out + )) + +(comment + --exit-code + --bs + ) + +(defun run-alembic (args) + (interactive "sAlembic command: ") + (message "%s" (-run-alembic args))) + +(defun generate-alembic-migration (msg &rest args) + (interactive "sMessage: ") + (-> + (format "revision %s -m \"%s\"" + (s-join " " args) + msg) + (-run-alembic) + (+grfn/extract-alembic-migration-name) + (find-file-other-window))) + +(cl-defun alembic-upgrade (&optional revision &key namespace) + (interactive "sRevision: ") + (let ((default-directory (funcall alembic-dir-fun))) + (run-alembic (format "%s upgrade %s" + (if namespace (concat "-n " namespace) "") + (or revision "head"))))) + +(defun alembic-downgrade (revision) + (interactive "sRevision: ") + (let ((default-directory (funcall alembic-dir-fun))) + (run-alembic (format "downgrade %s" (or revision "head"))))) + +(use-package! gnuplot) +(use-package! gnuplot-mode :after gnuplot) +(use-package! string-inflection) + +(after! anaconda-mode + ;; (set-company-backend! 'anaconda-mode #'company-yasnippet) + ) + +;; (add-hook! python-mode +;; (capf)) + +(cl-defstruct pull-request url number title author repository) + +(defun grfn/num-inbox-items () + (length (org-elements-agenda-match "inbox" t))) + +(use-package! dhall-mode + :mode "\\.dhall\\'") + +(use-package! github-review + :after forge) + +(after! forge + (set-popup-rule! + "^\\*forge" + :size 0.75)) + +(defun grfn/org-add-db-connection-params () + (interactive) + (ivy-read + "DB to connect to: " + (-map (lambda (opts) + (propertize (symbol-name (car opts)) + 'header-args (cdr opts))) + db-connection-param-options) + :require-match t + :action + (lambda (opt) + (let ((header-args (get-text-property 0 'header-args opt))) + (org-set-property "header-args" header-args))))) + +(use-package! kubernetes + :commands (kubernetes-overview)) + +(use-package! k8s-mode + :hook (k8s-mode . yas-minor-mode)) + +(use-package! sx) + +;; (use-package! nix-update +;; :config +;; (map! (:map nix-mode-map +;; (:leader +;; :desc "Update fetcher" :nv #'nix-update-fetch)))) + + +(after! lsp-haskell + (lsp-register-client + (make-lsp--client + :new-connection (lsp-stdio-connection (lambda () (lsp-haskell--hie-command))) + :major-modes '(haskell-mode) + :server-id 'hie + ;; :multi-root t + ;; :initialization-options 'lsp-haskell--make-init-options + ) + ) + ) + +(solaire-global-mode -1) + +(use-package! wsd-mode) + +(use-package! metal-mercury-mode) +(use-package! flycheck-mercury + :after (metal-mercury-mode flycheck-mercury)) + +(use-package! direnv + :config (direnv-mode)) + +(after! erc + ;; (setq erc-autojoin-channels-alist '(("freenode.net" "#nixos" "#haskell" "##tvl"))) + ) + +(defun evil-disable-insert-state-bindings () + evil-disable-insert-state-bindings) + +;; (use-package! terraform-mode) +;; (use-package! company-terraform +;; :after terraform-mode +;; :config (company-terraform-init)) + +(use-package! znc + :config + (setq znc-servers + '(("znc.gws.fyi" 5000 t + ((freenode "glittershark" "Ompquy")))))) + +(use-package! jsonnet-mode + :config + (map! + (:map jsonnet-mode-map + (:n "g SPC" #'jsonnet-eval-buffer)))) + +(add-to-list 'safe-local-variable-values + '(truncate-lines . t)) + +(set-popup-rule! + "^\\*gud-" + :quit nil) diff --git a/users/grfn/emacs.d/cpp.el b/users/grfn/emacs.d/cpp.el new file mode 100644 index 000000000000..5b5dc8ead652 --- /dev/null +++ b/users/grfn/emacs.d/cpp.el @@ -0,0 +1,39 @@ +;;; -*- lexical-binding: t; -*- + + +(load! "google-c-style") + +(after! flycheck + (add-to-list 'flycheck-disabled-checkers 'c/c++-gcc) + (add-to-list 'flycheck-disabled-checkers 'c/c++-clang)) + +(defun +grfn/cpp-setup () + (when (s-starts-with? + "/home/grfn/code/depot/third_party/nix" + (buffer-file-name)) + (setq lsp-clients-clangd-executable "/home/grfn/code/depot/users/grfn/emacs.d/nix-clangd.sh" + lsp-clients-clangd-args nil) + (google-set-c-style) + (lsp) + (add-to-list 'flycheck-disabled-checkers 'c/c++-gcc) + (add-to-list 'flycheck-disabled-checkers 'c/c++-clang))) + +(add-hook 'c++-mode-hook #'+grfn/cpp-setup) + +(use-package! protobuf-mode) + +(use-package! clang-format+ + :config + (add-hook 'c-mode-common-hook #'clang-format+-mode)) + +(map! + (:map c++-mode-map + :leader + (:n "/ i" #'counsel-semantic-or-imenu))) + +(comment + (setq + lsp-clients-clangd-executable + "/home/grfn/code/depot/third_party/nix/clangd.sh" + lsp-clients-clangd-args nil) + ) diff --git a/users/grfn/emacs.d/email.el b/users/grfn/emacs.d/email.el new file mode 100644 index 000000000000..83076898b4dc --- /dev/null +++ b/users/grfn/emacs.d/email.el @@ -0,0 +1,42 @@ +;;; -*- lexical-binding: t; -*- + +(after! notmuch + (setq notmuch-saved-searches + '((:name "inbox" :query "tag:inbox tag:important not tag:trash" :key "i") + (:name "flagged" :query "tag:flagged" :key "f") + (:name "sent" :query "tag:sent" :key "s") + (:name "drafts" :query "tag:draft" :key "d") + + (:name "work" :query "tag:inbox and tag:important and path:work/**" + :key "w") + (:name "personal" :query "tag:inbox and tag:important and path:personal/**" + :key "p")) + message-send-mail-function 'message-send-mail-with-sendmail + message-sendmail-f-is-evil 't + message-sendmail-envelope-from 'header + message-sendmail-extra-arguments '("--read-envelope-from")) + + (add-hook! notmuch-message-mode-hook #'notmuch-company-setup)) + +(setq notmuch-saved-searches + '((:name "inbox" :query "tag:inbox tag:important not tag:trash" :key "i") + (:name "flagged" :query "tag:flagged" :key "f") + (:name "sent" :query "tag:sent" :key "s") + (:name "drafts" :query "tag:draft" :key "d") + + (:name "work" :query "tag:inbox and tag:important and path:work/**" + :key "w") + (:name "personal" :query "tag:inbox and tag:important and path:personal/**" + :key "p")) + message-send-mail-function 'message-send-mail-with-sendmail + message-sendmail-f-is-evil 't + message-sendmail-envelope-from 'header + message-sendmail-extra-arguments '("--read-envelope-from")) + +(set-popup-rule! "^\\*notmuch-saved-search-" + :ignore t) + +(set-popup-rule! (lambda (_ action) + (eq (car action) + 'display-buffer-same-window)) + :ignore t) diff --git a/users/grfn/emacs.d/github-org.el b/users/grfn/emacs.d/github-org.el new file mode 100644 index 000000000000..f4f9d2e37069 --- /dev/null +++ b/users/grfn/emacs.d/github-org.el @@ -0,0 +1,99 @@ +;;; -*- lexical-binding: t; -*- + +(require 'ghub) + +(defun grfn/alist->plist (alist) + (->> alist + (-mapcat (lambda (pair) + (list (intern (concat ":" (symbol-name (car pair)))) + (cdr pair)))))) + +;;; + +(cl-defstruct pull-request url number title author repository) + +(defun grfn/query-pulls (query) + (let ((resp (ghub-graphql "query reviewRequests($query: String!) { + reviewRequests: search( + type:ISSUE, + query: $query, + first: 100 + ) { + issueCount + nodes { + ... on PullRequest { + url + number + title + author { + login + ... on User { name } + } + repository { + name + owner { login } + } + } + } + } + }" `((query . ,query))))) + (->> resp + (alist-get 'data) + (alist-get 'reviewRequests) + (alist-get 'nodes) + (-map + (lambda (pr) + (apply + #'make-pull-request + (grfn/alist->plist pr))))))) + +(defun grfn/requested-changes ()) + +(defun grfn/pull-request->org-headline (format-string level pr) + (check-type format-string string) + (check-type level integer) + (check-type pr pull-request) + (s-format (concat (make-string level ?*) " " format-string) + 'aget + `((author . ,(or (->> pr (pull-request-author) (alist-get 'name)) + "no author")) + (owner . ,(->> pr (pull-request-repository) + (alist-get 'owner) + (alist-get 'login))) + (repo . ,(->> pr (pull-request-repository) (alist-get 'name))) + (pr-link . ,(org-make-link-string + (pull-request-url pr) + (pull-request-title pr))) + (today . ,(format-time-string "%Y-%m-%d %a"))))) + +(defun grfn/org-headlines-from-review-requests (level) + "Create org-mode headlines at LEVEL from all review-requested PRs on Github" + (interactive "*nLevel: ") + (let* ((prs (grfn/query-pulls + "is:open is:pr review-requested:glittershark archived:false")) + (text (mapconcat + (apply-partially + #'grfn/pull-request->org-headline + "TODO Review ${author}'s PR on ${owner}/${repo}: ${pr-link} :pr: +SCHEDULED: <${today}>" + level) prs "\n"))) + (save-mark-and-excursion + (insert text)) + (org-align-tags 't))) + +(defun grfn/org-headlines-from-requested-changes (level) + "Create org-mode headlines at LEVEL from all PRs with changes requested + on Github" + (interactive "*nLevel: ") + (let* ((prs (grfn/query-pulls + (concat "is:pr is:open author:glittershark archived:false " + "sort:updated-desc review:changes-requested"))) + (text (mapconcat + (apply-partially + #'grfn/pull-request->org-headline + "TODO Address review comments on ${pr-link} :pr: +SCHEDULED: <${today}>" + level) prs "\n"))) + (save-mark-and-excursion + (insert text)) + (org-align-tags 't))) diff --git a/users/grfn/emacs.d/google-c-style.el b/users/grfn/emacs.d/google-c-style.el new file mode 100644 index 000000000000..9bb12c61aae4 --- /dev/null +++ b/users/grfn/emacs.d/google-c-style.el @@ -0,0 +1,151 @@ +;;; google-c-style.el --- Google's C/C++ style for c-mode + +;; Keywords: c, tools + +;; google-c-style.el is Copyright (C) 2008 Google Inc. All Rights Reserved. +;; +;; It is free software; you can redistribute it and/or modify it under the +;; terms of either: +;; +;; a) the GNU General Public License as published by the Free Software +;; Foundation; either version 1, or (at your option) any later version, or +;; +;; b) the "Artistic License". + +;;; Commentary: + +;; Provides the google C/C++ coding style. You may wish to add +;; `google-set-c-style' to your `c-mode-common-hook' after requiring this +;; file. For example: +;; +;; (add-hook 'c-mode-common-hook 'google-set-c-style) +;; +;; If you want the RETURN key to go to the next line and space over +;; to the right place, add this to your .emacs right after the load-file: +;; +;; (add-hook 'c-mode-common-hook 'google-make-newline-indent) + +;;; Code: + +;; For some reason 1) c-backward-syntactic-ws is a macro and 2) under Emacs 22 +;; bytecode cannot call (unexpanded) macros at run time: +(eval-when-compile (require 'cc-defs)) + +;; Wrapper function needed for Emacs 21 and XEmacs (Emacs 22 offers the more +;; elegant solution of composing a list of lineup functions or quantities with +;; operators such as "add") +(defun google-c-lineup-expression-plus-4 (langelem) + "Indents to the beginning of the current C expression plus 4 spaces. + +This implements title \"Function Declarations and Definitions\" +of the Google C++ Style Guide for the case where the previous +line ends with an open parenthese. + +\"Current C expression\", as per the Google Style Guide and as +clarified by subsequent discussions, means the whole expression +regardless of the number of nested parentheses, but excluding +non-expression material such as \"if(\" and \"for(\" control +structures. + +Suitable for inclusion in `c-offsets-alist'." + (save-excursion + (back-to-indentation) + ;; Go to beginning of *previous* line: + (c-backward-syntactic-ws) + (back-to-indentation) + (cond + ;; We are making a reasonable assumption that if there is a control + ;; structure to indent past, it has to be at the beginning of the line. + ((looking-at "\\(\\(if\\|for\\|while\\)\\s *(\\)") + (goto-char (match-end 1))) + ;; For constructor initializer lists, the reference point for line-up is + ;; the token after the initial colon. + ((looking-at ":\\s *") + (goto-char (match-end 0)))) + (vector (+ 4 (current-column))))) + +;;;###autoload +(defconst google-c-style + `((c-recognize-knr-p . nil) + (c-enable-xemacs-performance-kludge-p . t) ; speed up indentation in XEmacs + (c-basic-offset . 2) + (indent-tabs-mode . nil) + (c-comment-only-line-offset . 0) + (c-hanging-braces-alist . ((defun-open after) + (defun-close before after) + (class-open after) + (class-close before after) + (inexpr-class-open after) + (inexpr-class-close before) + (namespace-open after) + (inline-open after) + (inline-close before after) + (block-open after) + (block-close . c-snug-do-while) + (extern-lang-open after) + (extern-lang-close after) + (statement-case-open after) + (substatement-open after))) + (c-hanging-colons-alist . ((case-label) + (label after) + (access-label after) + (member-init-intro before) + (inher-intro))) + (c-hanging-semi&comma-criteria + . (c-semi&comma-no-newlines-for-oneline-inliners + c-semi&comma-inside-parenlist + c-semi&comma-no-newlines-before-nonblanks)) + (c-indent-comments-syntactically-p . t) + (comment-column . 40) + (c-indent-comment-alist . ((other . (space . 2)))) + (c-cleanup-list . (brace-else-brace + brace-elseif-brace + brace-catch-brace + empty-defun-braces + defun-close-semi + list-close-comma + scope-operator)) + (c-offsets-alist . ((arglist-intro google-c-lineup-expression-plus-4) + (func-decl-cont . ++) + (member-init-intro . ++) + (inher-intro . ++) + (comment-intro . 0) + (arglist-close . c-lineup-arglist) + (topmost-intro . 0) + (block-open . 0) + (inline-open . 0) + (substatement-open . 0) + (statement-cont + . + (,(when (fboundp 'c-no-indent-after-java-annotations) + 'c-no-indent-after-java-annotations) + ,(when (fboundp 'c-lineup-assignments) + 'c-lineup-assignments) + ++)) + (label . /) + (case-label . +) + (statement-case-open . +) + (statement-case-intro . +) ; case w/o { + (access-label . /) + (innamespace . 0)))) + "Google C/C++ Programming Style.") + +;;;###autoload +(defun google-set-c-style () + "Set the current buffer's c-style to Google C/C++ Programming + Style. Meant to be added to `c-mode-common-hook'." + (interactive) + (make-local-variable 'c-tab-always-indent) + (setq c-tab-always-indent t) + (c-add-style "Google" google-c-style t)) + +;;;###autoload +(defun google-make-newline-indent () + "Sets up preferred newline behavior. Not set by default. Meant + to be added to `c-mode-common-hook'." + (interactive) + (define-key c-mode-base-map "\C-m" 'newline-and-indent) + (define-key c-mode-base-map [ret] 'newline-and-indent)) + +(provide 'google-c-style) +;;; google-c-style.el ends here diff --git a/users/grfn/emacs.d/grid.el b/users/grfn/emacs.d/grid.el new file mode 100644 index 000000000000..75776a38cd9d --- /dev/null +++ b/users/grfn/emacs.d/grid.el @@ -0,0 +1,128 @@ +;;; -*- lexical-binding: t; -*- + +(require 's) + +(defun grfn/all-match-groups (s) + (loop for n from 1 + for x = (match-string n s) + while x + collect x)) + +(defun projectile-grid-ff (path &optional ask) + "Call `find-file' function on PATH when it is not nil and the file exists. +If file does not exist and ASK in not nil it will ask user to proceed." + (if (or (and path (file-exists-p path)) + (and ask (yes-or-no-p + (s-lex-format + "File does not exists. Create a new buffer ${path} ?")))) + (find-file path))) + +(defun projectile-grid-goto-file (filepath &optional ask) + "Find FILEPATH after expanding root. ASK is passed straight to `projectile-grid-ff'." + (projectile-grid-ff (projectile-expand-root filepath) ask)) + +(defun projectile-grid-choices (ds) + "Uses `projectile-dir-files' function to find files in directories. +The DIRS is list of lists consisting of a directory path and regexp to filter files from that directory. +Optional third element can be present in the DS list. The third element will be a prefix to be placed before +the filename in the resulting choice. +Returns a hash table with keys being short names (choices) and values being relative paths to the files." + (loop with hash = (make-hash-table :test 'equal) + for (dir re prefix) in ds do + (loop for file in (projectile-dir-files (projectile-expand-root dir)) do + (when (string-match re file) + (puthash + (concat (or prefix "") + (s-join "/" (grfn/all-match-groups file))) + (concat dir file) + hash))) + finally return hash)) + +(defmacro projectile-grid-find-resource (prompt dirs &optional newfile-template) + "Presents files from DIRS with PROMPT to the user using `projectile-completing-read'. +If users chooses a non existant file and NEWFILE-TEMPLATE is not nil +it will use that variable to interpolate the name for the new file. +NEWFILE-TEMPLATE will be the argument for `s-lex-format'. +The bound variable is \"filename\"." + `(lexical-let ((choices (projectile-grid-choices ,dirs))) + (projectile-completing-read + ,prompt + (hash-table-keys choices) + :action + (lambda (c) + (let* ((filepath (gethash c choices)) + (filename c)) ;; so `s-lex-format' can interpolate FILENAME + (if filepath + (projectile-grid-goto-file filepath) + (when-let ((newfile-template ,newfile-template)) + (projectile-grid-goto-file + (funcall newfile-template filepath) + ;; (cond + ;; ((functionp newfile-template) (funcall newfile-template filepath)) + ;; ((stringp newfile-template) (s-lex-format newfile-template))) + t)))))))) + +(defun projectile-grid-find-model () + "Find a model." + (interactive) + (projectile-grid-find-resource + "model: " + '(("python/urbint_lib/models/" + "\\(.+\\)\\.py$") + ("python/urbint_lib/" + "\\(.+\\)/models/\\(.+\\).py$")) + (lambda (filename) + (pcase (s-split "/" filename) + (`(,model) + (s-lex-format "python/urbint_lib/models/${model}.py")) + (`(,app ,model) + (s-lex-format "python/urbint_lib/${app}/models/${model}.py")))))) + +(defun projectile-grid-find-repository () + "Find a repository." + (interactive) + (projectile-grid-find-resource + "repository: " + '(("python/urbint_lib/repositories/" + "\\(.+\\)\\.py$") + ("python/urbint_lib/" + "\\(.+\\)/repositories/\\(.+\\).py$")) + (lambda (filename) + (pcase (s-split "/" filename) + (`(,repository) + (s-lex-format "python/urbint_lib/repositories/${repository}.py")) + (`(,app ,repository) + (s-lex-format "python/urbint_lib/${app}/repositories/${repository}.py")))))) + +(defun projectile-grid-find-controller () + "Find a controller." + (interactive) + (projectile-grid-find-resource + "controller: " + '(("backend/src/grid/api/controllers/" + "\\(.+\\)\\.py$") + ("backend/src/grid/api/apps/" + "\\(.+\\)/controllers/\\(.+\\).py$")) + (lambda (filename) + (pcase (s-split "/" filename) + (`(,controller) + (s-lex-format "backend/src/grid/api/controllers/${controller}.py")) + (`(,app ,controller) + (s-lex-format "backend/src/grid/api/apps/${app}/controllers/${controller}.py")))))) + +(setq projectile-grid-mode-map + (let ((map (make-keymap))) + (map! + (:map map + (:leader + (:desc "Edit..." :prefix "e" + :desc "Model" :n "m" #'projectile-grid-find-model + :desc "Controller" :n "c" #'projectile-grid-find-controller + :desc "Repository" :n "r" #'projectile-grid-find-repository)))) + map)) + +(define-minor-mode projectile-grid-mode + "Minor mode for finding files in GRID" + :init-value nil + :lighter " GRID" + :keymap projectile-grid-mode-map) diff --git a/users/grfn/emacs.d/init.el b/users/grfn/emacs.d/init.el new file mode 100644 index 000000000000..563b455dff15 --- /dev/null +++ b/users/grfn/emacs.d/init.el @@ -0,0 +1,233 @@ +;;; -*- lexical-binding: t; -*- + +(doom! :completion + company ; the ultimate code completion backend + (ivy +fuzzy + +prescient) ; a search engine for love and life + + :ui + ;;deft ; notational velocity for Emacs + doom ; what makes DOOM look the way it does + ;doom-dashboard ; a nifty splash screen for Emacs + doom-quit ; DOOM quit-message prompts when you quit Emacs + ;fill-column ; a `fill-column' indicator + hl-todo ; highlight TODO/FIXME/NOTE tags + ;;indent-guides ; highlighted indent columns + modeline ; snazzy, Atom-inspired modeline, plus API + nav-flash ; blink the current line after jumping + ;;neotree ; a project drawer, like NERDTree for vim + ophints ; highlight the region an operation acts on + (popup ; tame sudden yet inevitable temporary windows + +all ; catch all popups that start with an asterix + +defaults) ; default popup rules + ligatures ; replace bits of code with pretty symbols + ;;tabbar ; FIXME an (incomplete) tab bar for Emacs + ;;treemacs ; a project drawer, like neotree but cooler + unicode ; extended unicode support for various languages + vc-gutter ; vcs diff in the fringe + vi-tilde-fringe ; fringe tildes to mark beyond EOB + window-select ; visually switch windows + workspaces ; tab emulation, persistence & separate workspaces + + :editor + (evil +everywhere); come to the dark side, we have cookies + file-templates ; auto-snippets for empty files + fold ; (nigh) universal code folding + ;;(format +onsave) ; automated prettiness + ;;lispy ; vim for lisp, for people who dont like vim + multiple-cursors ; editing in many places at once + ;;parinfer ; turn lisp into python, sort of + rotate-text ; cycle region at point between text candidates + snippets ; my elves. They type so I don't have to + word-wrap + + :emacs + (dired ; making dired pretty [functional] + ;;+ranger ; bringing the goodness of ranger to dired + ;;+icons ; colorful icons for dired-mode + ) + electric ; smarter, keyword-based electric-indent + ;;eshell ; a consistent, cross-platform shell (WIP) + ;;term ; terminals in Emacs + vc ; version-control and Emacs, sitting in a tree + (undo +tree) + + :tools + ;;ansible + ;;debugger ; FIXME stepping through code, to help you add bugs + ;;direnv + docker + ;;editorconfig ; let someone else argue about tabs vs spaces + ;; ein ; tame Jupyter notebooks with emacs + (eval +overlay) ; run code, run (also, repls) + gist ; interacting with github gists + (lookup ; helps you navigate your code and documentation + +docsets) ; ...or in Dash docsets locally + lsp + ;;macos ; MacOS-specific commands + magit ; a git porcelain for Emacs + make ; run make tasks from Emacs + pass ; password manager for nerds + pdf ; pdf enhancements + ;;prodigy ; FIXME managing external services & code builders + ;;rgb ; creating color strings + ;;terraform ; infrastructure as code + ;;tmux ; an API for interacting with tmux + ;;upload ; map local to remote projects via ssh/ftp + ;;wakatime + ;;vterm ; another terminals in Emacs + + :checkers + syntax ; tasing you for every semicolon you forget + ; spell ; tasing you for misspelling mispelling + + :lang + agda ; types of types of types of types... + ;;assembly ; assembly for fun or debugging + cc ; C/C++/Obj-C madness + clojure ; java with a lisp + common-lisp ; if you've seen one lisp, you've seen them all + ; coq ; proofs-as-programs + ;;crystal ; ruby at the speed of c + ;;csharp ; unity, .NET, and mono shenanigans + data ; config/data formats + erlang ; an elegant language for a more civilized age + elixir ; erlang done right + ;;elm ; care for a cup of TEA? + emacs-lisp ; drown in parentheses + ;;ess ; emacs speaks statistics + ;;go ; the hipster dialect + ;; (haskell +intero) ; a language that's lazier than I am + haskell ; a language that's lazier than I am + ;;hy ; readability of scheme w/ speed of python + ;; idris ; + ;;(java +meghanada) ; the poster child for carpal tunnel syndrome + javascript ; all(hope(abandon(ye(who(enter(here)))))) + julia ; a better, faster MATLAB + ;;kotlin ; a better, slicker Java(Script) + latex ; writing papers in Emacs has never been so fun + ;;ledger ; an accounting system in Emacs + lua ; one-based indices? one-based indices + markdown ; writing docs for people to ignore + ;;nim ; python + lisp at the speed of c + nix ; I hereby declare "nix geht mehr!" + ;;ocaml ; an objective camel + (org ; organize your plain life in plain text + +dragndrop ; drag & drop files/images into org buffers + +attach ; custom attachment system + +babel ; running code in org + +capture ; org-capture in and outside of Emacs + +export ; Exporting org to whatever you want + ;; +habit ; Keep track of your habits + +present ; Emacs for presentations + +pretty + +brain + +protocol) ; Support for org-protocol:// links + ;;perl ; write code no one else can comprehend + ;;php ; perl's insecure younger brother + ;;plantuml ; diagrams for confusing people more + purescript ; javascript, but functional + (python +lsp) ; beautiful is better than ugly + ;;qt ; the 'cutest' gui framework ever + racket ; a DSL for DSLs + rest ; Emacs as a REST client + ;;ruby ; 1.step do {|i| p "Ruby is #{i.even? ? 'love' : 'life'}"} + rust ; Fe2O3.unwrap().unwrap().unwrap().unwrap() + ;;scala ; java, but good + (sh +fish) ; she sells (ba|z|fi)sh shells on the C xor + ;;solidity ; do you need a blockchain? No. + ;;swift ; who asked for emoji variables? + ;;terra ; Earth and Moon in alignment for performance. + ;;web ; the tubes + ;;vala ; GObjective-C + + ;; Applications are complex and opinionated modules that transform Emacs + ;; toward a specific purpose. They may have additional dependencies and + ;; should be loaded late. + :app + ;;(email +gmail) ; emacs as an email client + irc ; how neckbeards socialize + ;;(rss +org) ; emacs as an RSS reader + twitter ; twitter client https://twitter.com/vnought + ;;(write ; emacs as a word processor (latex + org + markdown) + ;; +wordnut ; wordnet (wn) search + ;; +langtool) ; a proofreader (grammar/style check) for Emacs + + :email + ;; (mu4e +gmail) + notmuch + + :collab + ;;floobits ; peer programming for a price + ;;impatient-mode ; show off code over HTTP + + :config + ;; For literate config users. This will tangle+compile a config.org + ;; literate config in your `doom-private-dir' whenever it changes. + ;;literate + + ;; The default module sets reasonable defaults for Emacs. It also + ;; provides a Spacemacs-inspired keybinding scheme and a smartparens + ;; config. Use it as a reference for your own modules. + (default +bindings +smartparens)) +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(doom-big-font-mode nil) + '(flycheck-javascript-flow-args nil) + '(org-agenda-files + '("/home/griffin/notes/personal.org" "/home/griffin/notes/2020-01-27-data-pipeline-deploy-mismatch.org" "/home/griffin/notes/architecture.org" "/home/griffin/notes/cooking.org" "/home/griffin/notes/culture-survey.org" "/home/griffin/notes/dir-structure.org" "/home/griffin/notes/dnd.org" "/home/griffin/notes/inbox.org" "/home/griffin/notes/misc-todo.org" "/home/griffin/notes/nix-talk.org" "/home/griffin/notes/notes.org" "/home/griffin/notes/one-on-one.org" "/home/griffin/notes/work.org" "/home/griffin/notes/xanthous.org" "/home/griffin/notes/xgboost.org")) + '(safe-local-variable-values + '((intero-stack-yaml . "/home/griffin/code/mlem/stack.yaml") + (elisp-lint-indent-specs + (if-let* . 2) + (when-let* . 1) + (let* . defun) + (nrepl-dbind-response . 2) + (cider-save-marker . 1) + (cider-propertize-region . 1) + (cider-map-repls . 1) + (cider--jack-in . 1) + (cider--make-result-overlay . 1) + (insert-label . defun) + (insert-align-label . defun) + (insert-rect . defun) + (cl-defun . 2) + (with-parsed-tramp-file-name . 2) + (thread-first . 1) + (thread-last . 1)) + (checkdoc-package-keywords-flag) + (cider-jack-in-default . "shadow-cljs") + (projectile-project-root . "/home/griffin/code/urb/grid/backend/src") + (python-pytest-executable . "/home/griffin/code/urb/grid/backend/src/.venv/bin/pytest")))) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(default ((((class color) (min-colors 89)) (:foreground "#657b83" :background "#fdf6e3")))) + '(agda2-highlight-bound-variable-face ((t nil))) + '(agda2-highlight-coinductive-constructor-face ((t (:foreground "#b58900")))) + '(agda2-highlight-datatype-face ((t (:foreground "#268bd2")))) + '(agda2-highlight-dotted-face ((t nil))) + '(agda2-highlight-error-face ((t (:foreground "#dc322f" :underline t)))) + '(agda2-highlight-field-face ((t (:foreground "#dc322f")))) + '(agda2-highlight-function-face ((t (:foreground "#268bd2")))) + '(agda2-highlight-incomplete-pattern-face ((t (:background "#cb4b16" :foreground "#002b36")))) + '(agda2-highlight-inductive-constructor-face ((t (:foreground "#859900")))) + '(agda2-highlight-keyword-face ((t (:foreground "#859900")))) + '(agda2-highlight-module-face ((t (:foreground "#b58900")))) + '(agda2-highlight-number-face ((t (:foreground "#6c71c4")))) + '(agda2-highlight-operator-face ((t nil))) + '(agda2-highlight-postulate-face ((t (:foreground "#268bd2")))) + '(agda2-highlight-primitive-face ((t (:foreground "#268bd2")))) + '(agda2-highlight-primitive-type-face ((t (:foreground "#268bd2")))) + '(agda2-highlight-record-face ((t (:foreground "#268bd2")))) + '(agda2-highlight-string-face ((t (:foreground "#2aa198")))) + '(agda2-highlight-symbol-face ((((background "#fdf6e3")) (:foreground "#586e75")))) + '(agda2-highlight-termination-problem-face ((t (:background "#cb4b16" :foreground "#002b36")))) + '(agda2-highlight-typechecks-face ((t (:background "#2aa198" :foreground "#002b36")))) + '(agda2-highlight-unsolved-constraint-face ((t (:background "#eee8d5")))) + '(agda2-highlight-unsolved-meta-face ((t (:background "#eee8d5"))))) diff --git a/users/grfn/emacs.d/irc.el b/users/grfn/emacs.d/irc.el new file mode 100644 index 000000000000..117869599d83 --- /dev/null +++ b/users/grfn/emacs.d/irc.el @@ -0,0 +1,131 @@ +;;; -*- lexical-binding: t; -*- + +(require 'erc) +(require 'alert) + +(defvar irc-servers + '("hackint" + "libera")) + +(defun irc-connect (server) + (interactive + (list (ivy-read "Server: " irc-servers))) + (let ((pw (s-trim (shell-command-to-string + (format "pass irccloud/%s" server)))) + (gnutls-verify-error nil)) + (erc-tls :server "bnc.irccloud.com" + :port 6697 + :nick "grfn" + :password (concat "bnc@" + (s-trim (shell-command-to-string "hostname")) + ":" + pw)))) + + +(defgroup erc-alert nil + "Alert me using alert.el for important ERC messages" + :group 'erc) + +(defcustom erc-noise-regexp + "\\(Logging in:\\|Signing off\\|You're now away\\|Welcome back\\)" + "This regexp matches unwanted noise." + :type 'regexp + :group 'erc) + +(setq tvl-enabled? t) + +(defun disable-tvl-notifications () + (interactive) + (setq tvl-enabled? nil)) + +(defun enable-tvl-notifications () + (interactive) + (setq tvl-enabled? t)) + +(defun erc-alert-important-p (info) + (let ((message (plist-get info :message)) + (erc-message (-> info (plist-get :data) (plist-get :message))) + (erc-channel (-> info (plist-get :data) (plist-get :channel)))) + (and erc-message + (not (or (string-match "^\\** *Users on #" message) + (string-match erc-noise-regexp + message))) + (or (and tvl-enabled? + (string-equal erc-channel "#tvl")) + (string-match "grfn" message))))) + +(comment + last-info + erc-noise-regexp + (setq tvl-enabled? nil) + ) + +(defun my-erc-hook (&optional match-type nick message) + "Shows a notification, when user's nick was mentioned. +If the buffer is currently not visible, makes it sticky." + (setq last-message message) + (if (or (null match-type) (not (eq match-type 'fool))) + (let (alert-log-messages) + (alert (or message (buffer-string)) + :severity (if (string-match "grfn" (or message "")) + 'high 'low) + :title (or nick (buffer-name)) + :data `(:message ,(or message (buffer-string)) + :channel ,(or nick (buffer-name))))))) + +(add-hook 'erc-text-matched-hook 'my-erc-hook) +(add-hook 'erc-insert-modify-hook 'my-erc-hook) + +(defun my-erc-define-alerts (&rest ignore) + ;; Unless the user has recently typed in the ERC buffer, highlight the fringe + (alert-add-rule + :status '(buried visible idle) + :severity '(moderate high urgent) + :mode 'erc-mode + :predicate + #'(lambda (info) + (and (not (eq (current-buffer) (plist-get info :buffer))) + (string-match "grfn:" (plist-get info :message)))) + :persistent + #'(lambda (info) + ;; If the buffer is buried, or the user has been idle for + ;; `alert-reveal-idle-time' seconds, make this alert + ;; persistent. Normally, alerts become persistent after + ;; `alert-persist-idle-time' seconds. + (memq (plist-get info :status) '(buried idle))) + :style 'message + :continue t) + + (alert-add-rule + :status 'buried + :mode 'erc-mode + :predicate #'erc-alert-important-p + :style 'libnotify + :append t) + + (alert-add-rule + :status 'buried + :mode 'erc-mode + :predicate #'erc-alert-important-p + :style 'message + :append t) + + (alert-add-rule + :mode 'erc-mode + :predicate #'erc-alert-important-p + :style 'log + :append t) + + (alert-add-rule :mode 'erc-mode :style 'ignore :append t)) + +(add-hook 'erc-connect-pre-hook 'my-erc-define-alerts) + +(defun fix-irc-message (msg) + (let ((msg (s-trim msg))) + (if (string-equal msg ":q") "" msg))) + +(advice-add #'erc-user-input :filter-return #'fix-irc-message) + +(comment + (my-erc-define-alerts) + ) diff --git a/users/grfn/emacs.d/lisp.el b/users/grfn/emacs.d/lisp.el new file mode 100644 index 000000000000..c45cc7e6e381 --- /dev/null +++ b/users/grfn/emacs.d/lisp.el @@ -0,0 +1,38 @@ +;;; -*- lexical-binding: t; -*- + +(defun grfn/sly-panettone () + (interactive) + (sly + (concat + (s-trim + (shell-command-to-string + "nix-build -o sbcl -E 'with import ~/code/depot {}; nix.buildLisp.sbclWith [web.panettone]'")) + "/bin/sbcl"))) + +(defun grfn/setup-lisp () + (interactive) + (unless paxedit-mode (paxedit-mode 1)) + (rainbow-delimiters-mode) + (flycheck-mode -1)) + +(add-hook 'common-lisp-lisp-mode-hook #'grfn/setup-lisp) + +(defun sly-run-tests () + (interactive) + ;; TODO: handle other test frameworks + (let ((orig-window (get-buffer-window))) + (sly-eval '(fiveam:run!)) + (funcall-interactively #'sly-mrepl-sync) + (select-window orig-window))) + +(map! + (:map sly-mode-map + :n "g \\" #'sly-mrepl-sync + :n "g d" #'sly-edit-definition + :n "K" #'sly-documentation + :n "g SPC" #'sly-compile-and-load-file + :n "g RET" #'sly-run-tests) + + (:map sly-mrepl-mode-map + "C-k" #'sly-mrepl-previous-prompt + "C-r" #'isearch-backward)) diff --git a/users/grfn/emacs.d/nix-clangd.sh b/users/grfn/emacs.d/nix-clangd.sh new file mode 100755 index 000000000000..16f6252d8b27 --- /dev/null +++ b/users/grfn/emacs.d/nix-clangd.sh @@ -0,0 +1,7 @@ +#!/usr/bin/env bash +set -euo pipefail + +CLANGD_FLAGS=--compile-commands-dir=/home/grfn/builds/tvix \ + nix-shell /home/grfn/code/depot \ + -A third_party.nix \ + --run nix-clangd diff --git a/users/grfn/emacs.d/nix.el b/users/grfn/emacs.d/nix.el new file mode 100644 index 000000000000..ec5b474af218 --- /dev/null +++ b/users/grfn/emacs.d/nix.el @@ -0,0 +1,30 @@ +;;; -*- lexical-binding: t; -*- + +(defun nix-buffer-type () + "Returns: + +'home-manager, if the current buffer is a home-manager module +'nixos, if the current buffer is a nixos module +nil, if none of the above are the case" + (when buffer-file-name + (pcase buffer-file-name + ((rx (0+ nonl) "system/home" (0+ nonl) ".nix" eos) + 'home-manager) + ((rx (0+ nonl) "system/system" (0+ nonl) ".nix" eos) + 'nixos)))) + +(defun set-nix-compile-command () + "Set the compile command for the current buffer based on the type of nix +buffer it is, per `nix-buffer-type'" + (interactive) + (when-let ((btype (nix-buffer-type))) + (setq-local + compile-command + (case btype + ('home-manager "home-manager switch") + ('nixos "sudo nixos-rebuild switch"))))) + +(add-hook 'nix-mode-hook #'set-nix-compile-command) + +(map! (:map nix-mode-map + (:n "g SPC" #'compile))) diff --git a/users/grfn/emacs.d/org-alerts.el b/users/grfn/emacs.d/org-alerts.el new file mode 100644 index 000000000000..8e6c3e0417ff --- /dev/null +++ b/users/grfn/emacs.d/org-alerts.el @@ -0,0 +1,188 @@ +;;; -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 's) +(require 'dash) +(require 'alert) +(require 'org-agenda) + + +(defvar grfn/org-alert-interval 300 + "Interval in seconds to recheck and display deadlines.") + + +(defvar grfn/org-alert-notification-title "*org*" + "Title to be sent with notify-send.") + +(defvar grfn/org-alert-headline-regexp "\\(Sched.+:.+\\|Deadline:.+\\)" + "Regexp for headlines to search in agenda buffer.") + +(defun grfn/org-alert--strip-prefix (headline) + "Remove the scheduled/deadline prefix from HEADLINE." + (replace-regexp-in-string ".*:\s+" "" headline)) + + +(defun grfn/org-alert--unique-headlines (regexp agenda) + "Return unique headlines from the results of REGEXP in AGENDA." + (let ((matches (-distinct (-flatten (s-match-strings-all regexp agenda))))) + (--map (grfn/org-alert--strip-prefix it) matches))) + + +(defun grfn/org-alert--get-headlines () + "Return the current org agenda as text only." + (with-temp-buffer + (let ((org-agenda-sticky nil) + (org-agenda-buffer-tmp-name (buffer-name))) + (ignore-errors (org-agenda-list nil "TODAY" 1)) + (grfn/org-alert--unique-headlines + grfn/org-alert-headline-regexp + (buffer-substring-no-properties (point-min) (point-max)))))) + +(defun grfn/parse-range-string (str) + (when + (string-match (rx (group (repeat 2 (any digit)) + ":" + (repeat 2 (any digit))) + (optional + (and + "-" + (group (repeat 2 (any digit)) + ":" + (repeat 2 (any digit)))))) + str) + (list + (org-read-date nil t + (match-string 1 str)) + (when-let ((et (match-string 2 str))) (org-read-date nil t et))))) + +(defun grfn/start-time-from-range-string (str) + (pcase-let ((`(,start-time . _) (grfn/parse-range-string str))) + start-time)) + +(comment + (org-agenda-list nil "TODAY" 1) + + (grfn/org-alert--get-headlines) + (setq --src + (with-temp-buffer + (let ((org-agenda-sticky nil) + (org-agenda-buffer-tmp-name (buffer-name))) + (ignore-errors (org-agenda-list nil "TODAY" 1)) + (buffer-substring-no-properties (point-min) (point-max))))) + + (setq --entries + (with-temp-buffer + (let ((inhibit-redisplay t) + (org-agenda-sticky nil) + (org-agenda-buffer-tmp-name (buffer-name)) + (org-agenda-buffer-name (buffer-name)) + (org-agenda-buffer (current-buffer))) + (org-agenda-get-day-entries + (cadr (org-agenda-files nil 'ifmode)) + (calendar-gregorian-from-absolute + (time-to-days (org-read-date nil t "TODAY"))))))) + + (loop for k in (text-properties-at 0 (car --entries)) + by #'cddr + collect k) + + (--map (substring-no-properties (get-text-property 0 'txt it)) --entries) + (--map (get-text-property 0 'time it) --entries) + (current-time) + + (format-time-string "%R" (org-read-date nil t "10:00-11:00")) + + (grfn/start-time-from-range-string "10:00") + + (current-time-string (org-read-date nil t "10:00-11:00")) + + (todo-state + org-habit-p + priority + warntime + ts-date + date + type + org-hd-marker + org-marker + face + undone-face + help-echo + mouse-face + done-face + org-complex-heading-regexp + org-todo-regexp + org-not-done-regexp + dotime + format + extra + time + level + txt + breadcrumbs + duration + time-of-day + org-lowest-priority + org-highest-priority + tags + org-category) + + (propertize) + + --src + ) + + +(defun grfn/org-alert--headline-complete? (headline) + "Return whether HEADLINE has been completed." + (--any? (s-starts-with? it headline) org-done-keywords-for-agenda)) + + +(defun grfn/org-alert--filter-active (deadlines) + "Remove any completed headings from the provided DEADLINES." + (-remove 'grfn/org-alert--headline-complete? deadlines)) + + +(defun grfn/org-alert--strip-states (deadlines) + "Remove the todo states from DEADLINES." + (--map (s-trim (s-chop-prefixes org-todo-keywords-for-agenda it)) deadlines)) + + +(defun grfn/org-alert-check () + "Check for active, due deadlines and initiate notifications." + (interactive) + ;; avoid interrupting current command. + (unless (minibufferp) + (save-window-excursion + (save-excursion + (save-restriction + (let ((active (grfn/org-alert--filter-active (grfn/org-alert--get-headlines)))) + (dolist (dl (grfn/org-alert--strip-states active)) + (alert dl :title grfn/org-alert-notification-title)))))) + (when (get-buffer org-agenda-buffer-name) + (ignore-errors + (with-current-buffer org-agenda-buffer-name + (org-agenda-redo t)))))) + + +(defun grfn/org-alert-enable () + "Enable the notification timer. Cancels existing timer if running." + (interactive) + (grfn/org-alert-disable) + (run-at-time 0 grfn/org-alert-interval 'grfn/org-alert-check)) + + +(defun grfn/org-alert-disable () + "Cancel the running notification timer." + (interactive) + (dolist (timer timer-list) + (if (eq (elt timer 5) 'grfn/org-alert-check) + (cancel-timer timer)))) + + + +(provide 'grfn/org-alert) +;;; grfn/org-alert.el ends here diff --git a/users/grfn/emacs.d/org-config.el b/users/grfn/emacs.d/org-config.el new file mode 100644 index 000000000000..81fb35a1cbda --- /dev/null +++ b/users/grfn/emacs.d/org-config.el @@ -0,0 +1,193 @@ +;;; -*- lexical-binding: t; -*- + +(defun notes-file (f) + (concat org-directory (if (string-prefix-p "/" f) "" "/") f)) + +(defun grfn/org-project-tag->key (tag) + (s-replace-regexp "^project__" "" tag)) + +(defun grfn/org-project-tag->name (tag) + (s-titleized-words + (s-join " " (s-split "_" (grfn/org-project-tag->key tag))))) + +(defun grfn/org-project-tag->keys (tag) + (s-join "" (cons "p" + (-map (lambda (s) (substring-no-properties s 0 1)) + (s-split "_" (grfn/org-project-tag->key tag)))))) + +(defun grfn/org-projects->agenda-commands (project-tags) + (loop for tag in project-tags + collect `(,(grfn/org-project-tag->keys tag) + ,(grfn/org-project-tag->name tag) + tags-todo + ,tag))) + +(defun grfn/org-projects () + (loop for (tag) in + (org-global-tags-completion-table + (directory-files-recursively "~/notes" "\\.org$")) + when (s-starts-with-p "project__" tag) + collect tag)) + +(comment + (grfn/org-projects->agenda-commands (grfn/org-projects)) + ) + +(setq + org-directory (expand-file-name "~/notes") + +org-dir (expand-file-name "~/notes") + org-default-notes-file (concat org-directory "/inbox.org") + +org-default-todo-file (concat org-directory "/inbox.org") + org-agenda-files (directory-files-recursively + "~/notes" "\\.org$") + org-refile-targets '((org-agenda-files :maxlevel . 3)) + org-outline-path-complete-in-steps nil + org-refile-use-outline-path t + org-file-apps `((auto-mode . emacs) + (,(rx (or (and "." (optional "x") (optional "htm") (optional "l") buffer-end) + (and buffer-start "http" (optional "s") "://"))) + . "firefox %s") + (,(rx ".pdf" buffer-end) . "apvlv %s") + (,(rx "." (or "png" + "jpg" + "jpeg" + "gif" + "tif" + "tiff") + buffer-end) + . "feh %s")) + org-log-done 'time + org-archive-location "~/notes/trash::* From %s" + org-cycle-separator-lines 2 + org-hidden-keywords '(title) + org-tags-column -130 + org-ellipsis "…" + org-imenu-depth 9 + org-capture-templates + `(("t" "Todo" entry + (file +org-default-todo-file) + "* TODO %?\n%i" + :kill-buffer t) + + ("m" "Email" entry + (file +org-default-todo-file) + "* TODO [[%L][%:subject]] :email:\n%i") + + ("n" "Notes" entry + (file +org-default-todo-file) + "* %U %?\n%i" + :prepend t + :kill-buffer t) + + ("c" "Task note" entry + (clock) + "* %U %?\n%i[%l[Context]]\n" + :kill-buffer t + :unnarrowed t) + + ("p" "Projects") + ("px" "Xanthous" entry + (file+headline ,(notes-file "xanthous.org") "Backlog") + "* TODO %?\nContext %a\nIn task: %K") + ("pt" "Tvix" entry + (file+headline ,(notes-file "tvix.org") "Tvix TODO") + "* TODO %?\nContext %a\nIn task: %K") + ("pw" "Windtunnel" entry + (file+headline ,(notes-file "windtunnel.org") "Tasks") + "* TODO %i%?\nContext: %a\nIn task: %K") + + ("d" "Data recording") + ) + + org-capture-templates-contexts + `(("px" ((in-file . "/home/grfn/code/depot/users/grfn/xanthous/.*")))) + + org-deadline-warning-days 1 + org-agenda-skip-scheduled-if-deadline-is-shown 'todo + org-todo-keywords '((sequence "TODO(t)" "ACTIVE(a)" "|" "DONE(d)" "RUNNING(r)") + (sequence "NEXT(n)" "WAITING(w)" "LATER(l)" "|" "CANCELLED(c)")) + org-agenda-custom-commands + `(("S" "Sprint Tasks" tags-todo "sprint") + ("i" "Inbox" tags "inbox") + ("r" "Running jobs" todo "RUNNING") + ("w" "@Work" tags-todo "@work") + ("n" . "Next...") + ("np" "Next Sprint" tags-todo "next_sprint|sprint_planning") + + ("p" . "Project...") + ,@(grfn/org-projects->agenda-commands (grfn/org-projects))) + + org-agenda-dim-blocked-tasks nil + org-enforce-todo-dependencies nil + + org-babel-clojure-backend 'cider) + + +(defun +grfn/insert-work-template () + (interactive) + (goto-char (point-min)) + (forward-line) + (insert "#+TODO: TODO(t) NEXT(n) ACTIVE(a) | DONE(d) PR(p) RUNNING(r) TESTING(D) +#+TODO: BLOCKED(b) BACKLOG(l) PROPOSED(o) | CANCELLED(c) +#+FILETAGS: @work +#+FILETAGS: @work +#+PROPERTY: Effort_ALL 0 4:00 8:00 12:00 20:00 32:00 +#+PROPERTY: ESTIMATE_ALL 0 1 2 3 5 8 +#+PROPERTY: STORY-TYPE_ALL Feature Bug Chore +#+PROPERTY: NOBLOCKING t +#+COLUMNS: %TODO %40ITEM(Task) %17EFFORT(Estimated){:} %CLOCKSUM(Time Spent) %17STORY-TYPE(Type) %TAGS")) + +(defun +grfn/insert-org-template () + (interactive) + (pcase (buffer-file-name) + ((s-contains "/work/") (+grfn/insert-work-template)))) + +;;; TODO: this doesn't work? +(define-auto-insert "\\.org?$" #'grfn/insert-org-template t) + +(defun forge--post-submit-around---link-pr-to-org-item + (orig) + (let ((cb (funcall orig))) + (lambda (value headers status req) + (prog1 (funcall cb value headers status req) + (grfn/at-org-clocked-in-item + (let ((url (alist-get 'html_url value)) + (number (alist-get 'number value))) + (org-set-property + "pull-request" + (org-make-link-string + url + (format "%s/%s/%d" + (->> value + (alist-get 'base) + (alist-get 'repo) + (alist-get 'name)) + (->> value + (alist-get 'base) + (alist-get 'repo) + (alist-get 'owner) + (alist-get 'login)) + number))))))))) + +(advice-add + #'forge--post-submit-callback + :around #'forge--post-submit-around---link-pr-to-org-item) + +(defun +grfn/org-setup () + (setq-local truncate-lines -1) + (display-line-numbers-mode -1) + (line-number-mode -1)) + +(add-hook 'org-mode-hook #'+grfn/org-setup) + +(set-face-foreground 'org-block +solarized-s-base00) +(setq whitespace-global-modes '(not org-mode magit-mode vterm-mode)) +(setf (alist-get 'file org-link-frame-setup) 'find-file-other-window) +(set-face-foreground 'org-block +solarized-s-base00) + +;; (add-hook! org-mode +;; (set-company-backend! 'org-mode +;; '(:separate company-ob-postgresql +;; company-dabbrev +;; company-yasnippet +;; company-ispell))) diff --git a/users/grfn/emacs.d/org-gcal.el b/users/grfn/emacs.d/org-gcal.el new file mode 100644 index 000000000000..3e315c5e6046 --- /dev/null +++ b/users/grfn/emacs.d/org-gcal.el @@ -0,0 +1,181 @@ +;;; -*- lexical-binding: t; -*- + +(require 'aio) +(require 'parse-time) + +(setq-local lexical-binding t) +(setq plstore-cache-passphrase-for-symmetric-encryption t) + +(defvar gcal-client-id) +(defvar gcal-client-secret) + +(defvar google-calendar-readonly-scope + "https://www.googleapis.com/auth/calendar.readonly") + +(defvar events-file "/home/grfn/notes/events.org") + +(defun google--get-token (scope client-id client-secret) + (oauth2-auth-and-store + "https://accounts.google.com/o/oauth2/v2/auth" + "https://oauth2.googleapis.com/token" + scope + client-id + client-secret)) + +(cl-defun google--request (url &key method params scope) + (let ((p (aio-promise)) + (auth-token (google--get-token scope gcal-client-id gcal-client-secret))) + (oauth2-refresh-access auth-token) + (oauth2-url-retrieve + auth-token + url + (lambda (&rest _) + (goto-char (point-min)) + (re-search-forward "^$") + (let ((resp (json-parse-buffer :object-type 'alist))) + (aio-resolve p (lambda () resp)))) + nil + (or method "GET") + params) + p)) + +(cl-defun list-events (&key min-time max-time) + (google--request + (concat + "https://www.googleapis.com/calendar/v3/calendars/griffin@urbint.com/events" + "?timeMin=" (format-time-string "%Y-%m-%dT%T%z" min-time) + "&timeMax=" (format-time-string "%Y-%m-%dT%T%z" max-time)) + :scope google-calendar-readonly-scope)) + + +(defun last-week-events () + (list-events :min-time (time-subtract + (current-time) + (seconds-to-time + (* 60 60 24 7))) + :max-time (current-time))) + +(defun next-week-events () + (list-events :min-time (current-time) + :max-time (time-add + (current-time) + (seconds-to-time + (* 60 60 24 7))))) + +(defun attending-event? (event) + (let* ((attendees (append (alist-get 'attendees event) nil)) + (self (--find (alist-get 'self it) attendees))) + (equal "accepted" (alist-get 'responseStatus self)))) + +(defun event->org-headline (event level) + (cl-flet ((make-time + (key) + (when-let ((raw-time (->> event (alist-get key) (alist-get 'dateTime)))) + (format-time-string + (org-time-stamp-format t) + (parse-iso8601-time-string raw-time))))) + (if-let ((start-time (make-time 'start)) + (end-time (make-time 'end))) + (s-format + "${headline} [[${htmlLink}][${summary}]] :event: +${startTime}--${endTime} +:PROPERTIES: +${location-prop} +:EVENT: ${htmlLink} +:END: + +${description}" + (function + (lambda (k m) + (or (alist-get (intern k) m) + (format "key not found: %s" k)))) + (append + event + `((headline . ,(make-string level ?*)) + (startTime . ,start-time) + (endTime . ,end-time) + (location-prop + . ,(if-let ((location (alist-get 'location event))) + (s-lex-format ":LOCATION: ${location}") + ""))))) + ""))) + +(comment + (alist-get 'foo nil) + ) + +(defun write-events (events) + (with-current-buffer (find-file-noselect events-file) + (save-mark-and-excursion + (save-restriction + (widen) + (erase-buffer) + (goto-char (point-min)) + (insert "#+TITLE: Events") + (newline) (newline) + (prog1 + (loop for event in (append events nil) + when (attending-event? event) + do + (insert (event->org-headline event 1)) + (newline) + sum 1) + (org-align-tags t)))))) + +(defun +grfn/sync-events () + (interactive) + (let* ((events (alist-get 'items (aio-wait-for (next-week-events)))) + (num-written (write-events events))) + (message "Successfully wrote %d events" num-written))) + +(comment + ((kind . "calendar#event") + (etag . "\"3174776941020000\"") + (id . "SNIP") + (status . "confirmed") + (htmlLink . "https://www.google.com/calendar/event?eid=SNIP") + (created . "2020-04-01T13:30:09.000Z") + (updated . "2020-04-20T13:14:30.510Z") + (summary . "SNIP") + (description . "SNIP") + (location . "SNIP") + (creator + (email . "griffin@urbint.com") + (self . t)) + (organizer + (email . "griffin@urbint.com") + (self . t)) + (start + (dateTime . "2020-04-01T12:00:00-04:00") + (timeZone . "America/New_York")) + (end + (dateTime . "2020-04-01T12:30:00-04:00") + (timeZone . "America/New_York")) + (recurrence . + ["RRULE:FREQ=WEEKLY;UNTIL=20200408T035959Z;BYDAY=WE"]) + (iCalUID . "SNIP") + (sequence . 0) + (attendees . + [((email . "griffin@urbint.com") + (organizer . t) + (self . t) + (responseStatus . "accepted")) + ((email . "SNIP") + (displayName . "SNIP") + (responseStatus . "needsAction"))]) + (extendedProperties + (private + (origRecurringId . "309q48kc1dihsvbi13pnlimb5a")) + (shared + (origRecurringId . "309q48kc1dihsvbi13pnlimb5a"))) + (reminders + (useDefault . t))) + + (require 'icalendar) + + (icalendar--convert-recurring-to-diary + nil + "RRULE:FREQ=WEEKLY;UNTIL=20200408T035959Z;BYDAY=WE" + ) + + ) diff --git a/users/grfn/emacs.d/org-query.el b/users/grfn/emacs.d/org-query.el new file mode 100644 index 000000000000..0b987280f2a1 --- /dev/null +++ b/users/grfn/emacs.d/org-query.el @@ -0,0 +1,100 @@ +;;; -*- lexical-binding: t; -*- + +(require 'org) +(require 'org-agenda) +(require 'inflections) + +(defun grfn/org-agenda-entry->element (agenda-entry) + ;; ??? + ()) + +(defun org-elements-agenda-match (match &optional todo-only) + (setq match + (propertize match 'inherited t)) + (with-temp-buffer + (let ((inhibit-redisplay (not debug-on-error)) + (org-agenda-sticky nil) + (org-agenda-buffer-tmp-name (buffer-name)) + (org-agenda-buffer-name (buffer-name)) + (org-agenda-buffer (current-buffer)) + (matcher (org-make-tags-matcher match)) + result) + (org-agenda-prepare (concat "TAGS " match)) + (setq match (car matcher) + matcher (cdr matcher)) + (dolist (file (org-agenda-files nil 'ifmode) + result) + (catch 'nextfile + (org-check-agenda-file file) + (when-let ((buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file)))) + (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in Org mode" file)) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (setq result + (append result (org-scan-tags + 'agenda + matcher + todo-only)))))))))))) + +(defun grfn/num-inbox-items () + (length (org-elements-agenda-match "inbox" t))) + +(defun grfn/num-inbox-items-message () + (let ((n (grfn/num-inbox-items))) + (if (zerop n) "" + (format "%d %s" + n + (if (= 1 n) "item" "items"))))) + +(defmacro grfn/at-org-clocked-in-item (&rest body) + `(when (org-clocking-p) + (let ((m org-clock-marker)) + (with-current-buffer (marker-buffer m) + (save-mark-and-excursion + (goto-char m) + (org-back-to-heading t) + ,@body))))) + +(defun grfn/org-element-clocked-in-task () + (grfn/at-org-clocked-in-item + (org-element-at-point))) + +(comment + (grfn/org-element-clocked-in-task) + (org-element-property :title (grfn/org-element-clocked-in-task)) + ) + +(defun grfn/minutes->hours:minutes (minutes) + (format "%d:%02d" + (floor (/ minutes 60)) + (mod minutes 60))) + +(comment + (grfn/minutes->hours:minutes 1) ; => "0:01" + (grfn/minutes->hours:minutes 15) ; => "0:15" + (grfn/minutes->hours:minutes 130) ; => "2:10" + ) + +(defun grfn/org-current-clocked-in-task-message () + (if (org-clocking-p) + (format "(%s) [%s]" + (->> (grfn/org-element-clocked-in-task) + (org-element-property :title) + (car) + (substring-no-properties) + (s-trim)) + (grfn/minutes->hours:minutes + (org-clock-get-clocked-time))) + "")) + +(comment + (grfn/org-current-clocked-in-task-message) + ) diff --git a/users/grfn/emacs.d/packages.el b/users/grfn/emacs.d/packages.el new file mode 100644 index 000000000000..5a580cad17e0 --- /dev/null +++ b/users/grfn/emacs.d/packages.el @@ -0,0 +1,152 @@ +;; -*- no-byte-compile: t; -*- +;;; private/grfn/packages.el + +(package! moody) + +;; Editor +(package! solarized-theme) +(package! fill-column-indicator) +(package! flx) +(package! general + :recipe (:host github :repo "noctuid/general.el")) +(package! fill-column-indicator) +(package! writeroom-mode) +(package! dash) +(package! w3m) +(package! rainbow-mode) +(package! string-inflection) + +;;; Org +(package! org-tracker + :recipe (:host file + :local-repo "~/code/org-tracker")) +(package! org-alert) +(package! ob-http) +(package! ob-ipython) +(package! ob-async) +(package! org-recent-headings) +(package! org-sticky-header) +(package! gnuplot) +(package! gnuplot-mode) + +;; Presentation +(package! epresent) +(package! org-tree-slide) +(package! ox-reveal) + +;; Slack etc +(package! slack) +(package! alert) + +;; Git +(package! evil-magit) +(package! marshal) +(package! forge) +(package! + github-review + :recipe + (:host github + :repo "charignon/github-review" + :files ("github-review.el"))) + +;; Elisp +(package! dash) +(package! dash-functional) +(package! s) +(package! request) +(package! predd + :recipe (:host github :repo "skeeto/predd")) +(package! aio) + +;; Haskell +(package! lsp-haskell) +(package! counsel-etags) + +;;; LSP +(package! lsp-mode) +(package! lsp-ui :recipe (:host github :repo "emacs-lsp/lsp-ui")) +(package! company-lsp) +(package! lsp-treemacs) + +;; Rust +(package! rustic :disable t) +;; (package! racer :disable t) +(package! cargo) + +;; Lisp +(package! paxedit) + +;; Javascript +(package! flow-minor-mode) +(package! flycheck-flow) +(package! company-flow) +(package! prettier-js) + +;; GraphQL +(package! graphql-mode) + +;; Haskell +(package! lsp-mode) +(package! lsp-ui) +(package! lsp-haskell) +(package! company-lsp) +;; (package! lsp-imenu) + +;; Clojure +(package! flycheck-clojure) + +;; SQL +(package! sqlup-mode) +(package! emacsql) +(package! emacsql-psql) + +;;; Python +(package! pyimport) +;; (package! yapfify) +(package! blacken) + + +;;; Desktop interaction +(package! counsel-spotify) + +;;; Dhall +(package! dhall-mode) + +;;; Kubernetes +(package! kubernetes) +(package! kubernetes-evil) +(package! k8s-mode) + +;;; Stack Exchange +(package! sx) + +;;; Nix +(package! nix-update + :recipe (:host github + :repo "glittershark/nix-update-el")) +(package! direnv) + +;;; Sequence diagrams +(package! wsd-mode + :recipe (:host github + :repo "josteink/wsd-mode")) + +;;; logic? +(package! metal-mercury-mode + :recipe (:host github + :repo "ahungry/metal-mercury-mode")) +(package! flycheck-mercury) + +(package! terraform-mode) +(package! company-terraform) + +(package! jsonnet-mode) + +;;; +(package! znc + :recipe (:host github + :repo "sshirokov/ZNC.el")) + +;;; cpp +(package! protobuf-mode) +(package! clang-format+) diff --git a/users/grfn/emacs.d/rust.el b/users/grfn/emacs.d/rust.el new file mode 100644 index 000000000000..689d843e78e1 --- /dev/null +++ b/users/grfn/emacs.d/rust.el @@ -0,0 +1,39 @@ +;;; -*- lexical-binding: t; -*- + +(add-to-list 'auto-mode-alist '("\\.rs$" . rust-mode)) + +(defun grfn/rust-setup () + (interactive) + + (push '(?> . ("<" . ">")) evil-surround-pairs-alist) + (push '(?< . ("< " . " >")) evil-surround-pairs-alist) + + (setq lsp-rust-server 'rust-analyzer) + (setq-local whitespace-line-column 100 + fill-column 100) + (setq rust-format-show-buffer nil) + (setq lsp-rust-analyzer-import-merge-behaviour "last" + lsp-rust-analyzer-cargo-watch-command "clippy" + lsp-rust-analyzer-cargo-watch-args ["--target-dir" "/home/grfn/code/readyset/readyset/target/rust-analyzer"] + lsp-ui-doc-enable t) + (rust-enable-format-on-save) + (lsp)) + +(add-hook 'rust-mode-hook #'grfn/rust-setup) + +(map! + (:map rust-mode-map + :n "g RET" #'lsp-rust-analyzer-run + :n "g R" #'lsp-find-references + :n "g d" #'lsp-find-definition + (:localleader + "m" #'lsp-rust-analyzer-expand-macro))) + +(comment + (flycheck-get-next-checkers 'lsp) + (flycheck-add-next-checker) + (flycheck-get-next-checkers 'lsp) + ) + +(set-company-backend! 'rust-mode + '(:separate company-capf company-yasnippet)) diff --git a/users/grfn/emacs.d/show-matching-paren.el b/users/grfn/emacs.d/show-matching-paren.el new file mode 100644 index 000000000000..ab65a912a8d1 --- /dev/null +++ b/users/grfn/emacs.d/show-matching-paren.el @@ -0,0 +1,61 @@ +;;; -*- lexical-binding: t; -*- + +;;; https://with-emacs.com/posts/ui-hacks/show-matching-lines-when-parentheses-go-off-screen/ + +;; we will call `blink-matching-open` ourselves... +(remove-hook 'post-self-insert-hook + #'blink-paren-post-self-insert-function) +;; this still needs to be set for `blink-matching-open` to work +(setq blink-matching-paren 'show) + +(let ((ov nil)) ; keep track of the overlay + (advice-add + #'show-paren-function + :after + (defun show-paren--off-screen+ (&rest _args) + "Display matching line for off-screen paren." + (when (overlayp ov) + (delete-overlay ov)) + ;; check if it's appropriate to show match info, + ;; see `blink-paren-post-self-insert-function' + (when (and (overlay-buffer show-paren--overlay) + (not (or cursor-in-echo-area + executing-kbd-macro + noninteractive + (minibufferp) + this-command)) + (and (not (bobp)) + (memq (char-syntax (char-before)) '(?\) ?\$))) + (= 1 (logand 1 (- (point) + (save-excursion + (forward-char -1) + (skip-syntax-backward "/\\") + (point)))))) + ;; rebind `minibuffer-message' called by + ;; `blink-matching-open' to handle the overlay display + (cl-letf (((symbol-function #'minibuffer-message) + (lambda (msg &rest args) + (let ((msg (apply #'format-message msg args))) + (setq ov (display-line-overlay+ + (window-start) msg )))))) + (blink-matching-open)))))) + +(defun display-line-overlay+ (pos str &optional face) + "Display line at POS as STR with FACE. + +FACE defaults to inheriting from default and highlight." + (let ((ol (save-excursion + (goto-char pos) + (make-overlay (line-beginning-position) + (line-end-position))))) + (overlay-put ol 'display str) + (overlay-put ol 'face + (or face '(:inherit default :inherit highlight))) + ol)) + +(setq show-paren-style 'paren + show-paren-delay 0.03 + show-paren-highlight-openparen t + show-paren-when-point-inside-paren nil + show-paren-when-point-in-periphery t) +(show-paren-mode 1) diff --git a/users/grfn/emacs.d/slack-snippets.el b/users/grfn/emacs.d/slack-snippets.el new file mode 100644 index 000000000000..b5bd4db7482c --- /dev/null +++ b/users/grfn/emacs.d/slack-snippets.el @@ -0,0 +1,227 @@ +;;; -*- lexical-binding: t; -*- + +(require 'dash) +(require 'dash-functional) +(require 'request) + +;;; +;;; Configuration +;;; + +(defvar slack/token nil + "Legacy (https://api.slack.com/custom-integrations/legacy-tokens) access token") + +(defvar slack/include-public-channels 't + "Whether or not to inclue public channels in the list of conversations") + +(defvar slack/include-private-channels 't + "Whether or not to inclue public channels in the list of conversations") + +(defvar slack/include-im 't + "Whether or not to inclue IMs (private messages) in the list of conversations") + +(defvar slack/include-mpim nil + "Whether or not to inclue multi-person IMs (multi-person private messages) in + the list of conversations") + +;;; +;;; Utilities +;;; + +(defmacro comment (&rest _body) + "Comment out one or more s-expressions" + nil) + +(defun ->list (vec) (append vec nil)) + +(defun json-truthy? (x) (and x (not (equal :json-false x)))) + +;;; +;;; Generic API integration +;;; + +(defvar slack/base-url "https://slack.com/api") + +(defun slack/get (path params &optional callback) + "params is an alist of query parameters" + (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) + (params (car params-callback)) (callback (cdr params-callback)) + (params (append `(("token" . ,slack/token)) params)) + (url (concat (file-name-as-directory slack/base-url) path))) + (request url + :type "GET" + :params params + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (funcall callback data)))))) + +(defun slack/post (path params &optional callback) + (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) + (params (car params-callback)) (callback (cdr params-callback)) + (url (concat (file-name-as-directory slack/base-url) path))) + (request url + :type "POST" + :data (json-encode params) + :headers `(("Content-Type" . "application/json") + ("Authorization" . ,(format "Bearer %s" slack/token))) + :success (cl-function + (lambda (&key data &allow-other-keys) + (funcall callback data)))))) + + +;;; +;;; Specific API endpoints +;;; + +;; Users + +(defun slack/users (cb) + "Returns users as (id . name) pairs" + (slack/get + "users.list" + (lambda (data) + (->> data + (assoc-default 'members) + ->list + (-map (lambda (user) + (cons (assoc-default 'id user) + (assoc-default 'real_name user)))) + (-filter #'cdr) + (funcall cb))))) + +(comment + (slack/get + "users.list" + (lambda (data) (setq response-data data))) + + (slack/users (lambda (data) (setq --users data))) + + ) + +;; Conversations + +(defun slack/conversation-types () + (->> + (list (when slack/include-public-channels "public_channel") + (when slack/include-private-channels "private_channel") + (when slack/include-im "im") + (when slack/include-mpim "mpim")) + (-filter #'identity) + (s-join ","))) + +(defun channel-label (chan users-alist) + (cond + ((json-truthy? (assoc-default 'is_channel chan)) + (format "#%s" (assoc-default 'name chan))) + ((json-truthy? (assoc-default 'is_im chan)) + (let ((user-id (assoc-default 'user chan))) + (format "Private message with %s" (assoc-default user-id users-alist)))) + ((json-truthy? (assoc-default 'is_mpim chan)) + (->> chan + (assoc-default 'purpose) + (assoc-default 'value))))) + +(defun slack/conversations (cb) + "Calls `cb' with (id . '((label . \"label\") '(topic . \"topic\") '(purpose . \"purpose\"))) pairs" + (slack/get + "conversations.list" + `(("types" . ,(slack/conversation-types)) + ("exclude-archived" . "true")) + (lambda (data) + (setq --data data) + (slack/users + (lambda (users) + (->> data + (assoc-default 'channels) + ->list + (-map + (lambda (chan) + (cons (assoc-default 'id chan) + `((label . ,(channel-label chan users)) + (topic . ,(->> chan + (assoc-default 'topic) + (assoc-default 'value))) + (purpose . ,(->> chan + (assoc-default 'purpose) + (assoc-default 'value))))))) + (funcall cb))))))) + +(comment + (slack/get + "conversations.list" + '(("types" . "public_channel,private_channel,im,mpim")) + (lambda (data) (setq response-data data))) + + (slack/get + "conversations.list" + '(("types" . "im")) + (lambda (data) (setq response-data data))) + + (slack/conversations + (lambda (convos) (setq --conversations convos))) + + ) + +;; Messages + +(cl-defun slack/post-message + (&key text channel-id (on-success #'identity)) + (slack/post "chat.postMessage" + `((text . ,text) + (channel . ,channel-id) + (as_user . t)) + on-success)) + +(comment + + (slack/post-message + :text "hi slackbot" + :channel-id slackbot-channel-id + :on-success (lambda (data) (setq resp data))) + + ) + +;;; +;;; Posting code snippets to slack +;;; + +(defun prompt-for-channel (cb) + (slack/conversations + (lambda (conversations) + (ivy-read + "Select channel: " + ;; TODO want to potentially use purpose / topic stuff here + (->> conversations + (-filter (lambda (c) (assoc-default 'label (cdr c)))) + (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))))) + :history 'slack/channel-history + :action (lambda (selected) + (let ((channel-id (get-text-property 0 'channel-id selected))) + (funcall cb channel-id) + (message "Sent message to %s" selected)))))) + nil) + +(comment + (prompt-for-channel #'message) + (->> --convos + (-filter (lambda (c) (assoc-default 'label (cdr c)))) + (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))))) + + (->> --convos (car) (cdr) (assoc-default 'label)) + ) + +(defun slack-send-code-snippet (&optional snippet-text) + (interactive + (list (buffer-substring-no-properties (mark) (point)))) + (prompt-for-channel + (lambda (channel-id) + (slack/post-message + :text (format "```\n%s```" snippet-text) + :channel-id channel-id)))) + +(provide 'slack-snippets) diff --git a/users/grfn/emacs.d/slack.el b/users/grfn/emacs.d/slack.el new file mode 100644 index 000000000000..54d3b40b099c --- /dev/null +++ b/users/grfn/emacs.d/slack.el @@ -0,0 +1,24 @@ +;;; -*- lexical-binding: t; -*- + +(after! slack + (set-face-foreground 'slack-message-output-header +solarized-s-base01) + (set-face-attribute 'slack-message-output-header nil :underline nil) + (set-face-attribute 'slack-message-output-text nil :height 1.0)) + +(require 'slack) +(setq slack-buffer-emojify 't + slack-prefer-current-team 't + slack-thread-also-send-to-room nil) + +(set-popup-rule! "^\\*Slack" + :quit nil + :select t + :side 'bottom + :ttl nil + :size 0.5) + +(add-hook #'slack-message-buffer-mode-hook + (lambda () (toggle-truncate-lines -1))) + +(map! (:map slack-message-buffer-mode-map + :n "q" #'delete-window)) diff --git a/users/grfn/emacs.d/snippets/haskell-mode/annotation b/users/grfn/emacs.d/snippets/haskell-mode/annotation new file mode 100644 index 000000000000..8a2854d759df --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/annotation @@ -0,0 +1,5 @@ +# key: ann +# name: annotation +# expand-env: ((yas-indent-line 'fixed)) +# -- +{-# ANN ${1:module} ("${2:HLint: ignore ${3:Reduce duplication}}" :: String) #-} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/benchmark-module b/users/grfn/emacs.d/snippets/haskell-mode/benchmark-module new file mode 100644 index 000000000000..cbb1646e41d1 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/benchmark-module @@ -0,0 +1,26 @@ +# key: bench +# name: benchmark-module +# expand-env: ((yas-indent-line (quote fixed))) +# -- +-------------------------------------------------------------------------------- +module ${1:`(if (not buffer-file-name) "Module" + (let ((name (file-name-sans-extension (buffer-file-name))) + (case-fold-search nil)) + (if (cl-search "bench/" name) + (replace-regexp-in-string "/" "." + (replace-regexp-in-string "^\/[^A-Z]*" "" + (car (last (split-string name "src"))))) + (file-name-nondirectory name))))`} ( benchmark, main ) where +-------------------------------------------------------------------------------- +import Bench.Prelude +-------------------------------------------------------------------------------- +import ${1:$(s-chop-suffix "Bench" yas-text)} +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain [benchmark] + +-------------------------------------------------------------------------------- + +benchmark :: Benchmark +benchmark = bgroup "${1:$(->> yas-text (s-chop-suffix "Bench") (s-split ".") -last-item)}" [bench "something dumb" $ nf (1 +) (1 :: Int)] diff --git a/users/grfn/emacs.d/snippets/haskell-mode/header b/users/grfn/emacs.d/snippets/haskell-mode/header new file mode 100644 index 000000000000..fdd8250d86ca --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/header @@ -0,0 +1,5 @@ +# key: hh +# name: header +# expand-env: ((yas-indent-line 'fixed)) +# -- +--------------------------------------------------------------------------------$2 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/hedgehog-generator b/users/grfn/emacs.d/snippets/haskell-mode/hedgehog-generator new file mode 100644 index 000000000000..68863f70542b --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/hedgehog-generator @@ -0,0 +1,8 @@ +# key: gen +# name: Hedgehog Generator +# expand-env: ((yas-indent-line (quote fixed))) +# -- +gen${1:Foo} :: Gen $1 +gen$1 = do + $2 + pure $1{..} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/hedgehog-property b/users/grfn/emacs.d/snippets/haskell-mode/hedgehog-property new file mode 100644 index 000000000000..bf39a2a3eecb --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/hedgehog-property @@ -0,0 +1,9 @@ +# -*- mode: snippet -*- +# name: Hedgehog Property +# key: hprop +# expand-env: ((yas-indent-line 'fixed)) +# -- +hprop_${1:somethingIsAlwaysTrue} :: Property +hprop_$1 = property $ do + ${2:x} <- forAll ${3:Gen.int $ Range.linear 1 100} + ${4:x === x} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/hlint b/users/grfn/emacs.d/snippets/haskell-mode/hlint new file mode 100644 index 000000000000..74b63dc672e4 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/hlint @@ -0,0 +1,8 @@ +# -*- mode: snippet -*- +# name: hlint +# uuid: +# expand-env: ((yas-indent-line 'fixed)) +# key: hlint +# condition: t +# -- +{-# ANN module ("Hlint: ignore $1" :: String) #- } \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/import-i b/users/grfn/emacs.d/snippets/haskell-mode/import-i new file mode 100644 index 000000000000..4a7fca2c2fd6 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/import-i @@ -0,0 +1,4 @@ +# key: i +# name: import-i +# -- +import ${1:Prelude} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/inl b/users/grfn/emacs.d/snippets/haskell-mode/inl new file mode 100644 index 000000000000..6e17b83d7114 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/inl @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: inl +# key: inl +# expand-env: ((yas-indent-line 'fixed)) +# -- +{-# INLINE $1 #-} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/inline b/users/grfn/emacs.d/snippets/haskell-mode/inline new file mode 100644 index 000000000000..1beafbe50b56 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/inline @@ -0,0 +1,5 @@ +# key: inline +# name: inline +# expand-env: ((yas-indent-line 'fixed)) +# -- +{-# INLINE $1 #-} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/language pragma b/users/grfn/emacs.d/snippets/haskell-mode/language pragma new file mode 100644 index 000000000000..6f84720f4511 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/language pragma @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: language pragma +# key: lang +# expand-env: ((yas-indent-line 'fixed)) +# -- +{-# LANGUAGE $1 #-} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/lens.field b/users/grfn/emacs.d/snippets/haskell-mode/lens.field new file mode 100644 index 000000000000..b22ea3d2e888 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/lens.field @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: lens.field +# key: lens +# expand-env: ((yas-indent-line 'fixed)) +# -- +${1:field} :: Lens' ${2:Source} ${3:Target} +$1 = lens _${4:sourceField} $ \\${2:$(-> yas-text s-word-initials s-downcase)} ${4:$(-> yas-text s-word-initials s-downcase)} -> ${2:$(-> yas-text s-word-initials s-downcase)} { _$4 = ${4:$(-> yas-text s-word-initials s-downcase)} } \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/module b/users/grfn/emacs.d/snippets/haskell-mode/module new file mode 100644 index 000000000000..4554d33f9ba7 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/module @@ -0,0 +1,32 @@ +# -*- mode: snippet -*- +# key: module +# name: module +# condition: (= (length "module") (current-column)) +# expand-env: ((yas-indent-line 'fixed)) +# contributor: Luke Hoersten <luke@hoersten.org> +# -- +-------------------------------------------------------------------------------- +-- | +-- Module : $1 +-- Description : $2 +-- Maintainer : Griffin Smith <grfn@urbint.com> +-- Maturity : ${3:Draft, Usable, Maintained, OR MatureAF} +-- +-- $4 +-------------------------------------------------------------------------------- +module ${1:`(if (not buffer-file-name) "Module" + (let ((name (file-name-sans-extension (buffer-file-name))) + (case-fold-search nil)) + (if (or (cl-search "src/" name) + (cl-search "test/" name)) + (replace-regexp-in-string "/" "." + (replace-regexp-in-string "^\/[^A-Z]*" "" + (car (last (split-string name "src"))))) + (file-name-nondirectory name))))`} + ( + ) where +-------------------------------------------------------------------------------- +import Prelude +-------------------------------------------------------------------------------- + +$0 diff --git a/users/grfn/emacs.d/snippets/haskell-mode/shut up, hlint b/users/grfn/emacs.d/snippets/haskell-mode/shut up, hlint new file mode 100644 index 000000000000..fccff1d66f29 --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/shut up, hlint @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: shut up, hlint +# key: dupl +# expand-env: ((yas-indent-line 'fixed)) +# -- +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/test-group b/users/grfn/emacs.d/snippets/haskell-mode/test-group new file mode 100644 index 000000000000..948e90d9e02e --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/test-group @@ -0,0 +1,9 @@ +# -*- mode: snippet -*- +# name: test-group +# uuid: +# key: testGroup +# condition: t +# -- +testGroup "${1:name}" +[ $0 +] \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/test-module b/users/grfn/emacs.d/snippets/haskell-mode/test-module new file mode 100644 index 000000000000..036b0ae9983a --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/test-module @@ -0,0 +1,27 @@ +# -*- mode: snippet -*- +# name: test-module +# key: test +# expand-env: ((yas-indent-line 'fixed)) +# -- +-------------------------------------------------------------------------------- +module ${1:`(if (not buffer-file-name) "Module" + (let ((name (file-name-sans-extension (buffer-file-name))) + (case-fold-search nil)) + (if (cl-search "test/" name) + (replace-regexp-in-string "/" "." + (replace-regexp-in-string "^\/[^A-Z]*" "" + (car (last (split-string name "src"))))) + (file-name-nondirectory name))))`} (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import ${1:$(s-chop-suffix "Spec" yas-text)} +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "$1" + [ $0 + ] \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/haskell-mode/undefined b/users/grfn/emacs.d/snippets/haskell-mode/undefined new file mode 100644 index 000000000000..7bcd99b5716c --- /dev/null +++ b/users/grfn/emacs.d/snippets/haskell-mode/undefined @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: undefined +# key: u +# expand-env: ((yas-indent-line 'fixed) (yas-wrap-around-region 'nil)) +# -- +undefined$1 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/action-type b/users/grfn/emacs.d/snippets/js2-mode/action-type new file mode 100644 index 000000000000..ef8d1a3863ee --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/action-type @@ -0,0 +1,4 @@ +# key: at +# name: action-type +# -- +export const ${1:FOO_BAR$(->> yas-text s-upcase (s-replace-all '(("-" . "_") (" " . "_"))))}: '${3:ns}/${1:$(-> yas-text s-dashed-words)}' = '$3/${1:$(-> yas-text s-dashed-words)}'$5 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/before b/users/grfn/emacs.d/snippets/js2-mode/before new file mode 100644 index 000000000000..4569b6583143 --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/before @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: before +# key: bef +# -- +before(function() { + $1 +}) diff --git a/users/grfn/emacs.d/snippets/js2-mode/context b/users/grfn/emacs.d/snippets/js2-mode/context new file mode 100644 index 000000000000..d83809f3c35e --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/context @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: context +# key: context +# -- +context('$1', function() { + $2 +}) diff --git a/users/grfn/emacs.d/snippets/js2-mode/describe b/users/grfn/emacs.d/snippets/js2-mode/describe new file mode 100644 index 000000000000..bd0198181d02 --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/describe @@ -0,0 +1,6 @@ +# key: desc +# name: describe +# -- +describe('$1', () => { + $2 +}) \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/expect b/users/grfn/emacs.d/snippets/js2-mode/expect new file mode 100644 index 000000000000..eba41ef3309d --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/expect @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: expect +# key: ex +# -- +expect($1).$2 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/function b/users/grfn/emacs.d/snippets/js2-mode/function new file mode 100644 index 000000000000..b423044b4410 --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/function @@ -0,0 +1,6 @@ +# key: f +# name: function +# -- +function $1($2) { + $3 +} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/header b/users/grfn/emacs.d/snippets/js2-mode/header new file mode 100644 index 000000000000..3e303764cb0b --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/header @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: header +# key: hh +# expand-env: ((yas-indent-line 'fixed)) +# -- +//////////////////////////////////////////////////////////////////////////////// diff --git a/users/grfn/emacs.d/snippets/js2-mode/it b/users/grfn/emacs.d/snippets/js2-mode/it new file mode 100644 index 000000000000..a451cfc08a90 --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/it @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: it +# key: it +# -- +it('$1', () => { + $2 +}) \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/it-pending b/users/grfn/emacs.d/snippets/js2-mode/it-pending new file mode 100644 index 000000000000..00da312e1096 --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/it-pending @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: it-pending +# key: xi +# -- +it('$1')$0 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/module b/users/grfn/emacs.d/snippets/js2-mode/module new file mode 100644 index 000000000000..dc79819d8979 --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/module @@ -0,0 +1,12 @@ +# key: module +# name: module +# expand-env: ((yas-indent-line (quote fixed))) +# condition: (= (length "module") (current-column)) +# -- +/** + * @fileOverview $1 + * @name ${2:`(file-name-nondirectory (buffer-file-name))`} + * @author Griffin Smith + * @license Proprietary + */ +$3 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/record b/users/grfn/emacs.d/snippets/js2-mode/record new file mode 100644 index 000000000000..0bb0f024367b --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/record @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: record +# key: rec +# -- +export default class $1 extends Record({ + $2 +}) {} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/js2-mode/test b/users/grfn/emacs.d/snippets/js2-mode/test new file mode 100644 index 000000000000..938d490a74e8 --- /dev/null +++ b/users/grfn/emacs.d/snippets/js2-mode/test @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: test +# key: test +# -- +test('$1', () => { + $2 +}) \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/nix-mode/fetchFromGitHub b/users/grfn/emacs.d/snippets/nix-mode/fetchFromGitHub new file mode 100644 index 000000000000..9b9373573048 --- /dev/null +++ b/users/grfn/emacs.d/snippets/nix-mode/fetchFromGitHub @@ -0,0 +1,12 @@ +# -*- mode: snippet -*- +# name: fetchFromGitHub +# uuid: +# key: fetchFromGitHub +# condition: t +# -- +fetchFromGitHub { + owner = "$1"; + repo = "$2"; + rev = "$3"; + sha256 = "0000000000000000000000000000000000000000000000000000"; +} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/nix-mode/pythonPackage b/users/grfn/emacs.d/snippets/nix-mode/pythonPackage new file mode 100644 index 000000000000..0a74c21e1857 --- /dev/null +++ b/users/grfn/emacs.d/snippets/nix-mode/pythonPackage @@ -0,0 +1,16 @@ +# key: pypkg +# name: pythonPackage +# condition: t +# -- +${1:pname} = buildPythonPackage rec { + name = "\${pname}-\${version}"; + pname = "$1"; + version = "${2:1.0.0}"; + src = fetchPypi { + inherit pname version; + sha256 = "0000000000000000000000000000000000000000000000000000"; + }; + propagatedBuildInputs = with pythonSelf; [ + $3 + ]; +}; \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/nix-mode/sha256 b/users/grfn/emacs.d/snippets/nix-mode/sha256 new file mode 100644 index 000000000000..e3d52e1c0201 --- /dev/null +++ b/users/grfn/emacs.d/snippets/nix-mode/sha256 @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: sha256 +# uuid: +# key: sha256 +# condition: t +# -- +sha256 = "0000000000000000000000000000000000000000000000000000"; \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/org-mode/SQL source block b/users/grfn/emacs.d/snippets/org-mode/SQL source block new file mode 100644 index 000000000000..b5d43fd6bc01 --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/SQL source block @@ -0,0 +1,6 @@ +# key: sql +# name: SQL source block +# -- +#+BEGIN_SRC sql ${1::async} +$2 +#+END_SRC diff --git a/users/grfn/emacs.d/snippets/org-mode/combat b/users/grfn/emacs.d/snippets/org-mode/combat new file mode 100644 index 000000000000..ef46062d09b4 --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/combat @@ -0,0 +1,13 @@ +# -*- mode: snippet -*- +# name: combat +# uuid: +# key: combat +# condition: t +# -- +| | initiative | max hp | current hp | status | | +|-------------+------------+--------+------------+--------+------| +| Barty Barty | | | | | <--- | +| Hectoroth | | | | | | +| Xanadu | | | | | | +| Aurora | | | | | | +| EFB | | | | | | \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/org-mode/date b/users/grfn/emacs.d/snippets/org-mode/date new file mode 100644 index 000000000000..297529cdac64 --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/date @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# key: date +# name: date.org +# -- +[`(format-time-string "%Y-%m-%d")`]$0 diff --git a/users/grfn/emacs.d/snippets/org-mode/date-time b/users/grfn/emacs.d/snippets/org-mode/date-time new file mode 100644 index 000000000000..fde469276c3f --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/date-time @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: date-time +# key: dt +# -- +[`(format-time-string "%Y-%m-%d %H:%m:%S")`] \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/org-mode/description b/users/grfn/emacs.d/snippets/org-mode/description new file mode 100644 index 000000000000..a43bc95cc3ed --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/description @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: description +# key: desc +# -- +:DESCRIPTION: +$1 +:END: diff --git a/users/grfn/emacs.d/snippets/org-mode/nologdone b/users/grfn/emacs.d/snippets/org-mode/nologdone new file mode 100644 index 000000000000..e5be85d6b3c0 --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/nologdone @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: nologdone +# key: nologdone +# -- +#+STARTUP: nologdone$0 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/org-mode/python source block b/users/grfn/emacs.d/snippets/org-mode/python source block new file mode 100644 index 000000000000..247ae51b0b78 --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/python source block @@ -0,0 +1,6 @@ +# key: py +# name: Python source block +# -- +#+BEGIN_SRC python +$0 +#+END_SRC \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/org-mode/reveal b/users/grfn/emacs.d/snippets/org-mode/reveal new file mode 100644 index 000000000000..1bdbdfa5dc36 --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/reveal @@ -0,0 +1,6 @@ +# key: reveal +# name: reveal +# condition: t +# -- +#+ATTR_REVEAL: :frag ${1:roll-in} +$0 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/org-mode/transaction b/users/grfn/emacs.d/snippets/org-mode/transaction new file mode 100644 index 000000000000..37f2dd31caff --- /dev/null +++ b/users/grfn/emacs.d/snippets/org-mode/transaction @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: transaction +# key: begin +# -- +BEGIN; +$0 +ROLLBACK; \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/python-mode/add_column b/users/grfn/emacs.d/snippets/python-mode/add_column new file mode 100644 index 000000000000..47e83850d5b7 --- /dev/null +++ b/users/grfn/emacs.d/snippets/python-mode/add_column @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: add_column +# key: op.add_column +# -- +op.add_column('${1:table}', sa.Column('${2:name}', sa.${3:String()}))$0 diff --git a/users/grfn/emacs.d/snippets/python-mode/decorate b/users/grfn/emacs.d/snippets/python-mode/decorate new file mode 100644 index 000000000000..9448b45c9623 --- /dev/null +++ b/users/grfn/emacs.d/snippets/python-mode/decorate @@ -0,0 +1,15 @@ +# -*- mode: snippet -*- +# name: decorate +# uuid: +# key: decorate +# condition: t +# -- +def wrap(inner): + @wraps(inner) + def wrapped(*args, **kwargs): + ret = inner(*args, **kwargs) + return ret + + return wrapped + +return wrap \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/python-mode/dunder b/users/grfn/emacs.d/snippets/python-mode/dunder new file mode 100644 index 000000000000..c49ec40a15cc --- /dev/null +++ b/users/grfn/emacs.d/snippets/python-mode/dunder @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: dunder +# uuid: +# key: du +# condition: t +# -- +__$1__$0 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/python-mode/name b/users/grfn/emacs.d/snippets/python-mode/name new file mode 100644 index 000000000000..eca6d60b481f --- /dev/null +++ b/users/grfn/emacs.d/snippets/python-mode/name @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: name +# uuid: +# key: name +# condition: t +# -- +__name__ \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/python-mode/op.get_bind.execute b/users/grfn/emacs.d/snippets/python-mode/op.get_bind.execute new file mode 100644 index 000000000000..aba801c6baf9 --- /dev/null +++ b/users/grfn/emacs.d/snippets/python-mode/op.get_bind.execute @@ -0,0 +1,7 @@ +# key: exec +# name: op.get_bind.execute +# -- +op.get_bind().execute( + """ + `(progn (sqlup-mode) "")`$1 + """) diff --git a/users/grfn/emacs.d/snippets/python-mode/pdb b/users/grfn/emacs.d/snippets/python-mode/pdb new file mode 100644 index 000000000000..6b5c0bbc0a73 --- /dev/null +++ b/users/grfn/emacs.d/snippets/python-mode/pdb @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: pdb +# uuid: +# key: pdb +# condition: t +# -- +import pdb; pdb.set_trace() \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/rust-mode/#[macro_use] b/users/grfn/emacs.d/snippets/rust-mode/#[macro_use] new file mode 100644 index 000000000000..fea942a337f6 --- /dev/null +++ b/users/grfn/emacs.d/snippets/rust-mode/#[macro_use] @@ -0,0 +1,5 @@ +# key: macro_use +# name: #[macro_use] +# -- +#[macro_use] +${1:extern crate} ${2:something};$0 diff --git a/users/grfn/emacs.d/snippets/rust-mode/async test b/users/grfn/emacs.d/snippets/rust-mode/async test new file mode 100644 index 000000000000..8465225663fb --- /dev/null +++ b/users/grfn/emacs.d/snippets/rust-mode/async test @@ -0,0 +1,10 @@ +# -*- mode: snippet -*- +# name: async test +# uuid: +# key: atest +# condition: t +# -- +#[tokio::test(flavor = "multi_thread")] +async fn ${1:test_name}() { + `%`$0 +} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/rust-mode/benchmark b/users/grfn/emacs.d/snippets/rust-mode/benchmark new file mode 100644 index 000000000000..f1446923a0e4 --- /dev/null +++ b/users/grfn/emacs.d/snippets/rust-mode/benchmark @@ -0,0 +1,10 @@ +# -*- mode: snippet -*- +# name: benchmark +# uuid: +# key: bench +# condition: t +# -- +#[bench] +fn ${1:benchmark_name}(b: &mut Bencher) { + `%`b.iter(|| $0); +} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/rust-mode/proptest b/users/grfn/emacs.d/snippets/rust-mode/proptest new file mode 100644 index 000000000000..377b3cfcf60c --- /dev/null +++ b/users/grfn/emacs.d/snippets/rust-mode/proptest @@ -0,0 +1,10 @@ +# -*- mode: snippet -*- +# name: proptest +# uuid: +# key: proptest +# condition: t +# -- +#[proptest] +fn ${1:test_name}($2) { + `%`$0 +} \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/rust-mode/tests b/users/grfn/emacs.d/snippets/rust-mode/tests new file mode 100644 index 000000000000..0a476ab58661 --- /dev/null +++ b/users/grfn/emacs.d/snippets/rust-mode/tests @@ -0,0 +1,9 @@ +# key: tests +# name: test module +# -- +#[cfg(test)] +mod ${1:tests} { + use super::*; + + $0 +} diff --git a/users/grfn/emacs.d/snippets/snippet-mode/indent b/users/grfn/emacs.d/snippets/snippet-mode/indent new file mode 100644 index 000000000000..d38ffceafbad --- /dev/null +++ b/users/grfn/emacs.d/snippets/snippet-mode/indent @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: indent +# key: indent +# -- +# expand-env: ((yas-indent-line 'fixed)) \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/sql-mode/count(*) group by b/users/grfn/emacs.d/snippets/sql-mode/count(*) group by new file mode 100644 index 000000000000..6acc46ff397a --- /dev/null +++ b/users/grfn/emacs.d/snippets/sql-mode/count(*) group by @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: count(*) group by +# key: countby +# -- +SELECT count(*), ${1:column} FROM ${2:table} GROUP BY $1; diff --git a/users/grfn/emacs.d/snippets/terraform-mode/variable b/users/grfn/emacs.d/snippets/terraform-mode/variable new file mode 100644 index 000000000000..e64175200f44 --- /dev/null +++ b/users/grfn/emacs.d/snippets/terraform-mode/variable @@ -0,0 +1,11 @@ +# -*- mode: snippet -*- +# name: variable +# uuid: +# key: var +# condition: t +# -- +variable "${1:name}" { + type = ${2:string} + ${3:default = ${4:default}} +} +$0 \ No newline at end of file diff --git a/users/grfn/emacs.d/snippets/text-mode/date b/users/grfn/emacs.d/snippets/text-mode/date new file mode 100644 index 000000000000..7b9431147011 --- /dev/null +++ b/users/grfn/emacs.d/snippets/text-mode/date @@ -0,0 +1,5 @@ +# -*- coding: utf-8 -*- +# name: date +# key: date +# -- +`(format-time-string "%Y-%m-%d")`$0 \ No newline at end of file diff --git a/users/grfn/emacs.d/splitjoin.el b/users/grfn/emacs.d/splitjoin.el new file mode 100644 index 000000000000..dbc9704d7909 --- /dev/null +++ b/users/grfn/emacs.d/splitjoin.el @@ -0,0 +1,192 @@ +;;; -*- lexical-binding: t; -*- + +(require 'dash) +(load! "utils") + +;;; +;;; Vars +;;; + +(defvar +splitjoin/split-callbacks '() + "Alist mapping major mode symbol names to lists of split callbacks") + +(defvar +splitjoin/join-callbacks '() + "Alist mapping major mode symbol names to lists of join callbacks") + + + +;;; +;;; Definition macros +;;; + +(defmacro +splitjoin/defsplit (mode name &rest body) + `(setf + (alist-get ',name (alist-get ,mode +splitjoin/split-callbacks)) + (λ! () ,@body))) + +(defmacro +splitjoin/defjoin (mode name &rest body) + `(setf + (alist-get ',name (alist-get ,mode +splitjoin/join-callbacks)) + (λ! () ,@body))) + +;;; +;;; Commands +;;; + +(defun +splitjoin/split () + (interactive) + (when-let (callbacks (->> +splitjoin/split-callbacks + (alist-get major-mode) + (-map #'cdr))) + (find-if #'funcall callbacks))) + +(defun +splitjoin/join () + (interactive) + (when-let (callbacks (->> +splitjoin/join-callbacks + (alist-get major-mode) + (-map #'cdr))) + (find-if #'funcall callbacks))) + + +;;; +;;; Splits and joins +;;; TODO: this should probably go in a file-per-language +;;; + +(+splitjoin/defjoin + 'elixir-mode + join-do + (let* ((function-pattern (rx (and (zero-or-more whitespace) + "do" + (zero-or-more whitespace) + (optional (and "#" (zero-or-more anything))) + eol))) + (end-pattern (rx bol + (zero-or-more whitespace) + "end" + (zero-or-more whitespace) + eol)) + (else-pattern (rx bol + (zero-or-more whitespace) + "else" + (zero-or-more whitespace) + eol)) + (lineno (line-number-at-pos)) + (line (thing-at-point 'line t))) + (when-let ((do-start-pos (string-match function-pattern line))) + (cond + ((string-match-p end-pattern (get-line (inc lineno))) + (modify-then-indent + (goto-line-char do-start-pos) + (insert ",") + (goto-char (line-end-position)) + (insert ": nil") + (line-move 1) + (delete-line)) + t) + + ((string-match-p end-pattern (get-line (+ 2 lineno))) + (modify-then-indent + (goto-line-char do-start-pos) + (insert ",") + (goto-char (line-end-position)) + (insert ":") + (join-line t) + (line-move 1) + (delete-line)) + t) + + ((and (string-match-p else-pattern (get-line (+ 2 lineno))) + (string-match-p end-pattern (get-line (+ 4 lineno)))) + (modify-then-indent + (goto-line-char do-start-pos) + (insert ",") + (goto-char (line-end-position)) + (insert ":") + (join-line t) + (goto-eol) + (insert ",") + (join-line t) + (goto-eol) + (insert ":") + (join-line t) + (line-move 1) + (delete-line)) + t))))) + +(comment + (string-match (rx (and bol + "if " + (one-or-more anything) + "," + (zero-or-more whitespace) + "do:" + (one-or-more anything) + "," + (zero-or-more whitespace) + "else:" + (one-or-more anything))) + "if 1, do: nil, else: nil") + + ) + +(+splitjoin/defsplit + 'elixir-mode + split-do-with-optional-else + (let* ((if-with-else-pattern (rx (and bol + (one-or-more anything) + "," + (zero-or-more whitespace) + "do:" + (one-or-more anything) + (optional + "," + (zero-or-more whitespace) + "else:" + (one-or-more anything))))) + (current-line (get-line))) + (when (string-match if-with-else-pattern current-line) + (modify-then-indent + (assert (goto-regex-on-line ",[[:space:]]*do:")) + (delete-char 1) + (assert (goto-regex-on-line ":")) + (delete-char 1) + (insert "\n") + (when (goto-regex-on-line-r ",[[:space:]]*else:") + (delete-char 1) + (insert "\n") + (assert (goto-regex-on-line ":")) + (delete-char 1) + (insert "\n")) + (goto-eol) + (insert "\nend")) + t))) + +(comment + (+splitjoin/defsplit 'elixir-mode split-def + (let ((function-pattern (rx (and "," + (zero-or-more whitespace) + "do:"))) + (line (thing-at-point 'line t))) + (when-let (idx (string-match function-pattern line)) + (let ((beg (line-beginning-position)) + (orig-line-char (- (point) (line-beginning-position)))) + (save-mark-and-excursion + (goto-line-char idx) + (delete-char 1) + (goto-line-char (string-match ":" (thing-at-point 'line t))) + (delete-char 1) + (insert "\n") + (goto-eol) + (insert "\n") + (insert "end") + (evil-indent beg (+ (line-end-position) 1)))) + (goto-line-char orig-line-char) + t)))) + +(+splitjoin/defjoin + 'elixir-mode + join-if-with-else + (let* ((current-line (thing-at-point 'line))))) + +(provide 'splitjoin) diff --git a/users/grfn/emacs.d/sql-strings.el b/users/grfn/emacs.d/sql-strings.el new file mode 100644 index 000000000000..eef397a24ea6 --- /dev/null +++ b/users/grfn/emacs.d/sql-strings.el @@ -0,0 +1,75 @@ +;;; -*- lexical-binding: t; -*- + +;;; https://www.emacswiki.org/emacs/StringAtPoint +(defun ourcomments-string-or-comment-bounds-1 (what) + (save-restriction + (widen) + (let* ((here (point)) + ;; Fix-me: when on end-point, how to handle that and which should be last hit point? + (state (parse-partial-sexp (point-min) (1+ here))) + (type (if (nth 3 state) + 'string + (if (nth 4 state) + 'comment))) + (start (when type (nth 8 state))) + end) + (unless start + (setq state (parse-partial-sexp (point-min) here)) + (setq type (if (nth 3 state) + 'string + (if (nth 4 state) + 'comment))) + (setq start (when type (nth 8 state)))) + (unless (or (not what) + (eq what type)) + (setq start nil)) + (if (not start) + (progn + (goto-char here) + nil) + (setq state (parse-partial-sexp (1+ start) (point-max) + nil nil state 'syntax-table)) + (setq end (point)) + (goto-char here) + (cons start end))))) + +(defun ourcomments-bounds-of-string-at-point () + "Return bounds of string at point if any." + (ourcomments-string-or-comment-bounds-1 'string)) + +(put 'string 'bounds-of-thing-at-point 'ourcomments-bounds-of-string-at-point) + +(defun -sanitize-sql-string (str) + (->> str + (downcase) + (s-trim) + (replace-regexp-in-string + (rx (or (and string-start (or "\"\"\"" + "\"")) + (and (or "\"\"\"" + "\"") + string-end))) + "") + (s-trim))) + +(defun sql-string-p (str) + "Returns 't if STR looks like a string literal for a SQL statement" + (setq str (-sanitize-sql-string str)) + (or (s-starts-with? "select" str))) + +;;; tests + +(require 'ert) + +(ert-deftest sanitize-sql-string-test () + (should (string-equal "select * from foo;" + (-sanitize-sql-string + "\"\"\"SELECT * FROM foo;\n\n\"\"\"")))) + +(ert-deftest test-sql-string-p () + (dolist (str '("SELECT * FROM foo;" + "select * from foo;")) + (should (sql-string-p str))) + + (dolist (str '("not a QUERY")) + (should-not (sql-string-p str)))) diff --git a/users/grfn/emacs.d/terraform.el b/users/grfn/emacs.d/terraform.el new file mode 100644 index 000000000000..2d69c9bad9db --- /dev/null +++ b/users/grfn/emacs.d/terraform.el @@ -0,0 +1,31 @@ +;;; -*- lexical-binding: t; -*- + +(add-hook 'terraform-mode-hook #'terraform-format-on-save-mode) + +(defun packer-format-buffer () + (interactive) + (let ((buf (get-buffer-create "*packer-fmt*"))) + (if (zerop (call-process-region (point-min) (point-max) + "packer" nil buf nil "fmt" "-")) + (let ((point (point)) + (window-start (window-start))) + (erase-buffer) + (insert-buffer-substring buf) + (goto-char point) + (set-window-start nil window-start)) + (message "packer fmt failed: %s" (with-current-buffer buf (buffer-string)))) + (kill-buffer buf))) + +(define-minor-mode packer-format-on-save-mode + "Run packer-format-buffer before saving the current buffer" + :lighter nil + (if packer-format-on-save-mode + (add-hook 'before-save-hook #'packer-format-buffer nil t) + (remove-hook 'before-save-hook #'packer-format-buffer t))) + +(defun maybe-init-packer () + (interactive) + (when (s-ends-with-p ".pkr" (file-name-base (buffer-file-name))) + (packer-format-on-save-mode))) + +(add-hook 'hcl-mode-hook #'maybe-init-packer) diff --git a/users/grfn/emacs.d/tests/splitjoin_test.el b/users/grfn/emacs.d/tests/splitjoin_test.el new file mode 100644 index 000000000000..6495a1a5952e --- /dev/null +++ b/users/grfn/emacs.d/tests/splitjoin_test.el @@ -0,0 +1,68 @@ +;;; private/grfn/tests/splitjoin_test.el -*- lexical-binding: t; -*- + +(require 'ert) +;; (load! 'splitjoin) +;; (load! 'utils) +; (require 'splitjoin) + +;;; Helpers + +(defvar *test-buffer* nil) +(make-variable-buffer-local '*test-buffer*) + +(defun test-buffer () + (when (not *test-buffer*) + (setq *test-buffer* (get-buffer-create "test-buffer"))) + *test-buffer*) + +(defmacro with-test-buffer (&rest body) + `(with-current-buffer (test-buffer) + ,@body)) + +(defun set-test-buffer-mode (mode) + (let ((mode (if (functionp mode) mode + (-> mode symbol-name (concat "-mode") intern)))) + (assert (functionp mode)) + (with-test-buffer (funcall mode)))) + +(defmacro set-test-buffer-contents (contents) + (with-test-buffer + (erase-buffer) + (insert contents))) + +(defun test-buffer-contents () + (with-test-buffer (substring-no-properties (buffer-string)))) + +(defmacro assert-test-buffer-contents (expected-contents) + `(should (equal (string-trim (test-buffer-contents)) + (string-trim ,expected-contents)))) + +(defmacro should-join-to (mode original-contents expected-contents) + `(progn + (set-test-buffer-mode ,mode) + (set-test-buffer-contents ,original-contents) + (with-test-buffer (+splitjoin/join)) + (assert-test-buffer-contents ,expected-contents))) + +(defmacro should-split-to (mode original-contents expected-contents) + `(progn + (set-test-buffer-mode ,mode) + (set-test-buffer-contents ,original-contents) + (with-test-buffer (+splitjoin/split)) + (assert-test-buffer-contents ,expected-contents))) + +(defmacro should-splitjoin (mode joined-contents split-contents) + `(progn + (should-split-to ,mode ,joined-contents ,split-contents) + (should-join-to ,mode ,split-contents ,joined-contents))) + +;;; Tests + +;; Elixir +(ert-deftest elixir-if-splitjoin-test () + (should-splitjoin 'elixir + "if predicate?(), do: result" + "if predicate?() do + result +end")) + diff --git a/users/grfn/emacs.d/themes/grfn-solarized-light-theme.el b/users/grfn/emacs.d/themes/grfn-solarized-light-theme.el new file mode 100644 index 000000000000..ae00b6b5fc75 --- /dev/null +++ b/users/grfn/emacs.d/themes/grfn-solarized-light-theme.el @@ -0,0 +1,115 @@ +(require 'solarized) +(eval-when-compile + (require 'solarized-palettes)) + +;; (defun grfn-solarized-theme () +;; (custom-theme-set-faces +;; theme-name +;; `(font-lock-doc-face ((,class (:foreground ,s-base1)))) +;; `(font-lock-preprocessor-face ((,class (:foreground ,red)))) +;; `(font-lock-keyword-face ((,class (:foreground ,green)))) + +;; `(elixir-attribute-face ((,class (:foreground ,blue)))) +;; `(elixir-atom-face ((,class (:foreground ,cyan)))))) + +(setq +solarized-s-base03 "#002b36" + +solarized-s-base02 "#073642" + ;; emphasized content + +solarized-s-base01 "#586e75" + ;; primary content + +solarized-s-base00 "#657b83" + +solarized-s-base0 "#839496" + ;; comments + +solarized-s-base1 "#93a1a1" + ;; background highlight light + +solarized-s-base2 "#eee8d5" + ;; background light + +solarized-s-base3 "#fdf6e3" + + ;; Solarized accented colors + +solarized-yellow "#b58900" + +solarized-orange "#cb4b16" + +solarized-red "#dc322f" + +solarized-magenta "#d33682" + +solarized-violet "#6c71c4" + +solarized-blue "#268bd2" + +solarized-cyan "#2aa198" + +solarized-green "#859900" + + ;; Darker and lighter accented colors + ;; Only use these in exceptional circumstances! + +solarized-yellow-d "#7B6000" + +solarized-yellow-l "#DEB542" + +solarized-orange-d "#8B2C02" + +solarized-orange-l "#F2804F" + +solarized-red-d "#990A1B" + +solarized-red-l "#FF6E64" + +solarized-magenta-d "#93115C" + +solarized-magenta-l "#F771AC" + +solarized-violet-d "#3F4D91" + +solarized-violet-l "#9EA0E5" + +solarized-blue-d "#00629D" + +solarized-blue-l "#69B7F0" + +solarized-cyan-d "#00736F" + +solarized-cyan-l "#69CABF" + +solarized-green-d "#546E00" + +solarized-green-l "#B4C342") + + +(deftheme grfn-solarized-light "The light variant of Griffin's solarized theme") + +(setq grfn-solarized-faces + '("Griffin's solarized theme customization" + (custom-theme-set-faces + theme-name + `(font-lock-doc-face ((t (:foreground ,+solarized-s-base1)))) + `(font-lock-preprocessor-face ((t (:foreground ,+solarized-red)))) + `(font-lock-keyword-face ((t (:foreground ,+solarized-green)))) + + `(elixir-attribute-face ((t (:foreground ,+solarized-blue)))) + `(elixir-atom-face ((t (:foreground ,+solarized-cyan)))) + `(agda2-highlight-keyword-face ((t (:foreground ,green)))) + `(agda2-highlight-string-face ((t (:foreground ,cyan)))) + `(agda2-highlight-number-face ((t (:foreground ,violet)))) + `(agda2-highlight-symbol-face ((((background ,base3)) (:foreground ,base01)))) + `(agda2-highlight-primitive-type-face ((t (:foreground ,blue)))) + `(agda2-highlight-bound-variable-face ((t nil))) + `(agda2-highlight-inductive-constructor-face ((t (:foreground ,green)))) + `(agda2-highlight-coinductive-constructor-face ((t (:foreground ,yellow)))) + `(agda2-highlight-datatype-face ((t (:foreground ,blue)))) + `(agda2-highlight-field-face ((t (:foreground ,red)))) + `(agda2-highlight-function-face ((t (:foreground ,blue)))) + `(agda2-highlight-module-face ((t (:foreground ,yellow)))) + `(agda2-highlight-postulate-face ((t (:foreground ,blue)))) + `(agda2-highlight-primitive-face ((t (:foreground ,blue)))) + `(agda2-highlight-record-face ((t (:foreground ,blue)))) + `(agda2-highlight-dotted-face ((t nil))) + `(agda2-highlight-operator-face ((t nil))) + `(agda2-highlight-error-face ((t (:foreground ,red :underline t)))) + `(agda2-highlight-unsolved-meta-face ((t (:background ,base2)))) + `(agda2-highlight-unsolved-constraint-face ((t (:background ,base2)))) + `(agda2-highlight-termination-problem-face ((t (:background ,orange :foreground ,base03)))) + `(agda2-highlight-incomplete-pattern-face ((t (:background ,orange :foreground ,base03)))) + `(agda2-highlight-typechecks-face ((t (:background ,cyan :foreground ,base03)))) + + `(font-lock-doc-face ((t (:foreground ,+solarized-s-base1)))) + `(font-lock-preprocessor-face ((t (:foreground ,+solarized-red)))) + `(font-lock-keyword-face ((t (:foreground ,+solarized-green :bold nil)))) + `(font-lock-builtin-face ((t (:foreground ,+solarized-s-base01 + :bold t)))) + + `(elixir-attribute-face ((t (:foreground ,+solarized-blue)))) + `(elixir-atom-face ((t (:foreground ,+solarized-cyan)))) + `(linum ((t (:background ,+solarized-s-base2 :foreground ,+solarized-s-base1)))) + `(line-number ((t (:background ,+solarized-s-base2 :foreground ,+solarized-s-base1)))) + + `(haskell-operator-face ((t (:foreground ,+solarized-green)))) + `(haskell-keyword-face ((t (:foreground ,+solarized-cyan)))) + + `(org-drawer ((t (:foreground ,+solarized-s-base1 + :bold t))))))) + +(solarized-with-color-variables + 'light 'grfn-solarized-light solarized-light-color-palette-alist) + +(provide-theme 'grfn-solarized-light) diff --git a/users/grfn/emacs.d/utils.el b/users/grfn/emacs.d/utils.el new file mode 100644 index 000000000000..21192753a268 --- /dev/null +++ b/users/grfn/emacs.d/utils.el @@ -0,0 +1,114 @@ +;;; -*- lexical-binding: t; -*- + + +;; Elisp Extras + +(defmacro comment (&rest _body) + "Comment out one or more s-expressions" + nil) + +(defun inc (x) "Returns x + 1" (+ 1 x)) +(defun dec (x) "Returns x - 1" (- x 1)) + +(defun average (ns) + "Arithmetic mean of xs" + (if (null ns) nil + (/ (apply #'+ ns) + (length ns)))) + +(comment + (average (list 1 2 3 4)) + ) + +;; +;; Text editing utils +;; + +;; Reading strings + +(defun get-char (&optional point) + "Get the character at the given `point' (defaulting to the current point), +without properties" + (let ((point (or point (point)))) + (buffer-substring-no-properties point (+ 1 point)))) + +(defun get-line (&optional lineno) + "Read the line number `lineno', or the current line if `lineno' is nil, and +return it as a string stripped of all text properties" + (let ((current-line (line-number-at-pos))) + (if (or (not lineno) + (= current-line lineno)) + (thing-at-point 'line t) + (save-mark-and-excursion + (line-move (- lineno (line-number-at-pos))) + (thing-at-point 'line t))))) + +(defun get-line-point () + "Get the position in the current line of the point" + (- (point) (line-beginning-position))) + +;; Moving in the file + +(defun goto-line-char (pt) + "Moves the point to the given position expressed as an offset from the start +of the line" + (goto-char (+ (line-beginning-position) pt))) + +(defun goto-eol () + "Moves to the end of the current line" + (goto-char (line-end-position))) + +(defun goto-regex-on-line (regex) + "Moves the point to the first occurrence of `regex' on the current line. +Returns nil if the regex did not match, non-nil otherwise" + (when-let ((current-line (get-line)) + (line-char (string-match regex current-line))) + (goto-line-char line-char))) + +(defun goto-regex-on-line-r (regex) + "Moves the point to the *last* occurrence of `regex' on the current line. +Returns nil if the regex did not match, non-nil otherwise" + (when-let ((current-line (get-line)) + (modified-regex (concat ".*\\(" regex "\\)")) + (_ (string-match modified-regex current-line)) + (match-start (match-beginning 1))) + (goto-line-char match-start))) + +(comment + (progn + (string-match (rx (and (zero-or-more anything) + (group "foo" "foo"))) + "foofoofoo") + (match-beginning 1))) + +;; Changing file contents + +(defun delete-line () + "Remove the line at the current point" + (delete-region (line-beginning-position) + (inc (line-end-position)))) + +(defmacro modify-then-indent (&rest body) + "Modify text in the buffer according to body, then re-indent from where the + cursor started to where the cursor ended up, then return the cursor to where + it started." + `(let ((beg (line-beginning-position)) + (orig-line-char (- (point) (line-beginning-position)))) + (atomic-change-group + (save-mark-and-excursion + ,@body + (evil-indent beg (+ (line-end-position) 1)))) + (goto-line-char orig-line-char))) + +(pcase-defmacro s-starts-with (prefix) + `(pred (s-starts-with-p ,prefix))) + +(pcase-defmacro s-contains (needle &optional ignore-case) + `(pred (s-contains-p ,needle + ,@(when ignore-case (list ignore-case))))) + +(comment + (pcase "foo" + ((s-contains "bar") 1) + ((s-contains "o") 2)) + ) diff --git a/users/grfn/emacs.d/vterm.el b/users/grfn/emacs.d/vterm.el new file mode 100644 index 000000000000..a7fdea46da32 --- /dev/null +++ b/users/grfn/emacs.d/vterm.el @@ -0,0 +1,24 @@ +;;; -*- lexical-binding: t; -*- + +(defun require-vterm () + (add-to-list + 'load-path + (concat + (s-trim + (shell-command-to-string + "nix-build --no-out-link ~/code/depot -A third_party.emacs.vterm")) + "/share/emacs/site-lisp/elpa/vterm-20200515.1412")) + (require 'vterm)) + +(defun +grfn/vterm-setup () + (hide-mode-line-mode) + (setq-local evil-collection-vterm-send-escape-to-vterm-p t)) + +(add-hook 'vterm-mode-hook #'+grfn/vterm-setup) + +(map! (:map vterm-mode-map + "<C-escape>" #'evil-normal-state)) + +(comment + (require-vterm) + ) diff --git a/users/grfn/gws.fyi/.envrc b/users/grfn/gws.fyi/.envrc new file mode 100644 index 000000000000..be81feddb1a5 --- /dev/null +++ b/users/grfn/gws.fyi/.envrc @@ -0,0 +1 @@ +eval "$(lorri direnv)" \ No newline at end of file diff --git a/users/grfn/gws.fyi/.gitignore b/users/grfn/gws.fyi/.gitignore new file mode 100644 index 000000000000..2b72eaed2988 --- /dev/null +++ b/users/grfn/gws.fyi/.gitignore @@ -0,0 +1,3 @@ +result +letsencrypt +index.html diff --git a/users/grfn/gws.fyi/Makefile b/users/grfn/gws.fyi/Makefile new file mode 100644 index 000000000000..d6c9f40c9536 --- /dev/null +++ b/users/grfn/gws.fyi/Makefile @@ -0,0 +1,31 @@ +.PHONY: deploy + +deploy: + @$(shell nix-build `git rev-parse --show-toplevel` -A 'users.grfn."gws.fyi"') + +renew: + @echo Renewing... + @certbot certonly \ + --manual \ + --domain www.gws.fyi \ + --preferred-challenges dns \ + --server https://acme-v02.api.letsencrypt.org/directory \ + --agree-tos \ + --work-dir $(shell pwd)/letsencrypt/work \ + --logs-dir $(shell pwd)/letsencrypt/logs \ + --config-dir $(shell pwd)/letsencrypt/config + @echo "Reimporting certificate" + @aws acm import-certificate \ + --profile personal \ + --certificate file://letsencrypt/config/live/www.gws.fyi/cert.pem \ + --certificate-chain file://letsencrypt/config/live/www.gws.fyi/fullchain.pem \ + --private-key file://letsencrypt/config/live/www.gws.fyi/privkey.pem \ + --certificate-arn arn:aws:acm:us-east-1:797089351721:certificate/628e54f3-55f9-49c0-811a-eba516b68e30 \ + --region us-east-1 + +backup: + @tarsnap -cf $(shell uname -n)-letsencrypt-$(shell date +%Y-%m-%d_%H-%M-%S) \ + letsencrypt/ + +open: + $$BROWSER "https://www.gws.fyi" diff --git a/users/grfn/gws.fyi/config.el b/users/grfn/gws.fyi/config.el new file mode 100644 index 000000000000..b05d897d3ddb --- /dev/null +++ b/users/grfn/gws.fyi/config.el @@ -0,0 +1,6 @@ +(require 'org) + +(setq org-html-postamble nil) + +(defadvice org-export-grab-title-from-buffer + (around org-export-grab-title-from-buffer-disable activate)) diff --git a/users/grfn/gws.fyi/default.nix b/users/grfn/gws.fyi/default.nix new file mode 100644 index 000000000000..5b7d8fc0e19a --- /dev/null +++ b/users/grfn/gws.fyi/default.nix @@ -0,0 +1,35 @@ +args@{ pkgs, depot, ... }: +with pkgs; +let + site = import ./site.nix args; + resume = import ../resume args; + bucket = "s3://gws.fyi"; + distributionID = "E2ST43JNBH8C64"; + + css = runCommand "main.css" { + buildInputs = [ pkgs.minify ]; + } '' + minify --type css < ${./main.css} > $out + ''; + + keys = runCommand "ssh-keys" {} '' + touch $out + echo "${depot.users.grfn.keys.main}" >> $out + ''; + + website = + runCommand "gws.fyi" { } '' + mkdir -p $out + cp ${css} $out/main.css + cp ${site.index} $out/index.html + cp -r ${site.recipes} $out/recipes + cp ${resume} $out/resume.pdf + cp ${keys} $out/keys + ''; + +in (writeShellScript "deploy.sh" '' + ${awscli2}/bin/aws --profile personal s3 sync ${website}/ ${bucket} + echo "Deployed to http://gws.fyi" +'') // { + inherit website site; +} diff --git a/users/grfn/gws.fyi/index.org b/users/grfn/gws.fyi/index.org new file mode 100644 index 000000000000..fa47b7c03668 --- /dev/null +++ b/users/grfn/gws.fyi/index.org @@ -0,0 +1,39 @@ +#+OPTIONS: title:nil toc:nil num:nil +#+HTML_HEAD: <title>griffin smith</title> +#+HTML_HEAD: <link rel="stylesheet" href="./main.css"> + +my name is griffin ward smith (aka grfn, glittershark, gws) and i'm a software +engineer and musician + +* code + +- [[https://github.com/glittershark/][github]] +- [[https://cs.tvl.fyi/depot/-/tree/users/grfn][my directory in the tvl monorepo]] + +* work + +i'm currently working for a relatively new stealth-mode startup. i can't talk much +about it yet, but if you're interested in rust, distributed systems, and +databases please reach out + +* projects + +- [[https://windtunnel.ci/][windtunnel]], a continuous benchmarking software-as-a-service currently accepting early alpha users (send me an email if you want to try it out!) +- [[https://cs.tvl.fyi/depot/-/tree/users/grfn/achilles][achilles]], a compiler for (what I plan to become) a dependently typed, low-level functional programming language targeting LLVM +- [[https://github.com/glittershark/org-clubhouse][org-clubhouse]], an emacs package for lightweight integration between [[https://orgmode.org/][org-mode]] and [[https://clubhouse.io/][the clubhouse project management tool]] +- [[https://cs.tvl.fyi/depot/-/tree/users/grfn/xanthous][xanthous]], a terminal roguelike in haskell that I work on intermittently and exclusively for fun \\ + you can now try xanthous out over ssh by running ~ssh -p 2222 xanthous.gws.fyi~. if you do so I'd love if you send me an email about it + +* music + +- https://sacrosanct.bandcamp.com/, a post-rock project with a [[https://bandcamp.com/h34rken][friend of mine]] +- [[https://soundcloud.com/missingggg][my current soundcloud]], releasing instrumental hip-hop under the name *missing* +- you can also find a log of all the music I listen to [[https://www.last.fm/user/wildgriffin45][on last.fm]] + +* contact + +- [[mailto:web@gws.fyi][web@gws.fyi]] +- [[https://twitter.com/glittershark1][twitter]] +- https://keybase.io/glittershark +- grfn on IRC (hackint or libera.chat) +- [[http://keys.gnupg.net/pks/lookup?op=get&search=0x44EF5B5E861C09A7][gpg key: 0F11A989879E8BBBFDC1E23644EF5B5E861C09A7]] diff --git a/users/grfn/gws.fyi/main.css b/users/grfn/gws.fyi/main.css new file mode 100644 index 000000000000..cdcd440766ca --- /dev/null +++ b/users/grfn/gws.fyi/main.css @@ -0,0 +1,139 @@ +@import url(https://fonts.googleapis.com/css?family=Inconsolata|Inter&display=swap); + +body { + margin-top: 40px; + max-width: 900px; + line-height: 1.6; + font-size: 16px; + background: #f8f3ff; + color: #3a1616; + padding: 0 10px; + font-family: Inter, sans-serif; +} + +@media (min-width: 1050px) { + body { + margin-left: 150px; + } +} + +@media (min-width: 2000px) { + body { + margin-left: 300px; + } +} + +input { + padding: 10px 16px; + margin: 2px 0; + box-sizing: border-box; + border: 2px solid #dabebe; + border-radius: 6px; + background: #f8f3ff; + color: #3a1616; + font-size: 16px; + -webkit-transition: 0.5s; + transition: 0.5s; + outline: 0; +} + +input:focus { + border: 2px solid #3a1616; +} + +.button { + background-color: #f8f3ff; + border: none; + color: #000; + padding: 6px 14px; + text-align: center; + text-decoration: none; + display: inline-block; + font-size: 16px; + margin: 4px 2px; + transition-duration: 0.4s; + cursor: pointer; + border: 2px solid #3a1616; + border-radius: 6px; +} + +.button:hover { + background-color: #3a1616; + color: #fff; +} + +.isa_error, +.isa_info, +.isa_success, +.isa_warning { + width: 90%; + margin: 10px 0; + padding: 12px; +} + +.isa_info { + color: #00529b; + background-color: #bde5f8; +} + +.isa_success { + color: #4f8a10; + background-color: #dff2bf; +} + +.isa_warning { + color: #9f6000; + background-color: #feefb3; +} + +.isa_error { + color: #d8000c; + background-color: #ffd2d2; +} + +h1, +h2, +h3 { + line-height: 1.2; + font-family: Inter, sans-serif; +} + +h1.title, +h2.title, +h3.title { + text-align: left; + margin-bottom: 1.5em; +} + +h2 { + font-size: 18px; +} + +img { + max-width: 750px; + border-radius: 10px; +} + +a { + cursor: pointer; + color: #217ab7; + line-height: inherit; +} + +a:hover { + background-color: #e3d6ff; +} + +a:visited { + color: #43458b; + border-color: #43458b; +} + +pre { + font-family: Inconsolata, monospace; +} + +::selection { + color: #fff; + background: #ff4081; +} diff --git a/users/grfn/gws.fyi/orgExportHTML.nix b/users/grfn/gws.fyi/orgExportHTML.nix new file mode 100644 index 000000000000..ac28580a5926 --- /dev/null +++ b/users/grfn/gws.fyi/orgExportHTML.nix @@ -0,0 +1,70 @@ +{ pkgs, depot, ... }: + +with pkgs; +with lib; + +let + + emacsWithPackages = (pkgs.emacsPackagesGen pkgs.emacs27).emacsWithPackages; + + emacs = emacsWithPackages (p: with p; [ + org + ]); + +in + +opts: + +let + src = if isAttrs opts then opts.src else opts; + headline = if isAttrs opts then opts.headline else null; + + bn = builtins.baseNameOf src; + filename = elemAt (splitString "." bn) 0; + + outName = + if isNull headline + then + let bn = builtins.baseNameOf src; + filename = elemAt (splitString "." bn) 0; + in + if depot.nix.utils.isDirectory src + then filename + else filename + ".html" + else "${filename}-${replaceStrings [" "] ["-"] filename}.html"; + + escapeDoubleQuotes = replaceStrings ["\""] ["\\\""]; + + navToHeadline = optionalString (! isNull headline) '' + (search-forward "${escapeDoubleQuotes headline}") + (org-narrow-to-subtree) + ''; + +in + +runCommand outName { inherit src; } '' + buildFile() { + cp "$1" file.org + ${emacs}/bin/emacs --batch \ + --load ${./config.el} \ + --visit file.org \ + --eval "(progn + ${escapeDoubleQuotes navToHeadline} + (org-html-export-to-html))" \ + --kill + rm file.org + substitute file.html "$2" \ + --replace '<title>‎</title>' "" + rm file.html + } + + if [ -d $src ]; then + for file in $src/*; do + result=''${file/$src/$out} + mkdir -p $(dirname $result) + buildFile $file ''${result/.org/.html} + done + else + buildFile $src $out + fi +'' diff --git a/users/grfn/gws.fyi/recipes/tomato-sauce.org b/users/grfn/gws.fyi/recipes/tomato-sauce.org new file mode 100644 index 000000000000..74e9b103c670 --- /dev/null +++ b/users/grfn/gws.fyi/recipes/tomato-sauce.org @@ -0,0 +1,102 @@ +#+TITLE: Tomato Sauce +#+OPTIONS: toc:nil num:nil +#+HTML_HEAD: <link rel="stylesheet" href="../main.css"> + +This is a general, all-purpose framework for turning some form of tomatoes into +some form of sauce. You can use fresh tomatoes or canned (the latter are really +quite surprisingly good sometimes), and include or omit garlic, basil, or other +add-ins. The only real non-negotiable ingredients are tomatoes (duh), onion, and +some kind of fat (I prefer butter). + +* Sauce + +1. *Prep*. If starting with canned tomatoes, skip this step. if starting with + whole tomatoes (which you should really only ever do if you grew them + yourself or got them fresh at a farmers market, grocery store tomatoes are + kinda sad), first, peel the tomatoes. The easiest way to do this is to score + them with an X pattern cut as shallow as possible while still breaking the + skin, trying to cover the whole surface area of the tomato, blanch them + briefly in boiling water, then dunk into an ice bath. After this, the skins + will slip right off. After peeling, cut out the stem, core, and any green or + brown bits, and go to the next step + +2. *Base layer*. Couple of variables here, though a perfectly good (in fact, my + usual go-to) tomato sauce can also skip this entire step: + - If you want meat with your sauce (pancetta/guanciale/bacon for an + amatriciana, ground beef or pork for a bolognese) you'll start out by + sautéing that in some sort of fat (probably olive oil), less fat for meat + with a lot of fat already in it, to brown and render out fat from the meat + - If you want onion in the final sauce, you'll chop them finely and sauté + them with whatever fat you've got (either from the meat, or olive oil or + butter if you're not making a meat sauce). Remember to always add a *bit* + of salt when sautéing onion like this, not for flavor but to draw out the + moisture. If you just want onion flavor but not bits of onion in the final + sauce, it's added whole later (so ignore this bullet point). + - If you feel like it (sometimes I do, usually I don't) you can also mince + garlic here and sauté that in with everything else. Add a little after the + onion, as garlic cooks slower than onion unless you want something roastier + (usually you don't for tomato sauce) + - The traditional (so I'm told) thing to do with amatriciana, but also nice + with all variations, is to add in a little crushed red pepper with the + fat to flavor it slightly, but do this late so it doesn't burn + - If you have tomato paste on hand and feel like using it, it's also nice to + fry that in the oil for a little bit - usually I'd do that around the same + time as the garlic + + If you're making tomato *paste* from your sauce, skip all of this - paste is + an ingredient, not a sauce on its own, so imo should be as neutral as + possible (i.e. just tomato). + +3. *Tomato layer*. Not a whole lot to do here, just add all of your tomatoes - + either your peeled and de-cored tomatoes from step 1 if you're using whole + tomatoes, or an entire can of whole, peeled san marzano tomatoes, including + the juice in the can - to a pot over medium-high heat. If you need more fat + or if you skipped step 2, this is where you'd add it - a classic and my + personal favorite is like 2/3rds to 3/4ths of a stick of butter, but you can + also go with olive oil. If you skipped the onion in step 2, add that here + too - usually that'd just be a fist-sized amount of onion or so peeled but + left with the stem on so you can fish it out from your final sauce later (and + snack on it!). Also salt here, again not to taste but primarily to draw out + moisture from the various ingredients. + +4. You can cook that for a wide variety of times, especially depending on how + hot you make your stove - there ends up being *lot* of liquid in there, so + you can go (in my experience) a reasonable amount hotter than you expect + without burning the sauce, though obviously your mileage may vary. The main + thing you're looking for is the whole chunks of tomato to break down, and the + whole sauce to get a texture that looks like it'll end up sticking to pasta + nicely. In all versions of this, stir pretty regularly with a wooden spoon, + and use the spoon to crush the big chunks of tomato occasionally. + +5. *Final layer*. Usually I don't do anything here - but if you feel + like it, usually right as you take stuff off the heat is where you'd add + basil, if you're using it. You can also add sugar to balance out too much + acidity from an especially acidic tomato here - I'm not going to tell anyone. + Also salt, but make sure to account for the extra salt you're gonna get from + the pasta water (see step 6) + +6. *Pasta*. You know how to cook pasta, I'm not going to tell you that. But, + like, salt your water until it tastes too salty, and remember to move the + pasta itself *directly* into the sauce pot from the pasta pot before it's + completely done cooking and without straining, bringing along some of the + pasta water (and a little extra for good measure) then finishing the pasta in + the sauce. You know, the thing you do for pasta. Remember the pasta water + will have salt in it, so adjust for that when salting the sauce overall (I + have made this mistake and ended up with too-salty pasta sauce). + +* Paste + +Start with the above recipe for tomato sauce, noting especially that (in my +opinion) you should skip step 2 entirely. Keep cooking the sauce until it's +*too* thick for pasta sauce (but don't burn it!), then spread it out across some +sort of lined sheet pan (like a silpat, if you've got one) and bake in the oven +at like 250-300 degrees for a *hell* of a long time - I've seen this take like +10 hours, for an especially juicy batch of tomatoes, but obviously keep a close +eye on it because it *definitely will burn* eventually. You're looking for the +end result to be the texture of tomato paste, because that's what the recipe is +for. Especially if you're using garden-grown or otherwise fresh tomatoes, +you'll notice quite a few seeds in the final product - don't worry too much +about those, they've never bothered me. Once everything's done and cooled down, +store in a jar in a fridge, topped with olive oil to seal things off and prevent +oxidation. Use in all your future endeavors, including the tomato sauce recipe +above itself. Tomato sauce is a beautiful oroborous. diff --git a/users/grfn/gws.fyi/shell.nix b/users/grfn/gws.fyi/shell.nix new file mode 100644 index 000000000000..846bdb6677a3 --- /dev/null +++ b/users/grfn/gws.fyi/shell.nix @@ -0,0 +1,9 @@ +with import <nixpkgs> { config.allowUnfree = true; }; +mkShell { + buildInputs = [ + awscli + gnumake + letsencrypt + tarsnap + ]; +} diff --git a/users/grfn/gws.fyi/site.nix b/users/grfn/gws.fyi/site.nix new file mode 100644 index 000000000000..33d4a71e7b1f --- /dev/null +++ b/users/grfn/gws.fyi/site.nix @@ -0,0 +1,12 @@ +args@{ pkgs ? import <nixpkgs> {}, ... }: + +let + + orgExportHTML = import ./orgExportHTML.nix args; + +in + +{ + index = orgExportHTML ./index.org; + recipes = orgExportHTML ./recipes; +} diff --git a/users/grfn/keyboard/.gitignore b/users/grfn/keyboard/.gitignore new file mode 100644 index 000000000000..b2be92b7db01 --- /dev/null +++ b/users/grfn/keyboard/.gitignore @@ -0,0 +1 @@ +result diff --git a/users/grfn/keyboard/README.org b/users/grfn/keyboard/README.org new file mode 100644 index 000000000000..b085883a1049 --- /dev/null +++ b/users/grfn/keyboard/README.org @@ -0,0 +1,10 @@ +This repository contains the source of the keyboard layout for my Ergodox EZ, +plus build tooling based on Nix. + +To flash to an Ergodox EZ that's connected to your computer via USB, run: + +#+BEGIN_SRC shell +./flash +#+END_SRC + +then press the reset switch on the keyboard. diff --git a/users/grfn/keyboard/default.nix b/users/grfn/keyboard/default.nix new file mode 100644 index 000000000000..dda1d9682cbf --- /dev/null +++ b/users/grfn/keyboard/default.nix @@ -0,0 +1,63 @@ +{ pkgs, ... }: + +with pkgs; + +let avrlibc = pkgsCross.avr.libcCross; in + +rec { + qmkSource = fetchgit { + url = "https://github.com/qmk/qmk_firmware"; + rev = "ab1650606c36f85018257aba65d9c3ff8ec42e71"; + sha256 = "1k59flkvhjzmfl0yz9z37lqhvad7m9r5wy1p1sjk5274rsmylh79"; + fetchSubmodules = true; + }; + + layout = stdenv.mkDerivation rec { + name = "ergodox_ez_grfn.hex"; + + src = qmkSource; + + buildInputs = [ + dfu-programmer + dfu-util + diffutils + git + python3 + pkgsCross.avr.buildPackages.binutils + pkgsCross.avr.buildPackages.gcc + avrlibc + avrdude + ]; + + AVR_CFLAGS = [ + "-isystem ${avrlibc}/avr/include" + "-L${avrlibc}/avr/lib/avr5" + ]; + + AVR_ASFLAGS = AVR_CFLAGS; + + patches = [ ./increase-tapping-delay.patch ]; + + postPatch = '' + mkdir keyboards/ergodox_ez/keymaps/grfn + cp ${./keymap.c} keyboards/ergodox_ez/keymaps/grfn/keymap.c + ''; + + buildPhase = '' + make ergodox_ez:grfn + ''; + + installPhase = '' + cp ergodox_ez_grfn.hex $out + ''; + }; + + flash = writeShellScript "flash.sh" '' + ${teensy-loader-cli}/bin/teensy-loader-cli \ + -v \ + --mcu=atmega32u4 \ + -w ${layout} + ''; + + meta.targets = [ "layout" ]; +} diff --git a/users/grfn/keyboard/flash b/users/grfn/keyboard/flash new file mode 100755 index 000000000000..76def36f9ca8 --- /dev/null +++ b/users/grfn/keyboard/flash @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +exec "$(nix-build --no-out-link ../../.. -A users.grfn.keyboard.flash)" diff --git a/users/grfn/keyboard/increase-tapping-delay.patch b/users/grfn/keyboard/increase-tapping-delay.patch new file mode 100644 index 000000000000..316c435fed6c --- /dev/null +++ b/users/grfn/keyboard/increase-tapping-delay.patch @@ -0,0 +1,13 @@ +diff --git a/keyboards/ergodox_ez/config.h b/keyboards/ergodox_ez/config.h +index ae70c4f2e..776110c09 100644 +--- a/keyboards/ergodox_ez/config.h ++++ b/keyboards/ergodox_ez/config.h +@@ -45,7 +45,7 @@ along with this program. If not, see <http://www.gnu.org/licenses/>. + /* define if matrix has ghost */ + //#define MATRIX_HAS_GHOST + +-#define TAPPING_TERM 200 ++#define TAPPING_TERM 150 + #define IGNORE_MOD_TAP_INTERRUPT // this makes it possible to do rolling combos (zx) with keys that convert to other keys on hold (z becomes ctrl when you hold it, and when this option isn't enabled, z rapidly followed by x actually sends Ctrl-x. That's bad.) + + /* Mechanical locking support. Use KC_LCAP, KC_LNUM or KC_LSCR instead in keymap */ diff --git a/users/grfn/keyboard/keymap.c b/users/grfn/keyboard/keymap.c new file mode 100644 index 000000000000..fbb28c9aac59 --- /dev/null +++ b/users/grfn/keyboard/keymap.c @@ -0,0 +1,206 @@ +#include QMK_KEYBOARD_H +#include "debug.h" +#include "action_layer.h" +#include "version.h" + + +#include "keymap_german.h" + +#include "keymap_nordic.h" + + + +enum custom_keycodes { + PLACEHOLDER = SAFE_RANGE, // can always be here + EPRM, + VRSN, + RGB_SLD, + + EX_PIPE, // |> + THIN_ARROW, // -> + FAT_ARROW, // => +}; + + + +#define LAMBDA UC(0x03BB) + +const uint16_t PROGMEM keymaps[][MATRIX_ROWS][MATRIX_COLS] = { + + [0] = LAYOUT_ergodox( + KC_EQUAL, KC_1, KC_2, KC_3, KC_4, KC_5, KC_LEFT, + KC_TAB, KC_Q, KC_W, KC_E, KC_R, KC_T, KC_LALT, + KC_ESCAPE, KC_A, KC_S, KC_D, KC_F, KC_G, + KC_RSFT, CTL_T(KC_Z), KC_X, KC_C, KC_V, KC_B, KC_TAB, + LT(1,KC_GRAVE), KC_QUOTE, LALT(KC_LSHIFT),KC_LEFT,KC_RIGHT, + ALT_T(KC_APPLICATION), LAMBDA, + KC_LBRACKET, + GUI_T(KC_NO), LSFT_T(KC_BSPACE), KC_COLN, + + KC_MY_COMPUTER, KC_6, KC_7, KC_8, KC_9, KC_0, KC_MINUS, + KC_RALT, KC_Y, KC_U, KC_I, KC_O, KC_P, KC_BSLASH, + KC_H, KC_J, KC_K, KC_L, LT(2,KC_SCOLON), LT(1,KC_QUOTE), + KC_MINUS, KC_N, KC_M, KC_COMMA, KC_DOT, CTL_T(KC_SLASH), KC_RSFT, + KC_DOWN,KC_UP, KC_LBRACKET,KC_RBRACKET,MO(1), + + KC_PAUSE, TG(3), + KC_RBRACKET, + KC_COLN, RSFT_T(KC_ENTER), KC_SPACE + ), + + [1] = LAYOUT_ergodox( + KC_ESCAPE, KC_F1, KC_F2, KC_F3, KC_F4, KC_F5, KC_TRANSPARENT, + KC_TRANSPARENT, KC_EXLM, KC_AT, KC_LCBR, KC_RCBR, KC_PIPE, KC_RABK, + KC_TRANSPARENT, KC_HASH, KC_DLR, KC_LPRN, KC_RPRN, KC_UNDERSCORE, + KC_LABK, KC_PERC, KC_CIRC, KC_LBRACKET, KC_RBRACKET, KC_TILD, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + RGB_MOD, KC_TRANSPARENT, + KC_TRANSPARENT, + RGB_VAD, RGB_VAI, EX_PIPE, + + KC_TRANSPARENT, KC_F6, KC_F7, KC_F8, KC_F9, KC_F10, KC_F11, + KC_PGUP, KC_UP, KC_7, KC_8, KC_9, KC_ASTR, KC_F12, + KC_DOWN, KC_4, KC_5, KC_6, KC_PLUS, KC_TRANSPARENT, + KC_PGDOWN, KC_AMPR, KC_1, KC_2, KC_3, KC_BSLASH, KC_TRANSPARENT, + KC_TRANSPARENT, KC_DOT, KC_0, KC_EQUAL, KC_TRANSPARENT, + RGB_TOG, RGB_SLD, + THIN_ARROW, + EX_PIPE, RGB_HUD, RGB_HUI + ), + + [2] = LAYOUT_ergodox( + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_MS_UP, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_MS_LEFT, KC_MS_DOWN, KC_MS_RIGHT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_MS_BTN1, KC_MS_BTN2, + KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, + KC_MS_BTN1, KC_MS_BTN2, KC_TRANSPARENT, + + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_MS_WH_DOWN, KC_MS_WH_UP, KC_TRANSPARENT, KC_TRANSPARENT, KC_MEDIA_PLAY_PAUSE, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_MEDIA_PREV_TRACK, KC_MEDIA_NEXT_TRACK, KC_TRANSPARENT, KC_TRANSPARENT, + KC_AUDIO_VOL_DOWN, KC_AUDIO_VOL_UP, KC_AUDIO_MUTE, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_WWW_BACK), + + // FPS layout + [3] = LAYOUT_ergodox( + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, + KC_SPACE, KC_TRANSPARENT, KC_TRANSPARENT, + + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT, + KC_TRANSPARENT, TG(3), + KC_TRANSPARENT, + KC_TRANSPARENT, KC_TRANSPARENT, KC_TRANSPARENT), +}; + +const uint16_t PROGMEM fn_actions[] = { + [1] = ACTION_LAYER_TAP_TOGGLE(1) +}; + +// leaving this in place for compatibilty with old keymaps cloned and re-compiled. +const macro_t *action_get_macro(keyrecord_t *record, uint8_t id, uint8_t opt) +{ + switch(id) { + case 0: + if (record->event.pressed) { + SEND_STRING (QMK_KEYBOARD "/" QMK_KEYMAP " @ " QMK_VERSION); + } + break; + } + return MACRO_NONE; +}; + +bool process_record_user(uint16_t keycode, keyrecord_t *record) { + switch (keycode) { + // dynamically generate these. + case EPRM: + if (record->event.pressed) { + eeconfig_init(); + } + return false; + break; + case VRSN: + if (record->event.pressed) { + SEND_STRING (QMK_KEYBOARD "/" QMK_KEYMAP " @ " QMK_VERSION); + } + return false; + break; + case RGB_SLD: + if (record->event.pressed) { + rgblight_mode(1); + } + return false; + break; + case EX_PIPE: + if (record->event.pressed) { + SEND_STRING ( "|> " ); + } + return false; + break; + case THIN_ARROW: + if (record->event.pressed) { + SEND_STRING ( "-> " ); + } + return false; + break; + + + } + return true; +} + +void matrix_scan_user(void) { + + uint8_t layer = biton32(layer_state); + + ergodox_board_led_off(); + ergodox_right_led_1_off(); + ergodox_right_led_2_off(); + ergodox_right_led_3_off(); + switch (layer) { + case 1: + ergodox_right_led_1_on(); + break; + case 2: + ergodox_right_led_2_on(); + break; + case 3: + ergodox_right_led_3_on(); + break; + case 4: + ergodox_right_led_1_on(); + ergodox_right_led_2_on(); + break; + case 5: + ergodox_right_led_1_on(); + ergodox_right_led_3_on(); + break; + case 6: + ergodox_right_led_2_on(); + ergodox_right_led_3_on(); + break; + case 7: + ergodox_right_led_1_on(); + ergodox_right_led_2_on(); + ergodox_right_led_3_on(); + break; + default: + break; + } + +}; diff --git a/users/grfn/keys.nix b/users/grfn/keys.nix new file mode 100644 index 000000000000..c52229b3a898 --- /dev/null +++ b/users/grfn/keys.nix @@ -0,0 +1,5 @@ +{ ... }: +{ + whitby = "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABgQDIwl+xQYRCk6Ijz/Ll8eXKZrcTH9/7xwlvIowiuqDSFtGkf+73QJkwVJ0YiKHWAPwIUWMzCEO/Ab2g6j4PcR+XYu8kXbrwT5aW65L/AK1oaav2RfV1bnQEVUP9FRPL52BN42J0ibI2QJZKJVws9JF7vxTWPPG0V0eoxcaRMk1ZEqq+/k3GuN8D69VSV8xo9lB8yZEvTxs0YQRiiF7Q6t/3jhYtz6lCdazQviRcSEOj5AVsDjcf1XIAPOcLK4Q4OEXL49T3UaitSYMyKIO8hzNLiyGAUlSbshAnutPXdyNBypkCs6FrSPSRdBfFjzUVE/a+JWCPmx0q0xAVd497Efxby+Vsa2/TPMp7tSisPaqk3MpPmjBS7eI/y4Pl2GpAB4OVANEBNd1Q6K2/37Pk+PrZtIUBiRG8sM0Od36BjwLCxvG0G5P/UYZ93aC8GzqkRf4evOBMiJCvR2o9CDEDycNyTm1y5dyJzQewOTWX9nsiF1rllc92W0ZALvpO03+W2+k= grfn@chupacabra"; + main = "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDHPiNpPB6Uqs/VSW/C8tR/Z5wCQxKppNL2iETb1ucsYsFf1B2apG5txj06NMT6IWXwWpZXq7ld+/sA+a2I03lO2INP7S1Dto5nAwpNhhKN/UBXk76qYTdY5tEvb9J89S2ZzfQWR30aZ0CEDDrcbc+YktU1eSLdluu6QH+M/uPBweSiVn5wNHkc5sRdbyiVsZSQJ41MO7PQrzGpe7Pxola/ghOHdEFlESJMKA5uoRpCGboxtDE9tMJwG5MxNwHERpfI9FjvvLsJRrp9dRf6A/RQjlV/nb1GmpX0I8pvrXEPxm/l0rOAgE81VSsM+BxJ7ZvCe8u/YqMYJ8xVfskzlVsf griffin@MacBook-Pro"; +} diff --git a/users/grfn/org-clubhouse/.gitignore b/users/grfn/org-clubhouse/.gitignore new file mode 100644 index 000000000000..2a7dd97debf1 --- /dev/null +++ b/users/grfn/org-clubhouse/.gitignore @@ -0,0 +1,3 @@ +# Spacemacs +org-clubhouse-autoloads.el +org-clubhouse-pkg.el diff --git a/users/grfn/org-clubhouse/CODE_OF_CONDUCT.org b/users/grfn/org-clubhouse/CODE_OF_CONDUCT.org new file mode 100644 index 000000000000..f15e387d5464 --- /dev/null +++ b/users/grfn/org-clubhouse/CODE_OF_CONDUCT.org @@ -0,0 +1,101 @@ +* Contributor Covenant Code of Conduct + :PROPERTIES: + :CUSTOM_ID: contributor-covenant-code-of-conduct + :END: + +** Our Pledge + :PROPERTIES: + :CUSTOM_ID: our-pledge + :END: + +In the interest of fostering an open and welcoming environment, we as +contributors and maintainers pledge to making participation in our +project and our community a harassment-free experience for everyone, +regardless of age, body size, disability, ethnicity, sex +characteristics, gender identity and expression, level of experience, +education, socio-economic status, nationality, personal appearance, +race, religion, or sexual identity and orientation. + +** Our Standards + :PROPERTIES: + :CUSTOM_ID: our-standards + :END: + +Examples of behavior that contributes to creating a positive environment +include: + +- Using welcoming and inclusive language +- Being respectful of differing viewpoints and experiences +- Gracefully accepting constructive criticism +- Focusing on what is best for the community +- Showing empathy towards other community members + +Examples of unacceptable behavior by participants include: + +- The use of sexualized language or imagery and unwelcome sexual + attention or advances +- Trolling, insulting/derogatory comments, and personal or political + attacks +- Public or private harassment +- Publishing others' private information, such as a physical or + electronic address, without explicit permission +- Other conduct which could reasonably be considered inappropriate in a + professional setting + +** Our Responsibilities + :PROPERTIES: + :CUSTOM_ID: our-responsibilities + :END: + +Project maintainers are responsible for clarifying the standards of +acceptable behavior and are expected to take appropriate and fair +corrective action in response to any instances of unacceptable behavior. + +Project maintainers have the right and responsibility to remove, edit, +or reject comments, commits, code, wiki edits, issues, and other +contributions that are not aligned to this Code of Conduct, or to ban +temporarily or permanently any contributor for other behaviors that they +deem inappropriate, threatening, offensive, or harmful. + +** Scope + :PROPERTIES: + :CUSTOM_ID: scope + :END: + +This Code of Conduct applies within all project spaces, and it also +applies when an individual is representing the project or its community +in public spaces. Examples of representing a project or community +include using an official project e-mail address, posting via an +official social media account, or acting as an appointed representative +at an online or offline event. Representation of a project may be +further defined and clarified by project maintainers. + +** Enforcement + :PROPERTIES: + :CUSTOM_ID: enforcement + :END: + +Instances of abusive, harassing, or otherwise unacceptable behavior may +be reported by contacting the project team at root@gws.fyi. All +complaints will be reviewed and investigated and will result in a +response that is deemed necessary and appropriate to the circumstances. +The project team is obligated to maintain confidentiality with regard to +the reporter of an incident. Further details of specific enforcement +policies may be posted separately. + +Project maintainers who do not follow or enforce the Code of Conduct in +good faith may face temporary or permanent repercussions as determined +by other members of the project's leadership. + +** Attribution + :PROPERTIES: + :CUSTOM_ID: attribution + :END: + +This Code of Conduct is adapted from the +[[https://www.contributor-covenant.org][Contributor Covenant]], version +1.4, available at +https://www.contributor-covenant.org/version/1/4/code-of-conduct.html + +For answers to common questions about this code of conduct, see +https://www.contributor-covenant.org/faq diff --git a/users/grfn/org-clubhouse/LICENSE b/users/grfn/org-clubhouse/LICENSE new file mode 100644 index 000000000000..1777f0fac3ea --- /dev/null +++ b/users/grfn/org-clubhouse/LICENSE @@ -0,0 +1,7 @@ +Copyright (C) 2018 Off Market Data, Inc. DBA Urbint + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/users/grfn/org-clubhouse/README.org b/users/grfn/org-clubhouse/README.org new file mode 100644 index 000000000000..9cd8fbe8921d --- /dev/null +++ b/users/grfn/org-clubhouse/README.org @@ -0,0 +1,142 @@ +#+TITLE:Org-Clubhouse + +Simple, unopinionated integration between Emacs's [[https://orgmode.org/][org-mode]] and the [[https://clubhouse.io/][Clubhouse]] +issue tracker + +(This used to be at urbint/org-clubhouse, by the way, but moved here as it's +more of a personal project than a company one) + +* Installation + +** [[https://github.com/quelpa/quelpa][Quelpa]] + +#+BEGIN_SRC emacs-lisp +(quelpa '(org-clubhouse + :fetcher github + :repo "glittershark/org-clubhouse")) +#+END_SRC + +** [[https://github.com/hlissner/doom-emacs/][DOOM Emacs]] + +#+BEGIN_SRC emacs-lisp +;; in packages.el +(package! org-clubhouse + :recipe (:fetcher github + :repo "glittershark/org-clubhouse" + :files ("*"))) + +;; in config.el +(def-package! org-clubhouse) +#+END_SRC + +** [[http://spacemacs.org/][Spacemacs]] +#+BEGIN_SRC emacs-lisp +;; in .spacemacs (SPC+fed) + dotspacemacs-additional-packages + '((org-clubhouse :location (recipe :fetcher github :repo "glittershark/org-clubhouse"))) +#+END_SRC + + +* Setup + +Once installed, you'll need to set three global config vars: + +#+BEGIN_SRC emacs-lisp +(setq org-clubhouse-auth-token "<your-token>" + org-clubhouse-team-name "<your-team-name>" + org-clubhouse-username "<your-username>") +#+END_SRC + +You can generate a new personal API token by going to the "API Tokens" tab on +the "Settings" page in the clubhouse UI. + +Note that ~org-clubhouse-username~ needs to be set to your *mention name*, not +your username, as currently there's no way to get the ID of a user given their +username in the clubhouse API + +* Usage + +** Reading from clubhouse + +- ~org-clubhouse-headlines-from-query~ + Create org-mode headlines from a [[https://help.clubhouse.io/hc/en-us/articles/360000046646-Searching-in-Clubhouse-Story-Search][clubhouse query]] at the cursor's current + position, prompting for the headline indentation level and clubhouse query + text +- ~org-clubhouse-headline-from-story~ + Prompts for headline indentation level and the title of a story (which will + complete using the titles of all stories in your Clubhouse workspace) and + creates an org-mode headline from that story +- ~org-clubhouse-headline-from-story-id~ + Creates an org-mode headline directly from the ID of a clubhouse story + +** Writing to clubhouse + +- ~org-clubhouse-create-story~ + Creates a new Clubhouse story from the current headline, or if a region of + headlines is selected bulk-creates stories with all those headlines +- ~org-clubhouse-create-epic~ + Creates a new Clubhouse epic from the current headline, or if a region of + headlines is selected bulk-creates epics with all those headlines +- ~org-clubhouse-create-story-with-task-list~ + Creates a Clubhouse story from the current headline, making all direct + children of the headline into tasks in the task list of the story +- ~org-clubhouse-push-task-list~ + Writes each child element of the current clubhouse element as a task list + item of the associated clubhouse ID. +- ~org-clubhouse-update-story-title~ + Updates the title of the Clubhouse story linked to the current headline with + the text of the headline +- ~org-clubhouse-update-description~ + Update the status of the Clubhouse story linked to the current element with + the contents of a drawer inside the element called DESCRIPTION, if any exists +- ~org-clubhouse-claim~ + Adds the user configured in ~org-clubhouse-username~ as the owner of the + clubhouse story associated with the headline at point + +*** Automatically updating Clubhouse story statuses + +Org-clubhouse can be configured to update the status of stories as you update +their todo-keyword in org-mode. To opt-into this behavior, set the +~org-clubhouse-mode~ minor-mode: + +#+BEGIN_SRC emacs-lisp +(add-hook 'org-mode-hook #'org-clubhouse-mode nil nil) +#+END_SRC + +The mapping from org-mode todo-keywords is configured via the +~org-clubhouse-state-alist~ variable, which should be an [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Association-Lists.html][alist]] mapping (string) +[[https://orgmode.org/manual/Workflow-states.html][org-mode todo-keywords]] to the (string) names of their corresponding workflow +state. You can have todo-keywords that don't map to a workflow state (I use this +in my workflow extensively) and org-clubhouse will just preserve the previous +state of the story when moving to that state. + +An example config: + +#+BEGIN_SRC emacs-lisp +(setq org-clubhouse-state-alist + '(("TODO" . "To Do") + ("ACTIVE" . "In Progress") + ("DONE" . "Done"))) +#+END_SRC + +* Philosophy + +I use org-mode every single day to manage tasks, notes, literate programming, +etc. Part of what that means for me is that I already have a system for the +structure of my .org files, and I don't want to sacrifice that system for any +external tool. Updating statuses, ~org-clubhouse-create-story~, and +~org-clubhouse-headline-from-story~ are my bread and butter for that reason - +rather than having some sort of bidirectional sync that pulls down full lists of +all the stories in Clubhouse (or whatever issue tracker / project management +tool I'm using at the time). I can be in a mode where I'm taking meeting notes, +think of something that I need to do, make it a TODO headline, and make that +TODO headline a clubhouse story. That's the same reason for the DESCRIPTION +drawers rather than just sending the entire contents of a headline to +Clubhouse - I almost always want to write things like personal notes, literate +code, etc inside of the tasks I'm working on, and don't always want to share +that with Clubhouse. + +* Configuration + +Refer to the beginning of the [[https://github.com/urbint/org-clubhouse/blob/master/org-clubhouse.el][org-clubhouse.el]] file in this repository for +documentation on all supported configuration variables diff --git a/users/grfn/org-clubhouse/org-clubhouse.el b/users/grfn/org-clubhouse/org-clubhouse.el new file mode 100644 index 000000000000..e6e29b575187 --- /dev/null +++ b/users/grfn/org-clubhouse/org-clubhouse.el @@ -0,0 +1,1241 @@ +;;; org-clubhouse.el --- Simple, unopinionated integration between org-mode and +;;; Clubhouse + +;;; Copyright (C) 2018 Off Market Data, Inc. DBA Urbint +;;; Permission is hereby granted, free of charge, to any person obtaining a copy +;;; of this software and associated documentation files (the "Software"), to +;;; deal in the Software without restriction, including without limitation the +;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +;;; sell copies of the Software, and to permit persons to whom the Software is +;;; furnished to do so, subject to the following conditions: + +;;; The above copyright notice and this permission notice shall be included in +;;; all copies or substantial portions of the Software. + +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +;;; IN THE SOFTWARE. + +;;; Commentary: +;;; org-clubhouse provides simple, unopinionated integration between Emacs's +;;; org-mode and the Clubhouse issue tracker +;;; +;;; To configure org-clubhouse, create an authorization token in Cluhbouse's +;;; settings, then place the following configuration somewhere private: +;;; +;;; (setq org-clubhouse-auth-token "<auth_token>" +;;; org-clubhouse-team-name "<team-name>") +;;; + +;;; Code: + +(require 'cl-macs) +(require 'dash) +(require 'dash-functional) +(require 's) +(require 'org) +(require 'org-element) +(require 'subr-x) +(require 'ivy) +(require 'json) + +;;; +;;; Configuration +;;; + +(defvar org-clubhouse-auth-token nil + "Authorization token for the Clubhouse API.") + +(defvar org-clubhouse-username nil + "Username for the current Clubhouse user. + +Unfortunately, the Clubhouse API doesn't seem to provide this via the API given +an API token, so we need to configure this for +`org-clubhouse-claim-story-on-status-updates' to work") + +(defvar org-clubhouse-team-name nil + "Team name to use in links to Clubhouse. +ie https://app.clubhouse.io/<TEAM_NAME>/stories") + +(defvar org-clubhouse-project-ids nil + "Specific list of project IDs to synchronize with clubhouse. +If unset all projects will be synchronized") + +(defvar org-clubhouse-workflow-name "Default") + +(defvar org-clubhouse-default-story-type nil + "Sets the default story type. If set to 'nil', it will interactively prompt +the user each and every time a new story is created. If set to 'feature', +'bug', or 'chore', that value will be used as the default and the user will +not be prompted") + +(defvar org-clubhouse-state-alist + '(("LATER" . "Unscheduled") + ("[ ]" . "Ready for Development") + ("TODO" . "Ready for Development") + ("OPEN" . "Ready for Development") + ("ACTIVE" . "In Development") + ("PR" . "Review") + ("DONE" . "Merged") + ("[X]" . "Merged") + ("CLOSED" . "Merged")) + "Alist mapping org-mode todo keywords to their corresponding states in + Clubhouse. In `org-clubhouse-mode', moving headlines to these todo keywords + will update to the corresponding status in Clubhouse") + +(defvar org-clubhouse-story-types + '(("feature" . "Feature") + ("bug" . "Bug") + ("chore" . "Chore"))) + +(defvar org-clubhouse-default-story-types + '(("feature" . "Feature") + ("bug" . "Bug") + ("chore" . "Chore") + ("prompt" . "**Prompt each time (do not set a default story type)**"))) + +(defvar org-clubhouse-default-state "Proposed" + "Default state to create all new stories in.") + +(defvar org-clubhouse-claim-story-on-status-update 't + "Controls the assignee behavior of stories on status update. + +If set to 't, will mark the current user as the owner of any clubhouse +stories on any update to the status. + +If set to nil, will never automatically update the assignee of clubhouse +stories. + +If set to a list of todo-state's, will mark the current user as the owner of +clubhouse stories whenever updating the status to one of those todo states.") + +(defvar org-clubhouse-create-stories-with-labels nil + "Controls the way org-clubhouse creates stories with labels based on org tags. + +If set to 't, will create labels for all org tags on headlines when stories are +created. + +If set to 'existing, will set labels on created stories only if the label +already exists in clubhouse + +If set to nil, will never create stories with labels") + +;;; +;;; Utilities +;;; + +(defmacro comment (&rest _) + "Comment out one or more s-expressions." + nil) + +(defun ->list (vec) (append vec nil)) + +(defun reject-archived (item-list) + (-reject (lambda (item) (equal :json-true (alist-get 'archived item))) item-list)) + +(defun alist->plist (key-map alist) + (->> key-map + (-map (lambda (key-pair) + (let ((alist-key (car key-pair)) + (plist-key (cdr key-pair))) + (list plist-key (alist-get alist-key alist))))) + (-flatten-n 1))) + +(defun alist-get-equal (key alist) + "Like `alist-get', but uses `equal' instead of `eq' for comparing keys" + (->> alist + (-find (lambda (pair) (equal key (car pair)))) + (cdr))) + +(defun invert-alist (alist) + "Invert the keys and values of ALIST." + (-map (lambda (cell) (cons (cdr cell) (car cell))) alist)) + +(comment + + (alist->plist + '((foo . :foo) + (bar . :something)) + + '((foo . "foo") (bar . "bar") (ignored . "ignoreme!"))) + ;; => (:foo "foo" :something "bar") + + ) + +(defun find-match-in-alist (target alist) + (->> alist + (-find (lambda (key-value) + (string-equal (cdr key-value) target))) + car)) + +(defun org-clubhouse-collect-headlines (beg end) + "Collects the headline at point or the headlines in a region. Returns a list." + (if (and beg end) + (org-clubhouse-get-headlines-in-region beg end) + (list (org-element-find-headline)))) + + +(defun org-clubhouse-get-headlines-in-region (beg end) + "Collects the headlines from BEG to END" + (save-excursion + ;; This beg/end clean up pulled from `reverse-region`. + ;; it expands the region to include the full lines from the selected region. + + ;; put beg at the start of a line and end and the end of one -- + ;; the largest possible region which fits this criteria + (goto-char beg) + (or (bolp) (forward-line 1)) + (setq beg (point)) + (goto-char end) + ;; the test for bolp is for those times when end is on an empty line; + ;; it is probably not the case that the line should be included in the + ;; reversal; it isn't difficult to add it afterward. + (or (and (eolp) (not (bolp))) (progn (forward-line -1) (end-of-line))) + (setq end (point-marker)) + + ;; move to the beginning + (goto-char beg) + ;; walk by line until past end + (let ((headlines '()) + (before-end 't)) + (while before-end + (add-to-list 'headlines (org-element-find-headline)) + (let ((before (point))) + (org-forward-heading-same-level 1) + (setq before-end (and (not (eq before (point))) (< (point) end))))) + (reverse headlines)))) + +;;; +;;; Org-element interaction +;;; + +;; (defun org-element-find-headline () +;; (let ((current-elt (org-element-at-point))) +;; (if (equal 'headline (car current-elt)) +;; current-elt +;; (let* ((elt-attrs (cadr current-elt)) +;; (parent (plist-get elt-attrs :post-affiliated))) +;; (goto-char parent) +;; (org-element-find-headline))))) + +(defun org-element-find-headline () + (save-mark-and-excursion + (when (not (outline-on-heading-p)) (org-back-to-heading)) + (let ((current-elt (org-element-at-point))) + (when (equal 'headline (car current-elt)) + (cadr current-elt))))) + +(defun org-element-extract-clubhouse-id (elt &optional property) + (when-let* ((clubhouse-id-link (plist-get elt (or property :CLUBHOUSE-ID)))) + (cond + ((string-match + (rx "[[" (one-or-more anything) "]" + "[" (group (one-or-more digit)) "]]") + clubhouse-id-link) + (string-to-number (match-string 1 clubhouse-id-link))) + ((string-match-p + (rx buffer-start + (one-or-more digit) + buffer-end) + clubhouse-id-link) + (string-to-number clubhouse-id-link))))) + +(comment + (let ((strn "[[https://app.clubhouse.io/example/story/2330][2330]]")) + (string-match + (rx "[[" (one-or-more anything) "]" + "[" (group (one-or-more digit)) "]]") + strn) + (string-to-number (match-string 1 strn))) + ) + +(defun org-element-clubhouse-id () + (org-element-extract-clubhouse-id + (org-element-find-headline))) + +(defun org-clubhouse-clocked-in-story-id () + "Return the clubhouse story-id of the currently clocked-in org entry, if any." + (save-mark-and-excursion + (save-current-buffer + (when (org-clocking-p) + (set-buffer (marker-buffer org-clock-marker)) + (save-restriction + (when (or (< org-clock-marker (point-min)) + (> org-clock-marker (point-max))) + (widen)) + (goto-char org-clock-marker) + (org-element-clubhouse-id)))))) + +(comment + (org-clubhouse-clocked-in-story-id) + ) + +(defun org-element-and-children-at-point () + (let* ((elt (org-element-find-headline)) + (contents-begin (or (plist-get elt :contents-begin) + (plist-get elt :begin))) + (end (plist-get elt :end)) + (level (plist-get elt :level)) + (children '())) + (save-excursion + (goto-char (+ contents-begin (length (plist-get elt :title)))) + (while (< (point) end) + (let* ((next-elt (org-element-at-point)) + (elt-type (car next-elt)) + (elt (cadr next-elt))) + (when (and (eql 'headline elt-type) + (eql (+ 1 level) (plist-get elt :level))) + (push elt children)) + (goto-char (plist-get elt :end))))) + (append elt `(:children ,(reverse children))))) + +(defun +org-element-contents (elt) + (if-let ((begin (plist-get (cadr elt) :contents-begin)) + (end (plist-get (cadr elt) :contents-end))) + (buffer-substring-no-properties begin end) + "")) + +(defun org-clubhouse-find-description-drawer () + "Try to find a DESCRIPTION drawer in the current element." + (let ((elt (org-element-at-point))) + (cl-case (car elt) + ('drawer (+org-element-contents elt)) + ('headline + (when-let ((drawer-pos (string-match + ":DESCRIPTION:" + (+org-element-contents elt)))) + (save-excursion + (goto-char (+ (plist-get (cadr elt) :contents-begin) + drawer-pos)) + (org-clubhouse-find-description-drawer))))))) + +(defun org-clubhouse--labels-for-elt (elt) + "Return the Clubhouse labels based on the tags of ELT and the user's config." + (unless (eq nil org-clubhouse-create-stories-with-labels) + (let ((tags (org-get-tags (plist-get elt :contents-begin)))) + (-map (lambda (l) `((name . ,l))) + (cl-case org-clubhouse-create-stories-with-labels + ('t tags) + ('existing (-filter (lambda (tag) (-some (lambda (l) + (string-equal tag (cdr l))) + (org-clubhouse-labels))) + tags))))))) + +;;; +;;; API integration +;;; + +(defvar org-clubhouse-base-url* "https://api.clubhouse.io/api/v3") + +(defun org-clubhouse-auth-url (url &optional params) + (concat url + "?" + (url-build-query-string + (cons `("token" ,org-clubhouse-auth-token) params)))) + +(defun org-clubhouse-baseify-url (url) + (if (s-starts-with? org-clubhouse-base-url* url) url + (concat org-clubhouse-base-url* + (if (s-starts-with? "/" url) url + (concat "/" url))))) + +(cl-defun org-clubhouse-request (method url &key data (params '())) + (message "%s %s %s" method url (prin1-to-string data)) + (let* ((url-request-method method) + (url-request-extra-headers + '(("Content-Type" . "application/json"))) + (url-request-data data) + (buf)) + + (setq url (-> url + org-clubhouse-baseify-url + (org-clubhouse-auth-url params))) + + (setq buf (url-retrieve-synchronously url)) + + (with-current-buffer buf + (goto-char url-http-end-of-headers) + (prog1 (json-read) (kill-buffer))))) + +(cl-defun to-id-name-pairs + (seq &optional (id-attr 'id) (name-attr 'name)) + (->> seq + ->list + (-map (lambda (resource) + (cons (alist-get id-attr resource) + (alist-get name-attr resource)))))) + +(cl-defun org-clubhouse-fetch-as-id-name-pairs + (resource &optional + (id-attr 'id) + (name-attr 'name)) + "Returns the given resource from clubhouse as (id . name) pairs" + (let ((resp-json (org-clubhouse-request "GET" resource))) + (-> resp-json + ->list + reject-archived + (to-id-name-pairs id-attr name-attr)))) + +(defun org-clubhouse-get-story + (clubhouse-id) + (org-clubhouse-request "GET" (format "/stories/%s" clubhouse-id))) + +(defun org-clubhouse-link-to-story (story-id) + (format "https://app.clubhouse.io/%s/story/%d" + org-clubhouse-team-name + story-id)) + +(defun org-clubhouse-link-to-epic (epic-id) + (format "https://app.clubhouse.io/%s/epic/%d" + org-clubhouse-team-name + epic-id)) + +(defun org-clubhouse-link-to-milestone (milestone-id) + (format "https://app.clubhouse.io/%s/milestone/%d" + org-clubhouse-team-name + milestone-id)) + +(defun org-clubhouse-link-to-project (project-id) + (format "https://app.clubhouse.io/%s/project/%d" + org-clubhouse-team-name + project-id)) + +;;; +;;; Caching +;;; + +(comment + (defcache org-clubhouse-projects + (org-sync-clubhouse-fetch-as-id-name-pairs "projectx")) + + (clear-org-clubhouse-projects-cache) + (clear-org-clubhouse-cache) + ) + +(defvar org-clubhouse-cache-clear-functions ()) + +(defmacro defcache (name &optional docstring &rest body) + (let* ((doc (when docstring (list docstring))) + (cache-var-name (intern (concat (symbol-name name) + "-cache"))) + (clear-cache-function-name + (intern (concat "clear-" (symbol-name cache-var-name))))) + `(progn + (defvar ,cache-var-name :no-cache) + (defun ,name () + ,@doc + (when (equal :no-cache ,cache-var-name) + (setq ,cache-var-name (progn ,@body))) + ,cache-var-name) + (defun ,clear-cache-function-name () + (interactive) + (setq ,cache-var-name :no-cache)) + + (push (quote ,clear-cache-function-name) + org-clubhouse-cache-clear-functions)))) + +(defun org-clubhouse-clear-cache () + (interactive) + (-map #'funcall org-clubhouse-cache-clear-functions)) + +;;; +;;; API resource functions +;;; + +(defcache org-clubhouse-projects + "Returns projects as (project-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "projects")) + +(defcache org-clubhouse-epics + "Returns epics as (epic-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "epics")) + +(defcache org-clubhouse-milestones + "Returns milestone-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "milestones")) + +(defcache org-clubhouse-workflow-states + "Returns worflow states as (name . id) pairs" + (let* ((resp-json (org-clubhouse-request "GET" "workflows")) + (workflows (->list resp-json)) + ;; just assume it exists, for now + (workflow (-find (lambda (workflow) + (equal org-clubhouse-workflow-name + (alist-get 'name workflow))) + workflows)) + (states (->list (alist-get 'states workflow)))) + (to-id-name-pairs states + 'name + 'id))) + +(defcache org-clubhouse-labels + "Returns labels as (label-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "labels")) + +(defcache org-clubhouse-whoami + "Returns the ID of the logged in user" + (->> (org-clubhouse-request + "GET" + "/members") + ->list + (find-if (lambda (m) + (->> m + (alist-get 'profile) + (alist-get 'mention_name) + (equal org-clubhouse-username)))) + (alist-get 'id))) + +(defcache org-clubhouse-iterations + "Returns iterations as (iteration-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "iterations")) + +(defun org-clubhouse-stories-in-project (project-id) + "Return the stories in the given PROJECT-ID as org headlines." + (let ((resp-json (org-clubhouse-request "GET" (format "/projects/%d/stories" project-id)))) + (->> resp-json ->list reject-archived + (-reject (lambda (story) (equal :json-true (alist-get 'completed story)))) + (-map (lambda (story) + (cons + (cons 'status + (cond + ((equal :json-true (alist-get 'started story)) + 'started) + ((equal :json-true (alist-get 'completed story)) + 'completed) + ('t + 'open))) + story))) + (-map (-partial #'alist->plist + '((name . :title) + (id . :id) + (status . :status))))))) + +(defun org-clubhouse-workflow-state-id-to-todo-keyword (workflow-state-id) + "Convert the named clubhouse WORKFLOW-STATE-ID to an org todo keyword." + (let* ((state-name (alist-get-equal + workflow-state-id + (invert-alist (org-clubhouse-workflow-states)))) + (inv-state-name-alist + (-map (lambda (cell) (cons (cdr cell) (car cell))) + org-clubhouse-state-alist))) + (or (alist-get-equal state-name inv-state-name-alist) + (if state-name (s-upcase state-name) "UNKNOWN")))) + +;;; +;;; Prompting +;;; + +(defun org-clubhouse-prompt-for-project (cb) + (ivy-read + "Select a project: " + (-map #'cdr (org-clubhouse-projects)) + :require-match t + :history 'org-clubhouse-project-history + :action (lambda (selected) + (let ((project-id + (find-match-in-alist selected (org-clubhouse-projects)))) + (funcall cb project-id))))) + +(defun org-clubhouse-prompt-for-epic (cb) + "Prompt the user for an epic using ivy and call CB with its ID." + (ivy-read + "Select an epic: " + (-map #'cdr (append '((nil . "No Epic")) (org-clubhouse-epics))) + :history 'org-clubhouse-epic-history + :action (lambda (selected) + (let ((epic-id + (find-match-in-alist selected (org-clubhouse-epics)))) + (funcall cb epic-id))))) + +(defun org-clubhouse-prompt-for-milestone (cb) + "Prompt the user for a milestone using ivy and call CB with its ID." + (ivy-read + "Select a milestone: " + (-map #'cdr (append '((nil . "No Milestone")) (org-clubhouse-milestones))) + :require-match t + :history 'org-clubhouse-milestone-history + :action (lambda (selected) + (let ((milestone-id + (find-match-in-alist selected (org-clubhouse-milestones)))) + (funcall cb milestone-id))))) + +(defun org-clubhouse-prompt-for-story-type (cb) + (ivy-read + "Select a story type: " + (-map #'cdr org-clubhouse-story-types) + :history 'org-clubhouse-story-history + :action (lambda (selected) + (let ((story-type + (find-match-in-alist selected org-clubhouse-story-types))) + (funcall cb story-type))))) + +(defun org-clubhouse-prompt-for-default-story-type () + (interactive) + (ivy-read + "Select a default story type: " + (-map #'cdr org-clubhouse-default-story-types) + :history 'org-clubhouse-default-story-history + :action (lambda (selected) + (let ((story-type + (find-match-in-alist selected org-clubhouse-default-story-types))) + (if (string-equal story-type "prompt") + (setq org-clubhouse-default-story-type nil) + (setq org-clubhouse-default-story-type story-type)))))) + +;;; +;;; Epic creation +;;; + +(cl-defun org-clubhouse-create-epic-internal + (title &key milestone-id) + (cl-assert (and (stringp title) + (or (null milestone-id) + (integerp milestone-id)))) + (org-clubhouse-request + "POST" + "epics" + :data + (json-encode + `((name . ,title) + (milestone_id . ,milestone-id))))) + +(defun org-clubhouse-populate-created-epic (elt epic) + (let ((elt-start (plist-get elt :begin)) + (epic-id (alist-get 'id epic)) + (milestone-id (alist-get 'milestone_id epic))) + (save-excursion + (goto-char elt-start) + + (org-set-property "clubhouse-epic-id" + (org-link-make-string + (org-clubhouse-link-to-epic epic-id) + (number-to-string epic-id))) + + (when milestone-id + (org-set-property "clubhouse-milestone" + (org-link-make-string + (org-clubhouse-link-to-milestone milestone-id) + (alist-get milestone-id (org-clubhouse-milestones)))))))) + +(defun org-clubhouse-create-epic (&optional beg end) + "Creates a clubhouse epic using selected headlines. +Will pull the title from the headline at point, or create epics for all the +headlines in the selected region. + +All epics are added to the same milestone, as selected via a prompt. +If the epics already have a CLUBHOUSE-EPIC-ID, they are filtered and ignored." + (interactive + (when (use-region-p) + (list (region-beginning region-end)))) + + (let* ((elts (org-clubhouse-collect-headlines beg end)) + (elts (-remove (lambda (elt) (plist-get elt :CLUBHOUSE-EPIC-ID)) elts))) + (org-clubhouse-prompt-for-milestone + (lambda (milestone-id) + (dolist (elt elts) + (let* ((title (plist-get elt :title)) + (epic (org-clubhouse-create-epic-internal + title + :milestone-id milestone-id))) + (org-clubhouse-populate-created-epic elt epic)) + elts))))) + +;;; +;;; Story creation +;;; + +(defun org-clubhouse-default-state-id () + (alist-get-equal org-clubhouse-default-state (org-clubhouse-workflow-states))) + +(cl-defun org-clubhouse-create-story-internal + (title &key project-id epic-id story-type description labels) + (cl-assert (and (stringp title) + (integerp project-id) + (or (null epic-id) (integerp epic-id)) + (or (null description) (stringp description)))) + (let ((workflow-state-id (org-clubhouse-default-state-id)) + (params `((name . ,title) + (project_id . ,project-id) + (epic_id . ,epic-id) + (story_type . ,story-type) + (description . ,(or description "")) + (labels . ,labels)))) + + (when workflow-state-id + (push `(workflow_state_id . ,workflow-state-id) params)) + + (org-clubhouse-request + "POST" + "stories" + :data + (json-encode params)))) + +(cl-defun org-clubhouse-populate-created-story (elt story &key extra-properties) + (let ((elt-start (plist-get elt :begin)) + (story-id (alist-get 'id story)) + (epic-id (alist-get 'epic_id story)) + (project-id (alist-get 'project_id story)) + (story-type (alist-get 'story_type story))) + + (save-excursion + (goto-char elt-start) + + (org-set-property "clubhouse-id" + (org-link-make-string + (org-clubhouse-link-to-story story-id) + (number-to-string story-id))) + (when epic-id + (org-set-property "clubhouse-epic" + (org-link-make-string + (org-clubhouse-link-to-epic epic-id) + (alist-get epic-id (org-clubhouse-epics))))) + + (org-set-property "clubhouse-project" + (org-link-make-string + (org-clubhouse-link-to-project project-id) + (alist-get project-id (org-clubhouse-projects)))) + + (org-set-property "story-type" + (alist-get-equal story-type org-clubhouse-story-types)) + + (dolist (extra-prop extra-properties) + (org-set-property (car extra-prop) + (alist-get (cdr extra-prop) story))) + + (org-todo "TODO")))) + +(defun org-clubhouse-create-story (&optional beg end &key then) + "Creates a clubhouse story using selected headlines. + +Will pull the title from the headline at point, +or create cards for all the headlines in the selected region. + +All stories are added to the same project and epic, as selected via two prompts. +If the stories already have a CLUBHOUSE-ID, they are filtered and ignored." + (interactive + (when (use-region-p) + (list (region-beginning) (region-end)))) + + (let* ((elts (org-clubhouse-collect-headlines beg end)) + (new-elts (-remove (lambda (elt) (plist-get elt :CLUBHOUSE-ID)) elts))) + (org-clubhouse-prompt-for-project + (lambda (project-id) + (when project-id + (org-clubhouse-prompt-for-epic + (lambda (epic-id) + (let ((create-story + (lambda (story-type) + (-map + (lambda (elt) + (let* ((title (plist-get elt :title)) + (description + (save-mark-and-excursion + (goto-char (plist-get elt :begin)) + (org-clubhouse-find-description-drawer))) + (labels (org-clubhouse--labels-for-elt elt)) + (story (org-clubhouse-create-story-internal + title + :project-id project-id + :epic-id epic-id + :story-type story-type + :description description + :labels labels))) + (org-clubhouse-populate-created-story elt story) + (when (functionp then) + (funcall then story)))) + new-elts)))) + (if org-clubhouse-default-story-type + (funcall create-story org-clubhouse-default-story-type) + (org-clubhouse-prompt-for-story-type create-story)))))))))) + +(defun org-clubhouse-create-story-with-task-list (&optional beg end) + "Creates a clubhouse story using the selected headline, making all direct +children of that headline into tasks in the task list of the story." + (interactive + (when (use-region-p) + (list (region-beginning) (region-end)))) + + (let* ((elt (org-element-and-children-at-point))) + (org-clubhouse-create-story nil nil + :then (lambda (story) + (pp story) + (org-clubhouse-push-task-list + (alist-get 'id story) + (plist-get elt :children)))))) + +;;; +;;; Task creation +;;; + +(cl-defun org-clubhouse-create-task (title &key story-id) + (cl-assert (and (stringp title) + (integerp story-id))) + (org-clubhouse-request + "POST" + (format "/stories/%d/tasks" story-id) + :data (json-encode `((description . ,title))))) + +(defun org-clubhouse-push-task-list (&optional parent-clubhouse-id child-elts) + "Writes each child of the element at point as a task list item. + +When called as (org-clubhouse-push-task-list PARENT-CLUBHOUSE-ID CHILD-ELTS), +allows manually passing a clubhouse ID and list of org-element plists to write" + (interactive) + (let* ((elt (org-element-and-children-at-point)) + (parent-clubhouse-id (or parent-clubhouse-id + (org-element-extract-clubhouse-id elt))) + (child-elts (or child-elts (plist-get elt :children))) + (story (org-clubhouse-get-story parent-clubhouse-id)) + (existing-tasks (alist-get 'tasks story)) + (task-exists + (lambda (task-name) + (cl-some (lambda (task) + (string-equal task-name (alist-get 'description task))) + existing-tasks))) + (elts-with-starts + (-map (lambda (e) (cons (set-marker (make-marker) + (plist-get e :begin)) + e)) + child-elts))) + (dolist (child-elt-and-start elts-with-starts) + (let* ((start (car child-elt-and-start)) + (child-elt (cdr child-elt-and-start)) + (task-name (plist-get child-elt :title))) + (unless (funcall task-exists task-name) + (let ((task (org-clubhouse-create-task + task-name + :story-id parent-clubhouse-id))) + (org-clubhouse-populate-created-task child-elt task start))))))) + +(defun org-clubhouse-populate-created-task (elt task &optional begin) + (let ((elt-start (or begin (plist-get elt :begin))) + (task-id (alist-get 'id task)) + (story-id (alist-get 'story_id task))) + + (save-excursion + (goto-char elt-start) + + (org-set-property "clubhouse-task-id" (format "%d" task-id)) + + (org-set-property "clubhouse-story-id" + (org-link-make-string + (org-clubhouse-link-to-story story-id) + (number-to-string story-id))) + + (org-todo "TODO")))) + +;;; +;;; Task Updates +;;; + +(cl-defun org-clubhouse-update-task-internal + (story-id task-id &rest attrs) + (cl-assert (and (integerp story-id) + (integerp task-id) + (listp attrs))) + (org-clubhouse-request + "PUT" + (format "stories/%d/tasks/%d" story-id task-id) + :data + (json-encode attrs))) + +;;; +;;; Story updates +;;; + +(cl-defun org-clubhouse-update-story-internal + (story-id &rest attrs) + (cl-assert (and (integerp story-id) + (listp attrs))) + (org-clubhouse-request + "PUT" + (format "stories/%d" story-id) + :data + (json-encode attrs))) + +(cl-defun org-clubhouse-update-story-at-point (&rest attrs) + (when-let* ((clubhouse-id (org-element-clubhouse-id))) + (apply + #'org-clubhouse-update-story-internal + (cons clubhouse-id attrs)) + t)) + +(defun org-clubhouse-update-story-title () + "Update the title of the Clubhouse story linked to the current headline. + +Update the title of the story linked to the current headline with the text of +the headline." + (interactive) + + (let* ((elt (org-element-find-headline)) + (title (plist-get elt :title)) + (clubhouse-id (org-element-clubhouse-id))) + (and + (org-clubhouse-update-story-at-point + clubhouse-id + :name title) + (message "Successfully updated story title to \"%s\"" + title)))) + +(defun org-clubhouse-update-status () + "Update the status of the Clubhouse story linked to the current element. + +Update the status of the Clubhouse story linked to the current element with the +entry in `org-clubhouse-state-alist' corresponding to the todo-keyword of the +element." + (interactive) + (let* ((elt (org-element-find-headline)) + (todo-keyword (-> elt + (plist-get :todo-keyword) + (substring-no-properties))) + + (clubhouse-id (org-element-extract-clubhouse-id elt)) + (task-id (plist-get elt :CLUBHOUSE-TASK-ID))) + (cond + (clubhouse-id + (let* ((todo-keyword (-> elt + (plist-get :todo-keyword) + (substring-no-properties)))) + (when-let* ((clubhouse-workflow-state + (alist-get-equal todo-keyword org-clubhouse-state-alist)) + (workflow-state-id + (alist-get-equal clubhouse-workflow-state + (org-clubhouse-workflow-states)))) + (let ((update-assignee? + (if (or (eq 't org-clubhouse-claim-story-on-status-update) + (member todo-keyword + org-clubhouse-claim-story-on-status-update)) + (if org-clubhouse-username + 't + (warn "Not claiming story since `org-clubhouse-username' + is not set") + nil)))) + + (if update-assignee? + (org-clubhouse-update-story-internal + clubhouse-id + :workflow_state_id workflow-state-id + :owner_ids (if update-assignee? + (list (org-clubhouse-whoami)) + (list))) + (org-clubhouse-update-story-internal + clubhouse-id + :workflow_state_id workflow-state-id)) + (message + (if update-assignee? + "Successfully claimed story and updated clubhouse status to \"%s\"" + "Successfully updated clubhouse status to \"%s\"") + clubhouse-workflow-state))))) + + (task-id + (let ((story-id (org-element-extract-clubhouse-id + elt + :CLUBHOUSE-STORY-ID)) + (done? (member todo-keyword org-done-keywords))) + (org-clubhouse-update-task-internal + story-id + (string-to-number task-id) + :complete (if done? 't :json-false)) + (message "Successfully marked clubhouse task status as %s" + (if done? "complete" "incomplete"))))))) + +(defun org-clubhouse-update-description () + "Update the description of the Clubhouse story linked to the current element. + +Update the status of the Clubhouse story linked to the current element with the +contents of a drawer inside the element called DESCRIPTION, if any." + (interactive) + (when-let* ((new-description (org-clubhouse-find-description-drawer))) + (and + (org-clubhouse-update-story-at-point + :description new-description) + (message "Successfully updated story description")))) + +(defun org-clubhouse-update-labels () + "Update the labels of the Clubhouse story linked to the current element. + +Will use the value of `org-clubhouse-create-stories-with-labels' to determine +which labels to set." + (interactive) + (when-let* ((elt (org-element-find-headline)) + (new-labels (org-clubhouse--labels-for-elt elt))) + (and + (org-clubhouse-update-story-at-point + :labels new-labels) + (message "Successfully updated story labels to :%s:" + (->> new-labels + (-map #'cdar) + (s-join ":")))))) + + +;;; +;;; Creating headlines from existing stories +;;; + +(defun org-clubhouse--task-to-headline-text (level task) + (format "%s %s %s +:PROPERTIES: +:clubhouse-task-id: %s +:clubhouse-story-id: %s +:END:" + (make-string level ?*) + (if (equal :json-false (alist-get 'complete task)) + "TODO" "DONE") + (alist-get 'description task) + (alist-get 'id task) + (let ((story-id (alist-get 'story_id task))) + (org-link-make-string + (org-clubhouse-link-to-story story-id) + story-id)))) + +(defun org-clubhouse--story-to-headline-text (level story) + (let ((story-id (alist-get 'id story))) + (format + "%s %s %s %s +:PROPERTIES: +:clubhouse-id: %s +:END: +%s +%s +" + (make-string level ?*) + (org-clubhouse-workflow-state-id-to-todo-keyword + (alist-get 'workflow_state_id story)) + (alist-get 'name story) + (if-let ((labels (->> story + (alist-get 'labels) + ->list + (-map (apply-partially #'alist-get 'name))))) + (format ":%s:" (s-join ":" labels)) + "") + (org-link-make-string + (org-clubhouse-link-to-story story-id) + (number-to-string story-id)) + (let ((desc (alist-get 'description story))) + (if (= 0 (length desc)) "" + (format ":DESCRIPTION:\n%s\n:END:" desc))) + (if-let ((tasks (seq-sort-by + (apply-partially #'alist-get 'position) + #'< + (or (alist-get 'tasks story) + (alist-get 'tasks + (org-clubhouse-get-story story-id)))))) + (mapconcat (apply-partially #'org-clubhouse--task-to-headline-text + (1+ level)) + tasks + "\n") + "")))) + +(defun org-clubhouse-headline-from-my-tasks (level) + "Prompt my active stories and create a single `org-mode' headline at LEVEL." + (interactive "*nLevel: \n") + (if org-clubhouse-username + (let* ((story-list (org-clubhouse--search-stories + (format "owner:%s !is:done !is:archived" + org-clubhouse-username))) + (stories (to-id-name-pairs story-list))) + (org-clubhouse-headline-from-story-id level + (find-match-in-alist + (ivy-read "Select Story: " + (-map #'cdr stories)) + stories))) + (warn "Can't fetch my tasks if `org-clubhouse-username' is unset"))) + +(defun org-clubhouse-headline-from-story-id (level story-id) + "Create a single `org-mode' headline at LEVEL based on the given clubhouse STORY-ID." + (interactive "*nLevel: \nnStory ID: ") + (let* ((story (org-clubhouse-get-story story-id))) + (if (equal '((message . "Resource not found.")) story) + (message "Story ID not found: %d" story-id) + (save-mark-and-excursion + (insert (org-clubhouse--story-to-headline-text level story)) + (org-align-tags))))) + +(defun org-clubhouse--search-stories (query) + (unless (string= "" query) + (-> (org-clubhouse-request "GET" "search/stories" :params `((query ,query))) + cdadr + (append nil) + reject-archived))) + +(defun org-clubhouse-prompt-for-iteration (cb) + "Prompt for iteration and call CB with that iteration" + (ivy-read + "Select an interation: " + (-map #'cdr (org-clubhouse-iterations)) + :require-match t + :history 'org-clubhouse-iteration-history + :action (lambda (selected) + (let ((iteration-id + (find-match-in-alist selected (org-clubhouse-iterations)))) + (funcall cb iteration-id))))) + +(defun org-clubhouse--get-iteration (iteration-id) + (-> (org-clubhouse-request "GET" (format "iterations/%d/stories" iteration-id)) + (append nil))) + +(defun org-clubhouse-headlines-from-iteration (level) + "Create `org-mode' headlines from a clubhouse iteration. + +Create `org-mode' headlines from all the resulting stories at headline level LEVEL." + (interactive "*nLevel: ") + (org-clubhouse-prompt-for-iteration + (lambda (iteration-id) + (let ((story-list (org-clubhouse--get-iteration iteration-id))) + (if (null story-list) + (message "Iteration id returned no stories: %d" iteration-id) + (let ((text (mapconcat (apply-partially + #'org-clubhouse--story-to-headline-text + level) + (reject-archived story-list) "\n"))) + (save-mark-and-excursion + (insert text) + (org-align-all-tags)) + text)))))) + +(defun org-clubhouse-headlines-from-query (level query) + "Create `org-mode' headlines from a clubhouse query. + +Submits QUERY to clubhouse, and creates `org-mode' headlines from all the +resulting stories at headline level LEVEL." + (interactive + "*nLevel: \nMQuery: ") + (let* ((story-list (org-clubhouse--search-stories query))) + (if (null story-list) + (message "Query returned no stories: %s" query) + (let ((text (mapconcat (apply-partially + #'org-clubhouse--story-to-headline-text + level) + (reject-archived story-list) "\n"))) + (if (called-interactively-p) + (save-mark-and-excursion + (insert text) + (org-align-all-tags)) + text))))) + +(defun org-clubhouse-prompt-for-story (cb) + "Prompt the user for a clubhouse story, then call CB with the full story." + (ivy-read "Story title: " + (lambda (search-term) + (let* ((stories (org-clubhouse--search-stories + (if search-term (format "\"%s\"" search-term) + "")))) + (-map (lambda (story) + (propertize (alist-get 'name story) 'story story)) + stories))) + :dynamic-collection t + :history 'org-clubhouse-story-prompt + :action (lambda (s) (funcall cb (get-text-property 0 'story s))) + :require-match t)) + +(defun org-clubhouse-headline-from-story (level) + "Prompt for a story, and create an org headline at LEVEL from that story." + (interactive "*nLevel: ") + (org-clubhouse-prompt-for-story + (lambda (story) + (save-mark-and-excursion + (insert (org-clubhouse--story-to-headline-text level story)) + (org-align-tags))))) + + +(defun org-clubhouse-link () + "Link the current `org-mode' headline with an existing clubhouse story." + (interactive) + (org-clubhouse-prompt-for-story + (lambda (story) + (org-clubhouse-populate-created-story + (org-element-find-headline) + story + :extra-properties '(("clubhouse-story-name" . name))) + (org-todo + (org-clubhouse-workflow-state-id-to-todo-keyword + (alist-get 'workflow_state_id story)))))) + +(defun org-clubhouse-claim () + "Assign the clubhouse story associated with the headline at point to yourself." + (interactive) + (if org-clubhouse-username + (and + (org-clubhouse-update-story-at-point + :owner_ids (list (org-clubhouse-whoami))) + (message "Successfully claimed story")) + (warn "Can't claim story if `org-clubhouse-username' is unset"))) + +(defun org-clubhouse-sync-status (&optional beg end) + "Pull the status(es) for the story(ies) in region and update the todo state. + +Uses `org-clubhouse-state-alist'. Operates over stories from BEG to END" + (interactive + (when (use-region-p) + (list (region-beginning) (region-end)))) + (let ((elts (-filter (lambda (e) (plist-get e :CLUBHOUSE-ID)) + (org-clubhouse-collect-headlines beg end)))) + (save-mark-and-excursion + (dolist (e elts) + (goto-char (plist-get e :begin)) + (let* ((clubhouse-id (org-element-extract-clubhouse-id e)) + (story (org-clubhouse-get-story clubhouse-id)) + (workflow-state-id (alist-get 'workflow_state_id story)) + (todo-keyword (org-clubhouse-workflow-state-id-to-todo-keyword + workflow-state-id))) + (let ((org-after-todo-state-change-hook + (remove 'org-clubhouse-update-status + org-after-todo-state-change-hook))) + (org-todo todo-keyword))))) + (message "Successfully synchronized status of %d stories from Clubhouse" + (length elts)))) + +(cl-defun org-clubhouse-set-epic (&optional story-id epic-id cb &key beg end) + "Set the epic of clubhouse story STORY-ID to EPIC-ID, then call CB. + +When called interactively, prompt for an epic and set the story of the clubhouse +stor{y,ies} at point or region" + (interactive + (when (use-region-p) + (list nil nil nil + :beg (region-beginning) + :end (region-end)))) + (if (and story-id epic-id) + (progn + (org-clubhouse-update-story-internal + story-id :epic-id epic-id) + (when cb (funcall cb))) + (let ((elts (-filter (lambda (elt) (plist-get elt :CLUBHOUSE-ID)) + (org-clubhouse-collect-headlines beg end)))) + (org-clubhouse-prompt-for-epic + (lambda (epic-id) + (-map + (lambda (elt) + (let ((story-id (org-element-extract-clubhouse-id elt))) + (org-clubhouse-set-epic + story-id epic-id + (lambda () + (org-set-property + "clubhouse-epic" + (org-link-make-string + (org-clubhouse-link-to-epic epic-id) + (alist-get epic-id (org-clubhouse-epics)))) + (message "Successfully set the epic on story %d to %d" + story-id epic-id)))))) + elts))))) + +;;; + +(define-minor-mode org-clubhouse-mode + "If enabled, updates to the todo keywords on org headlines will update the +linked ticket in Clubhouse." + :group 'org + :lighter "Org-Clubhouse" + :keymap '() + (add-hook 'org-after-todo-state-change-hook + 'org-clubhouse-update-status + nil + t)) + +(provide 'org-clubhouse) + +;;; org-clubhouse.el ends here diff --git a/users/grfn/resume/chimera.png b/users/grfn/resume/chimera.png new file mode 100644 index 000000000000..6dde989c53b0 --- /dev/null +++ b/users/grfn/resume/chimera.png Binary files differdiff --git a/users/grfn/resume/collection.sty b/users/grfn/resume/collection.sty new file mode 100644 index 000000000000..4f1540a9d214 --- /dev/null +++ b/users/grfn/resume/collection.sty @@ -0,0 +1,85 @@ +%% start of file `collection.sty'. +%% Copyright 2013-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{collection}[2013/03/28 v1.0.0 collections] + + +%------------------------------------------------------------------------------- +% requirements +%------------------------------------------------------------------------------- + + +\RequirePackage{ifthen} + + +%------------------------------------------------------------------------------- +% code +%------------------------------------------------------------------------------- + +% creates a new collection +% usage: \collectionnew{<collection name>} +\newcommand*{\collectionnew}[1]{% + \newcounter{collection@#1@count}} + +% adds an item to a collection +% usage: \collectionadd[<optional key>]{<collection name>}{<item to add>} +\newcommand*{\collectionadd}[3][]{% + \expandafter\def\csname collection@#2@item\roman{collection@#2@count}\endcsname{#3}% + \if\relax\noexpand#1\relax% if #1 is empty + \else\expandafter\def\csname collection@#2@key\roman{collection@#2@count}\endcsname{#1}\fi% + \stepcounter{collection@#2@count}} + +% returns the number of items in a collection +% usage: \collectioncount{<collection name>} +\newcommand*{\collectioncount}[1]{% + \value{collection@#1@count}} + +% gets an item from a collection +% usage: \collectiongetitem{<collection name>}{<element id>} +% where <element id> is an integer between 0 and (collectioncount-1) +\newcommand*{\collectiongetitem}[2]{% + \csname collection@#1@item\romannumeral #2\endcsname} + +% gets a key from a collection +% usage: \collectiongetkey{<collection name>}{<element id>} +% where <element id> is an integer between 0 and (collectioncount-1) +\newcommand*{\collectiongetkey}[2]{% + \csname collection@#1@key\romannumeral #2\endcsname} + +% loops through a collection and perform the given operation on every element +% usage: \collectionloop{<collection name>}{<operation sequence>} +% where <operation sequence> is the code sequence to be evaluated for each collection item, +% code which can refer to \collectionloopid, \collectionloopkey, \collectionloopitem and +% \collectionloopbreak +\newcounter{collection@iterator} +\newcommand*{\collectionloopbreak}{\let\iterate\relax} +\newcommand*{\collectionloop}[2]{% + \setcounter{collection@iterator}{0}% + \loop\ifnum\value{collection@iterator}<\value{collection@#1@count}% + \def\collectionloopid{\arabic{collection@iterator}}% + \def\collectionloopitem{\collectiongetitem{#1}{\collectionloopid}}% + \def\collectionloopkey{\collectiongetkey{#1}{\collectionloopid}}% + #2% + \stepcounter{collection@iterator}% + \repeat} + +% loops through a collection and finds the (first) element matching the given key +% usage: \collectionfindbykey{<collection name>}{key>} +\newcommand*{\collectionfindbykey}[2]{% + \collectionloop{#1}{% + \ifthenelse{\equal{\collectionloopkey}{#2}}{\collectionloopitem\collectionloopbreak}{}}} + + +\endinput + + +%% end of file `collection.cls'. diff --git a/users/grfn/resume/default.nix b/users/grfn/resume/default.nix new file mode 100644 index 000000000000..2db6a650bc6e --- /dev/null +++ b/users/grfn/resume/default.nix @@ -0,0 +1,37 @@ +{ pkgs, ... }: + +with pkgs.lib; + +pkgs.runCommandNoCC "resume.pdf" { + buildInputs = [(pkgs.texlive.combine { + inherit (pkgs.texlive) + capt-of + collection-fontsrecommended + enumitem + etoolbox + fancyvrb + float + fncychap + framed + l3packages + microtype + needspace + parskip + scheme-basic + tabulary + titlesec + ulem + upquote + varwidth + wrapfig + xcolor + ; + })]; +} '' + cp ${builtins.filterSource (path: type: + type == "regular" && + any (ext: hasSuffix ext path) [".sty" ".cls" ".tex" ".png"] + ) ./.}/* . + pdflatex ./resume.tex + cp resume.pdf $out +'' diff --git a/users/grfn/resume/helvetica.sty b/users/grfn/resume/helvetica.sty new file mode 100644 index 000000000000..dacc129a1025 --- /dev/null +++ b/users/grfn/resume/helvetica.sty @@ -0,0 +1,32 @@ +%% +%% This is file `helvetica.sty', based on helvet.sty extended to include +%% definitions for rm and tt. This means commands such as \textbf, \textit, +%% etc. will appear in Helvetica. +%% Changes added by Harriet Borton on <1995/12/11> +%% +%% The original source files were: +%% +%% psfonts.dtx (with options: `helvet') +%% +%% Copyright (C) 1994 Sebastian Rahtz +%% All rights reserved. +%% +%% The original file is part of the PSNFSS2e package. +%% ----------------------------------------- +%% +%% This is a generated file. Permission is granted to to customize the +%% declarations in this file to serve the needs of your installation. +%% However, no permission is granted to distribute a modified version of +%% this file under its original name. +\def\fileversion{4.2} +\def\filedate{94/11/11} +\def\docdate {94/11/06} +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{helvetica}[\filedate\space\fileversion\space +Helvetica PSNFSS2e package] +\renewcommand{\sfdefault}{phv} +\renewcommand{\rmdefault}{phv} +\renewcommand{\ttdefault}{pcr} +\endinput +%% +%% End of file `helvetica.sty'. diff --git a/users/grfn/resume/moderncv.cls b/users/grfn/resume/moderncv.cls new file mode 100644 index 000000000000..a40f80733736 --- /dev/null +++ b/users/grfn/resume/moderncv.cls @@ -0,0 +1,585 @@ +%% start of file `moderncv.cls'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesClass{moderncv}[2013/02/09 v1.3.0 modern curriculum vitae and letter document class] + + +%------------------------------------------------------------------------------- +% class options +% +% (need to be done before the external package loading, for example because +% we need \paperwidth, \paperheight and \@ptsize to be defined before loading +% geometry and fancyhdr) +%------------------------------------------------------------------------------- +% paper size option +\DeclareOption{a4paper}{ + \setlength\paperheight{297mm} + \setlength\paperwidth{210mm}} +\DeclareOption{a5paper}{ + \setlength\paperheight{210mm} + \setlength\paperwidth{148mm}} +\DeclareOption{b5paper}{ + \setlength\paperheight{250mm} + \setlength\paperwidth{176mm}} +\DeclareOption{letterpaper}{ + \setlength\paperheight{11in} + \setlength\paperwidth{8.5in}} +\DeclareOption{legalpaper}{ + \setlength\paperheight{14in} + \setlength\paperwidth{8.5in}} +\DeclareOption{executivepaper}{ + \setlength\paperheight{10.5in} + \setlength\paperwidth{7.25in}} +\DeclareOption{landscape}{ + \setlength\@tempdima{\paperheight} + \setlength\paperheight{\paperwidth} + \setlength\paperwidth{\@tempdima}} + +% font size options +\newcommand\@ptsize{} +\DeclareOption{10pt}{\renewcommand\@ptsize{0}} +\DeclareOption{11pt}{\renewcommand\@ptsize{1}} +\DeclareOption{12pt}{\renewcommand\@ptsize{2}} + +% font type options +\DeclareOption{sans}{\AtBeginDocument{\renewcommand{\familydefault}{\sfdefault}}} +\DeclareOption{roman}{\AtBeginDocument{\renewcommand{\familydefault}{\rmdefault}}} + +% draft/final option +\DeclareOption{draft}{\setlength\overfullrule{5pt}} +\DeclareOption{final}{\setlength\overfullrule{0pt}} + +% execute default options +\ExecuteOptions{a4paper,11pt,final} + +% process given options +\ProcessOptions\relax +\input{size1\@ptsize.clo} + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- +% \AtEndPreamble hook (loading etoolbox instead of defining the macro, as to avoid incompatibilities with etoolbox (and packages relying on it) defining the macro too) +\RequirePackage{etoolbox} +%\let\@endpreamblehook\@empty +%\def\AtEndPreamble{\g@addto@macro\@endpreamblehook} +%\let\document@original\document +%\def\document{\endgroup\@endpreamblehook\begingroup\document@original} + +% if... then... else... constructs +\RequirePackage{ifthen} +% TODO: move to xifthen and \isempty{<arg>} instead of \equal{<arg>}{} + +% color +\RequirePackage{xcolor} + +% font loading +%\RequirePackage{ifxetex,ifluatex} +%\newif\ifxetexorluatex +%\ifxetex +% \xetexorluatextrue +%\else +% \ifluatex +% \xetexorluatextrue +% \else +% \xetexorluatexfalse +% \fi +%\fi +% automatic loading of latin modern fonts +%\ifxetexorluatex +% \RequirePackage{fontspec} +% \defaultfontfeatures{Ligatures=TeX} +% \RequirePackage{unicode-math} +% \setmainfont{Latin Modern} +% \setsansfont{Latin Modern Sans} +% \setmathfont{Latin Modern Math} +%\else + \RequirePackage[T1]{fontenc} + \IfFileExists{lmodern.sty}% + {\RequirePackage{lmodern}}% + {} +%\fi + +% hyper links (hyperref is loaded at the end of the preamble to pass options required by loaded packages such as CJK) +\newcommand*\pdfpagemode{UseNone}% do not show thumbnails or bookmarks on opening (on supporting browsers); set \pdfpagemode to "UseOutlines" to show bookmarks +\RequirePackage{url} +\urlstyle{tt} +\AtEndPreamble{ + \pagenumbering{arabic}% has to be issued before loading hyperref, as to set \thepage and hence to avoid hyperref issuing a warning and setting pdfpagelabels=false + \RequirePackage[unicode]{hyperref}% unicode is required for unicode pdf metadata + \hypersetup{ + breaklinks, + baseurl = http://, + pdfborder = 0 0 0, + pdfpagemode = \pdfpagemode, + pdfstartpage = 1, + pdfcreator = {\LaTeX{} with 'moderncv' package}, +% pdfproducer = {\LaTeX{}},% will/should be set automatically to the correct TeX engine used + bookmarksopen = true, + bookmarksdepth= 2,% to show sections and subsections + pdfauthor = {\@firstname{}~\@lastname{}}, + pdftitle = {\@firstname{}~\@lastname{} -- \@title{}}, + pdfsubject = {Resum\'{e} of \@firstname{}~\@lastname{}}, + pdfkeywords = {\@firstname{}~\@lastname{}, curriculum vit\ae{}, resum\'{e}}}} + +% graphics +\RequirePackage{graphicx} + +% headers and footers +\RequirePackage{fancyhdr} +\fancypagestyle{plain}{ + \renewcommand{\headrulewidth}{0pt} + \renewcommand{\footrulewidth}{0pt} + \fancyhf{}} +% page numbers in footer if more than 1 page +\newif\if@displaypagenumbers\@displaypagenumberstrue +\newcommand*{\nopagenumbers}{\@displaypagenumbersfalse} +\AtEndPreamble{% + \AtBeginDocument{% + \if@displaypagenumbers% + \@ifundefined{r@lastpage}{}{% + \ifthenelse{\pageref{lastpage}>1}{% + \newlength{\pagenumberwidth}% + \settowidth{\pagenumberwidth}{\color{color2}\addressfont\itshape\strut\thepage/\pageref{lastpage}}% + \fancypagestyle{plain}{% + \fancyfoot[r]{\parbox[b]{\pagenumberwidth}{\color{color2}\pagenumberfont\strut\thepage/\pageref{lastpage}}}}% the parbox is required to ensure alignment with a possible center footer (e.g., as in the casual style) + \pagestyle{plain}}{}}% + \AtEndDocument{\label{lastpage}}\else\fi}} +\pagestyle{plain} + +% reduced list spacing +% package providing hooks into lists +% originally developped by Jakob Schiøtz (see http://dcwww.camd.dtu.dk/~schiotz/comp/LatexTips/tweaklist.sty) +% modified and distributed with moderncv(not available otherwise on ctan) +\RequirePackage{tweaklist} +\renewcommand*{\itemhook}{% + \@minipagetrue% removes spacing before lists as they use \addvspace, which doesn't add vertical space inside minipages + \@noparlisttrue% removes spacing at end of lists, caused by \par + \setlength{\topsep}{0pt}% normally not required thanks to \@minipagetrue + \setlength{\partopsep}{0pt}% normally not required thanks to \@minipagetrue + \setlength{\parsep}{0pt}% not required when \itemsep and \parskip are set to 0pt (?) + \setlength{\parskip}{0pt}% + \setlength{\itemsep}{0pt}} +\renewcommand*{\enumhook}{\itemhook{}} +\renewcommand*{\deschook}{\itemhook{}} + +% lengths calculations +\RequirePackage{calc} + +% advanced command arguments (LaTeX 3) +\RequirePackage{xparse} +% TODO (?): replace all \newcommand by \NewDocumentCommand + +% micro-typography (e.g., character protrusion, font expansion, hyphenatable letterspacing) +\RequirePackage{microtype} + +% compatibility package with older versions of moderncv +\RequirePackageWithOptions{moderncvcompatibility} + + +%------------------------------------------------------------------------------- +% class definition +%------------------------------------------------------------------------------- +% minimal base settings +\setlength\lineskip{1\p@} +\setlength\normallineskip{1\p@} +\renewcommand\baselinestretch{} +\setlength{\parindent}{0\p@} +\setlength{\parskip}{0\p@} +\setlength\columnsep{10\p@} +\setlength\columnseprule{0\p@} +\setlength\fboxsep{3\p@} +\setlength\fboxrule{.4\p@} +\setlength\arrayrulewidth{.4\p@} +\setlength\doublerulesep{2\p@} + +% not set on purpose +%\setlength\arraycolsep{5\p@} +%\setlength\tabcolsep{6\p@} +%\setlength\tabbingsep{\labelsep} + +\raggedbottom +\onecolumn + + +%------------------------------------------------------------------------------- +% overall design commands definitions +%------------------------------------------------------------------------------- +% elements +% defines one's name +% usage: \name{<firstname>}{<lastname>} +\newcommand*{\name}[2]{\def\@firstname{#1}\def\@lastname{#2}} +% defines one's title (optional) +% usage: \title{<title>} +\renewcommand*{\title}[1]{\def\@title{#1}} +% defines one's address (optional) +% usage: \address{<street>}{<city>}{<country>} +% where the <city> and <country> arguments can be omitted or provided empty +\NewDocumentCommand{\address}{mG{}G{}}{\def\@addressstreet{#1}\def\@addresscity{#2}\def\@addresscountry{#3}} +% adds a mobile/fixed/fax number to one's personal information (optional) +% usage: \phone[<optional type>]{<number>} +% where <optional type> should be either "mobile", "fixed" or "fax +\RequirePackage{collection} +\collectionnew{phones} +\newcommand*{\phone}[2][fixed]{\collectionadd[#1]{phones}{#2}} +\newcommand*{\email}[1]{\def\@email{#1}} +% defines one's home page (optional) +% usage: \homepage{<url>} +\newcommand*{\homepage}[1]{\def\@homepage{#1}} +% defines one's github (optional) +% usage: \homepage{<url>} +\newcommand*{\github}[1]{\def\@github{#1}} +% defines additional personal information (optional) +% usage: \extrainfo{<text>} +\newcommand*{\extrainfo}[1]{\def\@extrainfo{#1}} + +% colors +\definecolor{color0}{rgb}{0,0,0}% main default color, normally left to black +\definecolor{color1}{rgb}{0,0,0}% primary theme color +\definecolor{color2}{rgb}{0,0,0}% secondary theme color +\definecolor{color3}{rgb}{0,0,0}% tertiary theme color + +% symbols +% itemize labels (the struts were added to correct inter-item spacing (works for single line items, until a solution is found for multi-line ones...) +\newcommand*{\labelitemi}{\strut\textcolor{color1}{\large\rmfamily\textbullet}}% the \rmfamily is required to force Latin Modern fonts when using sans serif, as OMS/lmss/m/n is not defined and gets substituted by OMS/cmsy/m/n +\newcommand*{\labelitemii}{\strut\textcolor{color1}{\large\bfseries-}} +\newcommand*{\labelitemiii}{\strut\textcolor{color1}{\rmfamily\textperiodcentered}}% alternative: \textasteriskcentered; the \rmfamily is required to force Latin Modern fonts when using sans serif, as OMS/lmss/m/n is not defined and gets substituted by OMS/cmsy/m/n +\newcommand*{\labelitemiv}{\labelitemiii} +% enumerate labels +\renewcommand{\theenumi}{\@arabic\c@enumi} +\renewcommand{\theenumii}{\@alph\c@enumii} +\renewcommand{\theenumiii}{\@roman\c@enumiii} +\renewcommand{\theenumiv}{\@Alph\c@enumiv} +% other symbols +\newcommand*{\listitemsymbol}{\labelitemi~} +\newcommand*{\addresssymbol}{} +\newcommand*{\mobilephonesymbol}{} +\newcommand*{\fixedphonesymbol}{} +\newcommand*{\faxphonesymbol}{} +\newcommand*{\emailsymbol}{} +\newcommand*{\homepagesymbol}{} + +% fonts +\AtBeginDocument{\normalfont\color{color0}} + +% strings for internationalisation +\newcommand*{\refname}{Publications} +\newcommand*{\enclname}{Enclosure} + +% makes the footer (normally used both for the resume and the letter) +% usage: \makefooter +\newcommand*{\makefooter}{}% + +% loads a style variant +% usage: \moderncvstyle{<style variant name>} +\newcommand*{\moderncvstyle}[1]{ + \RequirePackage{moderncvstyle#1}} + +% loads a color scheme +% usage: \moderncvcolor{<color scheme name>} +\newcommand*{\moderncvcolor}[1]{ + \RequirePackage{moderncvcolor#1}} + +% loads an icons set +% usage: \moderncvicons{<icon set name>} +\newcommand*{\moderncvicons}[1]{ + \RequirePackage{moderncvicons#1}} + +% recomputes all automatic lengths +\newcommand*{\recomputelengths}{\recomputecvlengths} +\AtBeginDocument{\recomputelengths{}} + +% creates a length if not yet defined +\newcommand*{\@initializelength}[1]{% + \ifdefined#1\else\newlength{#1}\fi} + + +%------------------------------------------------------------------------------- +% resume design commands definitions +%------------------------------------------------------------------------------- +% elements +% defines one's picture (optional) +% usage: photo[<picture width>][<picture frame thickness>]{<picture filename>} +\NewDocumentCommand{\photo}{O{64pt}O{0.4pt}m}{\def\@photowidth{#1}\def\@photoframewidth{#2}\def\@photo{#3}} +\newcommand*{\quote}[1]{\def\@quote{#1}} + +% fonts +\newcommand*{\namefont}{} +\newcommand*{\titlefont}{} +\newcommand*{\addressfont}{} +\newcommand*{\quotefont}{} +\newcommand*{\sectionfont}{} +\newcommand*{\subsectionfont}{} +\newcommand*{\hintfont}{} +\newcommand*{\pagenumberfont}{\addressfont\itshape} + +% styles +\newcommand*{\namestyle}[1]{{\namefont#1}} +\newcommand*{\titlestyle}[1]{{\titlefont#1}} +\newcommand*{\addressstyle}[1]{{\addressfont#1}} +\newcommand*{\quotestyle}[1]{{\quotefont#1}} +\newcommand*{\sectionstyle}[1]{{\sectionfont#1}} +\newcommand*{\subsectionstyle}[1]{{\subsectionfont#1}} +\newcommand*{\hintstyle}[1]{{\hintfont#1}} +\newcommand*{\pagenumberstyle}[1]{{\pagenumberfont#1}} + +% recompute all resume lengths +\newcommand*{\recomputecvlengths}{} + +% internal maketitle command to issue a new line only when required +\newif\if@firstdetailselement\@firstdetailselementtrue +\newcommand*{\makenewline}{ + \if@firstdetailselement% + \strut% to ensure baseline alignment, e.g. with when put in the margin vs sections that also contains a \strut + \else% + \\\fi% + \@firstdetailselementfalse} + +% makes the resume title +% usage: \makecvtitle +\newcommand*{\makecvtitle}{} + +% makes the resume footer +% usage: \makecvfooter +\newcommand*{\makecvfooter}{\makefooter} + +% makes a resume section +% usage: \section{<title>} +% identical starred and non-starred variants should be defined for compatibility with other packages (e.g. with natbib, that uses \section*{} for the bibliography header) +\NewDocumentCommand{\section}{sm}{} + +% makes a resume subsection +% usage: \subsection{title} +\NewDocumentCommand{\subsection}{sm}{} + +% makes a resume line with a header and a corresponding text +% usage: \cvitem[spacing]{header}{text} +\newcommand*{\cvitem}[3][.25em]{} + +% makes a resume line 2 headers and their corresponding text +% usage: \cvdoubleitem[spacing]{header1}{text1}{header2}{text2} +\newcommand*{\cvdoubleitem}[5][.25em]{} + +% makes a resume line with a list item +% usage: \cvlistitem[label]{item} +\newcommand*{\cvlistitem}[2][\listitemsymbol]{} + +% makes a resume line with 2 list items +% usage: \cvlistdoubleitem[label]{item1}{item2} +\newcommand*{\cvlistdoubleitem}[3][\listitemsymbol]{} + +% makes a typical resume job / education entry +% usage: \cventry[spacing]{years}{degree/job title}{institution/employer}{localization}{optionnal: grade/...}{optional: comment/job description} +\newcommand*{\cventry}[7][.25em]{} + +% makes a resume entry with a proficiency comment +% usage: \cvitemwithcomment[spacing]{header}{text}{comment} +\newcommand*{\cvitemwithcomment}[4][.25em]{} + +% makes a generic hyperlink +% usage: \link[optional text]{link} +\newcommand*{\link}[2][]{% + \ifthenelse{\equal{#1}{}}% + {\href{#2}{#2}}% + {\href{#2}{#1}}} + +% makes a http hyperlink +% usage: \httplink[optional text]{link} +\newcommand*{\httplink}[2][]{% + \ifthenelse{\equal{#1}{}}% + {\href{http://#2}{#2}}% + {\href{http://#2}{#1}}} + +% makes an email hyperlink +% usage: \emaillink[optional text]{link} +\newcommand*{\emaillink}[2][]{% + \ifthenelse{\equal{#1}{}}% + {\href{mailto:#2}{#2}}% + {\href{mailto:#2}{#1}}} + +% cvcolumns environment, where every column is created through \cvcolumn +% usage: \begin{cvcolumns} +% \cvcolumn[width]{head}{content} +% \cvcolumn[width]{head}{content} +% ... +% \end{cvcolumns} +% where "width" is the width as a fraction of the line length (between 0 and 1), "head" is the column header and "content" its content +\newcounter{cvcolumnscounter}% counter for the number of columns +\newcounter{cvcolumnsautowidthcounter}% counter for the number of columns with no column width provided, and which will then be equally distributed +\newcounter{tmpiteratorcounter}% counter for any temporary purpose (e.g., iterating loops) +\newlength{\cvcolumnsdummywidth}\setlength{\cvcolumnsdummywidth}{1000pt}% dummy width for total width, in order to enable arithmetics (TeX has no float variables, only integer counters or lengths) +\newlength{\cvcolumnswidth}% total width available for head / content +\newlength{\cvcolumnsautowidth}% total width of columns with no explicit width provided +\newlength{\cvcolumnautowidth}% width of one of the columns with no explicit width provided (based on equal distribution of remaining space) +\newif\if@cvcolumns@head@empty% whether or not at least one of the columns has a header +\newenvironment*{cvcolumns}% + {% at environment opening: reset counters, lengths and ifs + \setcounter{cvcolumnscounter}{0}% + \setcounter{cvcolumnsautowidthcounter}{0}% + \setlength{\cvcolumnsautowidth}{\cvcolumnsdummywidth}% + \setlength{\cvcolumnautowidth}{0pt}% + \@cvcolumns@head@emptytrue}% + {% at environment closing: typeset environment + % compute the width of each cvcolumn, considering a spacing of \separatorcolumnwidth and the columns with set width + \ifnum\thecvcolumnscounter>0% + \setlength{\cvcolumnswidth}{\maincolumnwidth-\value{cvcolumnscounter}\separatorcolumnwidth+\separatorcolumnwidth}% + \setlength{\cvcolumnautowidth}{\cvcolumnswidth*\ratio{\cvcolumnsautowidth}{\cvcolumnsdummywidth}/\value{cvcolumnsautowidthcounter}}\fi% + % pre-aggregate the tabular definition, heading and content (required before creating the tabular, as the tabular environment doesn't like loops --- probably because "&" generates a \endgroup) + % - the tabular definition is the aggregation of the different "\cvcolumn<i>@def" (by default "p{\cvcolumnautowidth}"), separated by "@{\hspace*{\separatorcolumnwidth}}" + % - the tabular heading is the aggregation of the different "\cvcolumn<i>@head", separated by "&" + % - the tabular content is the aggregation of the different "\cvcolumn<i>@content", separated by "&" + % to aggregate the different elements, \protected@edef or \g@addto@macro is required to avoid that \cvcolumns@def, -@head and -@content get expanded in subsequent redefinitions, which would cause errors due to the expansions of \hspace, of \subsectionstyle and possibly of user content/argument such as font commands + \def\cvcolumns@def{}% + \def\cvcolumns@head{}% + \def\cvcolumns@content{}% + \setcounter{tmpiteratorcounter}{0}% + % loop based on \g@addto@macro + \loop\ifnum\thetmpiteratorcounter<\thecvcolumnscounter% + \ifnum\thetmpiteratorcounter=0\else% + \g@addto@macro\cvcolumns@def{@{\hspace*{\separatorcolumnwidth}}}% + \g@addto@macro\cvcolumns@head{&}% + \g@addto@macro\cvcolumns@content{&}\fi% + \expandafter\g@addto@macro\expandafter\cvcolumns@def\expandafter{\csname cvcolumn\roman{tmpiteratorcounter}@def\endcsname}% + \expandafter\g@addto@macro\expandafter\cvcolumns@head\expandafter{\csname cvcolumn\roman{tmpiteratorcounter}@head\endcsname}% + \expandafter\g@addto@macro\expandafter\cvcolumns@content\expandafter{\csname cvcolumn\roman{tmpiteratorcounter}@content\endcsname}% + \stepcounter{tmpiteratorcounter}% + \repeat% +% % same loop based on \protected@edef +% \loop\ifnum\thetmpiteratorcounter<\thecvcolumnscounter% +% \ifnum\thetmpiteratorcounter=0\else% +% \protected@edef\cvcolumns@def{\cvcolumns@def @{\hspace*{\separatorcolumnwidth}}}% +% \protected@edef\cvcolumns@head{\cvcolumns@head &}% +% \protected@edef\cvcolumns@content{\cvcolumns@content &}\fi% +% \expandafter\protected@edef\expandafter\cvcolumns@def\expandafter{\expandafter\cvcolumns@def\expandafter\protect\csname cvcolumn\roman{tmpiteratorcounter}@def\endcsname}% +% \expandafter\protected@edef\expandafter\cvcolumns@head\expandafter{\expandafter\cvcolumns@head\expandafter\protect\csname cvcolumn\roman{tmpiteratorcounter}@head\endcsname}% +% \expandafter\protected@edef\expandafter\cvcolumns@content\expandafter{\expandafter\cvcolumns@content\expandafter\protect\csname cvcolumn\roman{tmpiteratorcounter}@content\endcsname}% +% \stepcounter{tmpiteratorcounter}% +% \repeat% + % create the tabular + \cvitem{}{% + \begin{tabular}{\cvcolumns@def}% + \if@cvcolumns@head@empty\else% + \cvcolumns@head\\[-.8em]% + {\color{color1}\rule{\maincolumnwidth}{.25pt}}\\\fi% + \cvcolumns@content% + \end{tabular}}} + +% cvcolumn command, to create a column inside a cvcolumns environment +% usage: \cvcolumn[width]{head}{content} +% where "width" is the width as a fraction of the line length (between 0 and 1), "head" is the column header and "content" its content ("head" and "content" can contain "\\", "\newline" or any other paragraph command such as "itemize") +\newcommand*{\cvcolumn}[3][\cvcolumnautowidth]{% +% \def\cvcolumn@width{}% + \ifthenelse{\equal{#1}{\cvcolumnautowidth}}% + {% if no width fraction is provided, count this column as auto-adjusted and set its width to \cvcolumnsautowidth + \stepcounter{cvcolumnsautowidthcounter}% + \expandafter\expandafter\expandafter\def\expandafter\csname cvcolumn\roman{cvcolumnscounter}@def\endcsname{p{\cvcolumnautowidth}}% + \expandafter\expandafter\expandafter\def\expandafter\csname cvcolumn\roman{cvcolumnscounter}@head\endcsname{\protect\parbox[b]{\cvcolumnautowidth}{\protect\subsectionstyle{#2}}}}% + {% if a width is provided, set the width of the column to it and decrease the available space for auto-adjusted columns + \addtolength{\cvcolumnsautowidth}{-#1\cvcolumnsdummywidth}% + \expandafter\expandafter\expandafter\def\expandafter\csname cvcolumn\roman{cvcolumnscounter}@def\endcsname{p{#1\cvcolumnswidth}}% + \expandafter\expandafter\expandafter\def\expandafter\csname cvcolumn\roman{cvcolumnscounter}@head\endcsname{\protect\parbox[b]{#1\cvcolumnswidth}{\protect\subsectionstyle{#2}}}}% + \ifthenelse{\equal{#2}{}}{}{\@cvcolumns@head@emptyfalse}% + \expandafter\expandafter\expandafter\def\expandafter\csname cvcolumn\roman{cvcolumnscounter}@content\endcsname{\protect\cvcolumncell{#3}}% + \stepcounter{cvcolumnscounter}} + +% internal cvcolumncell command, that enables a cvcolumn cell to contain paragraph commands (lists, newlines, etc) +\newcommand*{\cvcolumncell}[1]{{% put cell inside a group, so that command redefinitions are only local + % roughly restore \\ to its regular definition (outside of tabular) + \renewcommand*{\\}{\newline}% + % enclose the contents of the cell inside a vertical box, to allow paragraph commands + \protect\vtop{#1}}} + +% thebibliography environment, for use with BibTeX and possibly multibib +\newlength{\bibindent} +\setlength{\bibindent}{1.5em} +% bibliography item label +\newcommand*{\bibliographyitemlabel}{}% use \@biblabel{\arabic{enumiv}} for BibTeX labels +%\newif\if@multibibfirstbib\@multibibfirstbibfalse +% bibliography head (section, etc}, depending on whether multibib is used +\newcommand*{\bibliographyhead}[1]{\section{#1}} +\AtEndPreamble{\@ifpackageloaded{multibib}{\renewcommand*{\bibliographyhead}[1]{\subsection{#1}}}{}} +% thebibliography environment definition +\newenvironment{thebibliography}[1]{}{} +\newcommand*{\newblock}{\hskip .11em\@plus.33em\@minus.07em} +\let\@openbib@code\@empty + +% itemize, enumerate and description environment +\setlength{\leftmargini} {1em} +\leftmargin\leftmargini +\setlength{\leftmarginii} {\leftmargini} +\setlength{\leftmarginiii} {\leftmargini} +\setlength{\leftmarginiv} {\leftmargini} +\setlength{\leftmarginv} {\leftmargini} +\setlength{\leftmarginvi} {\leftmargini} +\setlength{\labelsep} {.5em}% this is the distance between the label and the body, but it pushes the label to the left rather than pushing the body to the right (to do the latter, modify \leftmargin(i) +\setlength{\labelwidth} {\leftmargini}% unfortunately, \labelwidth is not defined by item level (i.e. no \labeliwidth, \labeliiwidth, etc) +\addtolength{\labelwidth} {-\labelsep} +\@beginparpenalty -\@lowpenalty +\@endparpenalty -\@lowpenalty +\@itempenalty -\@lowpenalty +\newcommand\labelenumi{\theenumi.} +\newcommand\labelenumii{(\theenumii)} +\newcommand\labelenumiii{\theenumiii.} +\newcommand\labelenumiv{\theenumiv.} +\renewcommand\p@enumii{\theenumi} +\renewcommand\p@enumiii{\p@enumii(\theenumii)} +\renewcommand\p@enumiv{\p@enumiii\theenumiii} +% description label +\newcommand*\descriptionlabel[1]{\hspace\labelsep\normalfont\bfseries#1} + +% classical \today definition +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} + +%\newcommand{\widthofautobox}[1]{% +% \widthof{\begin{tabular}{@{}l@{}}#1\end{tabular}}} + +%\newcommand{\autobox}[2][b]{% +% \parbox[#1]{\widthofautobox{#2}}{#2}} + + +%------------------------------------------------------------------------------- +% letter design commands definitions +%------------------------------------------------------------------------------- +% elements +\newcommand*{\recipient}[2]{\def\@recipientname{#1}\def\@recipientaddress{#2}} +\renewcommand*{\date}[1]{\def\@date{#1}}\date{\today} +\newcommand*{\opening}[1]{\def\@opening{#1}} +\newcommand*{\closing}[1]{\def\@closing{#1}} +\newcommand*{\enclosure}[2][]{% + % if an optional argument is provided, use it to redefine \enclname + \ifthenelse{\equal{#1}{}}{}{\renewcommand*{\enclname}{#1}}% + \def\@enclosure{#2}} + +% recompute all letter lengths +\newcommand*{\recomputeletterlengths}{} + +% makes the letter title +% usage: \makelettertitle +\newcommand*{\makelettertitle}{} + +% makes the letter footer +% usage: \makeletterfooter +\newcommand*{\makeletterfooter}{\makefooter} + +% makes the letter closing +% usage: \makeletterclosing +\newcommand*{\makeletterclosing}{} + + +\endinput + + +%% end of file `moderncv.cls'. diff --git a/users/grfn/resume/moderncvcolorblack.sty b/users/grfn/resume/moderncvcolorblack.sty new file mode 100644 index 000000000000..3a6e1477f322 --- /dev/null +++ b/users/grfn/resume/moderncvcolorblack.sty @@ -0,0 +1,27 @@ +%% start of file `moderncvcolorblack.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcolorblack}[2013/02/09 v1.3.0 modern curriculum vitae and letter color scheme: black] + + +%------------------------------------------------------------------------------- +% color scheme definition +%------------------------------------------------------------------------------- +\definecolor{color0}{rgb}{0,0,0}% black +\definecolor{color1}{rgb}{0,0,0}% black +\definecolor{color2}{rgb}{0,0,0}% black + + +\endinput + + +%% end of file `moderncvcolorblack.sty'. diff --git a/users/grfn/resume/moderncvcolorblue.sty b/users/grfn/resume/moderncvcolorblue.sty new file mode 100644 index 000000000000..7b949c704acd --- /dev/null +++ b/users/grfn/resume/moderncvcolorblue.sty @@ -0,0 +1,27 @@ +%% start of file `moderncvcolorblue.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcolorblue}[2013/02/09 v1.3.0 modern curriculum vitae and letter color scheme: blue] + + +%------------------------------------------------------------------------------- +% color scheme definition +%------------------------------------------------------------------------------- +\definecolor{color0}{rgb}{0,0,0}% black +\definecolor{color1}{rgb}{0.22,0.45,0.70}% light blue +\definecolor{color2}{rgb}{0.45,0.45,0.45}% dark grey + + +\endinput + + +%% end of file `moderncvcolorblue.sty'. diff --git a/users/grfn/resume/moderncvcolorgreen.sty b/users/grfn/resume/moderncvcolorgreen.sty new file mode 100644 index 000000000000..4de7f848a04e --- /dev/null +++ b/users/grfn/resume/moderncvcolorgreen.sty @@ -0,0 +1,27 @@ +%% start of file `moderncvcolorgreen.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcolorgreen}[2013/02/09 v1.3.0 modern curriculum vitae and letter color scheme: green] + + +%------------------------------------------------------------------------------- +% color scheme definition +%------------------------------------------------------------------------------- +\definecolor{color0}{rgb}{0,0,0}% black +\definecolor{color1}{rgb}{0.35,0.70,0.30}% green +\definecolor{color2}{rgb}{0.45,0.45,0.45}% dark grey + + +\endinput + + +%% end of file `moderncvcolorgreen.sty'. diff --git a/users/grfn/resume/moderncvcolorgrey.sty b/users/grfn/resume/moderncvcolorgrey.sty new file mode 100644 index 000000000000..9018726a2384 --- /dev/null +++ b/users/grfn/resume/moderncvcolorgrey.sty @@ -0,0 +1,27 @@ +%% start of file `moderncvcolorgrey.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcolorgrey}[2013/02/09 v1.3.0 modern curriculum vitae and letter color scheme: grey] + + +%------------------------------------------------------------------------------- +% color scheme definition +%------------------------------------------------------------------------------- +\definecolor{color0}{rgb}{0,0,0}% black +\definecolor{color1}{rgb}{0.55,0.55,0.55}% dark grey +\definecolor{color2}{rgb}{0.55,0.55,0.55}% dark grey + + +\endinput + + +%% end of file `moderncvcolorgrey.sty'. diff --git a/users/grfn/resume/moderncvcolororange.sty b/users/grfn/resume/moderncvcolororange.sty new file mode 100644 index 000000000000..134ae2401133 --- /dev/null +++ b/users/grfn/resume/moderncvcolororange.sty @@ -0,0 +1,27 @@ +%% start of file `moderncvcolororange.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcolororange}[2013/02/09 v1.3.0 modern curriculum vitae and letter color scheme: orange] + + +%------------------------------------------------------------------------------- +% color scheme definition +%------------------------------------------------------------------------------- +\definecolor{color0}{rgb}{0,0,0}% black +\definecolor{color1}{rgb}{0.95,0.55,0.15}% orange +\definecolor{color2}{rgb}{0.45,0.45,0.45}% dark grey + + +\endinput + + +%% end of file `moderncvcolororange.sty'. diff --git a/users/grfn/resume/moderncvcolorpurple.sty b/users/grfn/resume/moderncvcolorpurple.sty new file mode 100644 index 000000000000..d3dc5345b080 --- /dev/null +++ b/users/grfn/resume/moderncvcolorpurple.sty @@ -0,0 +1,27 @@ +%% start of file `moderncvcolorpurple.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcolorpurple}[2013/02/09 v1.3.0 modern curriculum vitae and letter color scheme: purple] + + +%------------------------------------------------------------------------------- +% color scheme definition +%------------------------------------------------------------------------------- +\definecolor{color0}{rgb}{0,0,0}% black +\definecolor{color1}{rgb}{0.50,0.33,0.80}% purple +\definecolor{color2}{rgb}{0.45,0.45,0.45}% dark grey + + +\endinput + + +%% end of file `moderncvcolorpurple.sty'. diff --git a/users/grfn/resume/moderncvcolorred.sty b/users/grfn/resume/moderncvcolorred.sty new file mode 100644 index 000000000000..681181997d38 --- /dev/null +++ b/users/grfn/resume/moderncvcolorred.sty @@ -0,0 +1,27 @@ +%% start of file `moderncvcolorred.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcolorred}[2013/02/09 v1.3.0 modern curriculum vitae and letter color scheme: red] + + +%------------------------------------------------------------------------------- +% color scheme definition +%------------------------------------------------------------------------------- +\definecolor{color0}{rgb}{0,0,0}% black +\definecolor{color1}{rgb}{0.95,0.20,0.20}% red +\definecolor{color2}{rgb}{0.45,0.45,0.45}% dark grey + + +\endinput + + +%% end of file `moderncvcolorred.sty'. diff --git a/users/grfn/resume/moderncvcompatibility.sty b/users/grfn/resume/moderncvcompatibility.sty new file mode 100644 index 000000000000..1fc53f2180e1 --- /dev/null +++ b/users/grfn/resume/moderncvcompatibility.sty @@ -0,0 +1,104 @@ +%% start of file `moderncvcompatibility.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvcompatibility}[2013/02/09 v1.3.0 modern curriculum vitae and letter compatibility patches] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- + + +%------------------------------------------------------------------------------- +% package options +%------------------------------------------------------------------------------- +% old casual option (version 0.1) +%\DeclareOption{casual}{\input{moderncvstylecasual.sty}} + +% old classic option (version 0.1) +%\DeclareOption{classic}{\input{moderncvstyleclassic.sty}} + +\DeclareOption*{} + +% process given options +\ProcessOptions\relax + +%------------------------------------------------------------------------------- +% definitions +%------------------------------------------------------------------------------- +% compatibility with version 0.1 +\newcommand*{\cvresume}[2]{\cvlistdoubleitem{#1}{#2}} + +% compatibility with versions <= 0.2 +% section, cvline, ... with width argument... +%\newcommand*{\section}[2][0.825]{% +% \closesection{}% +% \@sectionopentrue% +% \addcontentsline{toc}{part}{#2} +% \begin{longtable}[t]{@{}r@{\hspace{.025\textwidth}}@{}p{#1\textwidth}@{}}% +%% \colorrule{.15\textwidth}&\mbox{\color{sectiontitlecolor}\sectionfont#2}\\[1ex]}% +% {\color{sectionrectanglecolor}\rule{0.15\textwidth}{1ex}}&\mbox{\color{sectiontitlecolor}\sectionfont#2}\\[1ex]}% +%\newcommand*{\cvline}[3][.825]{% +% \begin{minipage}[t]{\hintscolumnwidth}\raggedleft\small\sffamily#2\end{minipage}&\begin{minipage}[t]{\maincolumnwidth}#3\end{minipage}\\} +%\newcommand*{\cvitem}[3][.825]{% +% \cvline[#1]{#2}{#3\vspace*{.75em}}} % the \vspace*{} inside the cvline environment is a hack... (should conceptually be outside the environment) + +% compatibility with versions <= 0.5 +%\newcommand*{\cvitem}[2]{\cvline{#1}{#2}} +%\newcommand*{\moderncvstyle}[1]{\moderncvtheme{#1}} + +% compatibility with versions <= 0.7 +\newcommand*{\closesection}{} +\newcommand*{\emptysection}{} +\newcommand*{\sethintscolumnlength}[1]{% + \setlength{\hintscolumnwidth}{#1}% + \recomputelengths} +\newcommand*{\sethintscolumntowidth}[1]{% + \settowidth{\hintscolumnwidth}{#1}% + \recomputelengths} + +% compatibility with versions <= 0.15 +\newcommand*{\cvline}[2]{\cvitem{#1}{#2}} +\newcommand*{\cvlanguage}[3]{\cvitemwithcomment{#1}{#2}{#3}} +\newcommand*{\cvcomputer}[4]{\cvdoubleitem{#1}{\small#2}{#3}{\small#4}} +\newcommand*{\moderncvtheme}[2][blue]{% + \moderncvcolor{#1}% + \moderncvstyle{#2}} + +% compatibility with versions <= 0.19 +\newcommand*{\maketitle}{\makecvtitle}% +\title{}% to avoid LaTeX complaining that \maketitle is a called without first a call to \title +\newcommand*{\maketitlenamewidth}{\makecvtitlenamewidth} + +% compatibility with versions <= 1.3.0 +\newcommand*{\firstname}[1]{\def\@firstname{#1}} +\newcommand*{\lastname}[1]{\def\@lastname{#1}} +\newcommand*{\givenname}[1]{\def\@firstname{#1}} +\newcommand*{\familyname}[1]{\def\@lastname{#1}} +\def\@familyname{\@lastname} + +% compatibility with versions <= 1.4.0 +\newcommand*{\mobile}[1]{\collectionadd[mobile]{phones}{#1}} +%\newcommand*{\phone}[1]{\collectionadd[fixed]{phones}{#1}}% implicit, as \phone{...} defaults to \phone[fixed]{...} +\newcommand*{\fax}[1]{\collectionadd[fax]{phones}{#1}} +\newcommand*{\@mobile}{\collectionfindbykey{phones}{mobile}} +\newcommand*{\@phone}{\collectionfindbykey{phones}{fixed}} +\newcommand*{\@fax}{\collectionfindbykey{phones}{fax}} +\newcommand*{\phonesymbol}{\fixedphonesymbol} +\newcommand*{\mobilesymbol}{\mobilephonesymbol} +\newcommand*{\faxsymbol}{\faxphonesymbol} + + +\endinput + + +%% end of file `moderncvcompatibility.sty'. diff --git a/users/grfn/resume/moderncviconsletters.sty b/users/grfn/resume/moderncviconsletters.sty new file mode 100644 index 000000000000..0a4e2864be29 --- /dev/null +++ b/users/grfn/resume/moderncviconsletters.sty @@ -0,0 +1,50 @@ +%% start of file `moderncviconsletters.sty'. +%% Copyright 2013-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncviconsmarvosym}[2013/02/09 v1.3.0 modern curriculum vitae and letter icons: letters] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- +% MarVoSym font +%\RequirePackage{marvosym} +\newcommand*{\marvosymbol}[1]{} +%\ifxetexorluatex +% \renewcommand*{\marvosymbol}[1]{{\fontspec{MarVoSym}\char#1}} +%\else + \renewcommand*{\marvosymbol}[1]{{\fontfamily{mvs}\fontencoding{U}\fontseries{m}\fontshape{n}\selectfont\char#1}} +%\fi + + +%------------------------------------------------------------------------------- +% symbols definition +%------------------------------------------------------------------------------- +\renewcommand*{\labelitemi}{\strut\textcolor{color1}{\marvosymbol{123}}}% equivalent to \Neutral from marvosym package; alternative: \fontencoding{U}\fontfamily{ding}\selectfont\tiny\symbol{'102} +%\renewcommand*{\labelitemii}{\strut\textcolor{color1}{\large\bfseries-}}% no change from default in moderncv.cls +%\renewcommand*{\labelitemiii}{\strut\textcolor{color1}{\rmfamily\textperiodcentered}}% no change from default in moderncv.cls +%\renewcommand*{\labelitemiv}{\labelitemiii}% no change from default in moderncv.cls + +\renewcommand*{\addresssymbol}{} +\renewcommand*{\mobilephonesymbol}{\textbf{M}~} +\renewcommand*{\fixedphonesymbol}{\textbf{T}~} +\renewcommand*{\faxphonesymbol}{\textbf{F}~} +\renewcommand*{\emailsymbol}{\textbf{E}~} +\renewcommand*{\homepagesymbol}{} + +\renewcommand*{\listitemsymbol}{\labelitemi~} + + +\endinput + + +%% end of file `moderncviconsletters.sty'. diff --git a/users/grfn/resume/moderncviconsmarvosym.sty b/users/grfn/resume/moderncviconsmarvosym.sty new file mode 100644 index 000000000000..eb1b1ec727bb --- /dev/null +++ b/users/grfn/resume/moderncviconsmarvosym.sty @@ -0,0 +1,48 @@ +%% start of file `moderncviconsmarvosym.sty'. +%% Copyright 2013-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncviconsmarvosym}[2013/02/09 v1.3.0 modern curriculum vitae and letter icons: marvosym] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- +% MarVoSym font +%\RequirePackage{marvosym} +\newcommand*{\marvosymbol}[1]{} +%\ifxetexorluatex +% \renewcommand*{\marvosymbol}[1]{{\fontspec{MarVoSym}\char#1}} +%\else + \renewcommand*{\marvosymbol}[1]{{\fontfamily{mvs}\fontencoding{U}\fontseries{m}\fontshape{n}\selectfont\char#1}} +%\fi + + +%------------------------------------------------------------------------------- +% symbols definition +%------------------------------------------------------------------------------- +\renewcommand*{\labelitemi}{\strut\textcolor{color1}{\marvosymbol{123}}}% equivalent to \Neutral from marvosym package; alternative: \fontencoding{U}\fontfamily{ding}\selectfont\tiny\symbol{'102} +%\renewcommand*{\labelitemii}{\strut\textcolor{color1}{\large\bfseries-}}% no change from default in moderncv.cls +%\renewcommand*{\labelitemiii}{\strut\textcolor{color1}{\rmfamily\textperiodcentered}}% no change from default in moderncv.cls +%\renewcommand*{\labelitemiv}{\labelitemiii}% no change from default in moderncv.cls + +\renewcommand*{\addresssymbol}{} +\renewcommand*{\mobilephonesymbol}{\marvosymbol{72}~} +\renewcommand*{\fixedphonesymbol}{\marvosymbol{84}~} +\renewcommand*{\faxphonesymbol}{\marvosymbol{117}~} +\renewcommand*{\emailsymbol}{\marvosymbol{66}~} +\renewcommand*{\homepagesymbol}{{\Large\marvosymbol{205}}~} + + +\endinput + + +%% end of file `moderncviconsmarvosym.sty'. diff --git a/users/grfn/resume/moderncvstylebanking.sty b/users/grfn/resume/moderncvstylebanking.sty new file mode 100644 index 000000000000..fb0b70fdcd10 --- /dev/null +++ b/users/grfn/resume/moderncvstylebanking.sty @@ -0,0 +1,287 @@ +%% start of file `moderncvstylebanking.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvstylebanking}[2013/02/09 v1.3.0 modern curriculum vitae and letter style scheme: banking] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- + + +%------------------------------------------------------------------------------- +% overall style definition +%------------------------------------------------------------------------------- +% fonts +%\ifxetexorluatex +% \setmainfont{Tex-Gyre Pagella} +% \setsansfont{Tex-Gyre Pagella} +% \setmathfont{Tex-Gyre Pagella} +% \setmathfont[range=\mathit,\mathsfit]{Tex-Gyre Pagella Italic} +% \setmathfont[range=\mathbfup,\mathbfsfup]{Tex-Gyre Pagella Bold} +% \setmathfont[range=\mathbfit,\mathbfsfit]{Tex-Gyre Pagella Bold Italic} +%\else + \IfFileExists{tgpagella.sty}% + {% + \RequirePackage{tgpagella}% + \renewcommand*{\familydefault}{\rmdefault}}% + {} +%\fi + +% symbols +\moderncvicons{marvosym} + +% commands +\newcommand*{\maketitlesymbol}{% + {~~~{\rmfamily\textbullet}~~~}}% the \rmfamily is required to force Latin Modern fonts when using sans serif, as OMS/lmss/m/n is not defined and gets substituted by OMS/cmsy/m/n +% internal command to add an element to the footer +% it collects the elements in a temporary box, and checks when to flush the box +\newsavebox{\maketitlebox}% +\newsavebox{\maketitletempbox}% +\newlength{\maketitlewidth}% +\newlength{\maketitleboxwidth}% +\newif\if@firstmaketitleelement\@firstmaketitleelementtrue% +% adds an element to the maketitle, separated by maketitlesymbol +% usage: \addtomaketitle[maketitlesymbol]{element} +\newcommand*{\addtomaketitle}[2][\maketitlesymbol]{% + \if@firstmaketitleelement% + \savebox{\maketitletempbox}{\usebox{\maketitlebox}#2}% + \else% + \savebox{\maketitletempbox}{\usebox{\maketitlebox}#1#2}\fi% + \settowidth{\maketitleboxwidth}{\usebox{\maketitletempbox}}% + \ifnum\maketitleboxwidth<\maketitlewidth% + \savebox{\maketitlebox}{\usebox{\maketitletempbox}}% + \@firstmaketitleelementfalse% + \else% + \flushmaketitle{}\\% + \savebox{\maketitlebox}{#2}% + \savebox{\maketitletempbox}{#2}% + \settowidth{\maketitleboxwidth}{\usebox{\maketitlebox}}% + \@firstmaketitleelementfalse\fi} +% internal command to flush the maketitle +\newcommand*{\flushmaketitle}{% + \strut\usebox{\maketitlebox}% + \savebox{\maketitlebox}{}% + \savebox{\maketitletempbox}{}% + \setlength{\maketitleboxwidth}{0pt}} +\renewcommand*{\maketitle}{% + \setlength{\maketitlewidth}{0.8\textwidth}% + \hfil% + \parbox{\maketitlewidth}{% + \centering% + % name and title + \namestyle{\@firstname~\@lastname}% + \ifthenelse{\equal{\@title}{}}{}{\titlestyle{~|~\@title}}\\% \isundefined doesn't work on \@title, as LaTeX itself defines \@title (before it possibly gets redefined by \title) + % detailed information + \addressfont\color{color2}% + \ifthenelse{\isundefined{\@addressstreet}}{}{\addtomaketitle{\addresssymbol\@addressstreet}% + \ifthenelse{\equal{\@addresscity}{}}{}{\addtomaketitle[~--~]{\@addresscity}}% if \addresstreet is defined, \addresscity and \addresscountry will always be defined but could be empty + \ifthenelse{\equal{\@addresscountry}{}}{}{\addtomaketitle[~--~]{\@addresscountry}}% + \flushmaketitle\@firstmaketitleelementtrue\\}% + \collectionloop{phones}{% the key holds the phone type (=symbol command prefix), the item holds the number + \addtomaketitle{\csname\collectionloopkey phonesymbol\endcsname\collectionloopitem}}% + \ifthenelse{\isundefined{\@email}}{}{\addtomaketitle{\emailsymbol\emaillink{\@email}}}% + \ifthenelse{\isundefined{\@homepage}}{}{\addtomaketitle{\homepagesymbol\httplink{\@homepage}}}% + \ifthenelse{\isundefined{\@extrainfo}}{}{\addtomaketitle{\@extrainfo}}% + \flushmaketitle}\\[2.5em]}% need to force a \par after this to avoid weird spacing bug at the first section if no blank line is left after \maketitle + + +%------------------------------------------------------------------------------- +% resume style definition +%------------------------------------------------------------------------------- +% fonts +\renewcommand*{\namefont}{\Huge\bfseries\upshape} +\renewcommand*{\titlefont}{\Huge\mdseries\upshape} +\renewcommand*{\addressfont}{\normalsize\mdseries\upshape} +\renewcommand*{\quotefont}{\large\slshape} +\renewcommand*{\sectionfont}{\Large\bfseries\upshape} +\renewcommand*{\subsectionfont}{\large\upshape\fontseries{sb}\selectfont} +\renewcommand*{\hintfont}{\bfseries} + +% styles +\renewcommand*{\namestyle}[1]{{\namefont\textcolor{color1}{#1}}} +\renewcommand*{\titlestyle}[1]{{\titlefont\textcolor{color2!85}{#1}}} +\renewcommand*{\addressstyle}[1]{{\addressfont\textcolor{color1}{#1}}} +\renewcommand*{\quotestyle}[1]{{\quotefont\textcolor{color1}{#1}}} +\renewcommand*{\sectionstyle}[1]{{\sectionfont\textcolor{color1}{#1}}} +\renewcommand*{\subsectionstyle}[1]{{\subsectionfont\textcolor{color1}{#1}}} +\renewcommand*{\hintstyle}[1]{{\hintfont\textcolor{color0}{#1}}} + +% lengths +\newlength{\quotewidth} +\newlength{\hintscolumnwidth} +\setlength{\hintscolumnwidth}{0.3\textwidth}% +\newlength{\separatorcolumnwidth} +\setlength{\separatorcolumnwidth}{0.025\textwidth}% +\newlength{\maincolumnwidth} +\newlength{\doubleitemcolumnwidth} +\newlength{\listitemsymbolwidth} +\settowidth{\listitemsymbolwidth}{\listitemsymbol} +\newlength{\listitemmaincolumnwidth} +\newlength{\listdoubleitemmaincolumnwidth} + +% commands +\renewcommand*{\recomputecvlengths}{% + \setlength{\quotewidth}{0.65\textwidth}% + % main lenghts + \setlength{\maincolumnwidth}{\textwidth}% + % listitem lengths + \setlength{\listitemmaincolumnwidth}{\maincolumnwidth-\listitemsymbolwidth}% + % doubleitem lengths + \setlength{\doubleitemcolumnwidth}{\maincolumnwidth-\separatorcolumnwidth}% + \setlength{\doubleitemcolumnwidth}{0.5\doubleitemcolumnwidth}% + % listdoubleitem lengths + \setlength{\listdoubleitemmaincolumnwidth}{\maincolumnwidth-\listitemsymbolwidth-\separatorcolumnwidth-\listitemsymbolwidth}% + \setlength{\listdoubleitemmaincolumnwidth}{0.5\listdoubleitemmaincolumnwidth}% + % fancyhdr lengths + \renewcommand{\headwidth}{\textwidth}% + % regular lengths + \setlength{\parskip}{0\p@}} + +\renewcommand*{\makecvtitle}{% + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputecvlengths% + \maketitle% + % optional quote + \ifthenelse{\isundefined{\@quote}}% + {}% + {{\centering\begin{minipage}{\quotewidth}\centering\quotestyle{\@quote}\end{minipage}\\[2.5em]}}% + \par}% to avoid weird spacing bug at the first section if no blank line is left after \maketitle} + +\RenewDocumentCommand{\section}{sm}{% + \par\addvspace{2.5ex}% + \phantomsection{}% reset the anchor for hyperrefs + \addcontentsline{toc}{section}{#2}% + \strut\sectionstyle{#2}% + {\color{color1}\hrule}% + \par\nobreak\addvspace{1ex}\@afterheading} + +\newcommand{\subsectionfill}{\xleaders\hbox to 0.35em{\scriptsize.}\hfill}% different subsectionfills will not be perfectly aligned, but remaining space at the end of the fill will be distributed evenly between leaders, so it will be barely visible +\RenewDocumentCommand{\subsection}{sm}{% + \par\addvspace{1ex}% + \phantomsection{}% + \addcontentsline{toc}{subsection}{#2}% + \strut\subsectionstyle{#2}{\color{color1}{\subsectionfill}}% + \par\nobreak\addvspace{0.5ex}\@afterheading} + +\renewcommand*{\cvitem}[3][.25em]{% + \ifthenelse{\equal{#2}{}}{}{\hintstyle{#2}: }{#3}% + \par\addvspace{#1}} + +\renewcommand*{\cvdoubleitem}[5][.25em]{% + \begin{minipage}[t]{\doubleitemcolumnwidth}\hintstyle{#2}: #3\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \begin{minipage}[t]{\doubleitemcolumnwidth}\ifthenelse{\equal{#4}{}}{}{\hintstyle{#4}: }#5\end{minipage}% + \par\addvspace{#1}} + +\renewcommand*{\cvlistitem}[2][.25em]{% + \listitemsymbol\begin{minipage}[t]{\listitemmaincolumnwidth}#2\end{minipage}% + \par\addvspace{#1}} + +\renewcommand*{\cvlistdoubleitem}[3][.25em]{% + \cvitem[#1]{}{\listitemsymbol\begin{minipage}[t]{\listdoubleitemmaincolumnwidth}#2\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \ifthenelse{\equal{#3}{}}% + {}% + {\listitemsymbol\begin{minipage}[t]{\listdoubleitemmaincolumnwidth}#3\end{minipage}}}} + +\renewcommand*{\cventry}[7][.25em]{ + \begin{tabular*}{\textwidth}{l@{\extracolsep{\fill}}r}% + {\bfseries #4} & {\bfseries #5} \\% + {\itshape #3\ifthenelse{\equal{#6}{}}{}{, #6}} & {\itshape #2}\\% + \end{tabular*}% + \ifx&% + \else{\\\vbox{\small#7}}\fi% + \par\addvspace{#1}} + +\newbox{\cvitemwithcommentmainbox} +\newlength{\cvitemwithcommentmainlength} +\newlength{\cvitemwithcommentcommentlength} +\renewcommand*{\cvitemwithcomment}[4][.25em]{% + \savebox{\cvitemwithcommentmainbox}{\ifthenelse{\equal{#2}{}}{}{\hintstyle{#2}: }#3}% + \setlength{\cvitemwithcommentmainlength}{\widthof{\usebox{\cvitemwithcommentmainbox}}}% + \setlength{\cvitemwithcommentcommentlength}{\maincolumnwidth-\separatorcolumnwidth-\cvitemwithcommentmainlength}% + \begin{minipage}[t]{\cvitemwithcommentmainlength}\ifthenelse{\equal{#2}{}}{}{\hintstyle{#2}: }#3\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \begin{minipage}[t]{\cvitemwithcommentcommentlength}\raggedleft\small\itshape#4\end{minipage}% + \par\addvspace{#1}} + +\renewenvironment{thebibliography}[1]% + {% + \bibliographyhead{\refname}% +% \small% + \begin{list}{\bibliographyitemlabel}% + {% + \setlength{\topsep}{0pt}% + \setlength{\labelwidth}{0pt}% + \setlength{\labelsep}{0pt}% + \leftmargin\labelwidth% + \advance\leftmargin\labelsep% + \@openbib@code% + \usecounter{enumiv}% + \let\p@enumiv\@empty% + \renewcommand\theenumiv{\@arabic\c@enumiv}}% + \sloppy\clubpenalty4000\widowpenalty4000% +% \sfcode`\.\@m% +% \sfcode `\=1000\relax% + }% + {% + \def\@noitemerr{\@latex@warning{Empty `thebibliography' environment}}% + \end{list}% + } + + +%------------------------------------------------------------------------------- +% letter style definition +%------------------------------------------------------------------------------- +% commands +\renewcommand*{\recomputeletterlengths}{ + \recomputecvlengths% + \setlength{\parskip}{6\p@}} + +\renewcommand*{\makelettertitle}{% + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputeletterlengths% + % sender block + \maketitle% + \par% + % recipient block + \begin{minipage}[t]{.5\textwidth} + \raggedright% + \addressfont% + {\bfseries\upshape\@recipientname}\\% + \@recipientaddress% + \end{minipage} + % date + \hfill % US style +% \\[1em] % UK style + \@date\\[2em]% US informal style: "April 6, 2006"; UK formal style: "05/04/2006" + % opening + \raggedright% + \@opening\\[1.5em]% + % ensure no extra spacing after \makelettertitle due to a possible blank line +% \ignorespacesafterend% not working + \hspace{0pt}\par\vspace{-\baselineskip}\vspace{-\parskip}} + +\renewcommand*{\makeletterclosing}{ + \@closing\\[3em]% + {\bfseries \@firstname~\@lastname}% + \ifthenelse{\isundefined{\@enclosure}}{}{% + \\% + \vfill% + {\color{color2}\itshape\enclname: \@enclosure}}} + + +\endinput + + +%% end of file `moderncvstylebanking.sty'. diff --git a/users/grfn/resume/moderncvstylecasual.sty b/users/grfn/resume/moderncvstylecasual.sty new file mode 100644 index 000000000000..e375e7612a5a --- /dev/null +++ b/users/grfn/resume/moderncvstylecasual.sty @@ -0,0 +1,182 @@ +%% start of file `moderncvstylecasual.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvstylecasual}[2013/02/09 v1.3.0 modern curriculum vitae and letter style scheme: casual] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- +\RequirePackage{moderncvstyleclassic} + + +%------------------------------------------------------------------------------- +% overall style definition +%------------------------------------------------------------------------------- +% commands +% footer symbol used to separate footer elements +\newcommand*{\footersymbol}{% + {~~~{\rmfamily\textbullet}~~~}}% the \rmfamily is required to force Latin Modern fonts when using sans serif, as OMS/lmss/m/n is not defined and gets substituted by OMS/cmsy/m/n +% internal command to add an element to the footer +% it collects the elements in a temporary box, and checks when to flush the box +\newsavebox{\footerbox}% +\newsavebox{\footertempbox}% +\newlength{\footerwidth}% +\newlength{\footerboxwidth}% +\newif\if@firstfooterelement\@firstfooterelementtrue% +% adds an element to the footer, separated by footersymbol +% usage: \addtofooter[footersymbol]{element} +\newcommand*{\addtofooter}[2][\footersymbol]{% + \if@firstfooterelement% + \savebox{\footertempbox}{\usebox{\footerbox}#2}% + \else% + \savebox{\footertempbox}{\usebox{\footerbox}#1#2}\fi% + \settowidth{\footerboxwidth}{\usebox{\footertempbox}}% + \ifnum\footerboxwidth<\footerwidth% + \savebox{\footerbox}{\usebox{\footertempbox}}% + \@firstfooterelementfalse% + \else% + \flushfooter\\% + \savebox{\footerbox}{#2}% + \savebox{\footertempbox}{#2}% + \settowidth{\footerboxwidth}{\usebox{\footerbox}}% + \@firstfooterelementfalse\fi} +% internal command to flush the footer +\newcommand*{\flushfooter}{% + \strut\usebox{\footerbox}% + \savebox{\footerbox}{}% + \savebox{\footertempbox}{}% + \setlength{\footerboxwidth}{0pt}} + + +%------------------------------------------------------------------------------- +% resume style definition +%------------------------------------------------------------------------------- +% fonts +\renewcommand*{\namefont}{\fontsize{38}{40}\mdseries\upshape} +\renewcommand*{\addressfont}{\normalsize\mdseries\slshape} + +% commands +\renewcommand*{\makecvtitle}{% + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputecvlengths% + % ensure footer with personal information + \makecvfooter% + % optional picture + \newbox{\makecvtitlepicturebox}% + \savebox{\makecvtitlepicturebox}{% + \ifthenelse{\isundefined{\@photo}}% + {}% + {% + \setlength\fboxrule{\@photoframewidth}% + \ifdim\@photoframewidth=0pt% + \setlength{\fboxsep}{0pt}\fi% + {\color{color1}\framebox{\includegraphics[width=\@photowidth]{\@photo}}}}}% + \usebox{\makecvtitlepicturebox}% + % name + \@initializelength{\makecvtitlepicturewidth}% + \settowidth{\makecvtitlepicturewidth}{\usebox{\makecvtitlepicturebox}}% + \parbox[b]{\textwidth-\makecvtitlepicturewidth}{% + \raggedleft\namefont{\color{color2!50}\@firstname} {\color{color2}\@lastname}}\\[-.35em]% alternate design: \MakeLowercase and no space + {\color{color2!50}\rule{\textwidth}{.25ex}}% + % optional title + \ifthenelse{\equal{\@title}{}}{}{\\[1.25em]\null\hfill\titlestyle{\@title}}\\[2.5em]% \null is required as there is no box on the line after \\, so glue (and leaders) disappears; this is in contrast to after \par, where the next line starts with an indent box (even after \noindent). + % optional quote + \ifthenelse{\isundefined{\@quote}}% + {}% + {{\null\hfill\begin{minipage}{\quotewidth}\centering\quotestyle{\@quote}\end{minipage}\hfill\null\\[2.5em]}}% + \par}% to avoid weird spacing bug at the first section if no blank line is left after \maketitle + +\renewcommand*{\makecvfooter}{% + \setlength{\footerwidth}{0.8\textwidth}% + \fancypagestyle{plain}{% + \fancyfoot[c]{% + \parbox[b]{\footerwidth}{% + \centering% + \color{color2}\addressfont% + \ifthenelse{\isundefined{\@addressstreet}}{}{\addtofooter[]{\addresssymbol\@addressstreet}% + \ifthenelse{\equal{\@addresscity}{}}{}{\addtofooter[~--~]{\@addresscity}}% if \addresstreet is defined, \addresscity and \addresscountry will always be defined but could be empty + \ifthenelse{\equal{\@addresscountry}{}}{}{\addtofooter[~--~]{\@addresscountry}}% + \flushfooter\@firstfooterelementtrue\\}% + \collectionloop{phones}{% the key holds the phone type (=symbol command prefix), the item holds the number + \addtofooter{\csname\collectionloopkey phonesymbol\endcsname\collectionloopitem}}% + \ifthenelse{\isundefined{\@email}}{}{\addtofooter{\emailsymbol\emaillink{\@email}}}% + \ifthenelse{\isundefined{\@homepage}}{}{\addtofooter{\homepagesymbol\httplink{\@homepage}}}% + \ifthenelse{\isundefined{\@github}}{}{\addtofooter{\httplink{http://github.com/\@github}}}% + \ifthenelse{\isundefined{\@extrainfo}}{}{\addtofooter{\@extrainfo}}% + \ifthenelse{\lengthtest{\footerboxwidth=0pt}}{}{\flushfooter}% the lengthtest is required to avoid flushing an empty footer, which could cause a blank line due to the \\ after the address, if no other personal info is used + }}}% + \pagestyle{plain}} + + +%------------------------------------------------------------------------------- +% letter style definition +%------------------------------------------------------------------------------- +\renewcommand*{\makelettertitle}{% + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputeletterlengths% + % ensure footer with personal information + \makeletterfooter% + % recipient block + \begin{minipage}[t]{.5\textwidth} + \raggedright% + \addressfont% + {\bfseries\upshape\@recipientname}\\% + \@recipientaddress% + \end{minipage} + % date + \hfill% US style +% \\[1em]% UK style + \@date\\[2em]% US informal style: "April 6, 2006"; UK formal style: "05/04/2006" + % opening + \raggedright% + \@opening\\[1.5em]% + % ensure no extra spacing after \makelettertitle due to a possible blank line +% \ignorespacesafterend% not working + \hspace{0pt}\par\vspace{-\baselineskip}\vspace{-\parskip}} + +\renewcommand*{\makeletterfooter}{% + \setlength{\footerwidth}{0.8\textwidth}% + \fancypagestyle{plain}{% + \fancyfoot[c]{% + \parbox[b]{\footerwidth}{% + \centering% + \addressfont\color{color2}% + \vspace{-\baselineskip}% to cancel out the extra vertical space taken by the name (below) and ensure perfect alignment of letter and cv footers + \strut{\bfseries\upshape\@firstname~\@lastname}\\% the \strut is required to ensure the line is exactly \baselineskip tall + \ifthenelse{\isundefined{\@addressstreet}}{}{\addtofooter[]{\addresssymbol\@addressstreet}% + \ifthenelse{\equal{\@addresscity}{}}{}{\addtofooter[~--~]{\@addresscity}}% if \addresstreet is defined, \addresscity and addresscountry will always be defined but could be empty + \ifthenelse{\equal{\@addresscountry}{}}{}{\addtofooter[~--~]{\@addresscountry}}% + \flushfooter\@firstfooterelementtrue\\}% + \collectionloop{phones}{% the key holds the phone type (=symbol command prefix), the item holds the number + \addtofooter{\csname\collectionloopkey phonesymbol\endcsname\collectionloopitem}}% + \ifthenelse{\isundefined{\@email}}{}{\addtofooter{\emailsymbol\emaillink{\@email}}}% + \ifthenelse{\isundefined{\@homepage}}{}{\addtofooter{\homepagesymbol\httplink{\@homepage}}}% + \ifthenelse{\isundefined{\@extrainfo}}{}{\addtofooter{\@extrainfo}}% + \ifthenelse{\lengthtest{\footerboxwidth=0pt}}{}{\flushfooter}% the lengthtest is required to avoid flushing an empty footer, which could cause a blank line due to the \\ after the address, if no other personal info is used + }}}% + \pagestyle{plain}} + +\renewcommand*{\makeletterclosing}{ + \@closing\\[3em]% + {\bfseries\@firstname~\@lastname}% + \ifthenelse{\isundefined{\@enclosure}}{}{% + \\% + \vfil% + {\color{color2}\itshape\enclname: \@enclosure}}% + \vfil} + + +\endinput + + +%% end of file `moderncvstylecasual.sty'. diff --git a/users/grfn/resume/moderncvstyleclassic.sty b/users/grfn/resume/moderncvstyleclassic.sty new file mode 100644 index 000000000000..63cf97aa3b7d --- /dev/null +++ b/users/grfn/resume/moderncvstyleclassic.sty @@ -0,0 +1,294 @@ +%% start of file `moderncvstyleclassic.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvstyleclassic}[2013/02/09 v1.3.0 modern curriculum vitae and letter style scheme: classic] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- +% Latin Modern fonts +%\ifxetexorluatex +% \setmainfont{Latin Modern Roman} +% \setsansfont{Latin Modern Sans} +% \setmathfont{Latin Modern Math} +%\else + \IfFileExists{lmodern.sty}% + {\RequirePackage{lmodern}}% + {} +%\fi + + +%------------------------------------------------------------------------------- +% overall style definition +%------------------------------------------------------------------------------- +% symbols +\moderncvicons{marvosym} + + +%------------------------------------------------------------------------------- +% resume style definition +%------------------------------------------------------------------------------- +% fonts +\renewcommand*{\namefont}{\fontsize{34}{36}\mdseries\upshape} +\renewcommand*{\titlefont}{\LARGE\mdseries\slshape} +\renewcommand*{\addressfont}{\small\mdseries\slshape} +\renewcommand*{\quotefont}{\large\slshape} +\renewcommand*{\sectionfont}{\Large\mdseries\upshape} +\renewcommand*{\subsectionfont}{\large\mdseries\upshape} +\renewcommand*{\hintfont}{} + +% styles +\renewcommand*{\namestyle}[1]{{\namefont\textcolor{color0}{#1}}} +\renewcommand*{\titlestyle}[1]{{\titlefont\textcolor{color2}{#1}}} +\renewcommand*{\addressstyle}[1]{{\addressfont\textcolor{color1}{#1}}} +\renewcommand*{\quotestyle}[1]{{\quotefont\textcolor{color1}{#1}}} +\renewcommand*{\sectionstyle}[1]{{\sectionfont\textcolor{color1}{#1}}} +\renewcommand*{\subsectionstyle}[1]{{\subsectionfont\textcolor{color1}{#1}}} +\renewcommand*{\hintstyle}[1]{{\hintfont\textcolor{color0}{#1}}} + +% lengths +\newlength{\quotewidth} +\newlength{\hintscolumnwidth} +\setlength{\hintscolumnwidth}{0.175\textwidth} +\newlength{\separatorcolumnwidth} +\setlength{\separatorcolumnwidth}{0.025\textwidth} +\newlength{\maincolumnwidth} +\newlength{\doubleitemmaincolumnwidth} +\newlength{\listitemsymbolwidth} +\settowidth{\listitemsymbolwidth}{\listitemsymbol} +\newlength{\listitemmaincolumnwidth} +\newlength{\listdoubleitemmaincolumnwidth} + +% commands +\renewcommand*{\recomputecvlengths}{% + \setlength{\quotewidth}{0.65\textwidth}% + % main lenghts + \setlength{\maincolumnwidth}{\textwidth-\separatorcolumnwidth-\hintscolumnwidth}% + % listitem lengths + \setlength{\listitemmaincolumnwidth}{\maincolumnwidth-\listitemsymbolwidth}% + % doubleitem lengths + \setlength{\doubleitemmaincolumnwidth}{\maincolumnwidth-\hintscolumnwidth-\separatorcolumnwidth-\separatorcolumnwidth}% + \setlength{\doubleitemmaincolumnwidth}{0.5\doubleitemmaincolumnwidth}% + % listdoubleitem lengths + \setlength{\listdoubleitemmaincolumnwidth}{\maincolumnwidth-\listitemsymbolwidth-\separatorcolumnwidth-\listitemsymbolwidth}% + \setlength{\listdoubleitemmaincolumnwidth}{0.5\listdoubleitemmaincolumnwidth}% + % fancyhdr lengths + \renewcommand{\headwidth}{\textwidth}% + % regular lengths + \setlength{\parskip}{0\p@}} + +% optional maketitle width to force a certain width (if set to 0pt, the width is calculated automatically) +\newlength{\makecvtitlenamewidth} +\setlength{\makecvtitlenamewidth}{0pt}% dummy value +\renewcommand*{\makecvtitle}{% + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputecvlengths% + % optional detailed information (pre-rendering) + \def\phonesdetails{}% + \collectionloop{phones}{% the key holds the phone type (=symbol command prefix), the item holds the number + \protected@edef\phonesdetails{\phonesdetails\protect\makenewline\csname\collectionloopkey phonesymbol\endcsname\collectionloopitem}}% + \newbox{\makecvtitledetailsbox}% + \savebox{\makecvtitledetailsbox}{% + \addressfont\color{color2}% + \begin{tabular}[b]{@{}r@{}}% + \ifthenelse{\isundefined{\@addressstreet}}{}{\makenewline\addresssymbol\@addressstreet% + \ifthenelse{\equal{\@addresscity}{}}{}{\makenewline\@addresscity}% if \addresstreet is defined, \addresscity and addresscountry will always be defined but could be empty + \ifthenelse{\equal{\@addresscountry}{}}{}{\makenewline\@addresscountry}}% + \phonesdetails% needed to be pre-rendered as loops and tabulars seem to conflict + \ifthenelse{\isundefined{\@email}}{}{\makenewline\emailsymbol\emaillink{\@email}}% + \ifthenelse{\isundefined{\@homepage}}{}{\makenewline\homepagesymbol\httplink{\@homepage}}% + \ifthenelse{\isundefined{\@extrainfo}}{}{\makenewline\@extrainfo}% + \end{tabular} + }% + % optional photo (pre-rendering) + \newbox{\makecvtitlepicturebox}% + \savebox{\makecvtitlepicturebox}{% + \ifthenelse{\isundefined{\@photo}}% + {}% + {% + \hspace*{\separatorcolumnwidth}% + \color{color1}% + \setlength{\fboxrule}{\@photoframewidth}% + \ifdim\@photoframewidth=0pt% + \setlength{\fboxsep}{0pt}\fi% + \framebox{\includegraphics[width=\@photowidth]{\@photo}}}}% + % name and title + \newlength{\makecvtitledetailswidth}\settowidth{\makecvtitledetailswidth}{\usebox{\makecvtitledetailsbox}}% + \newlength{\makecvtitlepicturewidth}\settowidth{\makecvtitlepicturewidth}{\usebox{\makecvtitlepicturebox}}% + \ifthenelse{\lengthtest{\makecvtitlenamewidth=0pt}}% check for dummy value (equivalent to \ifdim\makecvtitlenamewidth=0pt) + {\setlength{\makecvtitlenamewidth}{\textwidth-\makecvtitledetailswidth-\makecvtitlepicturewidth}}% + {}% + \begin{minipage}[b]{\makecvtitlenamewidth}% + \namestyle{\@firstname\ \@lastname}% + \ifthenelse{\equal{\@title}{}}{}{\\[1.25em]\titlestyle{\@title}}% + \end{minipage}% + \hfill% + % optional detailed information (rendering) + \llap{\usebox{\makecvtitledetailsbox}}% \llap is used to suppress the width of the box, allowing overlap if the value of makecvtitlenamewidth is forced + % optional photo (rendering) + \usebox{\makecvtitlepicturebox}\\[2.5em]% + % optional quote + \ifthenelse{\isundefined{\@quote}}% + {}% + {{\centering\begin{minipage}{\quotewidth}\centering\quotestyle{\@quote}\end{minipage}\\[2.5em]}}% + \par}% to avoid weird spacing bug at the first section if no blank line is left after \makecvtitle + +\newlength{\baseletterheight} +\settoheight{\baseletterheight}{\sectionstyle{o}} +\setlength{\baseletterheight}{\baseletterheight-0.95ex} +\RenewDocumentCommand{\section}{sm}{% + \par\addvspace{2.5ex}% + \phantomsection{}% reset the anchor for hyperrefs + \addcontentsline{toc}{section}{#2}% + \parbox[t]{\hintscolumnwidth}{\strut\raggedleft\raisebox{\baseletterheight}{\color{color1}\rule{\hintscolumnwidth}{0.95ex}}}% + \hspace{\separatorcolumnwidth}% + \parbox[t]{\maincolumnwidth}{\strut\sectionstyle{#2}}% + \par\nobreak\addvspace{1ex}\@afterheading}% to avoid a pagebreak after the heading + +\RenewDocumentCommand{\subsection}{sm}{% + \par\addvspace{1ex}% + \phantomsection{}% reset the anchor for hyperrefs + \addcontentsline{toc}{subsection}{#2}% + \begin{tabular}{@{}p{\hintscolumnwidth}@{\hspace{\separatorcolumnwidth}}p{\maincolumnwidth}@{}}% + \raggedleft\hintstyle{} &{\strut\subsectionstyle{#2}}% + \end{tabular}% + \par\nobreak\addvspace{0.5ex}\@afterheading}% to avoid a pagebreak after the heading + +\renewcommand*{\cvitem}[3][.25em]{% + \begin{tabular}{@{}p{\hintscolumnwidth}@{\hspace{\separatorcolumnwidth}}p{\maincolumnwidth}@{}}% + \raggedleft\hintstyle{#2} &{#3}% + \end{tabular}% + \par\addvspace{#1}} + +\renewcommand*{\cvdoubleitem}[5][.25em]{% + \cvitem[#1]{#2}{% + \begin{minipage}[t]{\doubleitemmaincolumnwidth}#3\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \begin{minipage}[t]{\hintscolumnwidth}\raggedleft\hintstyle{#4}\end{minipage}% + \hspace*{\separatorcolumnwidth}% + \begin{minipage}[t]{\doubleitemmaincolumnwidth}#5\end{minipage}}} + +\renewcommand*{\cvlistitem}[2][.25em]{% + \cvitem[#1]{}{\listitemsymbol\begin{minipage}[t]{\listitemmaincolumnwidth}#2\end{minipage}}} + +\renewcommand*{\cvlistdoubleitem}[3][.25em]{% + \cvitem[#1]{}{\listitemsymbol\begin{minipage}[t]{\listdoubleitemmaincolumnwidth}#2\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \ifthenelse{\equal{#3}{}}% + {}% + {\listitemsymbol\begin{minipage}[t]{\listdoubleitemmaincolumnwidth}#3\end{minipage}}}} + +\renewcommand*{\cventry}[7][.25em]{% + \cvitem[#1]{#2}{% + {\bfseries#3}% + \ifthenelse{\equal{#4}{}}{}{, {\slshape#4}}% + \ifthenelse{\equal{#5}{}}{}{, #5}% + \ifthenelse{\equal{#6}{}}{}{, #6}% + .\strut% + \ifx&% + \else{\newline{}\begin{minipage}[t]{\linewidth}\small#7\end{minipage}}\fi}} + +\newbox{\cvitemwithcommentmainbox} +\newlength{\cvitemwithcommentmainlength} +\newlength{\cvitemwithcommentcommentlength} +\renewcommand*{\cvitemwithcomment}[4][.25em]{% + \savebox{\cvitemwithcommentmainbox}{{\bfseries#3}}% + \setlength{\cvitemwithcommentmainlength}{\widthof{\usebox{\cvitemwithcommentmainbox}}}% + \setlength{\cvitemwithcommentcommentlength}{\maincolumnwidth-\separatorcolumnwidth-\cvitemwithcommentmainlength}% + \cvitem[#1]{#2}{% + \begin{minipage}[t]{\cvitemwithcommentmainlength}\bfseries#3\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \begin{minipage}[t]{\cvitemwithcommentcommentlength}\raggedleft\small\itshape#4\end{minipage}}} + +\renewenvironment{thebibliography}[1]% + {% + \bibliographyhead{\refname}% +% \small% + \begin{list}{\bibliographyitemlabel}% + {% + \setlength{\topsep}{0pt}% + \setlength{\labelwidth}{\hintscolumnwidth}% + \setlength{\labelsep}{\separatorcolumnwidth}% + \leftmargin\labelwidth% + \advance\leftmargin\labelsep% + \@openbib@code% + \usecounter{enumiv}% + \let\p@enumiv\@empty% + \renewcommand\theenumiv{\@arabic\c@enumiv}}% + \sloppy\clubpenalty4000\widowpenalty4000% +% \sfcode`\.\@m% +% \sfcode `\=1000\relax% + }% + {% + \def\@noitemerr{\@latex@warning{Empty `thebibliography' environment}}% + \end{list}% + } + + +%------------------------------------------------------------------------------- +% letter style definition +%------------------------------------------------------------------------------- +% commands +\renewcommand*{\recomputeletterlengths}{% + \recomputecvlengths% + \setlength{\parskip}{6\p@}} + +\renewcommand*{\makelettertitle}{% + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputeletterlengths% + % sender contact info + \hfill% + \begin{minipage}{.5\textwidth}% + \raggedleft% + \addressfont\textcolor{color2}{% + {\bfseries\upshape\@firstname~\@lastname}\@firstdetailselementfalse% + \ifthenelse{\isundefined{\@addressstreet}}{}{\makenewline\addresssymbol\@addressstreet% + \ifthenelse{\equal{\@addresscity}{}}{}{\makenewline\@addresscity}% if \addresstreet is defined, \addresscity and addresscountry will always be defined but could be empty + \ifthenelse{\equal{\@addresscountry}{}}{}{\makenewline\@addresscountry}}% + \collectionloop{phones}{% the key holds the phone type (=symbol command prefix), the item holds the number + \makenewline\csname\collectionloopkey phonesymbol\endcsname\collectionloopitem}% + \ifthenelse{\isundefined{\@email}}{}{\makenewline\emailsymbol\emaillink{\@email}}% + \ifthenelse{\isundefined{\@homepage}}{}{\makenewline\homepagesymbol\httplink{\@homepage}}% + \ifthenelse{\isundefined{\@extrainfo}}{}{\makenewline\@extrainfo}}% + \end{minipage}\\[1em] + % recipient block + \begin{minipage}[t]{.5\textwidth} + \raggedright% + \addressfont% + {\bfseries\upshape\@recipientname}\\% + \@recipientaddress% + \end{minipage} + % date + \hfill% US style +% \\[1em]% UK style + \@date\\[2em]% US informal style: "January 1, 1900"; UK formal style: "01/01/1900" + % opening + \raggedright% + \@opening\\[1.5em]% + % ensure no extra spacing after \makelettertitle due to a possible blank line +% \ignorespacesafterend% not working + \hspace{0pt}\par\vspace{-\baselineskip}\vspace{-\parskip}} + +\renewcommand*{\makeletterclosing}{ + \@closing\\[3em]% + {\bfseries \@firstname~\@lastname}% + \ifthenelse{\isundefined{\@enclosure}}{}{% + \\% + \vfill% + {\color{color2}\itshape\enclname: \@enclosure}}} + + +\endinput + + +%% end of file `moderncvstyleclassic.sty'. diff --git a/users/grfn/resume/moderncvstyleempty.sty b/users/grfn/resume/moderncvstyleempty.sty new file mode 100644 index 000000000000..85932464d1c5 --- /dev/null +++ b/users/grfn/resume/moderncvstyleempty.sty @@ -0,0 +1,34 @@ +%% start of file `moderncvstyleempty.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvstyleempty}[2013/02/09 v1.3.0 modern curriculum vitae scheme: empty] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- + + +%------------------------------------------------------------------------------- +% package options +%------------------------------------------------------------------------------- + + +%------------------------------------------------------------------------------- +% style definition +%------------------------------------------------------------------------------- +% see moderncv.cls for command declarations that needs to be implemented, e.g. \maketitle, \section, \subsections, \cvline, etc + +\endinput + + +%% end of file `moderncvstyleempty.sty'. diff --git a/users/grfn/resume/moderncvstyleoldstyle.sty b/users/grfn/resume/moderncvstyleoldstyle.sty new file mode 100644 index 000000000000..ff732f4e2af5 --- /dev/null +++ b/users/grfn/resume/moderncvstyleoldstyle.sty @@ -0,0 +1,306 @@ +%% start of file `moderncvstyleoldstyle.sty'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +%------------------------------------------------------------------------------- +% identification +%------------------------------------------------------------------------------- +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{moderncvstyleoldstyle}[2013/02/09 v1.3.0 modern curriculum vitae and letter style scheme: oldstyle] + + +%------------------------------------------------------------------------------- +% required packages +%------------------------------------------------------------------------------- +% change the layout of the page on the fly, for resume or letter layout +\RequirePackage{changepage} + + +%------------------------------------------------------------------------------- +% overall style definition +%------------------------------------------------------------------------------- +% fonts +%\ifxetexorluatex +% \setmainfont[Numbers={OldStyle,Proportional}, BoldFont={Kurier Bold}, ItalicFont={Kurier Light Italic}, BoldItalicFont={Kurier Bold Italic}]{Kurier Light} +% \setsansfont[Numbers={OldStyle,Proportional}, BoldFont={Kurier Bold}, ItalicFont={Kurier Light Italic}, BoldItalicFont={Kurier Bold Italic}]{Kurier Light} +% \setmathfont{Kurier Light} +% \setmathfont[range=\mathit,\mathsfit]{Kurier Light Italic} +% \setmathfont[range=\mathbfup,\mathbfsfup]{Kurier Bold} +% \setmathfont[range=\mathbfit,\mathbfsfit]{Kurier Bold Italic} +%\else + \IfFileExists{kurier.sty}% + {\RequirePackage[light,math]{kurier}}% + {} +%\fi + +% symbols +\moderncvicons{letters} + + +%------------------------------------------------------------------------------- +% resume style definition +%------------------------------------------------------------------------------- +% fonts +\renewcommand*{\namefont}{\fontsize{34}{36}\mdseries\upshape} +\renewcommand*{\titlefont}{\LARGE\mdseries\slshape} +\renewcommand*{\addressfont}{\small\mdseries} +\renewcommand*{\quotefont}{\large\itshape} +\renewcommand*{\sectionfont}{\Large\bfseries\upshape} +\renewcommand*{\subsectionfont}{\large\bfseries\itshape} +\renewcommand*{\hintfont}{\bfseries} + +% styles +\renewcommand*{\namestyle}[1]{{\namefont\textcolor{color0}{#1}}} +\renewcommand*{\titlestyle}[1]{{\titlefont\textcolor{color2}{#1}}} +\renewcommand*{\addressstyle}[1]{{\addressfont\textcolor{color2}{#1}}} +\renewcommand*{\quotestyle}[1]{{\quotefont\textcolor{color1}{#1}}} +\renewcommand*{\sectionstyle}[1]{{\sectionfont\textcolor{color1}{#1}}} +\renewcommand*{\subsectionstyle}[1]{{\subsectionfont\textcolor{color1}{#1}}} +\renewcommand*{\hintstyle}[1]{{\hintfont\textcolor{color0}{#1}}} + +% lengths +\newlength{\quotewidth} +\newlength{\hintscolumnwidth} +\setlength{\hintscolumnwidth}{0.3\textwidth}% +\newlength{\separatorcolumnwidth} +\setlength{\separatorcolumnwidth}{0.025\textwidth}% +\newlength{\maincolumnwidth} +\newlength{\doubleitemcolumnwidth} +\newlength{\listitemsymbolwidth} +\settowidth{\listitemsymbolwidth}{\listitemsymbol} +\newlength{\listitemmaincolumnwidth} +\newlength{\listdoubleitemmaincolumnwidth} + +% commands +\setlength{\marginparwidth}{0\p@}% +\setlength{\marginparsep}{0\p@} +\renewcommand*{\recomputecvlengths}{% + % regular lengths + \changepage{}{+\marginparwidth+\marginparsep}{}{}{}{}{}{}{}% if a letter was typeset before the resume, \marginparwidth and \marginparsep will be non-zero; otherwise, this has no effect + \setlength{\marginparwidth}{0\p@}% + \setlength{\marginparsep}{0\p@} + \setlength{\parskip}{0\p@}% + % maketitle lengths + \setlength{\quotewidth}{0.65\textwidth}% + % main lenghts + \setlength{\maincolumnwidth}{\textwidth-\hintscolumnwidth-\separatorcolumnwidth}% + % listitem lengths + \setlength{\listitemmaincolumnwidth}{\maincolumnwidth-\listitemsymbolwidth}% + % doubleitem lengths + \setlength{\doubleitemcolumnwidth}{\maincolumnwidth-\separatorcolumnwidth}% + \setlength{\doubleitemcolumnwidth}{0.5\doubleitemcolumnwidth}% + % listdoubleitem lengths + \setlength{\listdoubleitemmaincolumnwidth}{\maincolumnwidth-\listitemsymbolwidth-\separatorcolumnwidth-\listitemsymbolwidth}% + \setlength{\listdoubleitemmaincolumnwidth}{0.5\listdoubleitemmaincolumnwidth}% + % fancyhdr lengths + \renewcommand{\headwidth}{\textwidth}} + +\newcommand{\makecvinfo}[1]{% + \newbox{\makecvinfobox}% + \savebox{\makecvinfobox}{\parbox[t]{\hintscolumnwidth}{#1}}% + \newlength{\makecvinfoheight}% + \setlength{\makecvinfoheight}{\totalheightof{\usebox{\makecvinfobox}}}% the total height of the parbox is the sum of its height (\the\ht\makeinfobox) and its depth (\the\dp\makeinfobox); the \totalheightof command is provided by the "calc" package + \usebox{\makecvinfobox}\vspace{-\makecvinfoheight}% + \newlength{\leftcolumnwidth}% + \setlength{\leftcolumnwidth}{\hintscolumnwidth+\separatorcolumnwidth}% + \par\vspace{-\baselineskip}\vspace{-\parskip}\leftskip=\leftcolumnwidth} + +\renewcommand*{\makecvtitle}{ + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputecvlengths% + % optional picture box + \newbox{\makecvtitlepicturebox}% + \savebox{\makecvtitlepicturebox}{% + \ifthenelse{\isundefined{\@photo}}% + {}% + {% + \color{color1}% + \setlength\fboxrule{\@photoframewidth}% + \ifdim\@photoframewidth=0pt% + \setlength{\fboxsep}{0pt}\fi% + \framebox{\includegraphics[width=\@photowidth]{\@photo}}}}% + % name and title + \newlength{\makecvtitlepicturewidth}\settowidth{\makecvtitlepicturewidth}{\usebox{\makecvtitlepicturebox}}% + \newlength{\makecvtitlenamewidth}\setlength{\makecvtitlenamewidth}{\textwidth-\makecvtitlepicturewidth}% + \begin{minipage}[b]{\makecvtitlenamewidth}% + \namestyle{\@firstname\ \@lastname}% + \ifthenelse{\equal{\@title}{}}{}{\\[1.25em]\titlestyle{\@title}}% + \end{minipage}% + % optional photo + \usebox{\makecvtitlepicturebox}\\[2.5em]% + % optional quote + \ifthenelse{\isundefined{\@quote}}% + {}% + {{\centering\begin{minipage}{\quotewidth}\centering\quotestyle{\@quote}\end{minipage}\\[2.5em]}}% + % optional details + \makecvinfo{% + \addressfont\color{color2}% + \ifthenelse{\isundefined{\@addressstreet}}{}{\makenewline\addresssymbol\@addressstreet% + \ifthenelse{\equal{\@addresscity}{}}{}{\makenewline\@addresscity}% if \addresstreet is defined, \addresscity and \addresscountry will always be defined but could be empty + \ifthenelse{\equal{\@addresscountry}{}}{}{\makenewline\@addresscountry}}% + \collectionloop{phones}{% the key holds the phone type (=symbol command prefix), the item holds the number + \makenewline\csname\collectionloopkey phonesymbol\endcsname\collectionloopitem}% + \ifthenelse{\isundefined{\@email}}{}{\makenewline\emailsymbol\emaillink{\@email}}% + \ifthenelse{\isundefined{\@homepage}}{}{\makenewline\homepagesymbol\httplink{\@homepage}}% + \ifthenelse{\isundefined{\@extrainfo}}{}{\makenewline\@extrainfo}}} + +\RenewDocumentCommand{\section}{sm}{% + \par\addvspace{2.5ex}% + \phantomsection{}% reset the anchor for hyperrefs + \addcontentsline{toc}{section}{#2}% + \strut\sectionstyle{#2}% + \par\nobreak\addvspace{1ex}\@afterheading}% to avoid a pagebreak after the heading + +\RenewDocumentCommand{\subsection}{sm}{% + \par\addvspace{1ex}% + \phantomsection{}% reset the anchor for hyperrefs + \addcontentsline{toc}{subsection}{#2}% + \strut\subsectionstyle{#2}% + \par\nobreak\addvspace{0.5ex}\@afterheading}% to avoid a pagebreak after the heading + +\renewcommand*{\cvitem}[3][.25em]{% + \ifthenelse{\equal{#2}{}}{}{\hintstyle{#2}: }{#3}% + \par\addvspace{#1}} + +\renewcommand*{\cvdoubleitem}[5][.25em]{% + \begin{minipage}[t]{\doubleitemcolumnwidth}\hintstyle{#2}: #3\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \begin{minipage}[t]{\doubleitemcolumnwidth}\ifthenelse{\equal{#4}{}}{}{\hintstyle{#4}: }#5\end{minipage}% + \par\addvspace{#1}} + +\renewcommand*{\cvlistitem}[2][.25em]{% + \cvitem[#1]{}{\listitemsymbol\begin{minipage}[t]{\listitemmaincolumnwidth}#2\end{minipage}}} + +\renewcommand*{\cvlistdoubleitem}[3][.25em]{% + \cvitem[#1]{}{\listitemsymbol\begin{minipage}[t]{\listdoubleitemmaincolumnwidth}#2\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \ifthenelse{\equal{#3}{}}% + {}% + {\listitemsymbol\begin{minipage}[t]{\listdoubleitemmaincolumnwidth}#3\end{minipage}}}} + +\newbox{\cventryyearbox} +\newlength{\cventrytitleboxwidth} +\renewcommand*{\cventry}[7][.25em]{% + \savebox{\cventryyearbox}{% + \hspace*{2\separatorcolumnwidth}% + \hintstyle{#2}}% + \setlength{\cventrytitleboxwidth}{\widthof{\usebox{\cventryyearbox}}}% + \setlength{\cventrytitleboxwidth}{\maincolumnwidth-\cventrytitleboxwidth}% + \begin{minipage}{\maincolumnwidth}% + \parbox[t]{\cventrytitleboxwidth}{% + \strut% + {\bfseries#3}% + \ifthenelse{\equal{#4}{}}{}{, {\slshape#4}}% + \ifthenelse{\equal{#5}{}}{}{, #5}% + \ifthenelse{\equal{#6}{}}{}{, #6}% + .\strut}% + \usebox{\cventryyearbox}% + \end{minipage}% + \ifx&% + \else{% + \newline{}% + \begin{minipage}[t]{\maincolumnwidth}% + \small% + #7% + \end{minipage}}\fi% + \par\addvspace{#1}} + +\newbox{\cvitemwithcommentmainbox} +\newlength{\cvitemwithcommentmainlength} +\newlength{\cvitemwithcommentcommentlength} +\renewcommand*{\cvitemwithcomment}[4][.25em]{% + \savebox{\cvitemwithcommentmainbox}{\ifthenelse{\equal{#2}{}}{}{\hintstyle{#2}: }#3}% + \setlength{\cvitemwithcommentmainlength}{\widthof{\usebox{\cvitemwithcommentmainbox}}}% + \setlength{\cvitemwithcommentcommentlength}{\maincolumnwidth-\separatorcolumnwidth-\cvitemwithcommentmainlength}% + \begin{minipage}[t]{\cvitemwithcommentmainlength}\ifthenelse{\equal{#2}{}}{}{\hintstyle{#2}: }#3\end{minipage}% + \hfill% fill of \separatorcolumnwidth + \begin{minipage}[t]{\cvitemwithcommentcommentlength}\raggedleft\small\itshape#4\end{minipage}% + \par\addvspace{#1}} + +\renewenvironment{thebibliography}[1]% + {% + \bibliographyhead{\refname}% +% \small% + \begin{list}{\bibliographyitemlabel}% + {% + \setlength{\topsep}{0pt}% + \setlength{\labelwidth}{\hintscolumnwidth}% + \setlength{\labelsep}{\separatorcolumnwidth}% + \leftmargin\labelwidth% + \advance\leftmargin\labelsep% + \@openbib@code% + \usecounter{enumiv}% + \let\p@enumiv\@empty% + \renewcommand\theenumiv{\@arabic\c@enumiv}}% + \sloppy\clubpenalty4000\widowpenalty4000% +% \sfcode`\.\@m% +% \sfcode `\=1000\relax% + }% + {% + \def\@noitemerr{\@latex@warning{Empty `thebibliography' environment}}% + \end{list}% + } + + +%------------------------------------------------------------------------------- +% letter style definition +%------------------------------------------------------------------------------- +% commands +%\newlength{\textwidthdelta}% +\renewcommand*{\recomputeletterlengths}{% + \recomputecvlengths% + \setlength{\parskip}{6\p@}% + \leftskip=0pt% +% \setlength{\textwidthdelta}{+\marginparwidth+\marginparsep}% + \setlength{\marginparwidth}{\hintscolumnwidth}% + \setlength{\marginparsep}{2\separatorcolumnwidth}% +% \addtolength{\textwidthdelta}{-\marginparwidth-\marginparsep}% +% \changepage{}{\textwidthdelta}{-\textwidthdelta}{}{}{}{}{}{}%\changepage{<textheight>}{<textwidth>}{<evensidemargin>}{<oddsidemargin>}{<columnsep>}{<topmargin>}{<headheight>}{<headsep>}{<footskip>} + \changepage{}{-\marginparwidth-\marginparsep}{}{}{}{}{}{}{}%\changepage{<textheight>}{<textwidth>}{<evensidemargin>}{<oddsidemargin>}{<columnsep>}{<topmargin>}{<headheight>}{<headsep>}{<footskip>} + } + +\renewcommand*{\makelettertitle}{% + % recompute lengths (in case we are switching from letter to resume, or vice versa) + \recomputeletterlengths% + % recipient block + {\addressfont% + {\bfseries\upshape\@recipientname}\\% + \@recipientaddress}\\[1em]% + % date + \@date\\[2em]% + % opening + \@opening\\[1.5em]% + % sender contact info + \hspace{0pt}% + \marginpar{% + \addressfont\textcolor{color2}{% + {\bfseries\@firstname~\@lastname}\@firstdetailselementfalse% + \ifthenelse{\isundefined{\@addressstreet}}{}{\makenewline\addresssymbol\@addressstreet% + \ifthenelse{\equal{\@addresscity}{}}{}{\makenewline\@addresscity}% if \addresstreet is defined, \addresscity and \addresscountry will always be defined but could be empty + \ifthenelse{\equal{\@addresscountry}{}}{}{\makenewline\@addresscountry}}% + \collectionloop{phones}{% the key holds the phone type (=symbol command prefix), the item holds the number + \makenewline\csname\collectionloopkey phonesymbol\endcsname\collectionloopitem}% + \ifthenelse{\isundefined{\@email}}{}{\makenewline\emailsymbol\emaillink{\@email}}% + \ifthenelse{\isundefined{\@homepage}}{}{\makenewline\homepagesymbol\httplink{\@homepage}}% + \ifthenelse{\isundefined{\@extrainfo}}{}{\makenewline\@extrainfo}}}% + % ensure no extra spacing after \makelettertitle due to a possible blank line +% \ignorespacesafterend% not working + \par\vspace{-\baselineskip}\vspace{-\parskip}} + +\renewcommand*{\makeletterclosing}{ + \@closing\\[3em]% + {\bfseries\@firstname~\@lastname}% + \ifthenelse{\isundefined{\@enclosure}}{}{% + \\% + \vfill% + {\color{color2}\itshape\enclname: \@enclosure}}} + + +\endinput + + +%% end of file `moderncvstyleoldstyle.sty'. diff --git a/users/grfn/resume/picture.png b/users/grfn/resume/picture.png new file mode 100644 index 000000000000..63b21b5320ed --- /dev/null +++ b/users/grfn/resume/picture.png Binary files differdiff --git a/users/grfn/resume/resume.tex b/users/grfn/resume/resume.tex new file mode 100644 index 000000000000..933558d570b6 --- /dev/null +++ b/users/grfn/resume/resume.tex @@ -0,0 +1,212 @@ +%% start of file `template.tex'. +%% Copyright 2006-2013 Xavier Danaux (xdanaux@gmail.com). +%% Copyright 2014-2020 Griffin Smith (wildgriffin45@gmail.com). +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +\documentclass[10pt,a4paper,sans]{moderncv} % possible options include font size ('10pt', '11pt' and '12pt'), paper size ('a4paper', 'letterpaper', 'a5paper', 'legalpaper', 'executivepaper' and 'landscape') and font family ('sans' and 'roman') + +\usepackage[inline]{enumitem} + + +% moderncv themes +% style options are 'casual' (default), 'classic', 'oldstyle' and 'banking' +\moderncvstyle{casual} +% color options 'blue' (default), 'orange', 'green', 'red', 'purple', 'grey' and 'black' +\moderncvcolor{black} +% to set the default font; use '\sfdefault' for the default sans serif font, +% '\rmdefault' for the default roman one, or any tex font name +%\renewcommand{\familydefault}{\sfdefault} +\nopagenumbers{} + +\usepackage[utf8]{inputenc} + +\usepackage[scale=0.8, margin=0.65in]{geometry} +\setlength{\hintscolumnwidth}{2.6cm} + +\name{Griffin}{Smith} +\title{Software Engineer} +\phone[mobile]{(720) 206-7218} +\email{grfn@gws.fyi} +\homepage{https://www.gws.fyi} +\extrainfo{References available upon request} + +\begin{document} +\makecvtitle{} +\section{Skills} +\cvitem{Clojure}{Extensive experience architecting, deploying, and building +complex web applications in Clojure and Clojurescript, with a focus on +Re-Frame and Reagent.} +\cvitem{Haskell}{Passionate love for pure functional programming as a hobbyist +pursuit, but also practical experience building production systems in Haskell at +scale, and using Haskell's advanced type system extensions where appropriate to +deliver increased ergonomics and safety.} +\cvitem{Nix}{Experience with adopting and teaching nix at scale in a production +stack both for local development dependencies and for configuring and building +production software. Core contributer to a fork of the nix implementation itself +(tvix) aimed at providing increased safety, performance, and flexibility.} +\cvitem{Scala}{Understanding of Scala from the perspective of a functional +programmer rather than a Java programmer. Experience building production +big-data processing systems using Akka, and deep programming with Scala's type +system using Shapeless.} +\cvitem{Unix/Linux}{Experience with administrating highly available distributed +systems. Passion for the Unix philosophy of discrete, composable units of +functionality.} +\cvitem{Ruby}{Experience building both full-stack applications with Ruby on +Rails in addition to smaller microservices and custom frameworks. Deep +understanding of the internals of the Ruby interpreter and object system.} +\cvitem{Javascript}{Experience developing real-time responsive single-page web +applications using React, in addition to significant contributions to the React +open-source community.} +\cvitem{SQL}{Deep understanding of relational databases, including experience +designing the database schema in Postgres for an application with over a decade +of usage, hundreds of gigabytes of data, complex, multi-tiered hierarchical data +structures, as well as experience writing and optimizing large, complex queries +against that database.} + +\subsection{Additional Tools} +\cvitem{}{\footnotesize + \begin{itemize*} + \item Vim + \item Kubernetes + \item Git + \item Puppet + \item AWS + \item Reagent + \item Datomic + \item Elasticsearch + \item Redis + \item DynamoDB + \item Docker + \item JIRA + \item Java + \item QuickCheck (and similar tools) + \item Python + \item Elixir + \end{itemize*} + \newline + \textbf{Novice Level:} + \begin{itemize*} + \item Rust + \item C++ + \item Erlang + \item Prolog + \item Idris + \item Agda + \item Tensorflow + \end{itemize*}} + +\section{Experience} +\subsection{Employment} +\cventry{2019-present}{Engineering Manager}{Urbint}{New York, NY}{} +{\begin{itemize} + \item Lead of the platform team with two direct reports - a senior SRE and + a senior software engineer. + \item Performed user research on developers, project managers, product + managers, and other internal stakeholders to build the roadmap for the + platform team. + \item Built and maintained a system to deploy one-off full stack + application instances from pull requests to enable easier testing. + \item Led a large, multi-project migration between CI systems that resulted + in a decrease of average build times from 2 hours to less than 10 minutes. + \item Maintained and extended Nix-based build and development + infrastructure for both software engineers and machine learning engineers. + \end{itemize}} +\cventry{2018--2019}{Senior Software Engineer}{Urbint}{New York, NY}{} +{\begin{itemize} + \item Built, trained, and maintained a large, deep-learning-based + image-detection model for semi-automated (human-in-the-loop) video + classification. + \item Designed, built, and maintained a novel in-house tool for collection of + training data. + \item Maintained and guaranteed reliability of a large data pipeline for + video processing and classification. + \end{itemize}} +\cventry{2017--2018}{Senior Software Engineer}{Urbint}{New York, NY}{} +{\begin{itemize} + \item Integral in the architecture of a novel, serializable ACID + transactional graph database built on RocksDB, first in Elixir then in + Haskell. + \item Helped ship customer deliverables involving multi-day data + processing jobs for disparate data sources. + \item Instructed other developers in the use of and theory behind Haskell + \item Brought computational graph theory to bear on the problem of unifying + disparate, highly heterogeneous data sources across the world of open data. + \end{itemize}} +\cventry{2016--2017}{Senior Software Engineer}{SecurityScorecard, Inc.}{New York, NY}{} +{Lead frontend developer for a rapidly-moving and growing security software startup. + \begin{itemize} + \item Took part in collaborative product design meetings to make UX + tradeoffs with product designers and managers. + \item Drove application architecture for a large, complex, data-driven frontend + application. + \item Championed increased use of production monitoring and alerting. + \item Worked with business stakeholders to set long- and short-term priorities for + application development. + \item Mentored junior team members. + \end{itemize}} +\cventry{2015--2016}{Lead Developer}{Nomi, Inc.}{New York, NY}{} +{Lead web services developer transitioning to a full-stack role implementing + shared software components and architecting a large, complex microservices + application ingesting hundreds of gigabytes of IoT data per week. + \begin{itemize} + \item Lead application architecture of the majority of the backend services to + encourage consistent REST API design and code sharing. + \item Championed the use of Haskell for rapid, safe development of the API Gateway + service. + \item Took ownership of operations and server maintenance of a >100-instance AWS + account using Puppet. + \end{itemize}} +\cventry{2014--2015}{Lead Developer}{LandlordsNY, LLC}{New York, NY}{} +{Sole engineer for a small startup connecting landlords and property managers and + facilitating the online sharing of information in a historically technology-averse + industry. + \begin{itemize} + \item Drove product design, visual design, and UX architecture for a major revamping + of the core product. + \item Interfaced with customers to set priorities for new feature development. + \item Conducted hiring and recruiting to build out an engineering team. + \end{itemize}} +\cventry{2012--2014}{Associate Developer}{Visionlink Inc.}{Boulder, CO}{} +{Integral member of an agile development team building the nation's most-used Information + and Referral platform for organizations such as United Way Worldwide and the American Red + Cross. + \begin{itemize} + \item Refactored and revamped legacy code to increase performance and long-term + maintainablity. + \item Worked on several triage-teams to rapidly fix production bugs with strict deadlines. + \item Built a complex, yet highly-performant tool for searching human services by category. + \item Acted as a core designer and developer of a major product revamp. + \begin{itemize} + \item Drove a complete rethinking of the data model in the product, leading to greater + unification, simplicity, and consistency; + \item Championed the adoption of a test-driven-development model; + \item Drove product documentation and code standardization. + \end{itemize} + \end{itemize}} + +\section{Project Highlights} +\newcommand{\project}[3]{\item \textbf{#1} -- \textit{#2}\newline{}#3} +\cvitem{}{\begin{itemize} + \project{Github Bug Bounty}{https://bounty.github.com/researchers/glittershark.html}{ + Discovered and responsibly disclosed a persistent XSS on Github's main + website} + \project{Tvix}{https://cs.tvl.fyi/depot/-/blob/third\_party/nix/README.md}{ + Fork of the Nix build tool delivering increased reliability, code + quality, and pluggability} + \project{Panettone}{https://cs.tvl.fyi/depot/-/tree/web/panettone}{ + Aggressively simple bug-tracker developed in Common Lisp for the community + involved in the development of Tvix. Hosted at https://b.tvl.fyi} + \project{Org-Clubhouse}{https://github.com/glittershark/org-clubhouse}{ + Emacs library for integration between org-mode and the Clubhouse issue + tracker} + \project{core-async-storage}{https://github.com/glittershark/core-async-storage}{ + Simple Clojurescript wrapper around React Native's AsyncStorage using + core.async} +\end{itemize}} + +\end{document} +% vim: set tw=95 colorcolumn=-1: diff --git a/users/grfn/resume/tweaklist.sty b/users/grfn/resume/tweaklist.sty new file mode 100644 index 000000000000..adc939893261 --- /dev/null +++ b/users/grfn/resume/tweaklist.sty @@ -0,0 +1,56 @@ +%% start of file `tweaklist.sty'. +%% Original by Jakob Schiøtz, downloaded from http://dcwww.camd.dtu.dk/~schiotz/comp/LatexTips/tweaklist.sty; not found on ctan. +%% Modified by Xavier Danaux (xdanaux@gmail.com). +% +% The tweaklist.sty package redefines the itemize, enumerate and description packages, so that all parameters can be adjusted. +% This was done by copying the original definitions, and adding "hook commands" that are executed when entering the environment. +% The hook commands are initially empty, but can be redefined with \renewcommand. +% +% This work may be distributed and/or modified under the +% conditions of the LaTeX Project Public License version 1.3c, +% available at http://www.latex-project.org/lppl/. + + +% hooks for the itemize environment +\def\itemhook{} +\def\itemhooki{} +\def\itemhookii{} +\def\itemhookiii{} +\def\itemhookiv{} +% hooks for the enumerate environment +\def\enumhook{} +\def\enumhooki{} +\def\enumhookii{} +\def\enumhookiii{} +\def\enumhookiv{} +% hook for the description environment +\def\deschook{} +% original environment definitions, with hooks added +\def\enumerate{% + \ifnum \@enumdepth >\thr@@\@toodeep\else + \advance\@enumdepth\@ne + \edef\@enumctr{enum\romannumeral\the\@enumdepth}% + \expandafter + \list + \csname label\@enumctr\endcsname + {% + \enumhook \csname enumhook\romannumeral\the\@enumdepth\endcsname% + \usecounter\@enumctr\def\makelabel##1{\hss\llap{##1}}% + }% + \fi} +\def\itemize{% + \ifnum \@itemdepth >\thr@@\@toodeep\else + \advance\@itemdepth\@ne + \edef\@itemitem{labelitem\romannumeral\the\@itemdepth}% + \expandafter + \list + \csname\@itemitem\endcsname + {% + \itemhook \csname itemhook\romannumeral\the\@itemdepth\endcsname% + \def\makelabel##1{\hss\llap{##1}}% + }% + \fi} +\newenvironment{description} + {\list{}{\deschook\labelwidth\z@ \itemindent-\leftmargin + \let\makelabel\descriptionlabel}} + {\endlist} diff --git a/users/grfn/system/.gitignore b/users/grfn/system/.gitignore new file mode 100644 index 000000000000..41fbeb02c47d --- /dev/null +++ b/users/grfn/system/.gitignore @@ -0,0 +1 @@ +**/result diff --git a/users/grfn/system/home/.skip-subtree b/users/grfn/system/home/.skip-subtree new file mode 100644 index 000000000000..e69de29bb2d1 --- /dev/null +++ b/users/grfn/system/home/.skip-subtree diff --git a/users/grfn/system/home/common/solarized.nix b/users/grfn/system/home/common/solarized.nix new file mode 100644 index 000000000000..e94693edc566 --- /dev/null +++ b/users/grfn/system/home/common/solarized.nix @@ -0,0 +1,18 @@ +rec { + base03 = "#002B36"; + base02 = "#073642"; + base01 = "#586e75"; + base00 = "#657b83"; + base0 = "#839496"; + base1 = "#93a1a1"; + base2 = "#eee8d5"; + base3 = "#fdf6e3"; + yellow = "#b58900"; + orange = "#cb4b16"; + red = "#dc322f"; + magenta = "#d33682"; + violet = "#6c71c4"; + blue = "#268bd2"; + cyan = "#2aa198"; + green = "#859900"; +} diff --git a/users/grfn/system/home/default.nix b/users/grfn/system/home/default.nix new file mode 100644 index 000000000000..f62704152b28 --- /dev/null +++ b/users/grfn/system/home/default.nix @@ -0,0 +1,32 @@ +{ pkgs, depot, lib, ... }: + +with lib; + +rec { + home = confPath: (import "${pkgs.home-manager.src}/modules" { + inherit pkgs; + + configuration = { config, lib, ... }: { + imports = [ confPath ]; + lib.depot = depot; + + # home-manager exposes no API to override the package set that + # is used, unless called from the NixOS module. + # + # To get around it, the module argument is overridden here. + _module.args.pkgs = mkForce pkgs; + }; + }); + + dobharchu = home ./machines/dobharchu.nix; + + dobharchuHome = dobharchu.activation-script; + + yeren = home ./machines/yeren.nix; + + yerenHome = yeren.activation-script; + + meta.targets = [ + "yerenHome" + ]; +} diff --git a/users/grfn/system/home/home.nix b/users/grfn/system/home/home.nix new file mode 100644 index 000000000000..39045c147d76 --- /dev/null +++ b/users/grfn/system/home/home.nix @@ -0,0 +1,20 @@ +{ config, pkgs, ... }: + +{ + imports = [ + (throw "Pick a machine from ./machines") + ]; + + # Let Home Manager install and manage itself. + programs.home-manager.enable = true; + + # This value determines the Home Manager release that your + # configuration is compatible with. This helps avoid breakage + # when a new Home Manager release introduces backwards + # incompatible changes. + # + # You can update Home Manager without changing this value. See + # the Home Manager release notes for a list of state version + # changes in each release. + home.stateVersion = "19.09"; +} diff --git a/users/grfn/system/home/machines/dobharchu.nix b/users/grfn/system/home/machines/dobharchu.nix new file mode 100644 index 000000000000..0b8503a00e98 --- /dev/null +++ b/users/grfn/system/home/machines/dobharchu.nix @@ -0,0 +1,17 @@ +{ config, lib, pkgs, ... }: + +{ + imports = [ + ../platforms/darwin.nix + ../modules/common.nix + ../modules/games.nix + ]; + + home.packages = with pkgs; [ + coreutils + gnupg + nix-prefetch-github + pass + pinentry_mac + ]; +} diff --git a/users/grfn/system/home/machines/roswell.nix b/users/grfn/system/home/machines/roswell.nix new file mode 100644 index 000000000000..f68f3a7be36f --- /dev/null +++ b/users/grfn/system/home/machines/roswell.nix @@ -0,0 +1,54 @@ +{ pkgs, lib, config, ... }: + +let + laptopKeyboardId = "5"; +in + +{ + imports = [ + ../platforms/linux.nix + ../modules/shell.nix + ../modules/development.nix + ../modules/emacs.nix + ../modules/vim.nix + ]; + + home.packages = with pkgs; [ + # System utilities + bat + htop + killall + bind + zip unzip + tree + ncat + bc + pv + + # Security + gnupg + keybase + openssl + + # Nix things + nixfmt + nix-prefetch-github + nix-review + cachix + ]; + + programs.password-store.enable = true; + + programs.home-manager.enable = true; + home.stateVersion = "20.03"; + + xsession.enable = lib.mkForce false; + + services.lorri.enable = true; + + programs.direnv = { + enable = true; + enableBashIntegration = true; + enableZshIntegration = true; + }; +} diff --git a/users/grfn/system/home/machines/yeren.nix b/users/grfn/system/home/machines/yeren.nix new file mode 100644 index 000000000000..0c89e9d12393 --- /dev/null +++ b/users/grfn/system/home/machines/yeren.nix @@ -0,0 +1,77 @@ +{ pkgs, lib, config, ... }: + +let + inherit (builtins) pathExists; + laptopKeyboardId = "5"; +in + +{ + imports = [ + ../platforms/linux.nix + ../modules/common.nix + ../modules/development/readyset.nix + ] ++ (lib.optional (pathExists ../modules/private.nix) ../modules/private.nix); + + # for when hacking + programs.home-manager.enable = true; + home.stateVersion = "20.03"; + + system.machine = { + wirelessInterface = "wlp0s20f3"; + i3FontSize = 9; + }; + + home.packages = with pkgs; [ + zoom-us + slack + mysql + graphviz + mypaint + xdot + tdesktop + subsurface + + (discord.override rec { + version = "0.0.16"; + src = fetchurl { + url = "https://dl.discordapp.net/apps/linux/${version}/discord-${version}.tar.gz"; + sha256 = "1s9qym58cjm8m8kg3zywvwai2i3adiq6sdayygk2zv72ry74ldai"; + }; + }) + + steam + + awscli2 + ]; + + systemd.user.services.laptop-keyboard = { + Unit = { + Description = "Swap caps+escape and alt+super, but only on the built-in laptop keyboard"; + After = [ "graphical-session-pre.target" ]; + PartOf = [ "graphical-session.target" ]; + }; + + Install = { WantedBy = [ "graphical-session.target" ]; }; + + Service = { + Type = "oneshot"; + RemainAfterExit = true; + ExecStart = ( + "${pkgs.xorg.setxkbmap}/bin/setxkbmap " + + "-device ${laptopKeyboardId} " + + "-option caps:swapescape " + + "-option compose:ralt " + + "-option altwin:swap_alt_win" + ); + }; + }; + + xsession.windowManager.i3.config.keybindings.F9 = "exec lock"; + + xdg.mimeApps.defaultApplications."x-scheme-handler/tg" = + "telegramdesktop.desktop"; + + programs.zsh.shellAliases = { + "graph" = "curl -s localhost:6033/graph | dot -Tpng | feh -"; + }; +} diff --git a/users/grfn/system/home/modules/alacritty.nix b/users/grfn/system/home/modules/alacritty.nix new file mode 100644 index 000000000000..67d6638a31f8 --- /dev/null +++ b/users/grfn/system/home/modules/alacritty.nix @@ -0,0 +1,56 @@ +{ config, lib, pkgs, ... }: + +{ + programs.alacritty = { + enable = true; + settings = { + font.size = 6; + font.normal.family = "Meslo LGSDZ Nerd Font"; + + draw_bold_text_with_bright_colors = false; + + key_bindings = [ + { + key = "Escape"; + mods = "Control"; + action = "ToggleViMode"; + } + ]; + + colors = with import ../common/solarized.nix; rec { + # Default colors + primary = { + background = base3; + foreground = base00; + }; + + cursor = { + text = base3; + cursor = base00; + }; + + # Normal colors + normal = { + inherit red green yellow blue magenta cyan; + black = base02; + white = base2; + }; + + # Bright colors + # bright = normal; + bright = { + black = base03; + red = orange; + green = base01; + yellow = base00; + blue = base0; + magenta = violet; + cyan = base1; + white = base3; + }; + + vi_mode_cursor.cursor = red; + }; + }; + }; +} diff --git a/users/grfn/system/home/modules/alsi.nix b/users/grfn/system/home/modules/alsi.nix new file mode 100644 index 000000000000..c4a14e683c39 --- /dev/null +++ b/users/grfn/system/home/modules/alsi.nix @@ -0,0 +1,58 @@ +{ config, lib, pkgs, ... }: +{ + home.packages = [ config.lib.depot.third_party.alsi ]; + + xdg.configFile."alsi/alsi.logo" = { + source = ./nixos-logo.txt; + force = true; + }; + + xdg.configFile."alsi/alsi.conf" = { + force = true; + text = '' + #!${pkgs.perl}/bin/perl + + scalar { + ALSI_VERSION => "0.4.8", + COLORS_FILE => "/home/grfn/.config/alsi/alsi.colors", + DE_FILE => "/home/grfn/.config/alsi/alsi.de", + DEFAULT_COLOR_BOLD => "blue", + DEFAULT_COLOR_NORMAL => "blue", + DF_COMMAND => "df -Th -x sys -x tmpfs -x devtmpfs &>/dev/stdout", + GTK2_RC_FILE => "/home/grfn/.gtkrc-2.0", + GTK3_RC_FILE => "/home/grfn/.config/gtk-3.0/settings.ini", + LOGO_FILE => "/home/grfn/.config/alsi/alsi.logo", + OUTPUT_FILE => "/home/grfn/.config/alsi/alsi.output", + # PACKAGES_PATH => "/var/lib/pacman/local/", + PS_COMMAND => "ps -A", + USAGE_COLORS => 0, + USAGE_COLORS_BOLD => 0, + USAGE_PRECENT_GREEN => 50, + USAGE_PRECENT_RED => 100, + USAGE_PRECENT_YELLOW => 85, + USE_LOGO_FROM_FILE => 1, + USE_VALUES_COLOR => 0, + WM_FILE => "/home/grfn/.config/alsi/alsi.wm", + } + ''; + }; + + xdg.configFile."alsi/alsi.colors".text = '' + #!${pkgs.perl}/bin/perl + + # Colors for alsi + + scalar { + black => {normal => "\e[0;30m", bold => "\e[1;30m"}, + red => {normal => "\e[0;31m", bold => "\e[1;31m"}, + green => {normal => "\e[0;32m", bold => "\e[1;32m"}, + yellow => {normal => "\e[0;33m", bold => "\e[1;33m"}, + default => {normal => "\e[0;34m", bold => "\e[1;34m"}, + blue => {normal => "\e[0;34m", bold => "\e[1;34m"}, + purple => {normal => "\e[0;35m", bold => "\e[1;35m"}, + cyan => {normal => "\e[0;36m", bold => "\e[1;36m"}, + white => {normal => "\e[0;37m", bold => "\e[1;37m"}, + reset => "\e[0m", + } + ''; +} diff --git a/users/grfn/system/home/modules/common.nix b/users/grfn/system/home/modules/common.nix new file mode 100644 index 000000000000..86e4ba400e7c --- /dev/null +++ b/users/grfn/system/home/modules/common.nix @@ -0,0 +1,105 @@ +{ config, lib, pkgs, ... }: + +# Everything in here needs to work on linux or darwin + +{ + imports = [ + ../modules/shell.nix + ../modules/development.nix + ../modules/emacs.nix + ../modules/vim.nix + ../modules/tarsnap.nix + ../modules/twitter.nix + ../modules/lib/cloneRepo.nix + ]; + + programs.password-store.enable = true; + + grfn.impure.clonedRepos.passwordStore = { + github = "glittershark/pass"; + path = ".local/share/password-store"; + }; + + home.packages = with pkgs; [ + # System utilities + bat + htop + killall + bind + zip unzip + tree + ncat + bc + pv + + # Security + gnupg + keybase + openssl + + # Nix things + nixfmt + nix-prefetch-github + nix-review + cachix + (writeShellScriptBin "rebuild-mugwump" '' + set -eo pipefail + cd ~/code/depot + nix build -f . users.grfn.system.system.mugwumpSystem -o /tmp/mugwump + nix copy -f . users.grfn.system.system.mugwumpSystem \ + --to ssh://mugwump + system=$(readlink -ef /tmp/mugwump) + ssh mugwump sudo nix-env -p /nix/var/nix/profiles/system --set $system + ssh mugwump sudo $system/bin/switch-to-configuration switch + '') + (writeShellScriptBin "rebuild-home" '' + set -eo pipefail + cd ~/code/depot + nix build -f . users.grfn.system.home.$(hostname)Home -o /tmp/home + /tmp/home/activate + '') + ]; + + programs.ssh = { + enable = true; + + matchBlocks = { + "home" = { + host = "home.gws.fyi"; + forwardAgent = true; + }; + + "dobharchu" = { + host = "dobharchu"; + hostname = "172.16.0.4"; + forwardAgent = true; + user = "griffin"; + }; + + "cerberus" = { + host = "cerberus"; + hostname = "172.16.0.3"; + forwardAgent = true; + user = "griffin"; + }; + + "mugwump" = { + host = "mugwump"; + hostname = "172.16.0.5"; + forwardAgent = true; + }; + + "roswell" = { + host = "roswell"; + hostname = "18.223.118.13"; + forwardAgent = true; + }; + }; + }; + + programs.direnv = { + enable = true; + enableBashIntegration = true; + enableZshIntegration = true; + }; +} diff --git a/users/grfn/system/home/modules/development.nix b/users/grfn/system/home/modules/development.nix new file mode 100644 index 000000000000..1a5e912916f8 --- /dev/null +++ b/users/grfn/system/home/modules/development.nix @@ -0,0 +1,212 @@ +{ config, lib, pkgs, ... }: + +let + + clj2nix = pkgs.callPackage (pkgs.fetchFromGitHub { + owner = "hlolli"; + repo = "clj2nix"; + rev = "3ab3480a25e850b35d1f532a5e4e7b3202232383"; + sha256 = "1lry026mlpxp1j563qs13nhxf37i2zpl7lh0lgfdwc44afybqka6"; + }) {}; + + pg-dump-upsert = pkgs.buildGoModule rec { + pname = "pg-dump-upsert"; + version = "165258deaebded5e9b88f7a0acf3a4b7350e7bf4"; + + src = pkgs.fetchFromGitHub { + owner = "tomyl"; + repo = "pg-dump-upsert"; + rev = version; + sha256 = "1an4h8jjbj3r618ykjwk9brii4h9cxjqy47c4c8rivnvhimgf4wm"; + }; + + vendorSha256 = "1a5fx6mrv30cl46kswicd8lf5i5shn1fykchvbnbhdpgxhbz6qi4"; + }; + +in + +with lib; + +{ + imports = [ + ./lib/zshFunctions.nix + ./development/kube.nix + # TODO(grfn): agda build is broken in the nixpkgs checkout + # ./development/agda.nix + ./development/rust.nix + ]; + + home.packages = with pkgs; [ + jq + yq + gron + gitAndTools.hub + gitAndTools.tig + gitAndTools.gh + shellcheck + httpie + entr + gnumake + inetutils + tokei + jsonnet + ngrok + amber + + gdb + lldb + hyperfine + clang-tools_11 + (rr.overrideAttrs (_: rec { + version = "f25671d094edac8059cec56b98d7f10f2c740697"; + src = pkgs.fetchFromGitHub { + owner = "rr-debugger"; + repo = "rr"; + rev = version; + sha256 = "149s4mw8vl8d3nx15sfp62z0izp2dibz99k720j75rjnkwk2bq2z"; + fetchSubmodules = true; + }; + })) + + clj2nix + clojure + leiningen + clj-kondo + + pg-dump-upsert + + nodePackages.prettier + ] ++ optionals (stdenv.isLinux) [ + # TODO(grfn): replace with stable again once the current julia debacle + # is resolved upstream, see https://github.com/NixOS/nixpkgs/pull/121114 + julia_16-bin + valgrind + ]; + + programs.git = { + enable = true; + package = pkgs.gitFull; + userEmail = "root@gws.fyi"; + userName = "Griffin Smith"; + ignores = [ + "*.sw*" + ".classpath" + ".project" + ".settings/" + ".dir-locals.el" + ".stack-work-profiling" + ".projectile" + ]; + extraConfig = { + github.user = "glittershark"; + merge.conflictstyle = "diff3"; + rerere.enabled = "true"; + }; + + delta = { + enable = true; + options = { + syntax-theme = "Solarized (light)"; + hunk-style = "plain"; + commit-style = "box"; + }; + }; + }; + + home.file.".gdbinit".text = '' + set history filename ~/.gdb_history + set history save on + set history size unlimited + set history remove-duplicates unlimited + set history expansion on + ''; + + home.file.".psqlrc".text = '' + \set QUIET 1 + \timing + \set ON_ERROR_ROLLBACK interactive + \set VERBOSITY verbose + \x auto + \set PROMPT1 '%[%033[1m%]%M/%/%R%[%033[0m%]%# ' + \set PROMPT2 '...%# ' + \set HISTFILE ~/.psql_history- :DBNAME + \set HISTCONTROL ignoredups + \pset null [null] + \unset QUIET + ''; + + programs.readline = { + enable = true; + extraConfig = '' + set editing-mode vi + ''; + }; + + programs.zsh = { + shellAliases = { + # Git + "gwip" = "git add . && git commit -am wip"; + "gpr" = "g pull-request"; + "gcl" = "git clone"; + "grs" = "gr --soft"; + "grhh" = "grh HEAD"; + "grh" = "gr --hard"; + "gr" = "git reset"; + "gcb" = "gc -b"; + "gco" = "gc"; + "gcd" = "gc development"; + "gcm" = "gc master"; + "gcc" = "gc canon"; + "gc" = "git checkout"; + "gbg" = "git branch | grep"; + "gba" = "git branch -a"; + "gb" = "git branch"; + "gcv" = "git commit --verbose"; + "gci" = "git commit"; + "gm" = "git merge"; + "gdc" = "gd --cached"; + "gd" = "git diff"; + "gsl" = "git stash list"; + "gss" = "git show stash"; + "gsad" = "git stash drop"; + "gsa" = "git stash"; + "gst" = "gs"; + "gs" = "git status"; + "gg" = "gl --decorate --oneline --graph --date-order --all"; + "gl" = "git log"; + "gf" = "git fetch"; + "gur" = "gu --rebase"; + "gu" = "git pull"; + "gpf" = "gp -f"; + "gpa" = "gp --all"; + "gpu" = "git push -u origin \"$(git symbolic-ref --short HEAD)\""; + "gp" = "git push"; + "ganw" = "git diff -w --no-color | git apply --cached --ignore-whitespace"; + "ga" = "git add"; + "gnp" = "git --no-pager"; + "g" = "git"; + "git" = "hub"; + "grim" = "git fetch && git rebase -i --autostash origin/master"; + "grom" = "git fetch && git rebase --autostash origin/master"; + "groc" = "git fetch && git rebase --autostash origin/canon"; + "grc" = "git rebase --continue"; + "gcan" = "git commit --amend --no-edit"; + "grl" = "git reflog"; + + # Haskell + "crl" = "cabal repl"; + "cr" = "cabal run"; + "cnb" = "cabal new-build"; + "cob" = "cabal old-build"; + "cnr" = "cabal new-run"; + "cor" = "cabal old-run"; + "ho" = "hoogle"; + }; + + functions = { + gdelmerged = '' + git branch --merged | egrep -v 'master' | tr -d '+ ' | xargs git branch -d + ''; + }; + }; +} diff --git a/users/grfn/system/home/modules/development/agda.nix b/users/grfn/system/home/modules/development/agda.nix new file mode 100644 index 000000000000..afd22a306dc9 --- /dev/null +++ b/users/grfn/system/home/modules/development/agda.nix @@ -0,0 +1,58 @@ +{ config, lib, pkgs, ... }: + +let + agda-categories = with pkgs.agdaPackages; mkDerivation rec { + pname = "agda-categories"; + version = "2128fab"; + src = pkgs.fetchFromGitHub { + owner = "agda"; + repo = "agda-categories"; + rev = version; + sha256 = "08mc20qaz9vp5rhi60rh8wvjkg5aby3bgwwdhfnxha1663qf1q24"; + }; + + buildInputs = [ standard-library ]; + }; + +in + +{ + imports = [ + ../lib/cloneRepo.nix + ]; + + home.packages = with pkgs; [ + (pkgs.agda.withPackages + (p: with p; [ + p.standard-library + + ])) + ]; + + grfn.impure.clonedRepos = { + agda-stdlib = { + github = "agda/agda-stdlib"; + path = "code/agda-stdlib"; + }; + + agda-categories = { + github = "agda/agda-categories"; + path = "code/agda-categories"; + }; + + categories-examples = { + github = "agda/categories-examples"; + path = "code/categories-examples"; + }; + }; + + home.file.".agda/defaults".text = '' + standard-library + ''; + + home.file.".agda/libraries".text = '' + /home/grfn/code/agda-stdlib/standard-library.agda-lib + /home/grfn/code/agda-categories/agda-categories.agda-lib + ''; + +} diff --git a/users/grfn/system/home/modules/development/kube.nix b/users/grfn/system/home/modules/development/kube.nix new file mode 100644 index 000000000000..97ae4760d43b --- /dev/null +++ b/users/grfn/system/home/modules/development/kube.nix @@ -0,0 +1,34 @@ +{ config, lib, pkgs, ... }: +{ + home.packages = with pkgs; [ + kubectl + kubetail + sops + kubie + # pkgs-unstable.argocd # provided by urbos + ]; + + programs.zsh.shellAliases = { + "kc" = "kubectl"; + "kg" = "kc get"; + "kga" = "kc get --all-namespaces"; + "kpd" = "kubectl get pods"; + "kpa" = "kubectl get pods --all-namespaces"; + "klf" = "kubectl logs -f"; + "kdep" = "kubectl get deployments"; + "ked" = "kubectl edit deployment"; + "kpw" = "kubectl get pods -w"; + "kew" = "kubectl get events -w"; + "kdel" = "kubectl delete"; + "knw" = "kubectl get nodes -w"; + "kev" = "kubectl get events --sort-by='.metadata.creationTimestamp'"; + + "arsy" = "argocd app sync --prune"; + }; + + home.file.".kube/kubie.yaml".text = '' + shell: zsh + prompt: + zsh_use_rps1: true + ''; +} diff --git a/users/grfn/system/home/modules/development/readyset.nix b/users/grfn/system/home/modules/development/readyset.nix new file mode 100644 index 000000000000..19f44b770355 --- /dev/null +++ b/users/grfn/system/home/modules/development/readyset.nix @@ -0,0 +1,16 @@ +{ config, lib, pkgs, ... }: + +{ + imports = [ + ./rust.nix + ]; + + home.packages = with pkgs; [ + # This goes in $PATH so I can run it from rofi and parent to my WM + (writeShellScriptBin "dotclip" "xclip -out -selection clipboard | dot -Tpng | feh -") + ]; + + programs.zsh.shellAliases = { + "tf" = "terraform"; + }; +} diff --git a/users/grfn/system/home/modules/development/rust.nix b/users/grfn/system/home/modules/development/rust.nix new file mode 100644 index 000000000000..018b338bff2a --- /dev/null +++ b/users/grfn/system/home/modules/development/rust.nix @@ -0,0 +1,30 @@ +{ config, lib, pkgs, ... }: + + +{ + home.packages = with pkgs; [ + rustup + rust-analyzer + cargo-edit + cargo-expand + cargo-flamegraph + cargo-rr + cargo-udeps + cargo-bloat + sccache + evcxr + ]; + + programs.zsh.shellAliases = { + "cg" = "cargo"; + "cb" = "cargo build"; + "ct" = "cargo test"; + "ctw" = "fd -e rs | entr cargo test"; + "cch" = "cargo check"; + }; + + home.file.".cargo/config".text = '' + [build] + rustc-wrapper = "${pkgs.sccache}/bin/sccache" + ''; +} diff --git a/users/grfn/system/home/modules/emacs.nix b/users/grfn/system/home/modules/emacs.nix new file mode 100644 index 000000000000..6cc38bc7ab05 --- /dev/null +++ b/users/grfn/system/home/modules/emacs.nix @@ -0,0 +1,108 @@ +{ pkgs, lib, config, ... }: + +with lib; + +let + # doom-emacs = pkgs.callPackage (builtins.fetchTarball { + # url = https://github.com/vlaci/nix-doom-emacs/archive/master.tar.gz; + # }) { + # doomPrivateDir = ./doom.d; # Directory containing your config.el init.el + # # and packages.el files + # }; + + depot = config.lib.depot; + +in { + imports = [ + ./lib/cloneRepo.nix + ]; + + # home.packages = [ doom-emacs ]; + # home.file.".emacs.d/init.el".text = '' + # (load "default.el") + # ''; + # + + config = mkMerge [ + { + home.packages = with pkgs; [ + # LaTeX (for org export) + (pkgs.texlive.combine { + inherit (pkgs.texlive) + capt-of + collection-fontsrecommended + dvipng + fancyvrb + float + fncychap + framed + mathpartir + needspace + parskip + scheme-basic + semantic + tabulary + titlesec + ulem + upquote + varwidth + wrapfig + ; + }) + + ispell + + ripgrep + coreutils + fd + clang + gnutls + emacsPackages.telega + ]; + + programs.emacs = { + enable = true; + package = pkgs.emacsUnstable; + extraPackages = (epkgs: + (with epkgs; [ + tvlPackages.dottime + tvlPackages.tvl + vterm + telega + ]) + ); + }; + + grfn.impure.clonedRepos = { + orgClubhouse = { + github = "glittershark/org-clubhouse"; + path = "code/org-clubhouse"; + }; + + doomEmacs = { + github = "hlissner/doom-emacs"; + path = ".emacs.d"; + after = ["emacs.d"]; + onClone = "bin/doom install"; + }; + + "emacs.d" = { + github = "glittershark/emacs.d"; + path = ".doom.d"; + after = ["orgClubhouse"]; + }; + }; + + programs.zsh.shellAliases = { + "ec" = "emacsclient"; + }; + } + (mkIf pkgs.stdenv.isLinux { + # Notes + services.syncthing = { + enable = true; + tray = true; + }; + }) + ]; +} diff --git a/users/grfn/system/home/modules/email.nix b/users/grfn/system/home/modules/email.nix new file mode 100644 index 000000000000..0a3e58205ba6 --- /dev/null +++ b/users/grfn/system/home/modules/email.nix @@ -0,0 +1,87 @@ +{ lib, pkgs, config, ... }: + +with lib; + +let + + # from home-manager/modules/services/lieer.nix + escapeUnitName = name: + let + good = upperChars ++ lowerChars ++ stringToCharacters "0123456789-_"; + subst = c: if any (x: x == c) good then c else "-"; + in stringAsChars subst name; + + accounts = { + personal = { + primary = true; + address = "root@gws.fyi"; + aliases = [ "grfn@gws.fyi" ]; + passEntry = "root-gws-msmtp"; + }; + + work = { + address = "griffin@readyset.io"; + passEntry = "readyset/msmtp"; + }; + + }; + +in { + programs.lieer.enable = true; + programs.notmuch.enable = true; + services.lieer.enable = true; + programs.msmtp.enable = true; + + home.packages = with pkgs; [ + mu + msmtp + ]; + + systemd.user.services = mapAttrs' (name: account: { + name = escapeUnitName "lieer-${name}"; + value.Service = { + ExecStart = mkForce "${pkgs.writeShellScript "sync-${name}" '' + ${pkgs.gmailieer}/bin/gmi sync --path ~/mail/${name} + ''}"; + Environment = "NOTMUCH_CONFIG=${config.home.sessionVariables.NOTMUCH_CONFIG}"; + }; + + }) accounts; + + # xdg.configFile."notifymuch/notifymuch.cfg".text = generators.toINI {} { + # notifymuch = { + # query = "is:unread and is:important"; + # mail_client = ""; + # recency_interval_hours = "48"; + # hidden_tags = "inbox unread attachment replied sent encrypted signed"; + # }; + # }; + + accounts.email.maildirBasePath = "mail"; + accounts.email.accounts = mapAttrs (_: params@{ passEntry, ... }: { + realName = "Griffin Smith"; + passwordCommand = "pass ${passEntry}"; + + flavor = "gmail.com"; + + imapnotify = { + enable = true; + boxes = [ "Inbox" ]; + }; + + gpg = { + key = "0F11A989879E8BBBFDC1E23644EF5B5E861C09A7"; + signByDefault = true; + }; + + notmuch.enable = true; + lieer = { + enable = true; + sync = { + enable = true; + frequency = "*:*"; + }; + }; + msmtp.enable = true; + } // builtins.removeAttrs params ["passEntry"]) accounts; +} diff --git a/users/grfn/system/home/modules/firefox.nix b/users/grfn/system/home/modules/firefox.nix new file mode 100644 index 000000000000..c7e78685a5a3 --- /dev/null +++ b/users/grfn/system/home/modules/firefox.nix @@ -0,0 +1,22 @@ +{ config, lib, pkgs, ... }: + +{ + + xdg.mimeApps = rec { + enable = true; + defaultApplications = { + "text/html" = [ "firefox.desktop" ]; + "x-scheme-handler/http" = [ "firefox.desktop" ]; + "x-scheme-handler/https" = [ "firefox.desktop" ]; + "x-scheme-handler/ftp" = [ "firefox.desktop" ]; + "x-scheme-handler/chrome" = [ "firefox.desktop" ]; + "application/x-extension-htm" = [ "firefox.desktop" ]; + "application/x-extension-html" = [ "firefox.desktop" ]; + "application/x-extension-shtml" = [ "firefox.desktop" ]; + "application/xhtml+xml" = [ "firefox.desktop" ]; + "application/x-extension-xhtml" = [ "firefox.desktop" ]; + "application/x-extension-xht" = [ "firefox.desktop" ]; + }; + associations.added = defaultApplications; + }; +} diff --git a/users/grfn/system/home/modules/games.nix b/users/grfn/system/home/modules/games.nix new file mode 100644 index 000000000000..da54f99e5b39 --- /dev/null +++ b/users/grfn/system/home/modules/games.nix @@ -0,0 +1,59 @@ +{ config, lib, pkgs, ... }: + +with pkgs; +with lib; + +let + + df-orig = dwarf-fortress-packages.dwarf-fortress-original; + + df-full = (dwarf-fortress-packages.dwarf-fortress-full.override { + theme = null; + enableIntro = false; + enableFPS = true; + }); + + init = runCommand "init.txt" {} '' + substitute "${df-orig}/data/init/init.txt" $out \ + --replace "[INTRO:YES]" "[INTRO:NO]" \ + --replace "[VOLUME:255]" "[VOLUME:0]" \ + --replace "[FPS:NO]" "[FPS:YES]" + ''; + + d_init = runCommand "d_init.txt" {} '' + substitute "${df-orig}/data/init/d_init.txt" $out \ + --replace "[AUTOSAVE:NONE]" "[AUTOSAVE:SEASONAL]" \ + --replace "[AUTOSAVE_PAUSE:NO]" "[AUTOSAVE_PAUSE:YES]" \ + --replace "[INITIAL_SAVE:NO]" "[INITIAL_SAVE:YES]" \ + --replace "[EMBARK_WARNING_ALWAYS:NO]" "[EMBARK_WARNING_ALWAYS:YES]" \ + --replace "[VARIED_GROUND_TILES:YES]" "[VARIED_GROUND_TILES:NO]" \ + --replace "[SHOW_FLOW_AMOUNTS:NO]" "[SHOW_FLOW_AMOUNTS:YES]" + ''; + + df = runCommand "dwarf-fortress" {} '' + mkdir -p $out/bin + sed \ + -e '4icp -f ${init} "$DF_DIR/data/init/init.txt"' \ + -e '4icp -f ${d_init} "$DF_DIR/data/init/d_init.txt"' \ + < "${df-full}/bin/dwarf-fortress" >"$out/bin/dwarf-fortress" + + shopt -s extglob + ln -s ${df-full}/bin/!(dwarf-fortress) $out/bin + + chmod +x $out/bin/dwarf-fortress + ''; + +in mkMerge [ + { + home.packages = [ + crawl + xonotic + ]; + } + (mkIf stdenv.isLinux { + home.packages = [ + df + multimc + ]; + }) +] diff --git a/users/grfn/system/home/modules/i3.nix b/users/grfn/system/home/modules/i3.nix new file mode 100644 index 000000000000..df0859b46aef --- /dev/null +++ b/users/grfn/system/home/modules/i3.nix @@ -0,0 +1,366 @@ +{ config, lib, pkgs, ... }: +let + mod = "Mod4"; + solarized = import ../common/solarized.nix; + # TODO pull this out into lib + emacsclient = eval: pkgs.writeShellScript "emacsclient-eval" '' + msg=$(emacsclient --eval '${eval}' 2>&1) + echo "''${msg:1:-1}" + ''; + screenlayout = { + home = pkgs.writeShellScript "screenlayout_home.sh" '' + xrandr \ + --output eDP-1 --mode 1920x1200 --pos 0x2160 --rotate normal \ + --output DP-1 --off \ + --output DP-2 --off \ + --output DP-3 --mode 3840x2160 --pos 0x0 --rotate normal \ + --output DP-4 --off + ''; + }; + + inherit (builtins) map; + inherit (lib) mkMerge range; +in { + options = with lib; { + system.machine.wirelessInterface = mkOption { + description = '' + Name of the primary wireless interface. Used by i3status, etc. + ''; + default = "wlp3s0"; + type = types.str; + }; + + system.machine.i3FontSize = mkOption { + description = "Font size to use in i3 window decorations etc."; + default = 6; + type = types.int; + }; + }; + + config = + let decorationFont = "MesloLGSDZ ${toString config.system.machine.i3FontSize}"; in + { + home.packages = with pkgs; [ + rofi + rofi-pass + python38Packages.py3status + i3lock + i3status + dconf # for gtk + + # Screenshots + maim + + # GIFs + picom + peek + + (pkgs.writeShellScriptBin "lock" '' + playerctl pause + ${pkgs.i3lock}/bin/i3lock -c 222222 + '') + ]; + + xsession.scriptPath = ".xsession"; + + xsession.windowManager.i3 = { + enable = true; + config = { + modifier = mod; + keybindings = + mkMerge ( + (map + (n: { + "${mod}+${toString n}" = + "workspace ${toString n}"; + "${mod}+Shift+${toString n}" = + "move container to workspace ${toString n}"; + }) + (range 0 9)) + ++ [(rec { + "${mod}+h" = "focus left"; + "${mod}+j" = "focus down"; + "${mod}+k" = "focus up"; + "${mod}+l" = "focus right"; + "${mod}+semicolon" = "focus parent"; + + "${mod}+Shift+h" = "move left"; + "${mod}+Shift+j" = "move down"; + "${mod}+Shift+k" = "move up"; + "${mod}+Shift+l" = "move right"; + + "${mod}+Shift+x" = "kill"; + + "${mod}+Return" = "exec alacritty"; + + "${mod}+Shift+s" = "split h"; + "${mod}+Shift+v" = "split v"; + "${mod}+e" = "layout toggle split"; + "${mod}+w" = "layout tabbed"; + "${mod}+s" = "layout stacking"; + + "${mod}+f" = "fullscreen"; + + "${mod}+Shift+r" = "restart"; + + "${mod}+r" = "mode resize"; + + # Marks + "${mod}+Shift+m" = ''exec i3-input -F "mark %s" -l 1 -P 'Mark: ' ''; + "${mod}+m" = ''exec i3-input -F '[con_mark="%s"] focus' -l 1 -P 'Go to: ' ''; + + # Screenshots + "${mod}+q" = "exec \"maim | xclip -selection clipboard -t image/png\""; + "${mod}+Shift+q" = "exec \"maim -s | xclip -selection clipboard -t image/png\""; + "${mod}+Ctrl+q" = "exec ${pkgs.writeShellScript "peek.sh" '' + ${pkgs.picom}/bin/picom & + picom_pid=$! + ${pkgs.peek}/bin/peek || true + kill -SIGINT $picom_pid + ''}"; + + # Launching applications + "${mod}+u" = "exec ${pkgs.writeShellScript "rofi" '' + rofi \ + -modi 'combi' \ + -combi-modi "window,drun,ssh,run" \ + -font '${decorationFont}' \ + -show combi + ''}"; + + # Passwords + "${mod}+p" = "exec rofi-pass -font '${decorationFont}'"; + + # Media + "XF86AudioPlay" = "exec playerctl play-pause"; + "XF86AudioNext" = "exec playerctl next"; + "XF86AudioPrev" = "exec playerctl previous"; + "XF86AudioRaiseVolume" = "exec pulseaudio-ctl up"; + "XF86AudioLowerVolume" = "exec pulseaudio-ctl down"; + "XF86AudioMute" = "exec pulseaudio-ctl mute"; + + # Lock + Pause = "exec lock"; + + # Brightness + "XF86MonBrightnessDown" = "exec ${pkgs.brightnessctl}/bin/brightnessctl -q s 5%-"; + "XF86MonBrightnessUp" = "exec ${pkgs.brightnessctl}/bin/brightnessctl -q s 5%+"; + + # Sleep/hibernate + # "${mod}+Escape" = "exec systemctl suspend"; + # "${mod}+Shift+Escape" = "exec systemctl hibernate"; + + # Scratch buffer + "${mod}+minus" = "scratchpad show"; + "${mod}+Shift+minus" = "move scratchpad"; + "${mod}+space" = "focus mode_toggle"; + "${mod}+Shift+space" = "floating toggle"; + + # Screen Layout + "${mod}+Shift+t" = "exec xrandr --auto"; + "${mod}+t" = "exec ${screenlayout.home}"; + "${mod}+Ctrl+t" = "exec ${pkgs.writeShellScript "fix_term.sh" '' + xrandr --output eDP-1 --off && ${screenlayout.home} + ''}"; + + # Notifications + "${mod}+Shift+n" = "exec killall -SIGUSR1 .dunst-wrapped"; + "${mod}+n" = "exec killall -SIGUSR2 .dunst-wrapped"; + "Control+space" = "exec ${pkgs.dunst}/bin/dunstctl close"; + "Control+Shift+space" = "exec ${pkgs.dunst}/bin/dunstctl close-all"; + "Control+grave" = "exec ${pkgs.dunst}/bin/dunstctl history-pop"; + "Control+Shift+period" = "exec ${pkgs.dunst}/bin/dunstctl action"; + })]); + + fonts = [ decorationFont ]; + + colors = with solarized; rec { + focused = { + border = base01; + background = base01; + text = base3; + indicator = red; + childBorder = base02; + }; + focusedInactive = focused // { + border = base03; + background = base03; + # text = base1; + }; + unfocused = focusedInactive; + background = base03; + }; + + modes.resize = { + l = "resize shrink width 5 px or 5 ppt"; + k = "resize grow height 5 px or 5 ppt"; + j = "resize shrink height 5 px or 5 ppt"; + h = "resize grow width 5 px or 5 ppt"; + + Return = "mode \"default\""; + }; + + bars = [{ + statusCommand = + let i3status-conf = pkgs.writeText "i3status.conf" '' + general { + output_format = i3bar + colors = true + color_good = "#859900" + + interval = 1 + } + + order += "external_script current_task" + order += "external_script inbox" + order += "spotify" + order += "volume_status" + order += "wireless ${config.system.machine.wirelessInterface}" + # order += "ethernet enp3s0f0" + order += "cpu_usage" + order += "battery 0" + # order += "volume master" + order += "time" + order += "tztime utc" + + mpd { + format = "%artist - %album - %title" + } + + wireless ${config.system.machine.wirelessInterface} { + format_up = "W: (%quality - %essid - %bitrate) %ip" + format_down = "W: -" + } + + ethernet enp3s0f0 { + format_up = "E: %ip" + format_down = "E: -" + } + + battery 0 { + format = "%status %percentage" + path = "/sys/class/power_supply/BAT%d/uevent" + low_threshold = 10 + } + + cpu_usage { + format = "CPU: %usage" + } + + load { + format = "%5min" + } + + time { + format = " %a %h %d ⌚ %I:%M " + } + + spotify { + color_playing = "#fdf6e3" + color_paused = "#93a1a1" + format_stopped = "" + format_down = "" + format = "{title} - {artist} ({album})" + } + + external_script inbox { + script_path = '${emacsclient "(grfn/num-inbox-items-message)"}' + format = 'Inbox: {output}' + cache_timeout = 120 + color = "#93a1a1" + } + + external_script current_task { + script_path = '${emacsclient "(grfn/org-current-clocked-in-task-message)"}' + # format = '{output}' + cache_timeout = 60 + color = "#93a1a1" + } + + tztime utc { + timezone = "UTC" + format = " %H·%M " + } + + volume_status { + format = "☊ {percentage}" + format_muted = "☊ X" + # device = "default" + # mixer_idx = 0 + } + ''; + in "py3status -c ${i3status-conf}"; + fonts = [ decorationFont ]; + position = "top"; + colors = with solarized; rec { + background = base03; + statusline = base3; + separator = base1; + activeWorkspace = { + border = base03; + background = base1; + text = base3; + }; + focusedWorkspace = activeWorkspace; + inactiveWorkspace = activeWorkspace // { + background = base01; + }; + urgentWorkspace = activeWorkspace // { + background = red; + }; + }; + }]; + }; + }; + + services.dunst = { + enable = true; + settings = with solarized; { + global = { + font = "MesloLGSDZ ${toString (config.system.machine.i3FontSize * 1.5)}"; + allow_markup = true; + format = "<b>%s</b>\n%b"; + sort = true; + alignment = "left"; + geometry = "600x15-40+40"; + idle_threshold = 120; + separator_color = "frame"; + separator_height = 1; + word_wrap = true; + padding = 8; + horizontal_padding = 8; + max_icon_size = 45; + }; + + frame = { + width = 0; + color = "#aaaaaa"; + }; + + urgency_low = { + background = base03; + foreground = base3; + timeout = 5; + }; + + urgency_normal = { + background = base02; + foreground = base3; + timeout = 7; + }; + + urgency_critical = { + background = red; + foreground = base3; + timeout = 0; + }; + }; + }; + + gtk = { + enable = true; + iconTheme.name = "Adwaita"; + theme.name = "Adwaita"; + }; + }; +} diff --git a/users/grfn/system/home/modules/lib/cloneRepo.nix b/users/grfn/system/home/modules/lib/cloneRepo.nix new file mode 100644 index 000000000000..dc487dc6bd05 --- /dev/null +++ b/users/grfn/system/home/modules/lib/cloneRepo.nix @@ -0,0 +1,67 @@ +{ lib, config, ... }: +with lib; +{ + options = { + grfn.impure.clonedRepos = mkOption { + description = "Repositories to clone"; + default = {}; + type = with types; loaOf ( + let sm = submodule { + options = { + url = mkOption { + type = nullOr str; + description = "URL of repository to clone"; + default = null; + }; + + github = mkOption { + type = nullOr str; + description = "Github owner/repo of repository to clone"; + default = null; + }; + + path = mkOption { + type = str; + description = "Path to clone to"; + }; + + onClone = mkOption { + type = str; + description = '' + Shell command to run after cloning the repo for the first time. + Runs inside the repo itself. + ''; + default = ""; + }; + + after = mkOption { + type = listOf str; + description = "Activation hooks that this repository must be cloned after"; + default = []; + }; + }; + }; + in addCheck sm (cr: (! isNull cr.url || ! isNull cr.github)) + ); + }; + }; + + config = { + home.activation = + mapAttrs + (_: { + url, path, github, onClone, after, ... + }: + let repoURL = if isNull url then "git@github.com:${github}" else url; + in hm.dag.entryAfter (["writeBoundary"] ++ after) '' + $DRY_RUN_CMD mkdir -p $(dirname "${path}") + if [[ ! -d ${path} ]]; then + $DRY_RUN_CMD git clone "${repoURL}" "${path}" + pushd ${path} + $DRY_RUN_CMD ${onClone} + popd + fi + '') + config.grfn.impure.clonedRepos; + }; +} diff --git a/users/grfn/system/home/modules/lib/zshFunctions.nix b/users/grfn/system/home/modules/lib/zshFunctions.nix new file mode 100644 index 000000000000..7c39b3478cfd --- /dev/null +++ b/users/grfn/system/home/modules/lib/zshFunctions.nix @@ -0,0 +1,21 @@ +{ config, lib, pkgs, ... }: + +with lib; + +{ + options = { + programs.zsh.functions = mkOption { + description = "An attribute set that maps function names to their source"; + default = {}; + type = with types; attrsOf (either str path); + }; + }; + + config.programs.zsh.initExtra = concatStringsSep "\n" ( + mapAttrsToList (name: funSrc: '' + function ${name}() { + ${funSrc} + } + '') config.programs.zsh.functions + ); +} diff --git a/users/grfn/system/home/modules/nixos-logo.txt b/users/grfn/system/home/modules/nixos-logo.txt new file mode 100644 index 000000000000..d4b16b44f0bf --- /dev/null +++ b/users/grfn/system/home/modules/nixos-logo.txt @@ -0,0 +1,26 @@ + [38;5;m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m/ + [38;5;m,[38;5;068m([38;5;067m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;061m/[38;5;m( [38;5;m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;m# [38;5;m.[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;m# + [38;5;m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;061m/[38;5;061m/[38;5;m/ [38;5;m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;m. [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m/ + [38;5;m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;061m/[38;5;067m([38;5;061m/[38;5;061m/[38;5;m, [38;5;m/[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# + [38;5;m([38;5;067m([38;5;067m([38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m/ [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m( + [38;5;m.[38;5;068m([38;5;068m([38;5;068m([38;5;068m([38;5;068m([38;5;068m([38;5;068m([38;5;068m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;061m([38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m#[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m([38;5;m( + [38;5;m([38;5;067m([38;5;067m([38;5;067m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m/[38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m.[38;5;m([38;5;067m([38;5;067m([38;5;m( + [38;5;m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;061m/[38;5;061m([38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m/[38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;068m([38;5;067m([38;5;m( + [38;5;m([38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;074m#[38;5;m# [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m([38;5;067m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( + [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m/[38;5;m([38;5;067m([38;5;068m([38;5;067m([38;5;068m([38;5;067m([38;5;068m([38;5;067m([38;5;068m([38;5;m( + [38;5;m*[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m.[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m#[38;5;m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( + [38;5;m#[38;5;m#[38;5;m#[38;5;m%[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m([38;5;061m/[38;5;061m/[38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m([38;5;m([38;5;m([38;5;m([38;5;m([38;5;m([38;5;m([38;5;m([38;5;m([38;5;m( +[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m.[38;5;m#[38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( +[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m([38;5;m( [38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( + [38;5;m#[38;5;m#[38;5;m#[38;5;m%[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m#[38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m. [38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m/[38;5;m/[38;5;m/[38;5;m/[38;5;m/[38;5;m/[38;5;m/[38;5;m/[38;5;m/[38;5;m/[38;5;m([38;5;m([38;5;m([38;5;m( + [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m( [38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m/ + [38;5;m.[38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m/ [38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m, + [38;5;m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;m* [38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m( [38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m/ + [38;5;m.[38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;m# [38;5;m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m([38;5;m#[38;5;074m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m, + [38;5;m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m# [38;5;m([38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m% + [38;5;m.[38;5;m# [38;5;m([38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m/[38;5;061m([38;5;061m/[38;5;061m/[38;5;067m([38;5;m([38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;m% + [38;5;m([38;5;061m/[38;5;061m/[38;5;061m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m( [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m%[38;5;110m%[38;5;110m%[38;5;m( + [38;5;m/[38;5;061m/[38;5;067m([38;5;061m/[38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;m# + [38;5;m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( [38;5;m([38;5;067m([38;5;067m([38;5;067m([38;5;068m([38;5;067m([38;5;067m([38;5;067m([38;5;068m( [38;5;m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m/ + [38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;m( [38;5;m/[38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;067m([38;5;068m([38;5;067m([38;5;m( [38;5;m.[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m#[38;5;110m#[38;5;110m#[38;5;m% + [38;5;m([38;5;068m([38;5;067m([38;5;068m([38;5;067m([38;5;m( [38;5;m([38;5;068m([38;5;067m([38;5;068m([38;5;067m([38;5;068m([38;5;067m([38;5;068m([38;5;m( [38;5;m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;110m%[38;5;110m#[38;5;m/ diff --git a/users/grfn/system/home/modules/obs.nix b/users/grfn/system/home/modules/obs.nix new file mode 100644 index 000000000000..d1dade477ccc --- /dev/null +++ b/users/grfn/system/home/modules/obs.nix @@ -0,0 +1,66 @@ +{ config, lib, pkgs, ... }: + +with pkgs; + +let + libuiohook = stdenv.mkDerivation rec { + pname = "libuiohook"; + version = "1.1"; + src = fetchFromGitHub { + owner = "kwhat"; + repo = "libuiohook"; + rev = version; + sha256 = "1isfxn3cfrdqq22d3mlz2lzm4asf9gprs7ww2xy9c3j3srk9kd7r"; + }; + + preConfigure = '' + ./bootstrap.sh + ''; + + nativeBuildInputs = [ pkg-config ]; + buildInputs = [ + libtool autoconf automake + x11 + xorg.libXtst + xorg.libXinerama + xorg.libxkbfile + libxkbcommon + ]; + }; + + obs-input-overlay = stdenv.mkDerivation rec { + pname = "obs-input-overlay"; + version = "4.8"; + src = fetchFromGitHub { + owner = "univrsal"; + repo = "input-overlay"; + rev = "v${version}"; + sha256 = "1dklg0dx9ijwyhgwcaqz859rbpaivmqxqvh9w3h4byrh5pnkz8bf"; + fetchSubmodules = true; + }; + + nativeBuildInputs = [ cmake ]; + buildInputs = [ obs-studio libuiohook ]; + + postPatch = '' + sed -i CMakeLists.txt \ + -e '2iinclude(${obs-studio.src}/cmake/Modules/ObsHelpers.cmake)' \ + -e '2ifind_package(LibObs REQUIRED)' + ''; + + cmakeFlags = [ + "-Wno-dev" + ]; + }; +in +{ + home.packages = [ + obs-studio + obs-input-overlay + ]; + + xdg.configFile."obs-studio/plugins/input-overlay/bin/64bit/input-overlay.so".source = + "${obs-input-overlay}/lib/obs-plugins/input-overlay.so"; + xdg.configFile."obs-studio/plugins/input-overlay/data".source = + "${obs-input-overlay}/share/obs/obs-plugins/input-overlay"; +} diff --git a/users/grfn/system/home/modules/ptt.nix b/users/grfn/system/home/modules/ptt.nix new file mode 100644 index 000000000000..436c8f261797 --- /dev/null +++ b/users/grfn/system/home/modules/ptt.nix @@ -0,0 +1,44 @@ +{ config, lib, pkgs, ... }: + +let + + pttKeycode = "152"; + sourceID = "3"; + + mute = pkgs.writeShellScript "mute-mic" '' + xset -r ${pttKeycode} + ${pkgs.pulseaudio}/bin/pactl set-source-mute ${sourceID} 1 + ''; + + unmute = pkgs.writeShellScript "unmute-mic" '' + xset -r ${pttKeycode} + ${pkgs.pulseaudio}/bin/pactl set-source-mute ${sourceID} 0 + ''; + +in + +{ + home.packages = with pkgs; [ + xbindkeys + ]; + + + home.file.".xbindkeysrc.scm".text = '' + (xbindkey '("c:${pttKeycode}") "${unmute}") + (xbindkey '(release "c:${pttKeycode}") "${mute}") + ''; + + systemd.user.services."xbindkeys" = { + Unit = { + Description = "Keybind daemon for push-to-talk"; + After = [ "graphical-session-pre.target" ]; + PartOf = [ "graphical-session.target" ]; + }; + + Install = { WantedBy = [ "graphical-session.target" ]; }; + + Service = { + ExecStart = "${pkgs.xbindkeys}/bin/xbindkeys -n -v"; + }; + }; +} diff --git a/users/grfn/system/home/modules/pure.zsh-theme b/users/grfn/system/home/modules/pure.zsh-theme new file mode 100755 index 000000000000..b4776e81596d --- /dev/null +++ b/users/grfn/system/home/modules/pure.zsh-theme @@ -0,0 +1,151 @@ +#!/bin/zsh -f +# vim: ft=zsh: +# MIT License +# For my own and others sanity +# git: +# %b => current branch +# %a => current action (rebase/merge) +# prompt: +# %F => color dict +# %f => reset color +# %~ => current path +# %* => time +# %n => username +# %m => shortname host +# %(?..) => prompt conditional - %(condition.true.false) + +# turns seconds into human readable time +# 165392 => 1d 21h 56m 32s +prompt_pure_human_time() { + local tmp=$1 + local days=$(( tmp / 60 / 60 / 24 )) + local hours=$(( tmp / 60 / 60 % 24 )) + local minutes=$(( tmp / 60 % 60 )) + local seconds=$(( tmp % 60 )) + (( $days > 0 )) && echo -n "${days}d " + (( $hours > 0 )) && echo -n "${hours}h " + (( $minutes > 0 )) && echo -n "${minutes}m " + echo "${seconds}s" +} + +is_git_repo() { + command git rev-parse --is-inside-work-tree &>/dev/null + return $? +} + +# fastest possible way to check if repo is dirty +prompt_pure_git_dirty() { + # check if we're in a git repo + is_git_repo || return + # check if it's dirty + [[ "$PURE_GIT_UNTRACKED_DIRTY" == 0 ]] && local umode="-uno" || local umode="-unormal" + command test -n "$(git status --porcelain --ignore-submodules ${umode})" + + (($? == 0)) && echo '*' +} + +prompt_pure_git_wip() { + is_git_repo || return + local subject="$(command git show --pretty=%s --quiet HEAD 2>/dev/null)" + [ "$subject" == 'wip' ] && echo '[WIP]' +} + +# displays the exec time of the last command if set threshold was exceeded +prompt_pure_cmd_exec_time() { + local stop=$EPOCHSECONDS + local start=${cmd_timestamp:-$stop} + integer elapsed=$stop-$start + (($elapsed > ${PURE_CMD_MAX_EXEC_TIME:=5})) && prompt_pure_human_time $elapsed +} + +prompt_pure_preexec() { + cmd_timestamp=$EPOCHSECONDS + + # shows the current dir and executed command in the title when a process is active + print -Pn "\e]0;" + echo -nE "$PWD:t: $2" + print -Pn "\a" +} + +# string length ignoring ansi escapes +prompt_pure_string_length() { + echo ${#${(S%%)1//(\%([KF1]|)\{*\}|\%[Bbkf])}} +} + +prompt_pure_nix_info() { + local packages_info='' + if [[ -z $NIX_SHELL_PACKAGES ]]; then + packages_info='[nix-shell]' + else + packages_info="{ $NIX_SHELL_PACKAGES }" + fi + + case $IN_NIX_SHELL in + 'pure') + echo "$fg_bold[green][nix-shell] " + ;; + 'impure') + echo "$fg_bold[magenta][nix-shell] " + ;; + *) ;; + esac +} + +prompt_pure_precmd() { + # shows the full path in the title + print -Pn '\e]0;%~\a' + + # git info + vcs_info + + local prompt_pure_preprompt="\n$(prompt_pure_nix_info)$fg_bold[green]$prompt_pure_username%F{blue}%~%F{yellow}$vcs_info_msg_0_`prompt_pure_git_dirty` $fg_no_bold[red]`prompt_pure_git_wip`%f %F{yellow}`prompt_pure_cmd_exec_time`%f " + print -P $prompt_pure_preprompt + + # check async if there is anything to pull + # (( ${PURE_GIT_PULL:-1} )) && { + # # check if we're in a git repo + # command git rev-parse --is-inside-work-tree &>/dev/null && + # # make sure working tree is not $HOME + # [[ "$(command git rev-parse --show-toplevel)" != "$HOME" ]] && + # # check check if there is anything to pull + # command git fetch &>/dev/null && + # # check if there is an upstream configured for this branch + # command git rev-parse --abbrev-ref @'{u}' &>/dev/null && { + # local arrows='' + # (( $(command git rev-list --right-only --count HEAD...@'{u}' 2>/dev/null) > 0 )) && arrows='⇣' + # (( $(command git rev-list --left-only --count HEAD...@'{u}' 2>/dev/null) > 0 )) && arrows+='⇡' + # print -Pn "\e7\e[A\e[1G\e[`prompt_pure_string_length $prompt_pure_preprompt`C%F{cyan}${arrows}%f\e8" + # } + # } &! + + # reset value since `preexec` isn't always triggered + unset cmd_timestamp +} + + +prompt_pure_setup() { + # prevent percentage showing up + # if output doesn't end with a newline + export PROMPT_EOL_MARK='' + + prompt_opts=(cr subst percent) + + zmodload zsh/datetime + autoload -Uz add-zsh-hook + autoload -Uz vcs_info + + add-zsh-hook precmd prompt_pure_precmd + add-zsh-hook preexec prompt_pure_preexec + + zstyle ':vcs_info:*' enable git + zstyle ':vcs_info:git*' formats ' %b' + zstyle ':vcs_info:git*' actionformats ' %b|%a' + + # show username@host if logged in through SSH + [[ "$SSH_CONNECTION" != '' ]] && prompt_pure_username='%n@%m ' + + # prompt turns red if the previous command didn't exit with 0 + PROMPT='%(?.%F{green}.%F{red})❯%f ' +} + +prompt_pure_setup "$@" diff --git a/users/grfn/system/home/modules/rtlsdr.nix b/users/grfn/system/home/modules/rtlsdr.nix new file mode 100644 index 000000000000..a1c717617a62 --- /dev/null +++ b/users/grfn/system/home/modules/rtlsdr.nix @@ -0,0 +1,21 @@ +{ config, lib, pkgs, ... }: + +let + + nixpkgs-gnuradio = import (pkgs.fetchFromGitHub { + owner = "doronbehar"; + repo = "nixpkgs"; + rev = "712561aa5f10bfe6112a1726a912585612a70d1f"; + sha256 = "04yqflbwjcfl9vlplphpj82csqqz9k6m3nj1ybhwgmsc4by7vivl"; + }) {}; + +in + +{ + home.packages = with pkgs; [ + rtl-sdr + nixpkgs-gnuradio.gnuradio + nixpkgs-gnuradio.gnuradio.plugins.osmosdr + nixpkgs-gnuradio.gqrx + ]; +} diff --git a/users/grfn/system/home/modules/shell.nix b/users/grfn/system/home/modules/shell.nix new file mode 100644 index 000000000000..088fe9238c69 --- /dev/null +++ b/users/grfn/system/home/modules/shell.nix @@ -0,0 +1,184 @@ +{ config, lib, pkgs, ... }: +let + shellAliases = rec { + # NixOS stuff + hms = "home-manager switch"; + nor = "sudo nixos-rebuild switch"; + nrs = nor; + nrb = "sudo nixos-rebuild boot"; + ncg = "nix-collect-garbage"; + vihome = "vim ~/.config/nixpkgs/home.nix && home-manager switch"; + virc = "vim ~/code/system/home/modules/shell.nix && home-manager switch && source ~/.zshrc"; + visystem = "sudo vim /etc/nixos/configuration.nix && sudo nixos-rebuild switch"; + + # Nix + ns = "nix-shell"; + nb = "nix build -f ."; + nbl = "nix build -f . --builders ''"; # nix build local + lwo = "lorri watch --once"; + + # Docker and friends + "dcu" = "docker-compose up"; + "dcud" = "docker-compose up -d"; + "dc" = "docker-compose"; + "dcr" = "docker-compose restart"; + "dclf" = "docker-compose logs -f"; + "dck" = "docker"; + "dockerclean" = "dockercleancontainers && dockercleanimages"; + "dockercleanimages" = "docker images -a --no-trunc | grep none | awk '{print \$$3}' | xargs -L 1 -r docker rmi"; + "dockercleancontainers" = "docker ps -a --no-trunc| grep 'Exit' | awk '{print \$$1}' | xargs -L 1 -r docker rm"; + + # Directories + stck = "dirs -v"; + b= "cd ~1"; + ".." = "cd .."; + "..." = "cd ../.."; + "...." = "cd ../../.."; + "....." = "cd ../../../.."; + + # Aliases from old config + "http" = "http --style solarized"; + "grep" = "grep $GREP_OPTIONS"; + "bak" = "~/bin/backup.sh"; + "xmm" = "xmodmap ~/.Xmodmap"; + "asdflkj" = "asdf"; + "asdf" = "asdfghjkl"; + "asdfghjkl" = "echo \"Having some trouble?\""; + "ift" = "sudo iftop -i wlp3s0"; + "first" = "awk '{print \$$1}'"; + "cmt" = "git log --oneline | fzf-tmux | awk '{print \$$1}'"; + "workmon" = "xrandr --output DP-2 --pos 1440x900 --primary"; + "vi" = "vim"; + "adbdev" = "adb devices"; + "adbcon" = "adb connect $GNEX_IP"; + "mpalb" = "mpc search album"; + "mpart" = "mpc search artist"; + "mps" = "mpc search"; + "mpa" = "mpc add"; + "mpt" = "mpc toggle"; + "mpl" = "mpc playlist"; + "dsstore" = "find . -name '*.DS_Store' -type f -ls -delete"; + "df" = "df -h"; + "fs" = "stat -f '%z bytes'"; + "ll" = "ls -al"; + "la" = "ls -a"; + }; +in { + home.packages = with pkgs; [ + zsh + autojump + ntfy + ]; + + home.sessionVariables = { + EDITOR = "vim"; + LS_COLORS = "no=00:fi=00:di=01;34:ln=01;36:pi=40;33:so=01;35:do=01;35:bd=40;33;01:cd=40;33;01:or=40;31;01:ex=01;32:*.tar=01;31:*.tgz=01;31:*.arj=01;31:*.taz=01;31:*.lzh=01;31:*.zip=01;31:*.z=01;31:*.Z=01;31:*.gz=01;31:*.bz2=01;31:*.deb=01;31:*.rpm=01;31:*.jar=01;31:*.jpg=01;35:*.jpeg=01;35:*.gif=01;35:*.bmp=01;35:*.pbm=01;35:*.pgm=01;35:*.ppm=01;35:*.tga=01;35:*.xbm=01;35:*.xpm=01;35:*.tif=01;35:*.tiff=01;35:*.png=01;35:*.mov=01;35:*.mpg=01;35:*.mpeg=01;35:*.avi=01;35:*.fli=01;35:*.gl=01;35:*.dl=01;35:*.xcf=01;35:*.xwd=01;35:*.ogg=01;35:*.mp3=01;35:*.wav=01;35:"; + BROWSER = "firefox"; + BAT_THEME = "ansi-light"; + }; + + programs.bash = { + enable = true; + inherit shellAliases; + }; + + programs.zsh = { + enable = true; + enableAutosuggestions = true; + autocd = true; + + inherit shellAliases; + + history = rec { + save = 100000; + size = save; + }; + + oh-my-zsh = { + enable = true; + + plugins = [ + "battery" + "colorize" + "command-not-found" + "github" + "gitignore" + "postgres" + "systemd" + "themes" + "vi-mode" + ]; + + custom = "${pkgs.stdenv.mkDerivation { + name = "oh-my-zsh-custom"; + unpackPhase = ":"; + installPhase = '' + mkdir -p $out/themes + mkdir -p $out/custom/plugins + ln -s ${./pure.zsh-theme} $out/themes/pure.zsh-theme + ''; + }}"; + + theme = "pure"; + }; + + plugins = [{ + name = "pure-theme"; + src = pkgs.fetchFromGitHub { + owner = "sindresorhus"; + repo = "pure"; + rev = "0a92b02dd4172f6c64fdc9b81fe6cd4bddb0a23b"; + sha256 = "0l8jqhmmjn7p32hdjnv121xsjnqd2c0plhzgydv2yzrmqgyvx7cc"; + }; + }]; + + initExtraBeforeCompInit = '' + zstyle ':completion:*' completer _complete _ignored _correct _approximate + zstyle ':completion:*' matcher-list \'\' 'm:{[:lower:]}={[:upper:]} m:{[:lower:][:upper:]}={[:upper:][:lower:]} r:|[._- :]=** r:|=**' 'l:|=* r:|=*' + zstyle ':completion:*' max-errors 5 + zstyle ':completion:*' use-cache yes + zstyle ':completion::complete:grunt::options:' expire 1 + zstyle ':completion:*' prompt '%e errors' + # zstyle :compinstall filename '~/.zshrc' + autoload -Uz compinit + ''; + + initExtra = '' + source ${./zshrc} + source ${pkgs.fetchFromGitHub { + owner = "zsh-users"; + repo = "zsh-syntax-highlighting"; + rev = "7678a8a22780141617f809002eeccf054bf8f448"; + sha256 = "0xh4fbd54kvwwpqvabk8lpw7m80phxdzrd75q3y874jw0xx1a9q6"; + }}/zsh-syntax-highlighting.zsh + source ${pkgs.autojump}/share/autojump/autojump.zsh + source ${pkgs.fetchFromGitHub { + owner = "chisui"; + repo = "zsh-nix-shell"; + rev = "a65382a353eaee5a98f068c330947c032a1263bb"; + sha256 = "0l41ac5b7p8yyjvpfp438kw7zl9dblrpd7icjg1v3ig3xy87zv0n"; + }}/nix-shell.plugin.zsh + + eval "$(${pkgs.ntfy}/bin/ntfy shell-integration)" + + export RPS1="" + autoload -U promptinit; promptinit + prompt pure + + if [[ "$TERM" == "dumb" ]]; then + unsetopt zle + unsetopt prompt_cr + unsetopt prompt_subst + unfunction precmd + unfunction preexec + export PS1='$ ' + fi + ''; + }; + + programs.fzf = { + enable = true; + enableBashIntegration = true; + enableZshIntegration = true; + }; +} diff --git a/users/grfn/system/home/modules/tarsnap.nix b/users/grfn/system/home/modules/tarsnap.nix new file mode 100644 index 000000000000..4bff19910f05 --- /dev/null +++ b/users/grfn/system/home/modules/tarsnap.nix @@ -0,0 +1,64 @@ +{ config, lib, pkgs, ... }: + +{ + home.packages = with pkgs; [ + tarsnap + ]; + + home.file.".tarsnaprc".text = '' + ### Recommended options + + # Tarsnap cache directory + cachedir /home/grfn/.cache/tarsnap + + # Tarsnap key file + keyfile /home/grfn/.private/tarsnap.key + + # Don't archive files which have the nodump flag set. + nodump + + # Print statistics when creating or deleting archives. + print-stats + + # Create a checkpoint once per GB of uploaded data. + checkpoint-bytes 1G + + ### Commonly useful options + + # Use SI prefixes to make numbers printed by --print-stats more readable. + humanize-numbers + + ### Other options, not applicable to most systems + + # Aggressive network behaviour: Use multiple TCP connections when + # writing archives. Use of this option is recommended only in + # cases where TCP congestion control is known to be the limiting + # factor in upload performance. + #aggressive-networking + + # Exclude files and directories matching specified patterns. + # Only one file or directory per command; multiple "exclude" + # commands may be given. + #exclude + + # Include only files and directories matching specified patterns. + # Only one file or directory per command; multiple "include" + # commands may be given. + #include + + # Attempt to reduce tarsnap memory consumption. This option + # will slow down the process of creating archives, but may help + # on systems where the average size of files being backed up is + # less than 1 MB. + #lowmem + + # Try even harder to reduce tarsnap memory consumption. This can + # significantly slow down tarsnap, but reduces its memory usage + # by an additional factor of 2 beyond what the lowmem option does. + #verylowmem + + # Snapshot time. Use this option if you are backing up files + # from a filesystem snapshot rather than from a "live" filesystem. + #snaptime <file> + ''; +} diff --git a/users/grfn/system/home/modules/twitter.nix b/users/grfn/system/home/modules/twitter.nix new file mode 100644 index 000000000000..3cb2e90adc34 --- /dev/null +++ b/users/grfn/system/home/modules/twitter.nix @@ -0,0 +1,23 @@ +{ pkgs, lib, ... }: + +{ + home.packages = with pkgs; [ + t + ]; + + home.sessionVariables = { + TWITTER_WHOAMI = "glittershark1"; + }; + + programs.zsh = { + shellAliases = { + "mytl" = "t tl $TWITTER_WHOAMI"; + }; + + functions = { + favelast = "t fave $(t tl -l $1 | head -n1 | cut -d' ' -f1)"; + rtlast = "t rt $(t tl -l $1 | head -n1 | cut -d' ' -f1)"; + tthread = "t reply $(t tl -l $TWITTER_WHOAMI | head -n1 | cut -d' ' -f1) $@"; + }; + }; +} diff --git a/users/grfn/system/home/modules/vim.nix b/users/grfn/system/home/modules/vim.nix new file mode 100644 index 000000000000..b87cb09ad125 --- /dev/null +++ b/users/grfn/system/home/modules/vim.nix @@ -0,0 +1,48 @@ +{ config, pkgs, ... }: +{ + programs.neovim = { + enable = true; + viAlias = true; + vimAlias = true; + plugins = with pkgs.vimPlugins; [ + ctrlp + deoplete-nvim + syntastic + vim-abolish + vim-airline + vim-airline-themes + vim-bufferline + vim-closetag + # vim-colors-solarized + # solarized + (pkgs.vimUtils.buildVimPlugin { + pname = "vim-colors-solarized"; + version = "git"; + src = pkgs.fetchFromGitHub { + owner = "glittershark"; + repo = "vim-colors-solarized"; + rev = "4857c3221ec3f2693a45855154cb61a2cefb514d"; + sha256 = "0kqp5w14g7adaiinmixm7z3x4w74lv1lcgbqjbirx760f0wivf9y"; + }; + }) + vim-commentary + vim-dispatch + vim-endwise + vim-repeat + vim-fugitive + vim-markdown + vim-nix + vim-rhubarb + vim-sexp + vim-sexp-mappings-for-regular-people + vim-sleuth + vim-startify + vim-surround + vim-unimpaired + vinegar + ]; + extraConfig = '' + source ${./vimrc} + ''; + }; +} diff --git a/users/grfn/system/home/modules/vimrc b/users/grfn/system/home/modules/vimrc new file mode 100644 index 000000000000..3e33b5e2bee7 --- /dev/null +++ b/users/grfn/system/home/modules/vimrc @@ -0,0 +1,1121 @@ +" vim:set fdm=marker fmr={{{,}}} ts=2 sts=2 sw=2 expandtab: + + +" Basic Options {{{ +set nocompatible +set modeline +set modelines=10 +syntax enable +filetype plugin indent on +set ruler +set showcmd +set number +set incsearch +set smartcase +set ignorecase +set scrolloff=10 +set tabstop=4 +set shiftwidth=4 +set softtabstop=4 +set nosmartindent +set expandtab +set noerrorbells visualbell t_vb= +set laststatus=2 +set hidden +let mapleader = ',' +let maplocalleader = '\' +set undofile +" set undodir=~/.vim/undo +set wildignore=*.pyc,*.o,.git +set clipboard=unnamedplus +" set backupdir=$HOME/.vim/backup +" set directory=$HOME/.vim/tmp +set foldmarker={{{,}}} +set colorcolumn=+1 +set concealcursor= +set formatoptions+=j +set wildmenu +set wildmode=longest,list:full +set noincsearch +" }}} + +" GUI options {{{ +set go-=m +set go-=T +set go-=r +set go-=L +set go-=e +set guifont=Meslo\ LG\ S\ DZ\ 9 +" }}} + +" Colors {{{ +" set t_Co=256 + +fu! ReverseBackground() + if &bg=="light" + se bg=dark + else + se bg=light + endif +endf +com! BgToggle call ReverseBackground() +nm <F12> :BgToggle<CR> + +set background=light +colorscheme solarized +" }}} + +" --------------------------------------------------------------------------- + +" CtrlP {{{ +let g:ctrlp_custom_ignore = { + \ 'dir': '(node_modules|target)' + \ } +let g:ctrlp_max_files = 0 +let g:ctrlp_max_depth = 100 +" }}} + +" YouCompleteMe {{{ +let g:ycm_semantic_triggers = { + \ 'c' : ['->', '.'], + \ 'objc' : ['->', '.'], + \ 'ocaml' : ['.', '#'], + \ 'cpp,objcpp' : ['->', '.', '::'], + \ 'perl' : ['->'], + \ 'php' : ['->', '::'], + \ 'cs,java,javascript,d,python,perl6,scala,vb,elixir,go' : ['.'], + \ 'vim' : ['re![_a-zA-Z]+[_\w]*\.'], + \ 'lua' : ['.', ':'], + \ 'erlang' : [':'], + \ 'clojure' : [], + \ 'haskell' : ['re!.*', '.', ' ', '('] + \ } + " \ 'haskell' : ['.', '(', ' '] + " \ 'ruby' : ['.', '::'], + " \ 'clojure' : ['(', '.', '/', '['] +" }}} + +" Neocomplete {{{ +if !has('nvim') + " Use neocomplete. + let g:neocomplete#enable_at_startup = 1 + " Use smartcase. + let g:neocomplete#enable_smart_case = 1 + " Set minimum syntax keyword length. + let g:neocomplete#sources#syntax#min_keyword_length = 3 + let g:neocomplete#lock_buffer_name_pattern = '\*ku\*' + + " Define dictionary. + " let g:neocomplete#sources#dictionary#dictionaries = { + " \ 'default' : '', + " \ 'vimshell' : $HOME.'/.vimshell_hist', + " \ 'scheme' : $HOME.'/.gosh_completions' + " \ } + + " Define keyword. + if !exists('g:neocomplete#keyword_patterns') + let g:neocomplete#keyword_patterns = {} + endif + let g:neocomplete#keyword_patterns['default'] = '\h\w*' + + " Plugin key-mappings. + inoremap <expr><C-g> neocomplete#undo_completion() + inoremap <expr><C-l> neocomplete#complete_common_string() + + " Recommended key-mappings. + " <CR>: close popup and save indent. + inoremap <silent> <CR> <C-r>=<SID>my_cr_function()<CR> + function! s:my_cr_function() + return (pumvisible() ? "\<C-y>" : "" ) . "\<CR>" + " For no inserting <CR> key. + "return pumvisible() ? "\<C-y>" : "\<CR>" + endfunction + " <TAB>: completion. + inoremap <expr><TAB> pumvisible() ? "\<C-n>" : "\<TAB>" + " <C-h>, <BS>: close popup and delete backword char. + inoremap <expr><C-h> neocomplete#smart_close_popup()."\<C-h>" + inoremap <expr><BS> neocomplete#smart_close_popup()."\<C-h>" + " Close popup by <Space>. + "inoremap <expr><Space> pumvisible() ? "\<C-y>" : "\<Space>" + + " AutoComplPop like behavior. + "let g:neocomplete#enable_auto_select = 1 + + " Shell like behavior(not recommended). + "set completeopt+=longest + "let g:neocomplete#enable_auto_select = 1 + "let g:neocomplete#disable_auto_complete = 1 + "inoremap <expr><TAB> pumvisible() ? "\<Down>" : "\<C-x>\<C-u>" + + " Enable omni completion. + " autocmd FileType css setlocal omnifunc=csscomplete#CompleteCSS + " autocmd FileType html,markdown setlocal omnifunc=htmlcomplete#CompleteTags + " autocmd FileType javascript setlocal omnifunc=javascriptcomplete#CompleteJS + " autocmd FileType python setlocal omnifunc=pythoncomplete#Complete + " autocmd FileType xml setlocal omnifunc=xmlcomplete#CompleteTags + + " Enable heavy omni completion. + if !exists('g:neocomplete#sources#omni#input_patterns') + let g:neocomplete#sources#omni#input_patterns = {} + endif +endif +" }}} + +" Deoplete {{{ +if has('nvim') + let g:deoplete#enable_at_startup = 1 + + inoremap <silent> <CR> <C-r>=<SID>my_cr_function()<CR> + function! s:my_cr_function() + return (pumvisible() ? "\<C-y>" : "" ) . "\<CR>" + " For no inserting <CR> key. + "return pumvisible() ? "\<C-y>" : "\<CR>" + endfunction + " <TAB>: completion. + inoremap <expr><TAB> pumvisible() ? "\<C-n>" : "\<TAB>" + inoremap <expr><S-TAB> pumvisible() ? "\<C-p>" : "\<TAB>" +endif +" }}} + +" Neovim Terminal mode {{{ +if has('nvim') + tnoremap <Esc> <C-\><C-n> + nnoremap \\ :tabedit term://zsh<CR> + nnoremap q\ :call <SID>OpenRepl()<CR> + + if !exists('g:repl_size') + let g:repl_size=9 + endif + + function! s:OpenRepl() " {{{ + " Check if buffer exists and is open + if exists('s:repl_bufname') && bufexists(s:repl_bufname) && bufwinnr(s:repl_bufname) >=? 0 + " If so, just switch to it + execute bufwinnr(s:repl_bufname) . 'wincmd' 'w' + norm i + return + endif + + if !exists('b:console') + let b:console=$SHELL + endif + + let l:console_cmd = b:console + + execute 'bot' g:repl_size . 'new' + set winfixheight nobuflisted + call termopen(l:console_cmd) + let s:repl_bufname = bufname('%') + norm i + endfunction " }}} +endif +" }}} + +" Tagbar options {{{ +let g:tagbar_autoclose = 1 +let g:tagbar_autofocus = 1 +let g:tagbar_compact = 1 +" }}} + +" delimitMate options {{{ +let g:delimitMate_expand_cr = 1 +" }}} + +" UltiSnips options {{{ +let g:UltiSnipsExpandTrigger = '<c-j>' + "g:UltiSnipsJumpForwardTrigger <c-j> + "g:UltiSnipsJumpBackwardTrigger <c-k> +" }}} + +" VDebug Options {{{ +let g:vdebug_options = {'server': '192.168.56.1'} +" }}} + +" Statusline {{{ +let g:airline_powerline_fonts=1 + +if !exists('g:airline_symbols') + let g:airline_symbols = {} +endif +let g:airline_symbols.space = "\ua0" + +let g:airline#extensions#tagbar#flags = 'f' +let g:airline#extensions#tabline#enabled = 1 +let g:airline#extensions#tabline#show_buffers = 0 +let g:airline#extensions#tabline#show_tabs = 1 +let g:airline#extensions#tabline#tab_min_count = 2 +let g:airline#extensions#tmuxline#enabled = 0 + +let g:tmuxline_theme = 'airline' +let g:tmuxline_preset = 'full' + +"set statusline= +"set statusline+=%2*[%n%H%M%R%W]%*\ " flags and buf no +"set statusline+=%-40f%<\ " path +"set statusline+=%=%40{fugitive#statusline()}\ " Vim status +"set statusline+=%1*%y%*%*\ " file type +"set statusline+=%10((%l,%c)%)\ " line and column +"set statusline+=%P " percentage of file +" }}} + +" Code review mode {{{ +fun! GetFontName() + return substitute(&guifont, '^\(.\{-}\)[0-9]*$', '\1', '') +endfun + +fun! <SID>CodeReviewMode() + let &guifont = GetFontName() . ' 15' +endfun +com! CodeReviewMode call <SID>CodeReviewMode() +" }}} + +" Syntastic {{{ +let g:syntastic_enable_signs = 0 + +" Python {{{ +let g:syntastic_python_checkers = ['flake8'] +let g:syntastic_python_flake8_post_args = "--ignore=E101,E223,E224,E301,E302,E303,E501,E701,W,F401,E111,E261" + +" }}} +" Javascript {{{ +let g:syntastic_javascript_checkers = ['eslint'] +let g:flow#autoclose = 1 +let g:flow#enable = 1 + +" augroup syntastic_javascript_jsx +" autocmd! +" autocmd BufReadPre,BufNewFile *.js +" autocmd BufReadPre,BufNewFile *.jsx +" \ let g:syntastic_javascript_checkers = ['jsxhint'] +" augroup END + +" }}} +" Haml {{{ +let g:syntastic_haml_checkers = ['haml_lint'] + +" }}} +" Html {{{ +let g:syntastic_html_checkers = [] + +" }}} +" Ruby {{{ +let g:syntastic_ruby_checkers = ['rubocop'] +" }}} +" SASS/SCSS {{{ +let g:syntastic_scss_checkers = ['scss_lint'] +" }}} +" Haskell {{{ +" let g:syntastic_haskell_checkers = ['ghc-mod'] +" }}} +" Elixir {{{ +let g:syntastic_elixir_checkers = ['elixir'] +let g:syntastic_enable_elixir_checker = 1 +" }}} +" }}} + +" Bufferline {{{ +let g:bufferline_echo=0 +" }}} + +" Eclim {{{ +let g:EclimCompletionMethod = 'omnifunc' +augroup eclim + au! + au FileType java call <SID>JavaSetup() + au FileType java set textwidth=120 +augroup END + +function! s:JavaSetup() abort + noremap <C-I> :JavaImport<CR> + nnoremap K :JavaDocPreview<CR> + nnoremap ]d :JavaSearchContext<CR> + nnoremap [d :JavaSearchContext<CR> + nnoremap g<CR> :JUnit<CR> + nnoremap g\ :Mvn test<CR> +endfunction +" }}} + +" Signify options {{{ +let g:signify_mapping_next_hunk = ']h' +let g:signify_mapping_prev_hunk = '[h' +let g:signify_vcs_list = ['git'] +let g:signify_sign_change = '~' +let g:signify_sign_delete = '-' +" }}} + +" Simplenote {{{ +let g:SimplenoteFiletype = 'markdown' +let g:SimplenoteSortOrder = 'pinned,modifydate,tagged,createdate' +let g:SimplenoteVertical = 1 + +nnoremap <Leader>nn :Simplenote -n<CR> +nnoremap <Leader>nl :Simplenote -l<CR> +nnoremap <Leader>nw :Simplenote -l work<CR> +nnoremap <Leader>nt :Simplenote -t<CR> +" }}} + +" Emmet {{{ +" Expand abbreviation +let g:user_emmet_leader_key = '<C-y>' +" }}} + +" Startify {{{ +let g:startify_bookmarks=[ '~/.vimrc', '~/.zshrc' ] +" }}} + +" Abolish {{{ +let g:abolish_save_file = expand('~/.vim/after/plugin/abolish.vim') +" }}} + +" Rails projections {{{ + +if !exists('g:rails_projections') + let g:rails_projections = {} +endif + +call extend(g:rails_projections, { + \ "config/routes.rb": { "command": "routes" }, + \ "config/structure.sql": { "command": "structure" } + \ }, 'keep') + +if !exists('g:rails_gem_projections') + let g:rails_gem_projections = {} +endif + +call extend(g:rails_gem_projections, { + \ "active_model_serializers": { + \ "app/serializers/*_serializer.rb": { + \ "command": "serializer", + \ "template": "class %SSerializer < ActiveModel::Serializer\nend", + \ "affinity": "model"}}, + \ "react-rails": { + \ "app/assets/javascripts/components/*.jsx": { + \ "command": "component", + \ "template": "var %S = window.%S = React.createClass({\n render: function() {\n }\n});", + \ "alternate": "spec/javascripts/components/%s_spec.jsx" }, + \ "spec/javascripts/components/*_spec.jsx": { + \ "alternate": "app/assets/javascripts/components/{}.jsx" }}, + \ "rspec": { + \ "spec/**/support/*.rb": { + \ "command": "support"}}, + \ "cucumber": { + \ "features/*.feature": { + \ "command": "feature", + \ "template": "Feature: %h"}, + \ "features/support/*.rb": { + \ "command": "support"}, + \ "features/support/env.rb": { + \ "command": "support"}, + \ "features/step_definitions/*_steps.rb": { + \ "command": "steps"}}, + \ "carrierwave": { + \ "app/uploaders/*_uploader.rb": { + \ "command": "uploader", + \ "template": "class %SUploader < CarrierWave::Uploader::Base\nend"}}, + \ "draper": { + \ "app/decorators/*_decorator.rb": { + \ "command": "decorator", + \ "affinity": "model", + \ "template": "class %SDecorator < Draper::Decorator\nend"}}, + \ "fabrication": { + \ "spec/fabricators/*_fabricator.rb": { + \ "command": ["fabricator", "factory"], + \ "alternate": "app/models/%s.rb", + \ "related": "db/schema.rb#%p", + \ "test": "spec/models/%s_spec.rb", + \ "template": "Fabricator :%s do\nend", + \ "affinity": "model"}}, + \ "factory_girl": { + \ "spec/factories/*.rb": { + \ "command": "factory", + \ "alternate": "app/models/%i.rb", + \ "related": "db/structure.sql#%s", + \ "test": "spec/models/%s_spec.rb", + \ "template": "FactoryGirl.define do\n factory :%i do\n end\nend", + \ "affinity": "model"}, + \ "spec/factories.rb": { + \ "command": "factory"}, + \ "test/factories.rb": { + \ "command": "factory"}} + \ }, 'keep') +" }}} + +" Other projections {{{ +let g:projectionist_heuristics = { + \ "config.ru&docker-compose.yml&app/&config/&OWNERS": { + \ "app/jobs/*.rb": { + \ "type": "job", + \ "alternate": "spec/jobs/{}_spec.rb" + \ }, + \ "app/models/*.rb": { + \ "type": "model", + \ "alternate": "spec/models/{}_spec.rb" + \ }, + \ "app/resources/*_resource.rb": { + \ "type": "resource", + \ "alternate": "spec/resources/{}_resource_spec.rb" + \ }, + \ "config/*.yml": { + \ "type": "config" + \ }, + \ "spec/*_spec.rb": { + \ "type": "spec", + \ "alternate": "app/{}.rb" + \ }, + \ "spec/factories/*.rb": { + \ "type": "factory", + \ } + \ }, + \ "svc-gateway.cabal": { + \ "src/*.hs": { + \ "type": "src", + \ "alternate": "test/{}Spec.hs" + \ }, + \ "test/*Spec.hs": { + \ "type": "spec", + \ "alternate": "src/{}.hs", + \ "template": [ + \ "module Gateway.Resource.HierarchySpec (main, spec) where", + \ "", + \ "import Prelude", + \ "import Test.Hspec", + \ "import Data.Aeson", + \ "", + \ "import Gateway.Resource.Hierarchy", + \ "", + \ "main :: IO ()", + \ "main = hspec spec", + \ "", + \ "spec :: Spec", + \ "spec = do", + \ " describe \"something\" $ undefined" + \ ] + \ }, + \ "svc-gateway.cabal": { + \ "type": "cabal" + \ } + \ }, + \ "package.json&.flowconfig": { + \ "src/*.*": { + \ "type": "src", + \ "alternate": "test/{}_spec.js" + \ } + \ }, + \ "pom.xml&src/main/clj/|src/main/cljs": { + \ "*": { + \ "start": "USE_NREPL=1 bin/run -m elephant.dev-system" , + \ "connect": "nrepl://localhost:5554", + \ "piggieback": "(figwheel-sidecar.repl-api/repl-env)" + \ }, + \ "pom.xml": { "type": "pom" }, + \ "src/main/clj/*.clj": { + \ "alternate": "src/test/clj/{}_test.clj", + \ "template": ["(ns {dot|hyphenate})"] + \ }, + \ "src/test/clj/*_test.clj": { + \ "alternate": "src/main/clj/{}.clj", + \ "dispatch": ":RunTests {dot|hyphenate}-test", + \ "template": ["(ns {dot|hyphenate}-test", + \ " (:require [clojure.test :refer :all]))"] + \ }, + \ "src/main/cljs/*.cljs": { + \ "alternate": "src/test/cljs/{}_test.cljs" + \ }, + \ "src/main/cljs/*_test.cljs": { + \ "alternate": "src/main/cljs/{}.cljs", + \ "dispatch": ":RunTests {dot|hyphenate}-test" + \ }, + \ "src/main/clj/*.cljc": { + \ "alternate": "src/test/clj/{}_test.cljc" + \ }, + \ "src/main/clj/*_test.cljc": { + \ "alternate": "src/test/clj/{}.cljc", + \ "dispatch": ":RunTests {dot|hyphenate}-test" + \ } + \ }} +" }}} + +" AutoPairs {{{ +let g:AutoPairsCenterLine = 0 +" }}} + +" Filetypes {{{ + +" Python {{{ +aug Python + au! + au FileType python set tabstop=4 shiftwidth=4 softtabstop=4 expandtab +aug END +let g:python_highlight_all=1 +" }}} + +" PHP {{{ +aug PHP + au! + "au FileType php setlocal fdm=marker fmr={{{,}}} +aug END " }}} + +" Mail {{{ +aug Mail + au FileType mail setlocal spell +aug END " }}} + +" Haskell {{{ +let g:haskell_conceal_wide = 1 +let g:haskellmode_completion_ghc = 0 +let g:necoghc_enable_detailed_browse = 1 + +augroup Haskell + autocmd! + autocmd FileType haskell setlocal textwidth=110 shiftwidth=2 + autocmd FileType haskell setlocal omnifunc=necoghc#omnifunc + autocmd FileType haskell call <SID>HaskellSetup() + autocmd FileType haskell setlocal keywordprg=hoogle\ -cie +augroup END + +function! s:HaskellSetup() + set sw=4 + " compiler cabal + " let b:start='cabal run' + " let b:console='cabal repl' + " let b:dispatch='cabal test' + compiler stack + let b:start='stack run' + let b:console='stack ghci' + let b:dispatch='stack test' + nnoremap <buffer> gy :HdevtoolsType<CR> + nnoremap <buffer> yu :HdevtoolsClear<CR> +endfunction +" }}} + +" Ruby {{{ + +function! s:RSpecSyntax() + syn keyword rspecMethod describe context it its specify shared_context + \ shared_examples shared_examples_for shared_context include_examples + \ include_context it_should_behave_like it_behaves_like before after + \ around fixtures controller_name helper_name scenario feature + \ background given described_class + syn match rspecMethod '\<let\>!\=' + syn match rspecMethod '\<subject\>!\=' + syn keyword rspecMethod violated pending expect expect_any_instance_of allow + \ allow_any_instance_of double instance_double mock mock_model + \ stub_model xit + syn match rspecMethod '\.\@<!\<stub\>!\@!' + + call s:RSpecHiDefaults() +endfunction + +function! s:RSpecHiDefaults() + hi def link rspecMethod rubyFunction +endfunction + +augroup Ruby + au! + " au FileType ruby let b:surround_114 = "\\(module|class,def,if,unless,case,while,until,begin,do) \r end" + " au FileType ruby set fdm=syntax + au FileType ruby set tw=110 + au FileType ruby set omnifunc= + au FileType ruby nnoremap <buffer> gy orequire 'pry'; binding.pry<ESC>^ + au FileType ruby nnoremap <buffer> gY Orequire 'pry'; binding.pry<ESC>^ + au FileType ruby nnoremap <buffer> yu :g/require 'pry'; binding.pry/d<CR> + au BufNewFile,BufRead *_spec.rb call <SID>RSpecSyntax() +augroup END + +let ruby_operators = 1 +let ruby_space_errors = 1 + +let g:rubycomplete_rails = 1 +command! -range ConvertHashSyntax <line1>,<line2>s/:(\S{-})(\s{-})=> /\1:\2/ +" }}} + +" Clojure {{{ + +aug Clojure + au! + autocmd FileType clojure nnoremap <C-S> :Slamhound<CR> + autocmd FileType clojure nnoremap <silent> gr :w <bar> Require <bar> e<CR> + let g:clojure_align_multiline_strings = 1 + let g:clojure_fuzzy_indent_patterns = + \ ['^with', '^def', '^let', '^fact'] + let g:clojure_special_indent_words = + \ 'deftype,defrecord,reify,proxy,extend-type,extend-protocol,letfn,html' + + autocmd FileType clojure setlocal textwidth=80 + autocmd FileType clojure setlocal lispwords+=GET,POST,PATCH,PUT,DELETE | + \ setlocal lispwords+=context,select + autocmd BufNewFile,BufReadPost *.cljx setfiletype clojure + autocmd BufNewFile,BufReadPost *.cljx setlocal omnifunc= + autocmd BufNewFile,BufReadPost *.cljs setlocal omnifunc= + autocmd FileType clojure call <SID>TangentInit() + autocmd FileType clojure call <SID>sexp_mappings() + autocmd BufRead *.cljc ClojureHighlightReferences + autocmd FileType clojure let b:AutoPairs = { + \ '"': '"', + \ '{': '}', + \ '(': ')', + \ '[': ']'} + " Don't auto-pair quote reader macros + " \'`': '`', + " \ '''': '''', + + autocmd User ProjectionistActivate call s:projectionist_connect() + + function! s:projectionist_connect() abort + let connected = !empty(fireplace#path()) + if !connected + for [root, value] in projectionist#query('connect') + try + silent execute "FireplaceConnect" value root + let connected = 1 + break + catch /.*Connection refused.*/ + endtry + endfor + endif + + " if connected && exists(':Piggieback') + " for [root, value] in projectionist#query('piggieback') + " silent execute "Piggieback" value + " break + " endfor + " endif + endfunction + + " autocmd BufNewFile,BufReadPost *.cljx setlocal omnifunc= + " autocmd BufNewFile,BufReadPost *.cljs setlocal omnifunc= + + autocmd FileType clojure let b:console='lein repl' + autocmd FileType clojure call <SID>ClojureMaps() + + function! s:ClojureMaps() abort + nnoremap <silent> <buffer> [m :call search('^(def', 'Wzb')<CR> + nnoremap <silent> <buffer> ]m :call search('^(def', 'Wz')<CR> + endfunction + + command! Scratch call <SID>OpenScratch() + autocmd FileType clojure nnoremap <buffer> \s :Scratch<CR> + + let g:scratch_buffer_name = 'SCRATCH' + + function! s:OpenScratch() + if bufwinnr(g:scratch_buffer_name) > 0 + execute bufwinnr(g:scratch_buffer_name) . 'wincmd' 'w' + return + endif + + vsplit SCRATCH + set buftype=nofile + set filetype=clojure + let b:scratch = 1 + endfunction +aug END + +function! s:sexp_mappings() abort + if !exists('g:sexp_loaded') + return + endif + + nmap <buffer> cfo <Plug>(sexp_raise_list) + nmap <buffer> cfO <Plug>(sexp_raise_element) + nmap <buffer> cfe <Plug>(sexp_raise_element) +endfunction + +function! s:TangentInit() abort + set textwidth=80 + command! TReset call fireplace#session_eval('(user/reset)') + command! TGo call fireplace#session_eval('(user/go)') + command! TMigrate call fireplace#session_eval('(user/migrate)') + command! TRollback call fireplace#session_eval('(user/rollback)') + nnoremap g\ :TReset<CR> +endfunction + +" }}} + +" Go {{{ + +let g:go_highlight_functions = 1 +let g:go_highlight_methods = 1 +let g:go_highlight_structs = 1 +let g:go_highlight_operators = 1 +let g:go_highlight_build_constraints = 1 + +augroup Go + autocmd! + autocmd FileType go setlocal omnifunc=go#complete#Complete + autocmd FileType go setlocal foldmethod=syntax + autocmd FileType go setlocal foldlevel=100 + autocmd FileType go nnoremap <buffer> <F9> :GoTest<CR> + autocmd FileType go inoremap <buffer> <F9> <ESC>:GoTest<CR>i +augroup END + +" }}} + +" RAML {{{ + +function! s:buffer_syntax() " {{{ + syn keyword ramlRAML RAML contained + syn match ramlVersionString '^#%RAML \d\.\d' contains=ramlRAML +endfunction " }}} + +augroup RAML + autocmd! + autocmd BufRead,BufNewFile *.raml set filetype=yaml + autocmd BufRead,BufNewFile *.raml call s:buffer_syntax() +augroup END + +hi def link ramlVersionString Special +hi def link ramlRAML Error +" }}} + +" Mustache/Handlebars {{{ +let g:mustache_abbreviations = 1 +" }}} + +" Netrw {{{ +augroup netrw + autocmd! + autocmd FileType netrw nnoremap <buffer> Q :Rexplore<CR> + + " Hee hee, oil and vinegar + function! s:setup_oil() abort + nnoremap <buffer> q <C-6> + xnoremap <buffer> q <C-6> + endfunction +augroup END +" }}} +" }}} + +" Remove trailing whitespace {{{ +fun! <SID>StripTrailingWhitespaces() + let l = line(".") + let c = col(".") + %s/\s\+$//e + call cursor(l, c) +endfun + +augroup striptrailingwhitespaces " {{{ +autocmd FileType c,cpp,java,php,ruby,python,sql,javascript,sh,jst,less,haskell,haml,coffee,scss,clojure,objc,elixir,yaml,json,eruby + \ autocmd BufWritePre <buffer> :call <SID>StripTrailingWhitespaces() +augroup END " }}} + +" }}} + +" Goyo {{{ +let g:limelight_conceal_ctermfg = "10" +let g:limelight_conceal_guifg = "#586e75" +autocmd! User GoyoEnter Limelight +autocmd! User GoyoLeave Limelight! +" }}} + +"----------------------------------------------------------------------------- + +" Commands {{{ + +" Edit temporary SQL files {{{ +let s:curr_sql = 0 +fun! <SID>EditSqlTempFile() + let l:fname = '/tmp/q' . s:curr_sql . '.sql' + execute 'edit' l:fname + let s:curr_sql = s:curr_sql + 1 +endfun +com! EditSqlTempFile call <SID>EditSqlTempFile() +" }}} + +" Double Indentation +command! -range DoubleIndentation <line1>,<line2>s/^\(\s.\{-}\)\(\S\)/\1\1\2/ + +" Quick-and-dirty fix capitalization of sql files +command! -range FixSqlCapitalization <line1>,<line2>v/\v(^\s*--.*$)|(TG_)/norm guu + +" VimPipe Commands {{{ +" let g:sql_type_default = 'pgsql' +command! SqlLive let b:vimpipe_command="vagrant ssh -c '~/mysql'" +command! SqlRails let b:vimpipe_command="bin/rails dbconsole" +command! SqlHeroku let b:vimpipe_command="heroku pg:psql" +command! SqlEntities let b:vimpipe_command="psql -h 127.1 entities nomi" +command! SqlUsers let b:vimpipe_command="psql -h 127.1 users nomi" +command! SqlTangent let b:vimpipe_command="psql -h local.docker tangent super" +" }}} + +" Git commands {{{ +command! -nargs=* Gpf Gpush -f <args> +command! -nargs=* Gcv Gcommit --verbose <args> +" }}} + +" Focus dispatch to only the last failures +command! -nargs=* FocusFailures FocusDispatch rspec --only-failures <args> + +" }}} + +" Autocommands {{{ + +augroup fugitive " {{{ + au! + autocmd BufNewFile,BufRead fugitive://* set bufhidden=delete +augroup END " }}} + +augroup omni " {{{ + au! + " autocmd FileType javascript setlocal omnifunc=tern#Complete + "autocmd FileType python setlocal omnifunc=pythoncomplete#Complete + autocmd FileType php setlocal omnifunc= +augroup END " }}} + +augroup sql " {{{ + au! + autocmd FileType sql let b:vimpipe_command="psql -h 127.0.0.1 landlordsny_development landlordsny" + autocmd FileType sql let b:vimpipe_filetype="postgresql" + autocmd FileType sql set syntax=postgresql + autocmd FileType postgresql set nowrap + autocmd BufNewFile,BufReadPost *.sql set syntax=pgsql +augroup END " }}} + +augroup markdown " {{{ + au! + autocmd FileType markdown let b:vimpipe_command='markdown' + autocmd FileType markdown let b:vimpipe_filetype='html' + autocmd FileType markdown set tw=80 +augroup END " }}} + +augroup typescript " {{{ + au! + autocmd FileType typescript let b:vimpipe_command='tsc' + autocmd FileType typescript let b:vimpipe_filetype='javascript' + autocmd FileType typescript TSSstarthere + autocmd FileType typescript nnoremap <buffer> gd :TSSdef<CR> +augroup END " }}} + +augroup jsx " {{{ + au! + " autocmd FileType jsx set syntax=javascript + autocmd FileType javascript set filetype=javascript.jsx +augroup END " }}} + +augroup nicefoldmethod " {{{ + au! + " Don't screw up folds when inserting text that might affect them, until + " leaving insert mode. Foldmethod is local to the window. Protect against + " screwing up folding when switching between windows. + autocmd InsertEnter * + \ if !exists('w:last_fdm') | + \ let w:last_fdm=&foldmethod | + \ setlocal foldmethod=manual | + \ endif + autocmd InsertLeave,WinLeave * + \ if exists('w:last_fdm') | + \ let &l:foldmethod=w:last_fdm | + \ unlet w:last_fdm | + \ endif +augroup END " }}} + +augroup visualbell " {{{ + au! + autocmd GUIEnter * set visualbell t_vb= +augroup END +" }}} + +augroup quickfix " {{{ + au! + autocmd QuickFixCmdPost grep cwindow +augroup END " }}} + +augroup php " {{{ + au! +augroup END "}}} + +augroup rubylang " {{{ + au! + autocmd FileType ruby compiler rake +augroup END " }}} + +augroup javascript "{{{ + au! + autocmd FileType javascript let &errorformat = + \ '%E%.%#%n) %s:,' . + \ '%C%.%#Error: %m,' . + \ '%C%.%#at %s (%f:%l:%c),' . + \ '%Z%.%#at %s (%f:%l:%c),' . + \ '%-G%.%#,' +augroup END " }}} + +augroup git " {{{ + autocmd! + autocmd FileType gitcommit set textwidth=72 +augroup END +" }}} +" }}} + +" Leader commands {{{ + +" Edit specific files {{{ +nnoremap <silent> <leader>ev :split $MYVIMRC<CR> +nnoremap <silent> <leader>eb :split ~/.vim_bundles<CR> +nnoremap <silent> <leader>es :UltiSnipsEdit<CR> +nnoremap <silent> <leader>ea :split ~/.vim/after/plugin/abolish.vim<CR> + +nnoremap <silent> <leader>sv :so $MYVIMRC<CR> +nnoremap <silent> <leader>sb :so ~/.vim_bundles<CR> +nnoremap <silent> <leader>sa :so ~/.vim/after/plugin/abolish.vim<CR> + +nnoremap <Leader>el :EditSqlTempFile<CR> +" }}} + +" Toggle navigation panels {{{ +nnoremap <Leader>l :TagbarToggle<CR> +nnoremap <Leader>mb :MBEToggle<CR> +nnoremap <Leader>u :GundoToggle<CR> + +nnoremap <Leader>t :CtrlP<CR> +nnoremap <Leader>z :FZF<CR> +nnoremap <Leader>b :CtrlPBuffer<CR> +nnoremap <Leader>a :CtrlPTag<CR> +nnoremap <Leader>r :CtrlPGitBranch<CR> +" }}} + +" CtrlP {{{ +let g:ctrlp_custom_ignore = { + \ 'dir': 'node_modules', + \ } +" }}} + +" Git leader commands {{{ +noremap <Leader>g :Git<SPACE> +noremap <Leader>gu :Gpull<CR> +noremap <Leader>gp :Gpush<CR> +noremap <Leader>s :Gstatus<CR> +noremap <Leader>cv :Gcommit --verbose<CR> +noremap <Leader>ca :Gcommit --verbose --amend<CR> + +nnoremap <Leader>dl :diffg LOCAL<CR> +nnoremap <Leader>dr :diffg REMOTE<CR> +nnoremap <Leader>db :diffg BASE<CR> +nnoremap <Leader>du :diffu<CR> +nnoremap <Leader>dg :diffg<CR> + +nnoremap <Leader>d2 :diffg //2<CR>:diffu<CR> +nnoremap <Leader>d3 :diffg //3<CR>:diffu<CR> + +nnoremap <Leader>yt :SignifyToggle<CR> +" }}} + +" Breakpoint Leader Commands {{{ +nnoremap <Leader>x :Breakpoint<CR> +nnoremap <Leader>dx :BreakpointRemove *<CR> +" }}} + +" Tabularize {{{ + " Leader Commands {{{ + nnoremap <localleader>t= :Tabularize /=<CR> + vmap <localleader>t= :Tabularize /=<CR> + + nnoremap <localleader>t> :Tabularize /=><CR> + vmap <localleader>t> :Tabularize /=><CR> + " }}} + + " => Aligning {{{ + function! s:rocketalign() + let l:p = '^.*=>\s.*$' + echo l:p + if exists(':Tabularize') && getline('.') =~# '^.*=' && + \ (getline(line('.')-1) =~# l:p || getline(line('.')+1) =~# l:p) + let column = strlen(substitute(getline('.')[0:col('.')],'[^=>]','','g')) + let position = strlen(matchstr(getline('.')[0:col('.')],'.*=>\s*\zs.*')) + Tabularize/=>/l1 + normal! $ + call search(repeat('[^=>]*=>',column).'\s\{-\}'.repeat('.',position),'ce',line('.')) + endif + endfunction + "inoremap <buffer> <space>=><space> =><Esc>:call <SID>rocketalign()<CR>a + " }}} + + " = Aligning {{{ + function! s:eqalign() + let l:p = '^.*=\s.*$' + if exists(':Tabularize') && getline('.') =~# '^.*=' && + \ (getline(line('.')-1) =~# l:p || getline(line('.')+1) =~# l:p) + let column = strlen(substitute(getline('.')[0:col('.')],'[^=]','','g')) + let position = strlen(matchstr(getline('.')[0:col('.')],'.*=\s*\zs.*')) + Tabularize/=/l1 + normal! $ + call search(repeat('[^=]*=',column).'\s\{-\}'.repeat('.',position),'ce',line('.')) + endif + endfunction + "inoremap <buffer><silent> <space>=<space> =<Esc>:call <SID>eqalign()<CR>a + " }}} + + " : Aligning {{{ + function! s:colonalign() + let l:p : '^.*:\s.*$' + if exists(':Tabularize') && getline('.') :~# '^.*:' && + \ (getline(line('.')-1) :~# l:p || getline(line('.')+1) :~# l:p) + let column : strlen(substitute(getline('.')[0:col('.')],'[^:]','','g')) + let position : strlen(matchstr(getline('.')[0:col('.')],'.*:\s*\zs.*')) + Tabularize/:/l1 + normal! $ + call search(repeat('[^:]*:',column).'\s\{-\}'.repeat('.',position),'ce',line('.')) + endif + endfunction + "inoremap <buffer><silent> <space>:<space> :<Esc>:call <SID>colonalign()<CR>a + " }}} +" }}} + +" }}} + +" Mappings {{{ +" 'delete current' +nnoremap dc 0d$ +nnoremap com :silent !tmux set status<CR> +nnoremap <F9> :Make<CR> +nnoremap g<CR> :Dispatch<CR> +nnoremap g\ :Start<CR> +inoremap <F9> <ESC>:Make<CR>i + +" Navigate buffers {{{ +nnoremap gb :bn<CR> +nnoremap gB :bp<CR> +" }}} + +" Window Navigation {{{ +nnoremap <space>w <C-w> +nnoremap <space>h <C-w>h +nnoremap <space>j <C-w>j +nnoremap <space>k <C-w>k +nnoremap <space>l <C-w>l +nnoremap <space>z <C-w>z +" }}} + + +" Sort with motion {{{ +if !exists("g:sort_motion_flags") + let g:sort_motion_flags = "" +endif +function! s:sort_motion(mode) abort + if a:mode == 'line' + execute "'[,']sort " . g:sort_motion_flags + elseif a:mode == 'char' + execute "normal! `[v`]y" + let sorted = join(sort(split(@@, ', ')), ', ') + execute "normal! v`]c" . sorted + elseif a:mode == 'V' || a:mode == '' + execute "'<,'>sort " . g:sort_motion_flags + endif +endfunction + +function! s:sort_lines() + let beginning = line('.') + let end = v:count + beginning - 1 + execute beginning . ',' . end . 'sort' +endfunction + +xnoremap <silent> <Plug>SortMotionVisual :<C-U>call <SID>sort_motion(visualmode())<CR> +nnoremap <silent> <Plug>SortMotion :<C-U>set opfunc=<SID>sort_motion<CR>g@ +nnoremap <silent> <Plug>SortLines :<C-U>call <SID>sort_lines()<CR> + +map go <Plug>SortMotion +vmap go <Plug>SortMotionVisual +map goo <Plug>SortLines +" }}} +" }}} + +let g:hare_executable = 'cabal exec -- ghc-hare' diff --git a/users/grfn/system/home/modules/zshrc b/users/grfn/system/home/modules/zshrc new file mode 100644 index 000000000000..a12173d6842d --- /dev/null +++ b/users/grfn/system/home/modules/zshrc @@ -0,0 +1,327 @@ +#!/usr/bin/zsh +# vim: set fdm=marker fmr={{{,}}}: + +stty -ixon + +# Compinstall {{{ +zstyle ':completion:*' completer _complete _ignored _correct _approximate +zstyle ':completion:*' matcher-list '' 'm:{[:lower:]}={[:upper:]} m:{[:lower:][:upper:]}={[:upper:][:lower:]} r:|[._- :]=** r:|=**' 'l:|=* r:|=*' +zstyle ':completion:*' max-errors 5 +zstyle ':completion:*' use-cache yes +zstyle ':completion::complete:grunt::options:' expire 1 +zstyle ':completion:*' prompt '%e errors' +zstyle :compinstall filename '~/.zshrc' +autoload -Uz compinit +compinit +# }}} + +# Zsh-newuser-install {{{ +HISTFILE=~/.histfile +HISTSIZE=1000 +SAVEHIST=1000 +setopt appendhistory autocd extendedglob notify autopushd +unsetopt beep nomatch +bindkey -v +# }}} + +# Basic options {{{ +set -o vi +umask 022 +export VIRTUAL_ENV_DISABLE_PROMPT=1 +# export PATH=~/.local/bin:~/.cabal/bin:$PATH:~/code/go/bin:~/bin:~/npm/bin:~/.gem/ruby/2.1.0/bin:~/.gem/ruby/2.0.0/bin:/home/smith/bin +# }}} + +# Zsh highlight highlighters {{{ +ZSH_HIGHLIGHT_HIGHLIGHTERS=(main brackets pattern root) +# }}} + +# More basic options {{{ +setopt no_hist_verify +setopt histignorespace +# }}} + +# Utility Functions {{{ + +# Set the terminal's title bar. +function titlebar() { +echo -ne "\033]0;$*\007" +} + +function quiet() { +"$@" >/dev/null +} + +function quieter() { +"$@" >/dev/null 2>&1 +} + +# From http://stackoverflow.com/questions/370047/#370255 +function path_remove() { +IFS=: +# convert it to an array +t=($PATH) +unset IFS +# perform any array operations to remove elements from the array +t=(${t[@]%%$1}) +IFS=: +# output the new array +echo "${t[*]}" +} + +# }}} + +# Force screen to use zsh {{{ +# }}} + +# Environment {{{ +# }}} + +# Directory Stuff {{{ + +# Always use color output for `ls` + +# Directory listing + +# Easier navigation: .., ..., - + +# File size + +# Recursively delete `.DS_Store` files + +# Create a new directory and enter it +function md() { + mkdir -p "$@" && cd "$@" +} + +# }}} + +# MPD/MPC stuff {{{ +function mp() { +# Test if drive is already mounted +if ! lsblk | grep /media/external >/dev/null; then + if ! sudo mount /media/external; then + echo "External drive not plugged in, or could not mount" + return 1 + fi +fi +if (mpc >/dev/null 2>&1); then + ncmpcpp +else + mpd && + (pgrep mpdscribble || mpdscribble) && + ncmpcpp +fi +} + +# kill mp +function kmp() { +killall ncmpcpp +mpd --kill + +local files + +if (files=$(lsof 2>&1 | grep -v docker | grep external)); then + echo + echo "==> Still processes using external drive:" + echo + echo $files +else + sudo umount /media/external +fi +} + + +function mppal() { +mpc search album "$1" | mpc add && + mpc play; +} +# }}} + +# Git stuff {{{ +# function ga() { git add "${@:-.}"; } # Add all files by default +# Add non-whitespace changes +# function gc() { git checkout "${@:-master}"; } # Checkout master by default + +# open all changed files (that still actually exist) in the editor +function ged() { +local files=() +for f in $(git diff --name-only "$@"); do + [[ -e "$f" ]] && files=("${files[@]}" "$f") +done +local n=${#files[@]} +echo "Opening $n $([[ "$@" ]] || echo "modified ")file$([[ $n != 1 ]] && \ + echo s)${@:+ modified in }$@" +q "${files[@]}" +} + +# git find-replace +function gfr() { +if [[ "$#" == "0" ]]; then + echo 'Usage:' + echo ' gg_replace term replacement file_mask' + echo + echo 'Example:' + echo ' gg_replace cappuchino cappuccino *.html' + echo +else + find=$1; shift + replace=$1; shift + + ORIG_GLOBIGNORE=$GLOBIGNORE + GLOBIGNORE=*.* + if [[ "$#" = "0" ]]; then + set -- ' ' $@ + fi + + while [[ "$#" -gt "0" ]]; do + for file in `git grep -l $find -- $1`; do + sed -e "s/$find/$replace/g" -i'' $file + done + shift + done + + GLOBIGNORE=$ORIG_GLOBIGNORE +fi +} + +function vconflicts() { +$EDITOR $(git status --porcelain | awk '/^UU/ { print $2 }') +} +# }}} + +# fzf {{{ +v() { + local file + file=$(fzf-tmux --query="$1" --select-1 --exit-0) + [ -n "$file" ] && ${EDITOR:-vim} "$file" +} + +c() { + local dir + dir=$(find ${1:-*} -path '*/\.*' -prune -o -type d -print 2> /dev/null | fzf +m) && cd "$dir" +} + +co() { + local branch + branch=$(git branch -a | sed -s "s/\s*\**//g" | fzf --query="$1" --select-1 --exit-0) && git checkout "$branch" +} + + +# fh - repeat history +# h() { +# eval $(([ -n "$ZSH_NAME" ] && fc -l 1 || history) | fzf +s | sed 's/ *[0-9]* *//') +# } + +# fkill - kill process +fkill() { + ps -ef | sed 1d | fzf-tmux -m | awk '{print $2}' | xargs kill -${1:-9} +} +# }}} + +# Tmux utils {{{ +kill_detached() { + for sess in $(tmux ls | grep -v attached | sed -s "s/:.*$//"); do + tmux kill-session -t $sess; + done +} +# }}} + +# Docker {{{ + + +# dbp foo/bar . +function dbp () { + docker build -t $1 ${@:2} && docker push $1 +} + +# }}} + +# Twitter! {{{ + + +# favelast <username> +function favelast() { + t fave $(t tl -l $1 | head -n1 | first) +} + +function rtlast() { + t rt $(t tl -l $1 | head -n1 | first) +} + +function tthread() { + t reply $(t tl -l $TWITTER_WHOAMI | head -n1 | first) $@ +} +# }}} + +# Geeknote {{{ +gnc() { + gn create --title $1 --content '' && + gn find --count=1 "$1" + gn edit 1 +} +# }}} + +# Misc aliases {{{ + +function fw() { # fix white + local substitution + local substitution='s/\x1b\[90m/\x1b[92m/g' + $@ > >(perl -pe "$substitution") 2> >(perl -pe "$substitution" 1>&2) +} +# }}} + +# Grep options {{{ +unset GREP_OPTIONS +export GREP_OPTIONS= +# }}} + + +# Run docker containers {{{ + # -d \ + # -v $HOME/.pentadactyl:/home/firefox/.pentadactyl:rw \ + # -v $HOME/.pentadactylrc:/home/firefox/.pentadactylrc:rw \ + # -v $HOME/.mozilla:/home/firefox/.mozilla:rw \ + # -v $HOME/.config:/home/firefox/.config \ + # -v $HOME/Downloads:/home/firefox/Downloads:rw \ + # -v /etc/fonts:/etc/fonts \ + # -v /tmp/.X11-unix:/tmp/.X11-unix \ + # -v /dev/snd:/dev/snd \ + # --net=host \ + # -v $XDG_RUNTIME_DIR:$XDG_RUNTIME_DIR \ + # -e uid=$(id -u) \ + # -e gid=$(id -g) \ + # -e DISPLAY=$DISPLAY \ + # -e XDG_RUNTIME_DIR=$XDG_RUNTIME_DIR \ + # --name firefox \ + # --rm -it \ + # glittershark/firefox +# }}} + +# Change cursor shape on insert/normal mode {{{ +# (https://unix.stackexchange.com/q/433273/64261) + +KEYTIMEOUT=5 + +_fix_cursor() { + echo -ne '\e[5 q' +} + +precmd_functions+=(_fix_cursor) + +function zle-keymap-select { + if [[ ${KEYMAP} == vicmd ]] || + [[ $1 = 'block' ]]; then + echo -ne '\e[1 q' + + elif [[ ${KEYMAP} == main ]] || + [[ ${KEYMAP} == viins ]] || + [[ ${KEYMAP} = '' ]] || + [[ $1 = 'beam' ]]; then + echo -ne '\e[5 q' + fi +} +zle -N zle-keymap-select + +# }}} + +[ -f ./.localrc ] && source ./.localrc diff --git a/users/grfn/system/home/platforms/darwin.nix b/users/grfn/system/home/platforms/darwin.nix new file mode 100644 index 000000000000..cf0375e94162 --- /dev/null +++ b/users/grfn/system/home/platforms/darwin.nix @@ -0,0 +1,26 @@ +{ config, lib, pkgs, ... }: + +with lib; + +{ + config = { + home.packages = with pkgs; [ + coreutils + gnupg + pinentry_mac + ]; + + home.activation.linkApplications = lib.hm.dag.entryAfter ["writeBoundary"] '' + $DRY_RUN_CMD ln -sf $VERBOSE_ARG \ + ~/.nix-profile/Applications/* ~/Applications/ + ''; + + programs.zsh.initExtra = '' + export NIX_PATH=$HOME/.nix-defexpr/channels:$NIX_PATH + + if [[ "$TERM" == "alacritty" ]]; then + export TERM="xterm-256color" + fi + ''; + }; +} diff --git a/users/grfn/system/home/platforms/linux.nix b/users/grfn/system/home/platforms/linux.nix new file mode 100644 index 000000000000..92924e419973 --- /dev/null +++ b/users/grfn/system/home/platforms/linux.nix @@ -0,0 +1,93 @@ +{ config, pkgs, ... }: + +let + + depot = config.lib.depot; + +in + +{ + imports = [ + ../modules/alacritty.nix + ../modules/alsi.nix + ../modules/development.nix + ../modules/emacs.nix + ../modules/email.nix + ../modules/firefox.nix + ../modules/games.nix + ../modules/obs.nix + ../modules/i3.nix + ../modules/shell.nix + ../modules/tarsnap.nix + ../modules/vim.nix + ]; + + xsession.enable = true; + + home.packages = with pkgs; [ + (import (fetchTarball "https://github.com/ashkitten/nixpkgs/archive/init-glimpse.tar.gz") {}).glimpse + + # Desktop stuff + arandr + firefox + feh + chromium + xclip + xorg.xev + picom + peek + signal-desktop + apvlv # pdf viewer + vlc + irssi + gnutls + pandoc + barrier + depot.tools.nsfv-setup + + # System utilities + powertop + usbutils + pciutils + gdmap + lsof + tree + ncat + iftop + + # Security + gnupg + keybase + openssl + yubikey-manager + yubikey-manager-qt + + # Spotify...etc + spotify + playerctl + ]; + + services.redshift = { + enable = true; + provider = "geoclue2"; + }; + + services.pasystray.enable = true; + + services.gpg-agent = { + enable = true; + }; + + gtk = { + enable = true; + gtk3.bookmarks = [ + "file:///home/grfn/code" + ]; + }; + + programs.zsh.initExtra = '' + [[ ! $IN_NIX_SHELL ]] && alsi -l + ''; + + services.lorri.enable = true; +} diff --git a/users/grfn/system/install b/users/grfn/system/install new file mode 100755 index 000000000000..a9a45953da07 --- /dev/null +++ b/users/grfn/system/install @@ -0,0 +1,35 @@ +#!/usr/bin/env bash + +set -eo pipefail + +if [[ -f /etc/nixos/.system-installed ]]; then + echo "=== System config already installed, skipping" +else + echo "==> Installing system config" + + [[ -d /etc/nixos ]] && sudo mv /etc/nixos{,.bak} + sudo mkdir -p /etc/nixos + sudo cp /etc/nixos.bak/hardware-configuration.nix /etc/nixos + + sudo cp ./system/configuration.nix /etc/nixos/ + sudo ln -s $(pwd)/system/{machines,modules,pkgs} /etc/nixos + sudo touch /etc/nixos/.system-installed + + echo "==> System config installed, your old configuration is at /etc/nixos.bak" +fi +echo + +if [[ -f ~/.config/nixpkgs/system-installed ]]; then + echo "=== home-manager config already installed, skipping" +else + echo "==> Installing home-manager config" + nix-channel --add https://github.com/rycee/home-manager/archive/master.tar.gz home-manager + nix-channel --update + # nix-shell '<home-manager>' -A install + + [[ -d ~/.config/nixpkgs ]] && mv ~/.config/{nixpkgs,nixpkgs.bak} + mkdir -p ~/.config/nixpkgs + ln -s $(pwd)/home/* ~/.config/nixpkgs + + echo "==> home-manager config installed" +fi diff --git a/users/grfn/system/system/.skip-subtree b/users/grfn/system/system/.skip-subtree new file mode 100644 index 000000000000..e69de29bb2d1 --- /dev/null +++ b/users/grfn/system/system/.skip-subtree diff --git a/users/grfn/system/system/configuration.nix b/users/grfn/system/system/configuration.nix new file mode 100644 index 000000000000..eae567015b73 --- /dev/null +++ b/users/grfn/system/system/configuration.nix @@ -0,0 +1,11 @@ +{ config, pkgs, ... }: + +let machine = throw "Pick a machine from ./machines"; in +{ + imports = + [ + /etc/nixos/hardware-configuration.nix + ./modules/common.nix + machine + ]; +} diff --git a/users/grfn/system/system/default.nix b/users/grfn/system/system/default.nix new file mode 100644 index 000000000000..445d4ad2438d --- /dev/null +++ b/users/grfn/system/system/default.nix @@ -0,0 +1,38 @@ +args @ { depot, pkgs, ... }: + +rec { + mugwump = import ./machines/mugwump.nix; + + mugwumpSystem = (depot.ops.nixos.nixosFor mugwump).system; + + roswell = import ./machines/roswell.nix; + + roswellSystem = (depot.ops.nixos.nixosFor ({ ... }: { + imports = [ + ./machines/roswell.nix + "${pkgs.home-manager.src}/nixos" + ]; + + # Use the same nixpkgs as everything else + home-manager.useGlobalPkgs = true; + + home-manager.users.grfn = { config, lib, ... }: { + imports = [ ../home/machines/roswell.nix ]; + lib.depot = depot; + }; + })).system; + + yeren = import ./machines/yeren.nix; + + yerenSystem = (depot.ops.nixos.nixosFor yeren).system; + + iso = import ./iso.nix args; + + meta.targets = [ + "mugwumpSystem" + "roswellSystem" + "yerenSystem" + + "iso" + ]; +} diff --git a/users/grfn/system/system/iso.nix b/users/grfn/system/system/iso.nix new file mode 100644 index 000000000000..4adccebfb8a2 --- /dev/null +++ b/users/grfn/system/system/iso.nix @@ -0,0 +1,17 @@ +{ depot, lib, pkgs, ... }: + +let + configuration = { ... }: { + imports = [ + "${pkgs.path}/nixos/modules/installer/cd-dvd/installation-cd-minimal.nix" + "${pkgs.path}/nixos/modules/installer/cd-dvd/channel.nix" + ]; + + networking.networkmanager.enable = true; + networking.useDHCP = false; + networking.firewall.enable = false; + networking.wireless.enable = lib.mkForce false; + }; +in (depot.third_party.nixos { + inherit configuration; +}).config.system.build.isoImage diff --git a/users/grfn/system/system/machines/bumblebee.nix b/users/grfn/system/system/machines/bumblebee.nix new file mode 100644 index 000000000000..0fec21409255 --- /dev/null +++ b/users/grfn/system/system/machines/bumblebee.nix @@ -0,0 +1,23 @@ +{ config, lib, pkgs, ... }: +{ + imports = [ + ../modules/reusable/battery.nix + ]; + + networking.hostName = "bumblebee"; + + powerManagement = { + enable = true; + cpuFreqGovernor = "powersave"; + powertop.enable = true; + }; + + # Hibernate on low battery + laptop.onLowBattery = { + enable = true; + action = "hibernate"; + thresholdPercentage = 5; + }; + + services.xserver.xkbOptions = "caps:swapescape"; +} diff --git a/users/grfn/system/system/machines/mugwump.nix b/users/grfn/system/system/machines/mugwump.nix new file mode 100644 index 000000000000..aae9b0387ff5 --- /dev/null +++ b/users/grfn/system/system/machines/mugwump.nix @@ -0,0 +1,260 @@ +{ config, lib, pkgs, modulesPath, depot, ... }: + +with lib; + +{ + imports = [ + ../modules/common.nix + (modulesPath + "/installer/scan/not-detected.nix") + "${depot.path}/ops/modules/prometheus-fail2ban-exporter.nix" + "${depot.path}/users/grfn/xanthous/server/module.nix" + ]; + + networking.hostName = "mugwump"; + + boot = { + loader.systemd-boot.enable = true; + + kernelModules = [ "kvm-intel" ]; + extraModulePackages = [ ]; + + initrd = { + availableKernelModules = [ "xhci_pci" "ehci_pci" "ahci" "usb_storage" "usbhid" "sd_mod" ]; + kernelModules = [ + "uas" "usbcore" "usb_storage" "vfat" "nls_cp437" "nls_iso8859_1" + ]; + + postDeviceCommands = pkgs.lib.mkBefore '' + mkdir -m 0755 -p /key + sleep 2 + mount -n -t vfat -o ro `findfs UUID=9048-A9D5` /key + ''; + + luks.devices."cryptroot" = { + device = "/dev/disk/by-uuid/803a9028-339c-4617-a213-4fe138161f6d"; + keyFile = "/key/keyfile"; + preLVM = false; + }; + }; + }; + + fileSystems = { + "/" = { + device = "/dev/mapper/cryptroot"; + fsType = "btrfs"; + }; + "/boot" = { + device = "/dev/disk/by-uuid/7D74-0E4B"; + fsType = "vfat"; + }; + }; + + networking.interfaces = { + enp0s25.useDHCP = false; + wlp2s0.useDHCP = false; + }; + + networking.firewall.enable = true; + networking.firewall.allowedTCPPorts = [ 22 80 443 ]; + + security.sudo.extraRules = [{ + groups = ["wheel"]; + commands = [{ command = "ALL"; options = ["NOPASSWD"]; }]; + }]; + + nix.gc.dates = "monthly"; + + services.fail2ban = { + enable = true; + ignoreIP = [ + "172.16.0.0/16" + ]; + }; + + services.openssh = { + allowSFTP = false; + passwordAuthentication = false; + permitRootLogin = "no"; + }; + + services.grafana = { + enable = true; + port = 3000; + domain = "metrics.gws.fyi"; + rootUrl = "https://metrics.gws.fyi"; + dataDir = "/var/lib/grafana"; + analytics.reporting.enable = false; + + provision = { + enable = true; + datasources = [{ + name = "Prometheus"; + type = "prometheus"; + url = "http://localhost:9090"; + }]; + }; + }; + + security.acme.email = "root@gws.fyi"; + security.acme.acceptTerms = true; + + services.nginx = { + enable = true; + statusPage = true; + recommendedGzipSettings = true; + recommendedOptimisation = true; + recommendedTlsSettings = true; + + virtualHosts = { + "metrics.gws.fyi" = { + enableACME = true; + forceSSL = true; + locations."/" = { + proxyPass = "http://localhost:${toString config.services.grafana.port}"; + }; + }; + }; + }; + + services.ddclient = { + enable = true; + domains = [ "home.gws.fyi" ]; + interval = "1d"; + zone = "gws.fyi"; + protocol = "cloudflare"; + username = "root@gws.fyi"; + quiet = true; + }; + + systemd.services.ddclient.serviceConfig = { + EnvironmentFile = "/etc/secrets/cloudflare.env"; + DynamicUser = lib.mkForce false; + ExecStart = lib.mkForce ( + let runtimeDir = + config.systemd.services.ddclient.serviceConfig.RuntimeDirectory; + in pkgs.writeShellScript "ddclient" '' + set -eo pipefail + + ${pkgs.gnused}/bin/sed -i -s s/password=/password=$CLOUDFLARE_API_KEY/ /run/${runtimeDir}/ddclient.conf + exec ${pkgs.ddclient}/bin/ddclient \ + -file /run/${runtimeDir}/ddclient.conf \ + -login=$CLOUDFLARE_EMAIL \ + ''); + }; + + security.acme.certs."metrics.gws.fyi" = { + dnsProvider = "cloudflare"; + credentialsFile = "/etc/secrets/cloudflare.env"; + webroot = mkForce null; + }; + + services.prometheus = { + enable = true; + exporters = { + node = { + enable = true; + openFirewall = false; + + enabledCollectors = [ + "processes" + "systemd" + "tcpstat" + "wifi" + ]; + }; + + nginx = { + enable = true; + openFirewall = true; + sslVerify = false; + constLabels = [ "host=mugwump" ]; + }; + + blackbox = { + enable = true; + openFirewall = true; + configFile = pkgs.writeText "blackbox-exporter.yaml" (builtins.toJSON { + modules = { + https_2xx = { + prober = "http"; + http = { + method = "GET"; + fail_if_ssl = false; + fail_if_not_ssl = true; + preferred_ip_protocol = "ip4"; + }; + }; + }; + }); + }; + }; + + scrapeConfigs = [{ + job_name = "node"; + scrape_interval = "5s"; + static_configs = [{ + targets = ["localhost:${toString config.services.prometheus.exporters.node.port}"]; + }]; + } { + job_name = "nginx"; + scrape_interval = "5s"; + static_configs = [{ + targets = ["localhost:${toString config.services.prometheus.exporters.nginx.port}"]; + }]; + } { + job_name = "xanthous_server"; + scrape_interval = "1s"; + static_configs = [{ + targets = ["localhost:${toString config.services.xanthous-server.metricsPort}"]; + }]; + } { + job_name = "blackbox"; + metrics_path = "/probe"; + params.module = ["https_2xx"]; + scrape_interval = "5s"; + static_configs = [{ + targets = [ + "https://gws.fyi" + "https://windtunnel.ci" + "https://app.windtunnel.ci" + "https://metrics.gws.fyi" + ]; + }]; + relabel_configs = [{ + source_labels = ["__address__"]; + target_label = "__param_target"; + } { + source_labels = ["__param_target"]; + target_label = "instance"; + } { + target_label = "__address__"; + replacement = "localhost:${toString config.services.prometheus.exporters.blackbox.port}"; + }]; + }]; + }; + + services.xanthous-server.enable = true; + + virtualisation.docker.enable = true; + + services.buildkite-agents = listToAttrs (map (n: rec { + name = "mugwump-${toString n}"; + value = { + inherit name; + enable = true; + tokenPath = "/etc/secrets/buildkite-agent-token"; + privateSshKeyPath = "/etc/secrets/buildkite-ssh-key"; + runtimePackages = with pkgs; [ + docker + nix + gnutar + gzip + ]; + }; + }) (range 1 1)); + + users.users."buildkite-agent-mugwump-1" = { + isSystemUser = true; + extraGroups = [ "docker" ]; + }; +} diff --git a/users/grfn/system/system/machines/roswell.nix b/users/grfn/system/system/machines/roswell.nix new file mode 100644 index 000000000000..6eb4a510b8cd --- /dev/null +++ b/users/grfn/system/system/machines/roswell.nix @@ -0,0 +1,17 @@ +{ depot, config, lib, pkgs, modulesPath, ... }: + +{ + imports = [ + ../modules/common.nix + "${modulesPath}/installer/scan/not-detected.nix" + "${modulesPath}/virtualisation/amazon-image.nix" + ]; + + ec2.hvm = true; + + networking.hostName = "roswell"; + + users.users.grfn.openssh.authorizedKeys.keys = [ + depot.users.grfn.keys.main + ]; +} diff --git a/users/grfn/system/system/machines/yeren.nix b/users/grfn/system/system/machines/yeren.nix new file mode 100644 index 000000000000..c6aff886de2f --- /dev/null +++ b/users/grfn/system/system/machines/yeren.nix @@ -0,0 +1,132 @@ +{ depot, modulesPath, config, lib, pkgs, ... }: + +{ + imports = [ + (modulesPath + "/installer/scan/not-detected.nix") + ../modules/common.nix + ../modules/laptop.nix + ../modules/xserver.nix + ../modules/fonts.nix + ../modules/sound.nix + ../modules/tvl.nix + ../modules/development.nix + ../modules/work/kolide.nix + ]; + + networking.hostName = "yeren"; + + system.stateVersion = "21.03"; + + boot = { + initrd = { + availableKernelModules = [ "xhci_pci" "thunderbolt" "nvme" "usb_storage" "sd_mod" "rtsx_pci_sdmmc" ]; + kernelModules = [ ]; + + luks.devices = { + "cryptroot".device = "/dev/disk/by-uuid/dcfbc22d-e0d2-411b-8dd3-96704d3aae2e"; + }; + }; + + kernelPackages = pkgs.linuxPackages_5_14; + + kernelModules = [ "kvm-intel" ]; + blacklistedKernelModules = [ "psmouse" ]; + extraModulePackages = [ + config.boot.kernelPackages.digimend + ]; + kernelParams = [ + "i915.preliminary_hw_support=1" + "pcie_aspm=force" + ]; + + # https://bbs.archlinux.org/viewtopic.php?pid=1933643#p1933643 + extraModprobeConfig = '' + options snd-intel-dspcfg dsp_driver=1 + ''; + + kernel.sysctl = { + "kernel.perf_event_paranoid" = -1; + }; + }; + + fileSystems = { + "/" = { + device = "/dev/mapper/cryptroot"; + fsType = "btrfs"; + }; + + "/boot" = { + device = "/dev/disk/by-uuid/53A9-248B"; + fsType = "vfat"; + }; + }; + + swapDevices = [{ + device = "/dev/disk/by-uuid/b627cb0e-0451-4f25-94d0-6497e01f0da4"; + }]; + + services.xserver = { + exportConfiguration = true; + extraConfig = '' + Section "Device" + Identifier "Intel Graphics" + Driver "intel" + Option "TripleBuffer" "true" + Option "TearFree" "true" + Option "DRI" "true" + Option "AccelMethod" "sna" + EndSection + ''; + }; + + hardware.firmware = with pkgs; [ + alsa-firmware + sof-firmware + ]; + + hardware.opengl.extraPackages = with pkgs; [ + vaapiIntel + vaapiVdpau + libvdpau-va-gl + intel-media-driver + ]; + + # Disabled for now until libfprint-tod can get a version bump + # services.fprintd = { + # enable = true; + # package = pkgs.fprintd-tod; + # }; + + systemd.services.fprintd.environment.FP_TOD_DRIVERS_DIR = + "${pkgs.libfprint-2-tod1-goodix}/usr/lib/libfprint-2/tod-1"; + + security.pam.loginLimits = [ + { + domain = "grfn"; + type = "soft"; + item = "nofile"; + value = "65535"; + } + ]; + + security.pam.services = { + login.fprintAuth = true; + sudo.fprintAuth = true; + i3lock.fprintAuth = false; + i3lock-color.fprintAuth = false; + lightdm.fprintAuth = true; + lightdm-greeter.fprintAuth = true; + }; + + hardware.opengl.driSupport32Bit = true; + + hardware.pulseaudio.extraConfig = '' + load-module module-remap-source source_name=KompleteAudio6_1 source_properties=device.description=KompleteAudio6Input1 master=alsa_input.usb-Native_Instruments_Komplete_Audio_6_458E0FFD-00.multichannel-input remix=no channels=1 master_channel_map=front-left channel_map=mono + load-module module-remap-source source_name=KompleteAudio6_2 source_properties=device.description=KompleteAudio6Input2 master=alsa_input.usb-Native_Instruments_Komplete_Audio_6_458E0FFD-00.multichannel-input remix=no channels=1 master_channel_map=front-right channel_map=mono + load-module module-remap-sink sink_name=KompleteAudio6_12 sink_properties=device.description=KompleteAudio6_12 remix=no master=alsa_output.usb-Native_Instruments_Komplete_Audio_6_458E0FFD-00.analog-surround-21 channels=2 master_channel_map=front-left,front-right channel_map=front-left,front-right + ''; + + services.fwupd.enable = true; + + services.tailscale.enable = true; +} diff --git a/users/grfn/system/system/modules/common.nix b/users/grfn/system/system/modules/common.nix new file mode 100644 index 000000000000..a91584680d52 --- /dev/null +++ b/users/grfn/system/system/modules/common.nix @@ -0,0 +1,80 @@ +{ config, lib, pkgs, ... }: + +let + + depot = import ../../../../.. {}; + +in + +with lib; + +{ + boot.loader.systemd-boot.enable = true; + boot.loader.efi.canTouchEfiVariables = true; + + networking.useDHCP = false; + networking.networkmanager.enable = true; + + i18n = { + defaultLocale = "en_US.UTF-8"; + }; + + time.timeZone = lib.mkDefault "America/New_York"; + + environment.systemPackages = with pkgs; [ + wget + vim + zsh + git + w3m + libnotify + file + lm_sensors + dnsutils + htop + man-pages + man-pages-posix + ]; + + documentation.dev.enable = true; + documentation.man.generateCaches = true; + + services.openssh.enable = true; + + programs.ssh.startAgent = true; + + networking.firewall.enable = mkDefault false; + + users.mutableUsers = true; + programs.zsh.enable = true; + environment.pathsToLink = [ "/share/zsh" ]; + users.users.grfn = { + isNormalUser = true; + initialPassword = "password"; + extraGroups = [ + "wheel" + "networkmanager" + "audio" + "docker" + ]; + shell = pkgs.zsh; + }; + + nix = { + trustedUsers = [ "grfn" ]; + autoOptimiseStore = true; + distributedBuilds = true; + + gc = { + automatic = true; + dates = mkDefault "weekly"; + options = "--delete-older-than 30d"; + }; + }; + + services.udev.packages = with pkgs; [ + yubikey-personalization + ]; + + services.pcscd.enable = true; +} diff --git a/users/grfn/system/system/modules/desktop.nix b/users/grfn/system/system/modules/desktop.nix new file mode 100644 index 000000000000..3adbd9d9b07f --- /dev/null +++ b/users/grfn/system/system/modules/desktop.nix @@ -0,0 +1,19 @@ +{ config, lib, pkgs, ... }: + +{ + imports = [ + ./xserver.nix + ./fonts.nix + ./sound.nix + ./kernel.nix + ]; + + programs.nm-applet.enable = true; + + users.users.grfn.extraGroups = [ + "audio" + "video" + ]; + + services.geoclue2.enable = true; +} diff --git a/users/grfn/system/system/modules/development.nix b/users/grfn/system/system/modules/development.nix new file mode 100644 index 000000000000..bfa0e22cff0a --- /dev/null +++ b/users/grfn/system/system/modules/development.nix @@ -0,0 +1,6 @@ +{ config, lib, pkgs, ... }: + +{ + virtualisation.docker.enable = true; + users.users.grfn.extraGroups = [ "docker" ]; +} diff --git a/users/grfn/system/system/modules/fcitx.nix b/users/grfn/system/system/modules/fcitx.nix new file mode 100644 index 000000000000..812f598f9f47 --- /dev/null +++ b/users/grfn/system/system/modules/fcitx.nix @@ -0,0 +1,10 @@ +{ config, lib, pkgs, ... }: + +{ + i18n.inputMethod = { + enabled = "fcitx"; + fcitx.engines = with pkgs.fcitx-engines; [ + cloudpinyin + ]; + }; +} diff --git a/users/grfn/system/system/modules/fonts.nix b/users/grfn/system/system/modules/fonts.nix new file mode 100644 index 000000000000..babe30d4271f --- /dev/null +++ b/users/grfn/system/system/modules/fonts.nix @@ -0,0 +1,12 @@ +{ config, lib, pkgs, ... }: +{ + fonts = { + fonts = with pkgs; [ + nerdfonts + noto-fonts-emoji + twitter-color-emoji + ]; + + fontconfig.defaultFonts.emoji = ["Twitter Color Emoji"]; + }; +} diff --git a/users/grfn/system/system/modules/kernel.nix b/users/grfn/system/system/modules/kernel.nix new file mode 100644 index 000000000000..dd213fcca31c --- /dev/null +++ b/users/grfn/system/system/modules/kernel.nix @@ -0,0 +1,39 @@ +{ config, lib, pkgs, ... }: +with lib.versions; +let + inherit (pkgs) stdenvNoCC; + kernelRelease = config.boot.kernelPackages.kernel.version; + mj = major kernelRelease; + mm = majorMinor kernelRelease; + patched-linux-ck = stdenvNoCC.mkDerivation { + name = "linux-ck"; + src = builtins.fetchurl { + name = "linux-ck-patch-${mm}-ck1.xz"; + # example: http://ck.kolivas.org/patches/5.0/5.4/5.4-ck1/patch-5.4-ck1.xz + url = "http://ck.kolivas.org/patches/${mj}.0/${mm}/${mm}-ck1/patch-${mm}-ck1.xz"; + sha256 = "1kka38rmjcqsv4j2anczrsni0bf6yfdx2vsxbna3ic84nh3rz434"; + }; + + unpackPhase = '' + ${pkgs.xz}/bin/unxz -kfdc $src > patch-${mm}-ck1 + ''; + + installPhase = '' + cp patch-${mm}-ck1 $out + ''; + }; +in +{ + boot.kernelPackages = pkgs.linuxPackages_5_10.extend (self: super: { + kernel = super.kernel.override { + ignoreConfigErrors = true; + kernelPatches = super.kernel.kernelPatches ++ [{ + name = "linux-ck"; + patch = patched-linux-ck; + }]; + argsOverride = { + modDirVersion = super.kernel.modDirVersion + "-ck1"; + }; + }; + }); +} diff --git a/users/grfn/system/system/modules/laptop.nix b/users/grfn/system/system/modules/laptop.nix new file mode 100644 index 000000000000..05c5333e513f --- /dev/null +++ b/users/grfn/system/system/modules/laptop.nix @@ -0,0 +1,15 @@ +{ config, lib, pkgs, ... }: + +{ + imports = [ + ./reusable/battery.nix + ]; + + laptop.onLowBattery.enable = true; + + services.logind.extraConfig = '' + HandlePowerKey=hibernate + ''; + + services.tlp.enable = true; +} diff --git a/users/grfn/system/system/modules/reusable/README.org b/users/grfn/system/system/modules/reusable/README.org new file mode 100644 index 000000000000..34d9bfdcb729 --- /dev/null +++ b/users/grfn/system/system/modules/reusable/README.org @@ -0,0 +1,2 @@ +This directory contains things I'm eventually planning on contributing upstream +to nixpkgs diff --git a/users/grfn/system/system/modules/reusable/battery.nix b/users/grfn/system/system/modules/reusable/battery.nix new file mode 100644 index 000000000000..ca92e0c3f61c --- /dev/null +++ b/users/grfn/system/system/modules/reusable/battery.nix @@ -0,0 +1,32 @@ +{ config, lib, pkgs, ... }: +with lib; +{ + options = { + laptop.onLowBattery = { + enable = mkEnableOption "Perform action on low battery"; + + thresholdPercentage = mkOption { + description = "Threshold battery percentage on which to perform the action"; + default = 8; + type = types.int; + }; + + action = mkOption { + description = "Action to perform on low battery"; + default = "hibernate"; + type = types.enum [ "hibernate" "suspend" "suspend-then-hibernate" ]; + }; + }; + }; + + config = + let cfg = config.laptop.onLowBattery; + in mkIf cfg.enable { + services.udev.extraRules = concatStrings [ + ''SUBSYSTEM=="power_supply", '' + ''ATTR{status}=="Discharging", '' + ''ATTR{capacity}=="[0-${toString cfg.thresholdPercentage}]", '' + ''RUN+="${pkgs.systemd}/bin/systemctl ${cfg.action}"'' + ]; + }; +} diff --git a/users/grfn/system/system/modules/rtlsdr.nix b/users/grfn/system/system/modules/rtlsdr.nix new file mode 100644 index 000000000000..ce58ebb0dcda --- /dev/null +++ b/users/grfn/system/system/modules/rtlsdr.nix @@ -0,0 +1,17 @@ +{ config, lib, pkgs, ... }: + +{ + + environment.systemPackages = with pkgs; [ + rtl-sdr + ]; + + services.udev.packages = with pkgs; [ + rtl-sdr + ]; + + # blacklist for rtl-sdr + boot.blacklistedKernelModules = [ + "dvb_usb_rtl28xxu" + ]; +} diff --git a/users/grfn/system/system/modules/sound.nix b/users/grfn/system/system/modules/sound.nix new file mode 100644 index 000000000000..07a67a1ec43b --- /dev/null +++ b/users/grfn/system/system/modules/sound.nix @@ -0,0 +1,16 @@ +{ config, lib, pkgs, ... }: + +{ + # Enable sound. + sound.enable = true; + hardware.pulseaudio.enable = true; + + environment.systemPackages = with pkgs; [ + pulseaudio-ctl + paprefs + pasystray + pavucontrol + ]; + + hardware.pulseaudio.package = pkgs.pulseaudioFull; +} diff --git a/users/grfn/system/system/modules/tvl.nix b/users/grfn/system/system/modules/tvl.nix new file mode 100644 index 000000000000..905ec8ced537 --- /dev/null +++ b/users/grfn/system/system/modules/tvl.nix @@ -0,0 +1,37 @@ +{ config, lib, pkgs, ... }: + +{ + nix = { + buildMachines = [{ + hostName = "whitby.tvl.fyi"; + sshUser = "grfn"; + sshKey = "/root/.ssh/id_rsa"; + system = "x86_64-linux"; + maxJobs = 64; + supportedFeatures = ["big-parallel" "kvm" "nixos-test" "benchmark"]; + }]; + + extraOptions = '' + builders-use-substitutes = true + ''; + + binaryCaches = [ + "https://cache.nixos.org" + "ssh://nix-ssh@whitby.tvl.fyi" + ]; + trustedBinaryCaches = [ + "https://cache.nixos.org" + "ssh://nix-ssh@whitby.tvl.fyi" + ]; + binaryCachePublicKeys = [ + "cache.tvl.fyi:fd+9d1ceCPvDX/xVhcfv8nAa6njEhAGAEe+oGJDEeoc=" + ]; + }; + + programs.ssh.knownHosts.whitby = { + hostNames = [ "whitby" "whitby.tvl.fyi" "49.12.129.211"]; + publicKeyFile = pkgs.writeText "whitby.pub" '' + ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILNh/w4BSKov0jdz3gKBc98tpoLta5bb87fQXWBhAl2I + ''; + }; +} diff --git a/users/grfn/system/system/modules/work/kolide.deb b/users/grfn/system/system/modules/work/kolide.deb new file mode 100644 index 000000000000..a319a5806fca --- /dev/null +++ b/users/grfn/system/system/modules/work/kolide.deb Binary files differdiff --git a/users/grfn/system/system/modules/work/kolide.nix b/users/grfn/system/system/modules/work/kolide.nix new file mode 100644 index 000000000000..29ee0a0d7ce4 --- /dev/null +++ b/users/grfn/system/system/modules/work/kolide.nix @@ -0,0 +1,49 @@ +{ config, lib, pkgs, ... }: + +let + deb = ./kolide.deb; + + kolide = pkgs.runCommand "kolide-data" { + buildInputs = [ pkgs.binutils-unwrapped ]; + } '' + cp ${deb} ./kolide.deb + ar x kolide.deb + mkdir result + tar xzf data.tar.gz -C result + patchelf \ + --set-interpreter ${pkgs.glibc}/lib/ld-linux-x86-64.so.2 \ + --set-rpath "${lib.makeLibraryPath (with pkgs; [ + zlib + ])}" \ + result/usr/local/kolide-k2/bin/osqueryd + mv result $out + ''; + +in { + systemd.services."launcher.kolide-k2" = { + wantedBy = [ "multi-user.target" ]; + after = [ "network.target" "syslog.service" ]; + description = "The Kolide Launcher"; + serviceConfig = { + ExecStart = '' + ${kolide}/usr/local/kolide-k2/bin/launcher \ + -config \ + ${pkgs.writeText "launcher.flags" '' + with_initial_runner + control + autoupdate + root_directory /var/lib/kolide + osqueryd_path ${kolide}/usr/local/kolide-k2/bin/osqueryd + enroll_secret_path ${kolide}/etc/kolide-k2/secret + control_hostname k2control.kolide.com + update_channel stable + transport jsonrpc + hostname k2device.kolide.com + ''} + ''; + StateDirectory = "kolide"; + Restart = "on-failure"; + RestartSec = 3; + }; + }; +} diff --git a/users/grfn/system/system/modules/xserver.nix b/users/grfn/system/system/modules/xserver.nix new file mode 100644 index 000000000000..35ee44112ea1 --- /dev/null +++ b/users/grfn/system/system/modules/xserver.nix @@ -0,0 +1,16 @@ +{ config, pkgs, ... }: +{ + # Enable the X11 windowing system. + services.xserver = { + enable = true; + layout = "us"; + + libinput.enable = true; + + displayManager = { + defaultSession = "none+i3"; + }; + + windowManager.i3.enable = true; + }; +} diff --git a/users/grfn/wigglydonke.rs/index.html b/users/grfn/wigglydonke.rs/index.html new file mode 100644 index 000000000000..4fd7f25fcf8c --- /dev/null +++ b/users/grfn/wigglydonke.rs/index.html @@ -0,0 +1,16 @@ +<!DOCTYPE html> +<html> + <head> + <title>Kids Love Wiggly Donkers!</title> + <style type="text/css"> + #wiggly-donkers { + width: 100%; + } + </style> + </head> + <body> + <a href="https://tvl.fyi"> + <img src="/wd.png" id="wiggly-donkers"/> + </a> + </body> +</html> diff --git a/users/grfn/wigglydonke.rs/wd.png b/users/grfn/wigglydonke.rs/wd.png new file mode 100644 index 000000000000..217443e2df82 --- /dev/null +++ b/users/grfn/wigglydonke.rs/wd.png Binary files differdiff --git a/users/grfn/xanthous/.envrc b/users/grfn/xanthous/.envrc new file mode 100644 index 000000000000..be81feddb1a5 --- /dev/null +++ b/users/grfn/xanthous/.envrc @@ -0,0 +1 @@ +eval "$(lorri direnv)" \ No newline at end of file diff --git a/users/grfn/xanthous/.github/actions/nix-build/Dockerfile b/users/grfn/xanthous/.github/actions/nix-build/Dockerfile new file mode 100644 index 000000000000..cfe8e35df091 --- /dev/null +++ b/users/grfn/xanthous/.github/actions/nix-build/Dockerfile @@ -0,0 +1,23 @@ +FROM lnl7/nix:2.1.2 + +LABEL name="Nix Build for GitHub Actions" +LABEL version="1.0" +LABEL repository="http://github.com/glittershark/xanthous" +LABEL homepage="http://github.com/glittershark/xanthous" +LABEL maintainer="Griffin Smith <root at gws dot fyi>" + +LABEL "com.github.actions.name"="Nix Build" +LABEL "com.github.actions.description"="Runs 'nix-build'" +LABEL "com.github.actions.icon"="cpu" +LABEL "com.github.actions.color"="purple" + +RUN nix-env -iA \ + nixpkgs.gnutar nixpkgs.gzip \ + nixpkgs.gnugrep nixpkgs.git && \ + mkdir -p /etc/nix && \ + (echo "binary-caches = https://cache.nixos.org/" | tee -a /etc/nix/nix.conf) && \ + (echo "trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=" | tee -a /etc/nix/nix.conf) + +COPY entrypoint.sh /entrypoint.sh +ENTRYPOINT [ "/entrypoint.sh" ] +CMD [ "--help" ] diff --git a/users/grfn/xanthous/.github/actions/nix-build/entrypoint.sh b/users/grfn/xanthous/.github/actions/nix-build/entrypoint.sh new file mode 100755 index 000000000000..cb7aca541a3f --- /dev/null +++ b/users/grfn/xanthous/.github/actions/nix-build/entrypoint.sh @@ -0,0 +1,24 @@ +#!/usr/bin/env bash + +# Entrypoint that runs nix-build and, optionally, copies Docker image tarballs +# to real files. The reason this is necessary is because once a Nix container +# exits, you must copy out the artifacts to the working directory before exit. + +[ "$DEBUG" = "1" ] && set -x +[ "$QUIET" = "1" ] && QUIET_ARG="-Q" + +set -e + +# file to build (e.g. release.nix) +file="$1" + +[ "$file" = "" ] && echo "No .nix file to build specified!" && exit 1 +[ ! -e "$file" ] && echo "File $file not exist!" && exit 1 + +echo "Building all attrs in $file..." +nix-build --no-link ${QUIET_ARG} "$file" "${@:2}" + +echo "Copying build closure to $(pwd)/store..." +mapfile -t storePaths < <(nix-build ${QUIET_ARG} --no-link "$file" | grep -v cache-deps) +printf '%s\n' "${storePaths[@]}" > store.roots +nix copy --to "file://$(pwd)/store" "${storePaths[@]}" diff --git a/users/grfn/xanthous/.github/workflows/haskell.yml b/users/grfn/xanthous/.github/workflows/haskell.yml new file mode 100644 index 000000000000..df82de3e8caf --- /dev/null +++ b/users/grfn/xanthous/.github/workflows/haskell.yml @@ -0,0 +1,15 @@ +name: Haskell CI + +on: [push] + +jobs: + build: + + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v1 + - name: Nix Build + with: + args: default.nix --arg failOnWarnings true + uses: ./.github/actions/nix-build diff --git a/users/grfn/xanthous/.gitignore b/users/grfn/xanthous/.gitignore new file mode 100644 index 000000000000..2ad31c01d443 --- /dev/null +++ b/users/grfn/xanthous/.gitignore @@ -0,0 +1,37 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.hie +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +cabal.project.local~* +.HTF/ +.ghc.environment.* + + +# from nix-build +result + +# grr +*_flymake.hs + +# app-specific +debug.log +data +*.save +.tasty-rerun-log diff --git a/users/grfn/xanthous/LICENSE b/users/grfn/xanthous/LICENSE new file mode 100644 index 000000000000..45644ff76449 --- /dev/null +++ b/users/grfn/xanthous/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<http://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/users/grfn/xanthous/README.org b/users/grfn/xanthous/README.org new file mode 100644 index 000000000000..7e1fedb069b1 --- /dev/null +++ b/users/grfn/xanthous/README.org @@ -0,0 +1,36 @@ +#+TITLE: Xanthous + +* Building + +#+BEGIN_SRC shell +$ nix build +#+END_SRC + +* Running + +#+BEGIN_SRC shell +$ ./result/bin/xanthous [--help] +#+END_SRC + +** Keyboard commands + +Keyboard commands are currently undocumented, but can be found in [[[https://github.com/glittershark/xanthous/blob/master/src/Xanthous/Command.hs#L26][this file]]. +Movement uses the nethack-esque hjklybnu. + +* Development + +Use [[https://github.com/target/lorri][lorri]], or run everything in a ~nix-shell~ + +#+BEGIN_SRC shell +# Build (for dev) +$ cabal new-build + +# Run the game +$ cabal new-run xanthous + +# Run tests +$ cabal new-run test + +# Run a repl +$ cabal new-repl +#+END_SRC diff --git a/users/grfn/xanthous/Setup.hs b/users/grfn/xanthous/Setup.hs new file mode 100644 index 000000000000..9a994af677b0 --- /dev/null +++ b/users/grfn/xanthous/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/users/grfn/xanthous/app/Main.hs b/users/grfn/xanthous/app/Main.hs new file mode 100644 index 000000000000..c771a0d932cb --- /dev/null +++ b/users/grfn/xanthous/app/Main.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Main ( main ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (finally) +import Brick +import qualified Brick.BChan +import qualified Graphics.Vty as Vty +import qualified Options.Applicative as Opt +import System.Random +import Control.Monad.Random (getRandom) +import Control.Exception (finally) +import System.Exit (die) +-------------------------------------------------------------------------------- +import qualified Xanthous.Game as Game +import Xanthous.Game.Env (GameEnv(..)) +import qualified Xanthous.Game.Env as Game +import Xanthous.App +import Xanthous.Generators.Level + ( GeneratorInput + , parseGeneratorInput + , generateFromInput + , showCells + ) +import qualified Xanthous.Entities.Character as Character +import Xanthous.Generators.Level.Util (regions) +import Xanthous.Generators.Level.LevelContents +import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) +import Data.Array.IArray ( amap ) +-------------------------------------------------------------------------------- + +parseGameConfig :: Opt.Parser Game.Config +parseGameConfig = Game.Config + <$> Opt.switch + ( Opt.long "disable-saving" + <> Opt.help "Disallow saving games" + ) + +data RunParams = RunParams + { seed :: Maybe Int + , characterName :: Maybe Text + , gameConfig :: Game.Config + } + deriving stock (Show, Eq) + +parseRunParams :: Opt.Parser RunParams +parseRunParams = RunParams + <$> optional (Opt.option Opt.auto + ( Opt.long "seed" + <> Opt.help "Random seed for the game." + )) + <*> optional (Opt.strOption + ( Opt.short 'n' + <> Opt.long "name" + <> Opt.help + ( "Name for the character. If not set on the command line, " + <> "will be prompted for at runtime" + ) + )) + <*> parseGameConfig + +data Command + = Run RunParams + | Load FilePath + | Generate GeneratorInput Dimensions (Maybe Int) + +parseDimensions :: Opt.Parser Dimensions +parseDimensions = Dimensions + <$> Opt.option Opt.auto + ( Opt.short 'w' + <> Opt.long "width" + <> Opt.metavar "TILES" + ) + <*> Opt.option Opt.auto + ( Opt.short 'h' + <> Opt.long "height" + <> Opt.metavar "TILES" + ) + + +parseCommand :: Opt.Parser Command +parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser + $ Opt.command "run" + (Opt.info + (Run <$> parseRunParams) + (Opt.progDesc "Run the game")) + <> Opt.command "load" + (Opt.info + (Load <$> Opt.argument Opt.str (Opt.metavar "FILE")) + (Opt.progDesc "Load a saved game")) + <> Opt.command "generate" + (Opt.info + (Generate + <$> parseGeneratorInput + <*> parseDimensions + <*> optional + (Opt.option Opt.auto (Opt.long "seed")) + <**> Opt.helper + ) + (Opt.progDesc "Generate a sample level")) + +optParser :: Opt.ParserInfo Command +optParser = Opt.info + (parseCommand <**> Opt.helper) + (Opt.header "Xanthous: a WIP TUI RPG") + +thanks :: IO () +thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" + +newGame :: RunParams -> IO () +newGame rparams = do + gameSeed <- maybe getRandom pure $ seed rparams + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + let initialState = Game.initialStateFromSeed gameSeed &~ do + for_ (characterName rparams) $ \cn -> + Game.character . Character.characterName ?= cn + runGame NewGame (gameConfig rparams) initialState `finally` do + thanks + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + putStr "\n\n" + +loadGame :: FilePath -> IO () +loadGame saveFile = do + gameState <- maybe (die "Invalid save file!") pure . Game.loadGame . fromStrict + =<< readFile @IO saveFile + gameState `deepseq` runGame (LoadGame saveFile) Game.defaultConfig gameState + +runGame :: RunType -> Game.Config -> Game.GameState -> IO () +runGame rt _config gameState = do + _eventChan <- Brick.BChan.newBChan 10 + let gameEnv = GameEnv {..} + app <- makeApp gameEnv rt + let buildVty = Vty.mkVty Vty.defaultConfig + initialVty <- buildVty + _game' <- customMain + initialVty + buildVty + (Just _eventChan) + app + gameState + pure () + +runGenerate :: GeneratorInput -> Dimensions -> Maybe Int -> IO () +runGenerate input dims mSeed = do + putStrLn "Generating..." + genSeed <- maybe getRandom pure mSeed + let randGen = mkStdGen genSeed + res = generateFromInput input dims randGen + rs = regions $ amap not res + when (isNothing mSeed) + . putStrLn + $ "Seed: " <> tshow genSeed + putStr "num regions: " + print $ length rs + putStr "region lengths: " + print $ length <$> rs + putStr "character position: " + print =<< chooseCharacterPosition res + putStrLn $ showCells res + +runCommand :: Command -> IO () +runCommand (Run runParams) = newGame runParams +runCommand (Load saveFile) = loadGame saveFile +runCommand (Generate input dims mSeed) = runGenerate input dims mSeed + +main :: IO () +main = runCommand =<< Opt.execParser optParser diff --git a/users/grfn/xanthous/bench/Bench.hs b/users/grfn/xanthous/bench/Bench.hs new file mode 100644 index 000000000000..5889618ee432 --- /dev/null +++ b/users/grfn/xanthous/bench/Bench.hs @@ -0,0 +1,12 @@ +-------------------------------------------------------------------------------- +module Main where +-------------------------------------------------------------------------------- +import Bench.Prelude +-------------------------------------------------------------------------------- +import qualified Xanthous.RandomBench +import qualified Xanthous.Generators.UtilBench + +main :: IO () +main = defaultMain + [ Xanthous.Generators.UtilBench.benchmark + ] diff --git a/users/grfn/xanthous/bench/Bench/Prelude.hs b/users/grfn/xanthous/bench/Bench/Prelude.hs new file mode 100644 index 000000000000..c553abd6d5d0 --- /dev/null +++ b/users/grfn/xanthous/bench/Bench/Prelude.hs @@ -0,0 +1,9 @@ +-------------------------------------------------------------------------------- +module Bench.Prelude + ( module Xanthous.Prelude + , module Criterion.Main + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Criterion.Main +-------------------------------------------------------------------------------- diff --git a/users/grfn/xanthous/bench/Xanthous/Generators/UtilBench.hs b/users/grfn/xanthous/bench/Xanthous/Generators/UtilBench.hs new file mode 100644 index 000000000000..56310e691c33 --- /dev/null +++ b/users/grfn/xanthous/bench/Xanthous/Generators/UtilBench.hs @@ -0,0 +1,37 @@ +-------------------------------------------------------------------------------- +module Xanthous.Generators.UtilBench (benchmark, main) where +-------------------------------------------------------------------------------- +import Bench.Prelude +-------------------------------------------------------------------------------- +import Data.Array.IArray +import Data.Array.Unboxed +import System.Random (getStdGen) +-------------------------------------------------------------------------------- +import Xanthous.Generators.Util +import qualified Xanthous.Generators.CaveAutomata as CaveAutomata +import Xanthous.Data (Dimensions'(..)) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain [benchmark] + +-------------------------------------------------------------------------------- + +benchmark :: Benchmark +benchmark = bgroup "Generators.Util" + [ bgroup "floodFill" + [ env (NFWrapper <$> cells) $ \(NFWrapper ir) -> + bench "checkerboard" $ nf (floodFill ir) (1,0) + ] + ] + where + cells :: IO Cells + cells = CaveAutomata.generate + CaveAutomata.defaultParams + (Dimensions 50 50) + <$> getStdGen + +newtype NFWrapper a = NFWrapper a + +instance NFData (NFWrapper a) where + rnf (NFWrapper x) = x `seq` () diff --git a/users/grfn/xanthous/bench/Xanthous/RandomBench.hs b/users/grfn/xanthous/bench/Xanthous/RandomBench.hs new file mode 100644 index 000000000000..fae4af92a7a5 --- /dev/null +++ b/users/grfn/xanthous/bench/Xanthous/RandomBench.hs @@ -0,0 +1,32 @@ +-------------------------------------------------------------------------------- +module Xanthous.RandomBench (benchmark, main) where +-------------------------------------------------------------------------------- +import Bench.Prelude +-------------------------------------------------------------------------------- +import Control.Parallel.Strategies +import Control.Monad.Random +-------------------------------------------------------------------------------- +import Xanthous.Random +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain [benchmark] + +-------------------------------------------------------------------------------- + +benchmark :: Benchmark +benchmark = bgroup "Random" + [ bgroup "chooseSubset" + [ bench "serially" $ + nf (evalRand $ chooseSubset (0.5 :: Double) [1 :: Int ..1000000]) + (mkStdGen 1234) + ] + , bgroup "choose weightedBy" + [ bench "serially" $ + nf (evalRand + . choose + . weightedBy (\n -> product [n, pred n .. 1]) + $ [1 :: Int ..1000000]) + (mkStdGen 1234) + ] + ] diff --git a/users/grfn/xanthous/build/generic-arbitrary-export-garbitrary.patch b/users/grfn/xanthous/build/generic-arbitrary-export-garbitrary.patch new file mode 100644 index 000000000000..f0c936bfca18 --- /dev/null +++ b/users/grfn/xanthous/build/generic-arbitrary-export-garbitrary.patch @@ -0,0 +1,12 @@ +diff --git a/src/Test/QuickCheck/Arbitrary/Generic.hs b/src/Test/QuickCheck/Arbitrary/Generic.hs +index fed6ab3..91f59f1 100644 +--- a/src/Test/QuickCheck/Arbitrary/Generic.hs ++++ b/src/Test/QuickCheck/Arbitrary/Generic.hs +@@ -23,6 +23,7 @@ The generated 'arbitrary' method is equivalent to + + module Test.QuickCheck.Arbitrary.Generic + ( Arbitrary(..) ++ , GArbitrary + , genericArbitrary + , genericShrink + ) where diff --git a/users/grfn/xanthous/build/hgeometry-fix-haddock.patch b/users/grfn/xanthous/build/hgeometry-fix-haddock.patch new file mode 100644 index 000000000000..748c65b3e0db --- /dev/null +++ b/users/grfn/xanthous/build/hgeometry-fix-haddock.patch @@ -0,0 +1,13 @@ +diff --git a/src/Data/Geometry/PlanarSubdivision/Merge.hs b/src/Data/Geometry/PlanarSubdivision/Merge.hs +index 1136114..3f4e7bb 100644 +--- a/src/Data/Geometry/PlanarSubdivision/Merge.hs ++++ b/src/Data/Geometry/PlanarSubdivision/Merge.hs +@@ -153,7 +153,7 @@ mergeWith' mergeFaces p1 p2 = PlanarSubdivision cs vd rd rf + -- we have to shift the number of the *Arcs*. Since every dart + -- consists of two arcs, we have to shift by numDarts / 2 + -- Furthermore, we take numFaces - 1 since we want the first +- -- *internal* face of p2 (the one with FaceId 1) to correspond with the first free ++ -- /internal/ face of p2 (the one with FaceId 1) to correspond with the first free + -- position (at index numFaces) + + cs = p1^.components <> p2'^.components diff --git a/users/grfn/xanthous/build/update-comonad-extras.patch b/users/grfn/xanthous/build/update-comonad-extras.patch new file mode 100644 index 000000000000..cd1dbe24d361 --- /dev/null +++ b/users/grfn/xanthous/build/update-comonad-extras.patch @@ -0,0 +1,92 @@ +diff --git a/comonad-extras.cabal b/comonad-extras.cabal +index fc3745a..77a2f0d 100644 +--- a/comonad-extras.cabal ++++ b/comonad-extras.cabal +@@ -1,7 +1,7 @@ + name: comonad-extras + category: Control, Comonads +-version: 4.0 ++version: 5.0 + x-revision: 1 + license: BSD3 + cabal-version: >= 1.6 + license-file: LICENSE +@@ -34,8 +34,8 @@ library + build-depends: + array >= 0.3 && < 0.6, +- base >= 4 && < 4.7, +- containers >= 0.4 && < 0.6, +- comonad >= 4 && < 5, ++ base >= 4 && < 5, ++ containers >= 0.6 && < 0.7, ++ comonad >= 5 && < 6, + distributive >= 0.3.2 && < 1, +- semigroupoids >= 4 && < 5, +- transformers >= 0.2 && < 0.4 ++ semigroupoids >= 5 && < 6, ++ transformers >= 0.5 && < 0.6 + + exposed-modules: + Control.Comonad.Store.Zipper +diff --git a/src/Control/Comonad/Store/Pointer.hs b/src/Control/Comonad/Store/Pointer.hs +index 5044a1e..8d4c62d 100644 +--- a/src/Control/Comonad/Store/Pointer.hs ++++ b/src/Control/Comonad/Store/Pointer.hs +@@ -41,7 +41,6 @@ module Control.Comonad.Store.Pointer + , module Control.Comonad.Store.Class + ) where + +-import Control.Applicative + import Control.Comonad + import Control.Comonad.Hoist.Class + import Control.Comonad.Trans.Class +@@ -51,27 +50,8 @@ import Control.Comonad.Env.Class + import Data.Functor.Identity + import Data.Functor.Extend + import Data.Array +- + #ifdef __GLASGOW_HASKELL__ + import Data.Typeable +-instance (Typeable i, Typeable1 w) => Typeable1 (PointerT i w) where +- typeOf1 diwa = mkTyConApp storeTTyCon [typeOf (i diwa), typeOf1 (w diwa)] +- where +- i :: PointerT i w a -> i +- i = undefined +- w :: PointerT i w a -> w a +- w = undefined +- +-instance (Typeable i, Typeable1 w, Typeable a) => Typeable (PointerT i w a) where +- typeOf = typeOfDefault +- +-storeTTyCon :: TyCon +-#if __GLASGOW_HASKELL__ < 704 +-storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Pointer.PointerT" +-#else +-storeTTyCon = mkTyCon3 "comonad-extras" "Control.Comonad.Trans.Store.Pointer" "PointerT" +-#endif +-{-# NOINLINE storeTTyCon #-} + #endif + + type Pointer i = PointerT i Identity +@@ -83,6 +63,9 @@ runPointer :: Pointer i a -> (Array i a, i) + runPointer (PointerT (Identity f) i) = (f, i) + + data PointerT i w a = PointerT (w (Array i a)) i ++#ifdef __GLASGOW_HASKELL__ ++ deriving Typeable ++#endif + + runPointerT :: PointerT i w a -> (w (Array i a), i) + runPointerT (PointerT g i) = (g, i) +diff --git a/src/Control/Comonad/Store/Zipper.hs b/src/Control/Comonad/Store/Zipper.hs +index 3b70c86..decc378 100644 +--- a/src/Control/Comonad/Store/Zipper.hs ++++ b/src/Control/Comonad/Store/Zipper.hs +@@ -15,7 +15,6 @@ + module Control.Comonad.Store.Zipper + ( Zipper, zipper, zipper1, unzipper, size) where + +-import Control.Applicative + import Control.Comonad (Comonad(..)) + import Data.Functor.Extend + import Data.Foldable diff --git a/users/grfn/xanthous/default.nix b/users/grfn/xanthous/default.nix new file mode 100644 index 000000000000..c0eca446c9ed --- /dev/null +++ b/users/grfn/xanthous/default.nix @@ -0,0 +1,26 @@ +{ depot ? (import ../../../. {}) +, pkgs ? depot.third_party.nixpkgs +, ... }: + +let + ignore = depot.third_party.gitignoreSource.gitignoreFilter ./.; + src = builtins.path { + name = "xanthous-source"; + path = ./.; + filter = path: type: + !(type == "directory" && builtins.baseNameOf path == "server") + && !(type == "directory" && builtins.baseNameOf path == "docs") + && (ignore path type + || builtins.baseNameOf path == "package.yaml"); + }; + # generated by cabal2nix + basePkg = pkgs.haskellPackages.callPackage ./pkg.nix { }; +in + +pkgs.haskell.lib.overrideCabal basePkg (default: { + inherit src; + version = "canon"; + configureFlags = [ + "--ghc-option=-Wall --ghc-option=-Werror" + ] ++ (default.configureFlags or []); +}) diff --git a/users/grfn/xanthous/docs/raw-types.org b/users/grfn/xanthous/docs/raw-types.org new file mode 100644 index 000000000000..e5bcda04268f --- /dev/null +++ b/users/grfn/xanthous/docs/raw-types.org @@ -0,0 +1,24 @@ +#+TITLE: Raw Types (WIP) + + +* Raw Types +** Item +*** Attributes +| name | type | commentary | +|-----------------+---------------------------+------------------------------------------------------------------| +| name | string | | +| description | string | Not capitalized, should usually start with an indefinite article | +| longDescription | string | Capitalized, should usually start with an indefinite article | +| char | [[*EntityChar][EntityChar]] | | +| wieldable | [[*EntityWieldable][EntityWieldable]] | | +| density | number , [number, number] | Density, or range for random density, in g/m³ | +| volume | number , [number, number] | Volume, or range for random volume, in m³ | +* Data Types +** EntityChar +*** Attributes +| name | type | commentary | +|-------+------+-------------------------------------------------------| +| char | char | How the entity is displayed when dropped on the floor | +| style | Attr | | +** TODO EntityWieldable +** TODO Attr diff --git a/users/grfn/xanthous/hie.yaml b/users/grfn/xanthous/hie.yaml new file mode 100644 index 000000000000..e7cf01d158e5 --- /dev/null +++ b/users/grfn/xanthous/hie.yaml @@ -0,0 +1,10 @@ +cradle: + cabal: + - path: './src' + component: 'lib:xanthous' + - path: './test' + component: 'test:test' + - path: './app' + component: 'exe:xanthous' + - path: './bench' + component: 'bench:benchmark' diff --git a/users/grfn/xanthous/nixpkgs.nix b/users/grfn/xanthous/nixpkgs.nix new file mode 100644 index 000000000000..7d7c16440545 --- /dev/null +++ b/users/grfn/xanthous/nixpkgs.nix @@ -0,0 +1,3 @@ +args: +let pkgs = (import ../../../. args).third_party; +in pkgs // { inherit pkgs; } diff --git a/users/grfn/xanthous/package.yaml b/users/grfn/xanthous/package.yaml new file mode 100644 index 000000000000..630dc69c11d3 --- /dev/null +++ b/users/grfn/xanthous/package.yaml @@ -0,0 +1,156 @@ +name: xanthous +version: 0.1.0.0 +github: "glittershark/xanthous" +license: GPL-3 +author: "Griffin Smith" +maintainer: "root@gws.fyi" +copyright: "2019 Griffin Smith" + +extra-source-files: +- README.org + +synopsis: A WIP TUI RPG +category: Game + +description: Please see the README on GitHub at <https://github.com/glittershark/xanthous> + +dependencies: +- base + +- aeson +- array +- async +- QuickCheck +- quickcheck-text +- quickcheck-instances +- brick +- bifunctors +- checkers +- classy-prelude +- comonad +- comonad-extras +- constraints +- containers +- criterion +- data-default +- data-interval +- deepseq +- directory +- fgl +- fgl-arbitrary +- file-embed +- filepath +- generic-arbitrary +- generic-lens +- groups +- hgeometry +- hgeometry-combinatorial +- JuicyPixels +- lens +- lifted-async +- linear +- megaparsec +- mmorph +- monad-control +- MonadRandom +- mtl +- optparse-applicative +- parallel +- parser-combinators +- pointed +- random +- random-fu +- random-extras +- random-source +- raw-strings-qq +- reflection +- Rasterific +- splitmix +- streams +- stache +- semigroups +- semigroupoids +- tomland +- transformers +- text +- text-zipper +- vector +- vty +- witherable +- yaml +- zlib + +default-extensions: +- BlockArguments +- ConstraintKinds +- DataKinds +- DeriveAnyClass +- DeriveGeneric +- DerivingStrategies +- DerivingVia +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTSyntax +- GeneralizedNewtypeDeriving +- KindSignatures +- StandaloneKindSignatures +- LambdaCase +- MultiWayIf +- NoImplicitPrelude +- NoStarIsType +- OverloadedStrings +- PolyKinds +- RankNTypes +- ScopedTypeVariables +- TupleSections +- TypeApplications +- TypeFamilies +- TypeOperators +- ViewPatterns + +ghc-options: +- -Wall + +library: + source-dirs: src + +executable: + source-dirs: app + main: Main.hs + dependencies: + - xanthous + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + - -O2 + +tests: + test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + - -O0 + dependencies: + - xanthous + - tasty + - tasty-hunit + - tasty-quickcheck + - tasty-rerun + - lens-properties + +benchmarks: + benchmark: + main: Bench.hs + source-dirs: bench + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - xanthous + - criterion diff --git a/users/grfn/xanthous/pkg.nix b/users/grfn/xanthous/pkg.nix new file mode 100644 index 000000000000..0f0dbfc9822d --- /dev/null +++ b/users/grfn/xanthous/pkg.nix @@ -0,0 +1,80 @@ +{ mkDerivation, aeson, array, async, base, bifunctors, brick +, checkers, classy-prelude, comonad, comonad-extras, constraints +, containers, criterion, data-default, data-interval, deepseq +, directory, fgl, fgl-arbitrary, file-embed, filepath +, generic-arbitrary, generic-lens, groups, hgeometry +, hgeometry-combinatorial, hpack, JuicyPixels, lens +, lens-properties, lib, lifted-async, linear, megaparsec, mmorph +, monad-control, MonadRandom, mtl, optparse-applicative, parallel +, parser-combinators, pointed, QuickCheck, quickcheck-instances +, quickcheck-text, random, random-extras, random-fu, random-source +, Rasterific, raw-strings-qq, reflection, semigroupoids, semigroups +, splitmix, stache, streams, tasty, tasty-hunit, tasty-quickcheck +, tasty-rerun, text, text-zipper, tomland, transformers, vector +, vty, witherable, yaml, zlib +}: +mkDerivation { + pname = "xanthous"; + version = "0.1.0.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + aeson array async base bifunctors brick checkers classy-prelude + comonad comonad-extras constraints containers criterion + data-default data-interval deepseq directory fgl fgl-arbitrary + file-embed filepath generic-arbitrary generic-lens groups hgeometry + hgeometry-combinatorial JuicyPixels lens lifted-async linear + megaparsec mmorph monad-control MonadRandom mtl + optparse-applicative parallel parser-combinators pointed QuickCheck + quickcheck-instances quickcheck-text random random-extras random-fu + random-source Rasterific raw-strings-qq reflection semigroupoids + semigroups splitmix stache streams text text-zipper tomland + transformers vector vty witherable yaml zlib + ]; + libraryToolDepends = [ hpack ]; + executableHaskellDepends = [ + aeson array async base bifunctors brick checkers classy-prelude + comonad comonad-extras constraints containers criterion + data-default data-interval deepseq directory fgl fgl-arbitrary + file-embed filepath generic-arbitrary generic-lens groups hgeometry + hgeometry-combinatorial JuicyPixels lens lifted-async linear + megaparsec mmorph monad-control MonadRandom mtl + optparse-applicative parallel parser-combinators pointed QuickCheck + quickcheck-instances quickcheck-text random random-extras random-fu + random-source Rasterific raw-strings-qq reflection semigroupoids + semigroups splitmix stache streams text text-zipper tomland + transformers vector vty witherable yaml zlib + ]; + testHaskellDepends = [ + aeson array async base bifunctors brick checkers classy-prelude + comonad comonad-extras constraints containers criterion + data-default data-interval deepseq directory fgl fgl-arbitrary + file-embed filepath generic-arbitrary generic-lens groups hgeometry + hgeometry-combinatorial JuicyPixels lens lens-properties + lifted-async linear megaparsec mmorph monad-control MonadRandom mtl + optparse-applicative parallel parser-combinators pointed QuickCheck + quickcheck-instances quickcheck-text random random-extras random-fu + random-source Rasterific raw-strings-qq reflection semigroupoids + semigroups splitmix stache streams tasty tasty-hunit + tasty-quickcheck tasty-rerun text text-zipper tomland transformers + vector vty witherable yaml zlib + ]; + benchmarkHaskellDepends = [ + aeson array async base bifunctors brick checkers classy-prelude + comonad comonad-extras constraints containers criterion + data-default data-interval deepseq directory fgl fgl-arbitrary + file-embed filepath generic-arbitrary generic-lens groups hgeometry + hgeometry-combinatorial JuicyPixels lens lifted-async linear + megaparsec mmorph monad-control MonadRandom mtl + optparse-applicative parallel parser-combinators pointed QuickCheck + quickcheck-instances quickcheck-text random random-extras random-fu + random-source Rasterific raw-strings-qq reflection semigroupoids + semigroups splitmix stache streams text text-zipper tomland + transformers vector vty witherable yaml zlib + ]; + prePatch = "hpack"; + homepage = "https://github.com/glittershark/xanthous#readme"; + description = "A WIP TUI RPG"; + license = lib.licenses.gpl3Only; +} diff --git a/users/grfn/xanthous/server/.envrc b/users/grfn/xanthous/server/.envrc new file mode 100644 index 000000000000..051d09d292a8 --- /dev/null +++ b/users/grfn/xanthous/server/.envrc @@ -0,0 +1 @@ +eval "$(lorri direnv)" diff --git a/users/grfn/xanthous/server/.gitignore b/users/grfn/xanthous/server/.gitignore new file mode 100644 index 000000000000..2f7896d1d136 --- /dev/null +++ b/users/grfn/xanthous/server/.gitignore @@ -0,0 +1 @@ +target/ diff --git a/users/grfn/xanthous/server/Cargo.lock b/users/grfn/xanthous/server/Cargo.lock new file mode 100644 index 000000000000..46488d4575f2 --- /dev/null +++ b/users/grfn/xanthous/server/Cargo.lock @@ -0,0 +1,1937 @@ +# This file is automatically @generated by Cargo. +# It is not intended for manual editing. +version = 3 + +[[package]] +name = "addr2line" +version = "0.17.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b9ecd88a8c8378ca913a680cd98f0f13ac67383d35993f86c90a70e3f137816b" +dependencies = [ + "gimli", +] + +[[package]] +name = "adler" +version = "1.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f26201604c87b1e01bd3d98f8d5d9a8fcbb815e8cedb41ffccbeb4bf593a35fe" + +[[package]] +name = "aes" +version = "0.7.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9e8b47f52ea9bae42228d07ec09eb676433d7c4ed1ebdf0f1d1c29ed446f1ab8" +dependencies = [ + "cfg-if 1.0.0", + "cipher", + "cpufeatures", + "ctr", + "opaque-debug", +] + +[[package]] +name = "ahash" +version = "0.7.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fcb51a0695d8f838b1ee009b3fbf66bda078cd64590202a864a8f3e8c4315c47" +dependencies = [ + "getrandom", + "once_cell", + "version_check", +] + +[[package]] +name = "aho-corasick" +version = "0.7.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1e37cfd5e7657ada45f742d6e99ca5788580b5c529dc78faf11ece6dc702656f" +dependencies = [ + "memchr", +] + +[[package]] +name = "ansi_term" +version = "0.12.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d52a9bb7ec0cf484c551830a7ce27bd20d67eac647e1befb56b0be4ee39a55d2" +dependencies = [ + "winapi", +] + +[[package]] +name = "atomic-shim" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d20fdac7156779a1a30d970e838195558b4810dd06aa69e7c7461bdc518edf9b" +dependencies = [ + "crossbeam", +] + +[[package]] +name = "atty" +version = "0.2.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d9b39be18770d11421cdb1b9947a45dd3f37e93092cbf377614828a319d5fee8" +dependencies = [ + "hermit-abi", + "libc", + "winapi", +] + +[[package]] +name = "autocfg" +version = "1.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cdb031dd78e28731d87d56cc8ffef4a8f36ca26c38fe2de700543e627f8a464a" + +[[package]] +name = "backtrace" +version = "0.3.63" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "321629d8ba6513061f26707241fa9bc89524ff1cd7a915a97ef0c62c666ce1b6" +dependencies = [ + "addr2line", + "cc", + "cfg-if 1.0.0", + "libc", + "miniz_oxide", + "object", + "rustc-demangle", +] + +[[package]] +name = "base64ct" +version = "1.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e6b4d9b1225d28d360ec6a231d65af1fd99a2a095154c8040689617290569c5c" + +[[package]] +name = "bcrypt-pbkdf" +version = "0.6.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7c38c03b9506bd92bf1ef50665a81eda156f615438f7654bffba58907e6149d7" +dependencies = [ + "blowfish", + "crypto-mac", + "pbkdf2", + "sha2", + "zeroize", +] + +[[package]] +name = "bit-vec" +version = "0.6.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "349f9b6a179ed607305526ca489b34ad0a41aed5f7980fa90eb03160b69598fb" + +[[package]] +name = "bitflags" +version = "1.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bef38d45163c2f1dde094a7dfd33ccf595c92905c8f8f4fdc18d06fb1037718a" + +[[package]] +name = "block-buffer" +version = "0.9.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4152116fd6e9dadb291ae18fc1ec3575ed6d84c29642d97890f4b4a3417297e4" +dependencies = [ + "generic-array", +] + +[[package]] +name = "block-modes" +version = "0.8.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2cb03d1bed155d89dce0f845b7899b18a9a163e148fd004e1c28421a783e2d8e" +dependencies = [ + "block-padding", + "cipher", +] + +[[package]] +name = "block-padding" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8d696c370c750c948ada61c69a0ee2cbbb9c50b1019ddb86d9317157a99c2cae" + +[[package]] +name = "blowfish" +version = "0.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fe3ff3fc1de48c1ac2e3341c4df38b0d1bfb8fdf04632a187c8b75aaa319a7ab" +dependencies = [ + "byteorder", + "cipher", + "opaque-debug", +] + +[[package]] +name = "bumpalo" +version = "3.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8f1e260c3a9040a7c19a12468758f4c16f31a81a1fe087482be9570ec864bb6c" + +[[package]] +name = "byteorder" +version = "1.4.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "14c189c53d098945499cdfa7ecc63567cf3886b3332b312a5b4585d8d3a6a610" + +[[package]] +name = "bytes" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c4872d67bab6358e59559027aa3b9157c53d9358c51423c17554809a8858e0f8" + +[[package]] +name = "cc" +version = "1.0.71" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "79c2681d6594606957bbb8631c4b90a7fcaaa72cdb714743a437b156d6a7eedd" + +[[package]] +name = "cfg-if" +version = "0.1.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4785bdd1c96b2a846b2bd7cc02e86b6b3dbf14e7e53446c4f54c92a361040822" + +[[package]] +name = "cfg-if" +version = "1.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd" + +[[package]] +name = "chrono" +version = "0.4.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "670ad68c9088c2a963aaa298cb369688cf3f9465ce5e2d4ca10e6e0098a1ce73" +dependencies = [ + "libc", + "num-integer", + "num-traits", + "winapi", +] + +[[package]] +name = "cipher" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7ee52072ec15386f770805afd189a01c8841be8696bed250fa2f13c4c0d6dfb7" +dependencies = [ + "generic-array", +] + +[[package]] +name = "clap" +version = "3.0.0-beta.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "feff3878564edb93745d58cf63e17b63f24142506e7a20c87a5521ed7bfb1d63" +dependencies = [ + "atty", + "bitflags", + "clap_derive", + "indexmap", + "lazy_static", + "os_str_bytes", + "strsim", + "termcolor", + "textwrap", + "unicase", +] + +[[package]] +name = "clap_derive" +version = "3.0.0-beta.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8b15c6b4f786ffb6192ffe65a36855bc1fc2444bcd0945ae16748dcd6ed7d0d3" +dependencies = [ + "heck", + "proc-macro-error", + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "color-eyre" +version = "0.5.11" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1f1885697ee8a177096d42f158922251a41973117f6d8a234cee94b9509157b7" +dependencies = [ + "backtrace", + "color-spantrace", + "eyre", + "indenter", + "once_cell", + "owo-colors", + "tracing-error", +] + +[[package]] +name = "color-spantrace" +version = "0.1.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b6eee477a4a8a72f4addd4de416eb56d54bc307b284d6601bafdee1f4ea462d1" +dependencies = [ + "once_cell", + "owo-colors", + "tracing-core", + "tracing-error", +] + +[[package]] +name = "cpufeatures" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "95059428f66df56b63431fdb4e1947ed2190586af5c5a8a8b71122bdf5a7f469" +dependencies = [ + "libc", +] + +[[package]] +name = "crc32fast" +version = "1.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "81156fece84ab6a9f2afdb109ce3ae577e42b1228441eded99bd77f627953b1a" +dependencies = [ + "cfg-if 1.0.0", +] + +[[package]] +name = "crossbeam" +version = "0.7.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "69323bff1fb41c635347b8ead484a5ca6c3f11914d784170b158d8449ab07f8e" +dependencies = [ + "cfg-if 0.1.10", + "crossbeam-channel", + "crossbeam-deque", + "crossbeam-epoch 0.8.2", + "crossbeam-queue", + "crossbeam-utils 0.7.2", +] + +[[package]] +name = "crossbeam-channel" +version = "0.4.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b153fe7cbef478c567df0f972e02e6d736db11affe43dfc9c56a9374d1adfb87" +dependencies = [ + "crossbeam-utils 0.7.2", + "maybe-uninit", +] + +[[package]] +name = "crossbeam-deque" +version = "0.7.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c20ff29ded3204c5106278a81a38f4b482636ed4fa1e6cfbeef193291beb29ed" +dependencies = [ + "crossbeam-epoch 0.8.2", + "crossbeam-utils 0.7.2", + "maybe-uninit", +] + +[[package]] +name = "crossbeam-epoch" +version = "0.8.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "058ed274caafc1f60c4997b5fc07bf7dc7cca454af7c6e81edffe5f33f70dace" +dependencies = [ + "autocfg", + "cfg-if 0.1.10", + "crossbeam-utils 0.7.2", + "lazy_static", + "maybe-uninit", + "memoffset 0.5.6", + "scopeguard", +] + +[[package]] +name = "crossbeam-epoch" +version = "0.9.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4ec02e091aa634e2c3ada4a392989e7c3116673ef0ac5b72232439094d73b7fd" +dependencies = [ + "cfg-if 1.0.0", + "crossbeam-utils 0.8.5", + "lazy_static", + "memoffset 0.6.4", + "scopeguard", +] + +[[package]] +name = "crossbeam-queue" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "774ba60a54c213d409d5353bda12d49cd68d14e45036a285234c8d6f91f92570" +dependencies = [ + "cfg-if 0.1.10", + "crossbeam-utils 0.7.2", + "maybe-uninit", +] + +[[package]] +name = "crossbeam-utils" +version = "0.7.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c3c7c73a2d1e9fc0886a08b93e98eb643461230d5f1925e4036204d5f2e261a8" +dependencies = [ + "autocfg", + "cfg-if 0.1.10", + "lazy_static", +] + +[[package]] +name = "crossbeam-utils" +version = "0.8.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d82cfc11ce7f2c3faef78d8a684447b40d503d9681acebed6cb728d45940c4db" +dependencies = [ + "cfg-if 1.0.0", + "lazy_static", +] + +[[package]] +name = "crypto-mac" +version = "0.11.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b1d1a86f49236c215f271d40892d5fc950490551400b02ef360692c29815c714" +dependencies = [ + "generic-array", + "subtle", +] + +[[package]] +name = "cryptovec" +version = "0.6.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ccc7fa13a6bbb2322d325292c57f4c8e7291595506f8289968a0eb61c3130bdf" +dependencies = [ + "libc", + "winapi", +] + +[[package]] +name = "ctr" +version = "0.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "049bb91fb4aaf0e3c7efa6cd5ef877dbbbd15b39dad06d9948de4ec8a75761ea" +dependencies = [ + "cipher", +] + +[[package]] +name = "dashmap" +version = "4.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e77a43b28d0668df09411cb0bc9a8c2adc40f9a048afe863e05fd43251e8e39c" +dependencies = [ + "cfg-if 1.0.0", + "num_cpus", +] + +[[package]] +name = "data-encoding" +version = "2.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3ee2393c4a91429dffb4bedf19f4d6abf27d8a732c8ce4980305d782e5426d57" + +[[package]] +name = "digest" +version = "0.9.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d3dd60d1080a57a05ab032377049e0591415d2b31afd7028356dbf3cc6dcb066" +dependencies = [ + "generic-array", +] + +[[package]] +name = "dirs" +version = "3.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "30baa043103c9d0c2a57cf537cc2f35623889dc0d405e6c3cccfadbc81c71309" +dependencies = [ + "dirs-sys", +] + +[[package]] +name = "dirs-sys" +version = "0.3.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "03d86534ed367a67548dc68113a0f5db55432fdfbb6e6f9d77704397d95d5780" +dependencies = [ + "libc", + "redox_users", + "winapi", +] + +[[package]] +name = "endian-type" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c34f04666d835ff5d62e058c3995147c06f42fe86ff053337632bca83e42702d" + +[[package]] +name = "eyre" +version = "0.6.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "221239d1d5ea86bf5d6f91c9d6bc3646ffe471b08ff9b0f91c44f115ac969d2b" +dependencies = [ + "indenter", + "once_cell", +] + +[[package]] +name = "flate2" +version = "1.0.22" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1e6988e897c1c9c485f43b47a529cef42fde0547f9d8d41a7062518f1d8fc53f" +dependencies = [ + "cfg-if 1.0.0", + "crc32fast", + "libc", + "miniz_oxide", +] + +[[package]] +name = "fnv" +version = "1.0.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1" + +[[package]] +name = "futures" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a12aa0eb539080d55c3f2d45a67c3b58b6b0773c1a3ca2dfec66d58c97fd66ca" +dependencies = [ + "futures-channel", + "futures-core", + "futures-executor", + "futures-io", + "futures-sink", + "futures-task", + "futures-util", +] + +[[package]] +name = "futures-channel" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5da6ba8c3bb3c165d3c7319fc1cc8304facf1fb8db99c5de877183c08a273888" +dependencies = [ + "futures-core", + "futures-sink", +] + +[[package]] +name = "futures-core" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "88d1c26957f23603395cd326b0ffe64124b818f4449552f960d815cfba83a53d" + +[[package]] +name = "futures-executor" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "45025be030969d763025784f7f355043dc6bc74093e4ecc5000ca4dc50d8745c" +dependencies = [ + "futures-core", + "futures-task", + "futures-util", +] + +[[package]] +name = "futures-io" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "522de2a0fe3e380f1bc577ba0474108faf3f6b18321dbf60b3b9c39a75073377" + +[[package]] +name = "futures-macro" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "18e4a4b95cea4b4ccbcf1c5675ca7c4ee4e9e75eb79944d07defde18068f79bb" +dependencies = [ + "autocfg", + "proc-macro-hack", + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "futures-sink" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "36ea153c13024fe480590b3e3d4cad89a0cfacecc24577b68f86c6ced9c2bc11" + +[[package]] +name = "futures-task" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1d3d00f4eddb73e498a54394f228cd55853bdf059259e8e7bc6e69d408892e99" + +[[package]] +name = "futures-util" +version = "0.3.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "36568465210a3a6ee45e1f165136d68671471a501e632e9a98d96872222b5481" +dependencies = [ + "autocfg", + "futures-channel", + "futures-core", + "futures-io", + "futures-macro", + "futures-sink", + "futures-task", + "memchr", + "pin-project-lite", + "pin-utils", + "proc-macro-hack", + "proc-macro-nested", + "slab", +] + +[[package]] +name = "generic-array" +version = "0.14.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "501466ecc8a30d1d3b7fc9229b122b2ce8ed6e9d9223f1138d4babb253e51817" +dependencies = [ + "typenum", + "version_check", +] + +[[package]] +name = "getrandom" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7fcd999463524c52659517fe2cea98493cfe485d10565e7b0fb07dbba7ad2753" +dependencies = [ + "cfg-if 1.0.0", + "libc", + "wasi", +] + +[[package]] +name = "gimli" +version = "0.26.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "78cc372d058dcf6d5ecd98510e7fbc9e5aec4d21de70f65fea8fecebcd881bd4" + +[[package]] +name = "hashbrown" +version = "0.11.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ab5ef0d4909ef3724cc8cce6ccc8572c5c817592e9285f5464f8e86f8bd3726e" +dependencies = [ + "ahash", +] + +[[package]] +name = "heck" +version = "0.3.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6d621efb26863f0e9924c6ac577e8275e5e6b77455db64ffa6c65c904e9e132c" +dependencies = [ + "unicode-segmentation", +] + +[[package]] +name = "hermit-abi" +version = "0.1.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "62b467343b94ba476dcb2500d242dadbb39557df889310ac77c5d99100aaac33" +dependencies = [ + "libc", +] + +[[package]] +name = "hmac" +version = "0.11.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2a2a2320eb7ec0ebe8da8f744d7812d9fc4cb4d09344ac01898dbcb6a20ae69b" +dependencies = [ + "crypto-mac", + "digest", +] + +[[package]] +name = "http" +version = "0.2.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1323096b05d41827dadeaee54c9981958c0f94e670bc94ed80037d1a7b8b186b" +dependencies = [ + "bytes", + "fnv", + "itoa", +] + +[[package]] +name = "http-body" +version = "0.4.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1ff4f84919677303da5f147645dbea6b1881f368d03ac84e1dc09031ebd7b2c6" +dependencies = [ + "bytes", + "http", + "pin-project-lite", +] + +[[package]] +name = "httparse" +version = "1.5.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "acd94fdbe1d4ff688b67b04eee2e17bd50995534a61539e45adfefb45e5e5503" + +[[package]] +name = "httpdate" +version = "1.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6456b8a6c8f33fee7d958fcd1b60d55b11940a79e63ae87013e6d22e26034440" + +[[package]] +name = "hyper" +version = "0.14.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2b91bb1f221b6ea1f1e4371216b70f40748774c2fb5971b450c07773fb92d26b" +dependencies = [ + "bytes", + "futures-channel", + "futures-core", + "futures-util", + "http", + "http-body", + "httparse", + "httpdate", + "itoa", + "pin-project-lite", + "socket2", + "tokio", + "tower-service", + "tracing", + "want", +] + +[[package]] +name = "indenter" +version = "0.3.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ce23b50ad8242c51a442f3ff322d56b02f08852c77e4c0b4d3fd684abc89c683" + +[[package]] +name = "indexmap" +version = "1.7.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bc633605454125dec4b66843673f01c7df2b89479b32e0ed634e43a91cff62a5" +dependencies = [ + "autocfg", + "hashbrown", +] + +[[package]] +name = "instant" +version = "0.1.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7a5bbe824c507c5da5956355e86a746d82e0e1464f65d862cc5e71da70e94b2c" +dependencies = [ + "cfg-if 1.0.0", +] + +[[package]] +name = "ipnet" +version = "2.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "68f2d64f2edebec4ce84ad108148e67e1064789bee435edc5b60ad398714a3a9" + +[[package]] +name = "itoa" +version = "0.4.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b71991ff56294aa922b450139ee08b3bfc70982c6b2c7562771375cf73542dd4" + +[[package]] +name = "js-sys" +version = "0.3.55" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7cc9ffccd38c451a86bf13657df244e9c3f37493cce8e5e21e940963777acc84" +dependencies = [ + "wasm-bindgen", +] + +[[package]] +name = "lazy_static" +version = "1.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e2abad23fbc42b3700f2f279844dc832adb2b2eb069b2df918f455c4e18cc646" + +[[package]] +name = "libc" +version = "0.2.107" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fbe5e23404da5b4f555ef85ebed98fb4083e55a00c317800bc2a50ede9f3d219" + +[[package]] +name = "libsodium-sys" +version = "0.2.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6b779387cd56adfbc02ea4a668e704f729be8d6a6abd2c27ca5ee537849a92fd" +dependencies = [ + "cc", + "libc", + "pkg-config", + "walkdir", +] + +[[package]] +name = "lock_api" +version = "0.4.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "712a4d093c9976e24e7dbca41db895dabcbac38eb5f4045393d17a95bdfb1109" +dependencies = [ + "scopeguard", +] + +[[package]] +name = "log" +version = "0.4.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "51b9bbe6c47d51fc3e1a9b945965946b4c44142ab8792c50835a980d362c2710" +dependencies = [ + "cfg-if 1.0.0", +] + +[[package]] +name = "mach" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b823e83b2affd8f40a9ee8c29dbc56404c1e34cd2710921f2801e2cf29527afa" +dependencies = [ + "libc", +] + +[[package]] +name = "matchers" +version = "0.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f099785f7595cc4b4553a174ce30dd7589ef93391ff414dbb67f62392b9e0ce1" +dependencies = [ + "regex-automata", +] + +[[package]] +name = "maybe-uninit" +version = "2.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "60302e4db3a61da70c0cb7991976248362f30319e88850c487b9b95bbf059e00" + +[[package]] +name = "md5" +version = "0.7.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "490cc448043f947bae3cbee9c203358d62dbee0db12107a74be5c30ccfd09771" + +[[package]] +name = "memchr" +version = "2.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "308cc39be01b73d0d18f82a0e7b2a3df85245f84af96fdddc5d202d27e47b86a" + +[[package]] +name = "memoffset" +version = "0.5.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "043175f069eda7b85febe4a74abbaeff828d9f8b448515d3151a14a3542811aa" +dependencies = [ + "autocfg", +] + +[[package]] +name = "memoffset" +version = "0.6.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "59accc507f1338036a0477ef61afdae33cde60840f4dfe481319ce3ad116ddf9" +dependencies = [ + "autocfg", +] + +[[package]] +name = "metrics" +version = "0.17.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a00f42f354a2ed4894db863b3a4db47aef2d2e4435b937221749bd37a8a7aaa8" +dependencies = [ + "ahash", + "metrics-macros", + "proc-macro-hack", +] + +[[package]] +name = "metrics-exporter-prometheus" +version = "0.6.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "343a5ceb38235928e7a5687412590f07e6d281522dcd9ff51246f8856eef5fe5" +dependencies = [ + "hyper", + "ipnet", + "metrics", + "metrics-util", + "parking_lot", + "quanta", + "thiserror", + "tokio", +] + +[[package]] +name = "metrics-macros" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "caa72e4a3d157986dd2565c82ecbddcc23941513669a3766b938f6b72eb87f3f" +dependencies = [ + "lazy_static", + "proc-macro-hack", + "proc-macro2", + "quote", + "regex", + "syn", +] + +[[package]] +name = "metrics-util" +version = "0.10.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "74c9b6aee519e1461b678952d3671652bb341d0664b1188f895a436a4e2e6ffa" +dependencies = [ + "ahash", + "aho-corasick", + "atomic-shim", + "crossbeam-epoch 0.9.5", + "crossbeam-utils 0.8.5", + "dashmap", + "hashbrown", + "indexmap", + "metrics", + "num_cpus", + "ordered-float", + "parking_lot", + "quanta", + "radix_trie", + "sketches-ddsketch", +] + +[[package]] +name = "miniz_oxide" +version = "0.4.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a92518e98c078586bc6c934028adcca4c92a53d6a958196de835170a01d84e4b" +dependencies = [ + "adler", + "autocfg", +] + +[[package]] +name = "mio" +version = "0.7.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8067b404fe97c70829f082dec8bcf4f71225d7eaea1d8645349cb76fa06205cc" +dependencies = [ + "libc", + "log", + "miow", + "ntapi", + "winapi", +] + +[[package]] +name = "miow" +version = "0.3.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b9f1c5b025cda876f66ef43a113f91ebc9f4ccef34843000e0adf6ebbab84e21" +dependencies = [ + "winapi", +] + +[[package]] +name = "nibble_vec" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "77a5d83df9f36fe23f0c3648c6bbb8b0298bb5f1939c8f2704431371f4b84d43" +dependencies = [ + "smallvec", +] + +[[package]] +name = "nix" +version = "0.23.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f305c2c2e4c39a82f7bf0bf65fb557f9070ce06781d4f2454295cc34b1c43188" +dependencies = [ + "bitflags", + "cc", + "cfg-if 1.0.0", + "libc", + "memoffset 0.6.4", +] + +[[package]] +name = "ntapi" +version = "0.3.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3f6bb902e437b6d86e03cce10a7e2af662292c5dfef23b65899ea3ac9354ad44" +dependencies = [ + "winapi", +] + +[[package]] +name = "num-bigint" +version = "0.4.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f93ab6289c7b344a8a9f60f88d80aa20032336fe78da341afc91c8a2341fc75f" +dependencies = [ + "autocfg", + "num-integer", + "num-traits", +] + +[[package]] +name = "num-integer" +version = "0.1.44" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d2cc698a63b549a70bc047073d2949cce27cd1c7b0a4a862d08a8031bc2801db" +dependencies = [ + "autocfg", + "num-traits", +] + +[[package]] +name = "num-traits" +version = "0.2.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9a64b1ec5cda2586e284722486d802acf1f7dbdc623e2bfc57e65ca1cd099290" +dependencies = [ + "autocfg", +] + +[[package]] +name = "num_cpus" +version = "1.13.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "05499f3756671c15885fee9034446956fff3f243d6077b91e5767df161f766b3" +dependencies = [ + "hermit-abi", + "libc", +] + +[[package]] +name = "object" +version = "0.27.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "67ac1d3f9a1d3616fd9a60c8d74296f22406a238b6a72f5cc1e6f314df4ffbf9" +dependencies = [ + "memchr", +] + +[[package]] +name = "once_cell" +version = "1.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "692fcb63b64b1758029e0a96ee63e049ce8c5948587f2f7208df04625e5f6b56" + +[[package]] +name = "opaque-debug" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "624a8340c38c1b80fd549087862da4ba43e08858af025b236e509b6649fc13d5" + +[[package]] +name = "ordered-float" +version = "2.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "97c9d06878b3a851e8026ef94bf7fef9ba93062cd412601da4d9cf369b1cc62d" +dependencies = [ + "num-traits", +] + +[[package]] +name = "os_str_bytes" +version = "4.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "addaa943333a514159c80c97ff4a93306530d965d27e139188283cd13e06a799" +dependencies = [ + "memchr", +] + +[[package]] +name = "owo-colors" +version = "1.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2386b4ebe91c2f7f51082d4cefa145d030e33a1842a96b12e4885cc3c01f7a55" + +[[package]] +name = "parking_lot" +version = "0.11.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7d17b78036a60663b797adeaee46f5c9dfebb86948d1255007a1d6be0271ff99" +dependencies = [ + "instant", + "lock_api", + "parking_lot_core", +] + +[[package]] +name = "parking_lot_core" +version = "0.8.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d76e8e1493bcac0d2766c42737f34458f1c8c50c0d23bcb24ea953affb273216" +dependencies = [ + "cfg-if 1.0.0", + "instant", + "libc", + "redox_syscall", + "smallvec", + "winapi", +] + +[[package]] +name = "password-hash" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "77e0b28ace46c5a396546bcf443bf422b57049617433d8854227352a4a9b24e7" +dependencies = [ + "base64ct", + "rand_core", + "subtle", +] + +[[package]] +name = "pbkdf2" +version = "0.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d95f5254224e617595d2cc3cc73ff0a5eaf2637519e25f03388154e9378b6ffa" +dependencies = [ + "base64ct", + "crypto-mac", + "hmac", + "password-hash", + "sha2", +] + +[[package]] +name = "pin-project-lite" +version = "0.2.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8d31d11c69a6b52a174b42bdc0c30e5e11670f90788b2c471c31c1d17d449443" + +[[package]] +name = "pin-utils" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8b870d8c151b6f2fb93e84a13146138f05d02ed11c7e7c54f8826aaaf7c9f184" + +[[package]] +name = "pkg-config" +version = "0.3.22" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "12295df4f294471248581bc09bef3c38a5e46f1e36d6a37353621a0c6c357e1f" + +[[package]] +name = "ppv-lite86" +version = "0.2.15" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ed0cfbc8191465bed66e1718596ee0b0b35d5ee1f41c5df2189d0fe8bde535ba" + +[[package]] +name = "proc-macro-error" +version = "1.0.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "da25490ff9892aab3fcf7c36f08cfb902dd3e71ca0f9f9517bea02a73a5ce38c" +dependencies = [ + "proc-macro-error-attr", + "proc-macro2", + "quote", + "syn", + "version_check", +] + +[[package]] +name = "proc-macro-error-attr" +version = "1.0.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a1be40180e52ecc98ad80b184934baf3d0d29f979574e439af5a55274b35f869" +dependencies = [ + "proc-macro2", + "quote", + "version_check", +] + +[[package]] +name = "proc-macro-hack" +version = "0.5.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dbf0c48bc1d91375ae5c3cd81e3722dff1abcf81a30960240640d223f59fe0e5" + +[[package]] +name = "proc-macro-nested" +version = "0.1.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bc881b2c22681370c6a780e47af9840ef841837bc98118431d4e1868bd0c1086" + +[[package]] +name = "proc-macro2" +version = "1.0.32" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ba508cc11742c0dc5c1659771673afbab7a0efab23aa17e854cbab0837ed0b43" +dependencies = [ + "unicode-xid", +] + +[[package]] +name = "quanta" +version = "0.9.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "20afe714292d5e879d8b12740aa223c6a88f118af41870e8b6196e39a02238a8" +dependencies = [ + "crossbeam-utils 0.8.5", + "libc", + "mach", + "once_cell", + "raw-cpuid", + "wasi", + "web-sys", + "winapi", +] + +[[package]] +name = "quote" +version = "1.0.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "38bc8cc6a5f2e3655e0899c1b848643b2562f853f114bfec7be120678e3ace05" +dependencies = [ + "proc-macro2", +] + +[[package]] +name = "radix_trie" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c069c179fcdc6a2fe24d8d18305cf085fdbd4f922c041943e203685d6a1c58fd" +dependencies = [ + "endian-type", + "nibble_vec", +] + +[[package]] +name = "rand" +version = "0.8.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2e7573632e6454cf6b99d7aac4ccca54be06da05aca2ef7423d22d27d4d4bcd8" +dependencies = [ + "libc", + "rand_chacha", + "rand_core", + "rand_hc", +] + +[[package]] +name = "rand_chacha" +version = "0.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e6c10a63a0fa32252be49d21e7709d4d4baf8d231c2dbce1eaa8141b9b127d88" +dependencies = [ + "ppv-lite86", + "rand_core", +] + +[[package]] +name = "rand_core" +version = "0.6.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d34f1408f55294453790c48b2f1ebbb1c5b4b7563eb1f418bcfcfdbb06ebb4e7" +dependencies = [ + "getrandom", +] + +[[package]] +name = "rand_hc" +version = "0.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d51e9f596de227fda2ea6c84607f5558e196eeaf43c986b724ba4fb8fdf497e7" +dependencies = [ + "rand_core", +] + +[[package]] +name = "raw-cpuid" +version = "10.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "929f54e29691d4e6a9cc558479de70db7aa3d98cd6fe7ab86d7507aa2886b9d2" +dependencies = [ + "bitflags", +] + +[[package]] +name = "redox_syscall" +version = "0.2.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8383f39639269cde97d255a32bdb68c047337295414940c68bdd30c2e13203ff" +dependencies = [ + "bitflags", +] + +[[package]] +name = "redox_users" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "528532f3d801c87aec9def2add9ca802fe569e44a544afe633765267840abe64" +dependencies = [ + "getrandom", + "redox_syscall", +] + +[[package]] +name = "regex" +version = "1.5.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d07a8629359eb56f1e2fb1652bb04212c072a87ba68546a04065d525673ac461" +dependencies = [ + "aho-corasick", + "memchr", + "regex-syntax", +] + +[[package]] +name = "regex-automata" +version = "0.1.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6c230d73fb8d8c1b9c0b3135c5142a8acee3a0558fb8db5cf1cb65f8d7862132" +dependencies = [ + "regex-syntax", +] + +[[package]] +name = "regex-syntax" +version = "0.6.25" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f497285884f3fcff424ffc933e56d7cbca511def0c9831a7f9b5f6153e3cc89b" + +[[package]] +name = "remove_dir_all" +version = "0.5.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3acd125665422973a33ac9d3dd2df85edad0f4ae9b00dafb1a05e43a9f5ef8e7" +dependencies = [ + "winapi", +] + +[[package]] +name = "rustc-demangle" +version = "0.1.21" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7ef03e0a2b150c7a90d01faf6254c9c48a41e95fb2a8c2ac1c6f0d2b9aefc342" + +[[package]] +name = "ryu" +version = "1.0.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "71d301d4193d031abdd79ff7e3dd721168a9572ef3fe51a1517aba235bd8f86e" + +[[package]] +name = "same-file" +version = "1.0.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "93fc1dc3aaa9bfed95e02e6eadabb4baf7e3078b0bd1b4d7b6b0b68378900502" +dependencies = [ + "winapi-util", +] + +[[package]] +name = "scopeguard" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d29ab0c6d3fc0ee92fe66e2d99f700eab17a8d57d1c1d3b748380fb20baa78cd" + +[[package]] +name = "serde" +version = "1.0.130" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f12d06de37cf59146fbdecab66aa99f9fe4f78722e3607577a5375d66bd0c913" + +[[package]] +name = "serde_derive" +version = "1.0.130" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d7bc1a1ab1961464eae040d96713baa5a724a8152c1222492465b54322ec508b" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "serde_json" +version = "1.0.69" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e466864e431129c7e0d3476b92f20458e5879919a0596c6472738d9fa2d342f8" +dependencies = [ + "itoa", + "ryu", + "serde", +] + +[[package]] +name = "sha2" +version = "0.9.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b69f9a4c9740d74c5baa3fd2e547f9525fa8088a8a958e0ca2409a514e33f5fa" +dependencies = [ + "block-buffer", + "cfg-if 1.0.0", + "cpufeatures", + "digest", + "opaque-debug", +] + +[[package]] +name = "sharded-slab" +version = "0.1.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "900fba806f70c630b0a382d0d825e17a0f19fcd059a2ade1ff237bcddf446b31" +dependencies = [ + "lazy_static", +] + +[[package]] +name = "signal-hook-registry" +version = "1.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e51e73328dc4ac0c7ccbda3a494dfa03df1de2f46018127f60c693f2648455b0" +dependencies = [ + "libc", +] + +[[package]] +name = "sketches-ddsketch" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "76a77a8fd93886010f05e7ea0720e569d6d16c65329dbe3ec033bbbccccb017b" + +[[package]] +name = "slab" +version = "0.4.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9def91fd1e018fe007022791f865d0ccc9b3a0d5001e01aabb8b40e46000afb5" + +[[package]] +name = "smallvec" +version = "1.7.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1ecab6c735a6bb4139c0caafd0cc3635748bbb3acf4550e8138122099251f309" + +[[package]] +name = "socket2" +version = "0.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5dc90fe6c7be1a323296982db1836d1ea9e47b6839496dde9a541bc496df3516" +dependencies = [ + "libc", + "winapi", +] + +[[package]] +name = "strsim" +version = "0.10.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "73473c0e59e6d5812c5dfe2a064a6444949f089e20eec9a2e5506596494e4623" + +[[package]] +name = "subtle" +version = "2.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6bdef32e8150c2a081110b42772ffe7d7c9032b606bc226c8260fd97e0976601" + +[[package]] +name = "syn" +version = "1.0.81" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f2afee18b8beb5a596ecb4a2dce128c719b4ba399d34126b9e4396e3f9860966" +dependencies = [ + "proc-macro2", + "quote", + "unicode-xid", +] + +[[package]] +name = "tempfile" +version = "3.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dac1c663cfc93810f88aed9b8941d48cabf856a1b111c29a40439018d870eb22" +dependencies = [ + "cfg-if 1.0.0", + "libc", + "rand", + "redox_syscall", + "remove_dir_all", + "winapi", +] + +[[package]] +name = "termcolor" +version = "1.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2dfed899f0eb03f32ee8c6a0aabdb8a7949659e3466561fc0adf54e26d88c5f4" +dependencies = [ + "winapi-util", +] + +[[package]] +name = "textwrap" +version = "0.14.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0066c8d12af8b5acd21e00547c3797fde4e8677254a7ee429176ccebbe93dd80" +dependencies = [ + "unicode-width", +] + +[[package]] +name = "thiserror" +version = "1.0.30" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "854babe52e4df1653706b98fcfc05843010039b406875930a70e4d9644e5c417" +dependencies = [ + "thiserror-impl", +] + +[[package]] +name = "thiserror-impl" +version = "1.0.30" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "aa32fd3f627f367fe16f893e2597ae3c05020f8bba2666a4e6ea73d377e5714b" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "thread_local" +version = "1.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8018d24e04c95ac8790716a5987d0fec4f8b27249ffa0f7d33f1369bdfb88cbd" +dependencies = [ + "once_cell", +] + +[[package]] +name = "thrussh" +version = "0.33.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8e6540238a9adf83df6e66541c182a52acf892ab335595ca965c229ade8536f8" +dependencies = [ + "bitflags", + "byteorder", + "cryptovec", + "digest", + "flate2", + "futures", + "generic-array", + "log", + "rand", + "sha2", + "thiserror", + "thrussh-keys", + "thrussh-libsodium", + "tokio", +] + +[[package]] +name = "thrussh-keys" +version = "0.21.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a72cc51a2932b18d92f7289332d8564cec4a5014063722a9d3fdca52c5d8f5ab" +dependencies = [ + "aes", + "bcrypt-pbkdf", + "bit-vec", + "block-modes", + "byteorder", + "cryptovec", + "data-encoding", + "dirs", + "futures", + "hmac", + "log", + "md5", + "num-bigint", + "num-integer", + "pbkdf2", + "rand", + "serde", + "serde_derive", + "sha2", + "thiserror", + "thrussh-libsodium", + "tokio", + "tokio-stream", + "yasna", +] + +[[package]] +name = "thrussh-libsodium" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cfe89c70d27b1cb92e13bc8af63493e890d0de46dae4df0e28233f62b4ed9500" +dependencies = [ + "lazy_static", + "libc", + "libsodium-sys", + "pkg-config", + "vcpkg", +] + +[[package]] +name = "tokio" +version = "1.13.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "588b2d10a336da58d877567cd8fb8a14b463e2104910f8132cd054b4b96e29ee" +dependencies = [ + "autocfg", + "bytes", + "libc", + "memchr", + "mio", + "num_cpus", + "once_cell", + "pin-project-lite", + "signal-hook-registry", + "tokio-macros", + "winapi", +] + +[[package]] +name = "tokio-macros" +version = "1.5.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "114383b041aa6212c579467afa0075fbbdd0718de036100bc0ba7961d8cb9095" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "tokio-stream" +version = "0.1.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "50145484efff8818b5ccd256697f36863f587da82cf8b409c53adf1e840798e3" +dependencies = [ + "futures-core", + "pin-project-lite", + "tokio", +] + +[[package]] +name = "tower-service" +version = "0.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "360dfd1d6d30e05fda32ace2c8c70e9c0a9da713275777f5a4dbb8a1893930c6" + +[[package]] +name = "tracing" +version = "0.1.29" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "375a639232caf30edfc78e8d89b2d4c375515393e7af7e16f01cd96917fb2105" +dependencies = [ + "cfg-if 1.0.0", + "pin-project-lite", + "tracing-attributes", + "tracing-core", +] + +[[package]] +name = "tracing-attributes" +version = "0.1.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f4f480b8f81512e825f337ad51e94c1eb5d3bbdf2b363dcd01e2b19a9ffe3f8e" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "tracing-core" +version = "0.1.21" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1f4ed65637b8390770814083d20756f87bfa2c21bf2f110babdc5438351746e4" +dependencies = [ + "lazy_static", +] + +[[package]] +name = "tracing-error" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b4d7c0b83d4a500748fa5879461652b361edf5c9d51ede2a2ac03875ca185e24" +dependencies = [ + "tracing", + "tracing-subscriber", +] + +[[package]] +name = "tracing-log" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a6923477a48e41c1951f1999ef8bb5a3023eb723ceadafe78ffb65dc366761e3" +dependencies = [ + "lazy_static", + "log", + "tracing-core", +] + +[[package]] +name = "tracing-serde" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fb65ea441fbb84f9f6748fd496cf7f63ec9af5bca94dd86456978d055e8eb28b" +dependencies = [ + "serde", + "tracing-core", +] + +[[package]] +name = "tracing-subscriber" +version = "0.2.25" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0e0d2eaa99c3c2e41547cfa109e910a68ea03823cccad4a0525dcbc9b01e8c71" +dependencies = [ + "ansi_term", + "chrono", + "lazy_static", + "matchers", + "regex", + "serde", + "serde_json", + "sharded-slab", + "smallvec", + "thread_local", + "tracing", + "tracing-core", + "tracing-log", + "tracing-serde", +] + +[[package]] +name = "try-lock" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "59547bce71d9c38b83d9c0e92b6066c4253371f15005def0c30d9657f50c7642" + +[[package]] +name = "typenum" +version = "1.14.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b63708a265f51345575b27fe43f9500ad611579e764c79edbc2037b1121959ec" + +[[package]] +name = "unicase" +version = "2.6.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "50f37be617794602aabbeee0be4f259dc1778fabe05e2d67ee8f79326d5cb4f6" +dependencies = [ + "version_check", +] + +[[package]] +name = "unicode-segmentation" +version = "1.8.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8895849a949e7845e06bd6dc1aa51731a103c42707010a5b591c0038fb73385b" + +[[package]] +name = "unicode-width" +version = "0.1.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3ed742d4ea2bd1176e236172c8429aaf54486e7ac098db29ffe6529e0ce50973" + +[[package]] +name = "unicode-xid" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8ccb82d61f80a663efe1f787a51b16b5a51e3314d6ac365b08639f52387b33f3" + +[[package]] +name = "vcpkg" +version = "0.2.15" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "accd4ea62f7bb7a82fe23066fb0957d48ef677f6eeb8215f372f52e48bb32426" + +[[package]] +name = "version_check" +version = "0.9.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5fecdca9a5291cc2b8dcf7dc02453fee791a280f3743cb0905f8822ae463b3fe" + +[[package]] +name = "walkdir" +version = "2.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "808cf2735cd4b6866113f648b791c6adc5714537bc222d9347bb203386ffda56" +dependencies = [ + "same-file", + "winapi", + "winapi-util", +] + +[[package]] +name = "want" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1ce8a968cb1cd110d136ff8b819a556d6fb6d919363c61534f6860c7eb172ba0" +dependencies = [ + "log", + "try-lock", +] + +[[package]] +name = "wasi" +version = "0.10.2+wasi-snapshot-preview1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fd6fbd9a79829dd1ad0cc20627bf1ed606756a7f77edff7b66b7064f9cb327c6" + +[[package]] +name = "wasm-bindgen" +version = "0.2.78" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "632f73e236b219150ea279196e54e610f5dbafa5d61786303d4da54f84e47fce" +dependencies = [ + "cfg-if 1.0.0", + "wasm-bindgen-macro", +] + +[[package]] +name = "wasm-bindgen-backend" +version = "0.2.78" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a317bf8f9fba2476b4b2c85ef4c4af8ff39c3c7f0cdfeed4f82c34a880aa837b" +dependencies = [ + "bumpalo", + "lazy_static", + "log", + "proc-macro2", + "quote", + "syn", + "wasm-bindgen-shared", +] + +[[package]] +name = "wasm-bindgen-macro" +version = "0.2.78" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d56146e7c495528bf6587663bea13a8eb588d39b36b679d83972e1a2dbbdacf9" +dependencies = [ + "quote", + "wasm-bindgen-macro-support", +] + +[[package]] +name = "wasm-bindgen-macro-support" +version = "0.2.78" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7803e0eea25835f8abdc585cd3021b3deb11543c6fe226dcd30b228857c5c5ab" +dependencies = [ + "proc-macro2", + "quote", + "syn", + "wasm-bindgen-backend", + "wasm-bindgen-shared", +] + +[[package]] +name = "wasm-bindgen-shared" +version = "0.2.78" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0237232789cf037d5480773fe568aac745bfe2afbc11a863e97901780a6b47cc" + +[[package]] +name = "web-sys" +version = "0.3.55" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "38eb105f1c59d9eaa6b5cdc92b859d85b926e82cb2e0945cd0c9259faa6fe9fb" +dependencies = [ + "js-sys", + "wasm-bindgen", +] + +[[package]] +name = "winapi" +version = "0.3.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5c839a674fcd7a98952e593242ea400abe93992746761e38641405d28b00f419" +dependencies = [ + "winapi-i686-pc-windows-gnu", + "winapi-x86_64-pc-windows-gnu", +] + +[[package]] +name = "winapi-i686-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6" + +[[package]] +name = "winapi-util" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "70ec6ce85bb158151cae5e5c87f95a8e97d2c0c4b001223f33a334e3ce5de178" +dependencies = [ + "winapi", +] + +[[package]] +name = "winapi-x86_64-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f" + +[[package]] +name = "xanthous-server" +version = "0.1.0" +dependencies = [ + "base64ct", + "clap", + "color-eyre", + "eyre", + "futures", + "libc", + "metrics", + "metrics-exporter-prometheus", + "nix", + "pbkdf2", + "tempfile", + "thrussh", + "thrussh-keys", + "tokio", + "tracing", + "tracing-subscriber", +] + +[[package]] +name = "yasna" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e262a29d0e61ccf2b6190d7050d4b237535fc76ce4c1210d9caa316f71dffa75" +dependencies = [ + "bit-vec", + "num-bigint", +] + +[[package]] +name = "zeroize" +version = "1.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4756f7db3f7b5574938c3eb1c117038b8e07f95ee6718c0efad4ac21508f1efd" diff --git a/users/grfn/xanthous/server/Cargo.toml b/users/grfn/xanthous/server/Cargo.toml new file mode 100644 index 000000000000..adb2a02391bd --- /dev/null +++ b/users/grfn/xanthous/server/Cargo.toml @@ -0,0 +1,29 @@ +[package] +name = "xanthous-server" +version = "0.1.0" +edition = "2018" + +[dependencies] +clap = "3.0.0-beta.5" +color-eyre = "0.5.11" +eyre = "0.6.5" +thrussh = "0.33.5" +thrussh-keys = "0.21.0" +tracing = "0.1.29" +tracing-subscriber = "0.2.25" +metrics = "0.17.0" +metrics-exporter-prometheus = "0.6.1" +futures = "0.3.17" +libc = "0.2.103" +nix = "0.23.0" + +# Pins for rust 1.55 (2018 edition) until we have 1.56 in nixpkgs-unstable +pbkdf2 = "<0.9" +base64ct = "<1.2" + +[dependencies.tokio] +version = "1.13" +features = ["rt", "rt-multi-thread", "macros", "net", "process", "fs", "signal"] + +[dev-dependencies] +tempfile = "3.2.0" diff --git a/users/grfn/xanthous/server/default.nix b/users/grfn/xanthous/server/default.nix new file mode 100644 index 000000000000..0b3900e4d5fe --- /dev/null +++ b/users/grfn/xanthous/server/default.nix @@ -0,0 +1,14 @@ +args@{ + depot ? import ../../../.. {} +, pkgs ? depot.third_party.nixpkgs +, ... +}: + +depot.third_party.naersk.buildPackage { + name = "xanthous-server"; + version = "0.0.1"; + src = depot.third_party.gitignoreSource ./.; + passthru = { + docker = import ./docker.nix args; + }; +} diff --git a/users/grfn/xanthous/server/docker.nix b/users/grfn/xanthous/server/docker.nix new file mode 100644 index 000000000000..a62943c2b077 --- /dev/null +++ b/users/grfn/xanthous/server/docker.nix @@ -0,0 +1,19 @@ +{ depot ? import ../../../.. {} +, pkgs ? depot.third_party.nixpkgs +, ... +}: + +let + inherit (depot.users.grfn) xanthous; + xanthous-server = xanthous.server; +in pkgs.dockerTools.buildLayeredImage { + name = "xanthous-server"; + tag = "latest"; + contents = [ xanthous xanthous-server ]; + config = { + Cmd = [ + "${xanthous-server}/bin/xanthous-server" + "--xanthous-binary-path" "${xanthous}/bin/xanthous" + ]; + }; +} diff --git a/users/grfn/xanthous/server/module.nix b/users/grfn/xanthous/server/module.nix new file mode 100644 index 000000000000..73ac276caf4a --- /dev/null +++ b/users/grfn/xanthous/server/module.nix @@ -0,0 +1,48 @@ +{ config, lib, pkgs, depot, ... }: + +let + cfg = config.services.xanthous-server; +in { + options = with lib; { + services.xanthous-server = { + enable = mkEnableOption "xanthous server"; + + port = mkOption { + type = types.int; + default = 2222; + description = "Port to listen to for SSH connections"; + }; + + metricsPort = mkOption { + type = types.int; + default = 9000; + description = "Port to listen to for prometheus metrics"; + }; + + image = mkOption { + type = types.package; + default = depot.users.grfn.xanthous.server.docker; + description = "OCI image file to run"; + }; + + ed25519SecretKeyFile = mkOption { + type = with types; uniq string; + description = "Path to the ed25519 secret key for the server"; + }; + }; + }; + + config = lib.mkIf cfg.enable { + virtualisation.oci-containers.containers."xanthous-server" = { + autoStart = true; + image = "${cfg.image.imageName}:${cfg.image.imageTag}"; + imageFile = cfg.image; + ports = [ + "${toString cfg.port}:22" + "${toString cfg.metricsPort}:9000" + ]; + environment.SECRET_KEY_FILE = "/secret-key"; + volumes = [ "/etc/secrets/xanthous-server-secret-key:/secret-key" ]; + }; + }; +} diff --git a/users/grfn/xanthous/server/shell.nix b/users/grfn/xanthous/server/shell.nix new file mode 100644 index 000000000000..a6747175f105 --- /dev/null +++ b/users/grfn/xanthous/server/shell.nix @@ -0,0 +1,11 @@ +let + depot = import ../../../.. {}; + pkgs = depot.third_party.nixpkgs; +in + +pkgs.mkShell { + buildInputs = with pkgs; [ + rustup + rust-analyzer + ]; +} diff --git a/users/grfn/xanthous/server/src/main.rs b/users/grfn/xanthous/server/src/main.rs new file mode 100644 index 000000000000..ed8f831c7d3f --- /dev/null +++ b/users/grfn/xanthous/server/src/main.rs @@ -0,0 +1,388 @@ +use std::net::SocketAddr; +use std::path::PathBuf; +use std::pin::Pin; +use std::process::Command; +use std::str; +use std::sync::Arc; + +use clap::Parser; +use color_eyre::eyre::Result; +use eyre::{bail, Context}; +use futures::future::{ready, Ready}; +use futures::Future; +use metrics_exporter_prometheus::PrometheusBuilder; +use nix::pty::Winsize; +use pty::ChildHandle; +use thrussh::ChannelId; +use thrussh::{ + server::{self, Auth, Session}, + CryptoVec, +}; +use thrussh_keys::decode_secret_key; +use thrussh_keys::key::KeyPair; +use tokio::fs::File; +use tokio::io::{AsyncReadExt, AsyncWriteExt}; +use tokio::net::TcpListener; +use tokio::select; +use tokio::time::Instant; +use tracing::{debug, error, info, info_span, trace, warn, Instrument}; +use tracing_subscriber::EnvFilter; + +use crate::pty::WaitPid; + +mod metrics; +mod pty; + +use crate::metrics::reported::*; +use crate::metrics::{decrement_gauge, histogram, increment_counter, increment_gauge}; + +/// SSH-compatible server for playing Xanthous +#[derive(Parser, Debug)] +struct Opts { + /// Address to bind to + #[clap(long, short = 'a', default_value = "0.0.0.0:22")] + address: String, + + /// Address to listen to for metrics + #[clap(long, default_value = "0.0.0.0:9000")] + metrics_address: SocketAddr, + + /// Format to use when emitting log events + #[clap( + long, + env = "LOG_FORMAT", + default_value = "full", + possible_values = &["compact", "full", "pretty", "json"] + )] + log_format: String, + + /// Full path to the xanthous binary + #[clap(long, env = "XANTHOUS_BINARY_PATH")] + xanthous_binary_path: String, + + /// Path to a file containing the ed25519 secret key for the server + #[clap(long, env = "SECRET_KEY_FILE")] + secret_key_file: PathBuf, + + /// Level to log at + #[clap(long, env = "LOG_LEVEL", default_value = "info")] + log_level: String, +} + +impl Opts { + async fn read_secret_key(&self) -> Result<KeyPair> { + let mut file = File::open(&self.secret_key_file) + .await + .context("Reading secret key file")?; + let mut secret_key = Vec::with_capacity(464); + file.read_to_end(&mut secret_key).await?; + Ok(decode_secret_key(str::from_utf8(&secret_key)?, None)?) + } + + async fn ssh_server_config(&self) -> Result<server::Config> { + let key_pair = self.read_secret_key().await?; + + Ok(server::Config { + server_id: "SSH-2.0-xanthous".to_owned(), + keys: vec![key_pair], + ..Default::default() + }) + } + + fn init_logging(&self) -> Result<()> { + let filter = EnvFilter::try_new(&self.log_level)?; + let s = tracing_subscriber::fmt().with_env_filter(filter); + + match self.log_format.as_str() { + "compact" => s.compact().init(), + "full" => s.init(), + "pretty" => s.pretty().init(), + "json" => s.json().with_current_span(true).init(), + _ => bail!("Invalid log format `{}`"), + } + + Ok(()) + } +} + +struct Handler { + address: SocketAddr, + xanthous_binary_path: &'static str, + username: Option<String>, + child: Option<ChildHandle>, +} + +async fn run_child( + mut child: pty::Child, + mut server_handle: server::Handle, + channel_id: ChannelId, +) -> Result<()> { + let mut buf = [0; 2048]; + loop { + select! { + r = child.tty.read(&mut buf) => { + let read_bytes = r?; + if read_bytes == 0 { + info!("EOF received from process"); + let _ = server_handle.close(channel_id).await; + return Ok(()) + } else { + trace!(?read_bytes, "read bytes from child"); + let _ = server_handle.data(channel_id, CryptoVec::from_slice(&buf[..read_bytes])).await; + } + } + status = WaitPid::new(child.pid) => { + match status { + Ok(_status) => info!("Child exited"), + Err(error) => error!(%error, "Child failed"), + } + let _ = server_handle.close(channel_id).await; + return Ok(()) + } + } + } +} + +impl Handler { + async fn spawn_shell( + &mut self, + mut handle: server::Handle, + channel_id: ChannelId, + term: String, + winsize: Winsize, + ) -> Result<()> { + let mut cmd = Command::new(self.xanthous_binary_path); + cmd.env("TERM", term); + if let Some(username) = &self.username { + cmd.args(["--name", username]); + } + cmd.arg("--disable-saving"); + + let child = pty::spawn(cmd, Some(winsize), None).await?; + info!(pid = %child.pid, "Spawned child"); + increment_gauge!(RUNNING_PROCESSES, 1.0); + self.child = Some(child.handle().await?); + tokio::spawn( + async move { + let span = info_span!("child", pid = %child.pid); + if let Err(error) = run_child(child, handle.clone(), channel_id) + .instrument(span.clone()) + .await + { + span.in_scope(|| error!(%error, "Error running child")); + let _ = handle.close(channel_id).await; + } + decrement_gauge!(RUNNING_PROCESSES, 1.0); + } + .in_current_span(), + ); + Ok(()) + } +} + +#[allow(clippy::type_complexity)] +impl server::Handler for Handler { + type Error = eyre::Error; + type FutureAuth = Ready<Result<(Self, Auth)>>; + type FutureUnit = Pin<Box<dyn Future<Output = Result<(Self, Session)>> + Send + 'static>>; + type FutureBool = Ready<Result<(Self, Session, bool)>>; + + fn finished_auth(self, auth: Auth) -> Self::FutureAuth { + ready(Ok((self, auth))) + } + + fn finished_bool(self, b: bool, session: Session) -> Self::FutureBool { + ready(Ok((self, session, b))) + } + + fn finished(self, session: Session) -> Self::FutureUnit { + Box::pin(ready(Ok((self, session)))) + } + + fn auth_none(mut self, username: &str) -> Self::FutureAuth { + info!(%username, "Accepted new connection"); + self.username = Some(username.to_owned()); + self.finished_auth(Auth::Accept) + } + + fn auth_password(mut self, username: &str, _password: &str) -> Self::FutureAuth { + info!(%username, "Accepted new connection"); + self.username = Some(username.to_owned()); + self.finished_auth(Auth::Accept) + } + + fn auth_publickey( + mut self, + username: &str, + _: &thrussh_keys::key::PublicKey, + ) -> Self::FutureAuth { + info!(%username, "Accepted new connection"); + self.username = Some(username.to_owned()); + self.finished_auth(Auth::Accept) + } + + fn pty_request( + mut self, + channel: thrussh::ChannelId, + term: &str, + col_width: u32, + row_height: u32, + pix_width: u32, + pix_height: u32, + modes: &[(thrussh::Pty, u32)], + session: Session, + ) -> Self::FutureUnit { + let term = term.to_owned(); + let modes = modes.to_vec(); + Box::pin(async move { + debug!( + %term, + %col_width, + %row_height, + %pix_width, + %pix_height, + ?modes, + "PTY Requested" + ); + + self.spawn_shell( + session.handle(), + channel, + term, + Winsize { + ws_row: row_height as _, + ws_col: col_width as _, + ws_xpixel: pix_width as _, + ws_ypixel: pix_height as _, + }, + ) + .await?; + + Ok((self, session)) + }) + } + + fn window_change_request( + mut self, + _channel: ChannelId, + col_width: u32, + row_height: u32, + pix_width: u32, + pix_height: u32, + session: Session, + ) -> Self::FutureUnit { + Box::pin(async move { + if let Some(child) = self.child.as_mut() { + trace!(%row_height, %col_width, "Window resize request received"); + child + .resize_window(Winsize { + ws_row: row_height as _, + ws_col: col_width as _, + ws_xpixel: pix_width as _, + ws_ypixel: pix_height as _, + }) + .await?; + } else { + warn!("Resize request received without child process; ignoring"); + } + + Ok((self, session)) + }) + } + + fn data( + mut self, + _channel: thrussh::ChannelId, + data: &[u8], + session: Session, + ) -> Self::FutureUnit { + trace!(data = %String::from_utf8_lossy(data), raw_data = ?data); + let data = data.to_owned(); + Box::pin(async move { + if let Some(child) = self.child.as_mut() { + child.write_all(&data).await?; + } else { + warn!("Data received without child process; ignoring"); + } + + Ok((self, session)) + }) + } +} + +#[tokio::main] +async fn main() -> Result<()> { + color_eyre::install()?; + let opts = Box::leak::<'static>(Box::new(Opts::parse())); + opts.init_logging()?; + PrometheusBuilder::new() + .listen_address(opts.metrics_address) + .install()?; + metrics::register(); + + let config = Arc::new(opts.ssh_server_config().await?); + info!(address = %opts.address, "Listening for new SSH connections"); + let listener = TcpListener::bind(&opts.address).await?; + + loop { + let (stream, address) = listener.accept().await?; + increment_counter!(CONNECTIONS_ACCEPTED); + increment_gauge!(ACTIVE_CONNECTIONS, 1.0); + let config = config.clone(); + let handler = Handler { + xanthous_binary_path: &opts.xanthous_binary_path, + address, + username: None, + child: None, + }; + tokio::spawn(async move { + let span = info_span!("client", address = %handler.address); + let start = Instant::now(); + if let Err(error) = server::run_stream(config, stream, handler) + .instrument(span.clone()) + .await + { + span.in_scope(|| error!(%error)); + } + let duration = start.elapsed(); + span.in_scope(|| info!(duration_ms = %duration.as_millis(), "Client disconnected")); + histogram!(CONNECTION_DURATION, duration); + decrement_gauge!(ACTIVE_CONNECTIONS, 1.0); + }); + } +} + +#[cfg(test)] +mod tests { + use tempfile::NamedTempFile; + + use super::*; + + #[tokio::test] + async fn read_secret_key() { + use std::io::Write; + + let mut file = NamedTempFile::new().unwrap(); + file.write_all( + b" +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACAYz80xcK7jYxZMAl6apIHKRtB0Z2U78gG39c1QaIhgMwAAAJB9vxK9fb8S +vQAAAAtzc2gtZWQyNTUxOQAAACAYz80xcK7jYxZMAl6apIHKRtB0Z2U78gG39c1QaIhgMw +AAAEDNZ0d3lLNBGU6Im4JOpr490TOjm+cB7kMVXjVg3iCowBjPzTFwruNjFkwCXpqkgcpG +0HRnZTvyAbf1zVBoiGAzAAAACHRlc3Qta2V5AQIDBAU= +-----END OPENSSH PRIVATE KEY----- +", + ) + .unwrap(); + + let opts: Opts = Opts::parse_from(&[ + "xanthous-server".as_ref(), + "--xanthous-binary-path".as_ref(), + "/bin/xanthous".as_ref(), + "--secret-key-file".as_ref(), + file.path().as_os_str(), + ]); + opts.read_secret_key().await.unwrap(); + } +} diff --git a/users/grfn/xanthous/server/src/metrics.rs b/users/grfn/xanthous/server/src/metrics.rs new file mode 100644 index 000000000000..6912cdd9c9ee --- /dev/null +++ b/users/grfn/xanthous/server/src/metrics.rs @@ -0,0 +1,24 @@ +pub use ::metrics::*; + +pub mod reported { + /// Counter: Connections accepted on the TCP listener + pub const CONNECTIONS_ACCEPTED: &str = "ssh.connections.accepted"; + + /// Histogram: Connection duration + pub const CONNECTION_DURATION: &str = "ssh.connections.duration"; + + /// Gauge: Currently active connections + pub const ACTIVE_CONNECTIONS: &str = "ssh.connections.active"; + + /// Gauge: Currently running xanthous processes + pub const RUNNING_PROCESSES: &str = "ssh.child.processes"; +} + +pub fn register() { + use reported::*; + + register_counter!(CONNECTIONS_ACCEPTED); + register_histogram!(CONNECTION_DURATION); + register_gauge!(ACTIVE_CONNECTIONS); + register_gauge!(RUNNING_PROCESSES); +} diff --git a/users/grfn/xanthous/server/src/pty.rs b/users/grfn/xanthous/server/src/pty.rs new file mode 100644 index 000000000000..611130f5bcd9 --- /dev/null +++ b/users/grfn/xanthous/server/src/pty.rs @@ -0,0 +1,173 @@ +use std::io::{self}; +use std::os::unix::prelude::{AsRawFd, CommandExt, FromRawFd}; +use std::pin::Pin; +use std::process::{abort, Command}; +use std::task::{Context, Poll}; + +use eyre::{bail, Result}; +use futures::Future; +use nix::pty::forkpty; +use nix::pty::Winsize; +use nix::sys::termios::Termios; +use nix::sys::wait::{waitpid, WaitPidFlag, WaitStatus}; +use nix::unistd::{ForkResult, Pid}; +use tokio::fs::File; +use tokio::io::{AsyncRead, AsyncWrite}; +use tokio::signal::unix::{signal, Signal, SignalKind}; +use tokio::task::spawn_blocking; + +mod ioctl { + use super::Winsize; + use libc::TIOCSWINSZ; + use nix::ioctl_write_ptr_bad; + + ioctl_write_ptr_bad!(tiocswinsz, TIOCSWINSZ, Winsize); +} + +async fn asyncify<F, T>(f: F) -> Result<T> +where + F: FnOnce() -> Result<T> + Send + 'static, + T: Send + 'static, +{ + match spawn_blocking(f).await { + Ok(res) => res, + Err(_) => bail!("background task failed",), + } +} + +pub struct Child { + pub tty: File, + pub pid: Pid, +} + +pub struct ChildHandle { + pub tty: File, +} + +pub struct WaitPid { + pid: Pid, + signal: Signal, +} + +impl WaitPid { + pub fn new(pid: Pid) -> Self { + Self { + pid, + signal: signal(SignalKind::child()).unwrap(), + } + } +} + +impl Future for WaitPid { + type Output = nix::Result<WaitStatus>; + + fn poll(mut self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll<Self::Output> { + let _ = self.signal.poll_recv(cx); + match waitpid(self.pid, Some(WaitPidFlag::WNOHANG)) { + Ok(WaitStatus::StillAlive) => Poll::Pending, + result => Poll::Ready(result), + } + } +} + +impl Child { + pub async fn handle(&self) -> io::Result<ChildHandle> { + Ok(ChildHandle { + tty: self.tty.try_clone().await?, + }) + } +} + +impl ChildHandle { + pub async fn resize_window(&mut self, winsize: Winsize) -> Result<()> { + let fd = self.tty.as_raw_fd(); + asyncify(move || unsafe { + ioctl::tiocswinsz(fd, &winsize as *const Winsize)?; + Ok(()) + }) + .await + } +} + +pub async fn spawn( + mut cmd: Command, + winsize: Option<Winsize>, + termios: Option<Termios>, +) -> Result<Child> { + asyncify(move || unsafe { + let res = forkpty(winsize.as_ref(), termios.as_ref())?; + match res.fork_result { + ForkResult::Parent { child } => Ok(Child { + pid: child, + tty: File::from_raw_fd(res.master), + }), + ForkResult::Child => { + cmd.exec(); + abort(); + } + } + }) + .await +} + +impl AsyncRead for Child { + fn poll_read( + mut self: Pin<&mut Self>, + cx: &mut Context<'_>, + buf: &mut tokio::io::ReadBuf<'_>, + ) -> Poll<io::Result<()>> { + Pin::new(&mut self.tty).poll_read(cx, buf) + } +} + +impl AsyncWrite for Child { + fn poll_write( + mut self: Pin<&mut Self>, + cx: &mut Context<'_>, + buf: &[u8], + ) -> Poll<Result<usize, io::Error>> { + Pin::new(&mut self.tty).poll_write(cx, buf) + } + + fn poll_flush(mut self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll<Result<(), io::Error>> { + Pin::new(&mut self.tty).poll_flush(cx) + } + + fn poll_shutdown( + mut self: Pin<&mut Self>, + cx: &mut Context<'_>, + ) -> Poll<Result<(), io::Error>> { + Pin::new(&mut self.tty).poll_shutdown(cx) + } +} + +impl AsyncRead for ChildHandle { + fn poll_read( + mut self: Pin<&mut Self>, + cx: &mut Context<'_>, + buf: &mut tokio::io::ReadBuf<'_>, + ) -> Poll<io::Result<()>> { + Pin::new(&mut self.tty).poll_read(cx, buf) + } +} + +impl AsyncWrite for ChildHandle { + fn poll_write( + mut self: Pin<&mut Self>, + cx: &mut Context<'_>, + buf: &[u8], + ) -> Poll<Result<usize, io::Error>> { + Pin::new(&mut self.tty).poll_write(cx, buf) + } + + fn poll_flush(mut self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll<Result<(), io::Error>> { + Pin::new(&mut self.tty).poll_flush(cx) + } + + fn poll_shutdown( + mut self: Pin<&mut Self>, + cx: &mut Context<'_>, + ) -> Poll<Result<(), io::Error>> { + Pin::new(&mut self.tty).poll_shutdown(cx) + } +} diff --git a/users/grfn/xanthous/shell.nix b/users/grfn/xanthous/shell.nix new file mode 100644 index 000000000000..572ed211bcf4 --- /dev/null +++ b/users/grfn/xanthous/shell.nix @@ -0,0 +1,23 @@ +let + depot = import ../../../. {}; + inherit (depot) third_party; + pkgs = third_party.nixpkgs; +in + +(pkgs.haskellPackages.extend (pkgs.haskell.lib.packageSourceOverrides { + xanthous = third_party.gitignoreSource ./.; +})).shellFor { + packages = p: [p.xanthous]; + withHoogle = true; + doBenchmark = true; + buildInputs = (with pkgs.haskellPackages; [ + cabal-install + ghc-prof-flamegraph + hp2pretty + hlint + haskell-language-server + cabal2nix + ]) ++ (with pkgs; [ + qpdf + ]); +} diff --git a/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs b/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs new file mode 100644 index 000000000000..e89fcd621157 --- /dev/null +++ b/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE ConstraintKinds, DataKinds, DeriveGeneric, DerivingVia #-} +{-# LANGUAGE ExplicitNamespaces, FlexibleContexts, FlexibleInstances #-} +{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds, ScopedTypeVariables, StandaloneDeriving #-} +{-# LANGUAGE TypeApplications, TypeFamilies, TypeInType, TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wall #-} +-- | https://gist.github.com/konn/27c00f784dd883ec2b90eab8bc84a81d +module Data.Aeson.Generic.DerivingVia + ( StrFun(..), Setting(..), SumEncoding'(..), DefaultOptions, WithOptions(..) + , -- Utility type synonyms to save ticks (') before promoted data constructors + type Drop, type CamelTo2, type UserDefined + , type TaggedObj, type UntaggedVal, type ObjWithSingleField, type TwoElemArr + , type FieldLabelModifier + , type ConstructorTagModifier + , type AllNullaryToStringTag + , type OmitNothingFields + , type SumEnc + , type UnwrapUnaryRecords + , type TagSingleConstructors + ) + where + +import Prelude +import Data.Aeson (FromJSON (..), GFromJSON, GToJSON, + ToJSON (..)) +import Data.Aeson (Options (..), Zero, camelTo2, + genericParseJSON) +import Data.Aeson (defaultOptions, genericToJSON) +import qualified Data.Aeson as Aeson +import Data.Kind (Constraint, Type) +import Data.Proxy (Proxy (..)) +import Data.Reflection (Reifies (..)) +import GHC.Generics (Generic, Rep) +import GHC.TypeLits (KnownNat, KnownSymbol, natVal, symbolVal) +import GHC.TypeLits (Nat, Symbol) + +newtype WithOptions options a = WithOptions { runWithOptions :: a } + +data StrFun = Drop Nat + | CamelTo2 Symbol + | forall p. UserDefined p + +type Drop = 'Drop +type CamelTo2 = 'CamelTo2 +type UserDefined = 'UserDefined + +type family Demoted a where + Demoted Symbol = String + Demoted StrFun = String -> String + Demoted [a] = [Demoted a] + Demoted Setting = Options -> Options + Demoted SumEncoding' = Aeson.SumEncoding + Demoted a = a + +data SumEncoding' = TaggedObj {tagFieldName' :: Symbol, contentsFieldName :: Symbol } + | UntaggedVal + | ObjWithSingleField + | TwoElemArr + +type TaggedObj = 'TaggedObj +type UntaggedVal = 'UntaggedVal +type ObjWithSingleField = 'ObjWithSingleField +type TwoElemArr = 'TwoElemArr + +data Setting = FieldLabelModifier [StrFun] + | ConstructorTagModifier [StrFun] + | AllNullaryToStringTag Bool + | OmitNothingFields Bool + | SumEnc SumEncoding' + | UnwrapUnaryRecords Bool + | TagSingleConstructors Bool + +type FieldLabelModifier = 'FieldLabelModifier +type ConstructorTagModifier = 'ConstructorTagModifier +-- | If 'True' the constructors of a datatype, with all nullary constructors, +-- will be encoded to just a string with the constructor tag. If 'False' the +-- encoding will always follow the 'SumEncoding'. +type AllNullaryToStringTag = 'AllNullaryToStringTag +type OmitNothingFields = 'OmitNothingFields +type SumEnc = 'SumEnc +-- | Hide the field name when a record constructor has only one field, like a +-- newtype. +type UnwrapUnaryRecords = 'UnwrapUnaryRecords +-- | Encode types with a single constructor as sums, so that +-- 'AllNullaryToStringTag' and 'SumEncoding' apply. +type TagSingleConstructors = 'TagSingleConstructors + +class Demotable (a :: k) where + demote :: proxy a -> Demoted k + +type All :: (Type -> Constraint) -> [Type] -> Constraint +type family All p xs where + All p '[] = () + All p (x ': xs) = (p x, All p xs) + +instance Reifies f (String -> String) => Demotable ('UserDefined f) where + demote _ = reflect @f Proxy + +instance KnownSymbol sym => Demotable sym where + demote = symbolVal + +instance (KnownSymbol s, KnownSymbol t) => Demotable ('TaggedObj s t) where + demote _ = Aeson.TaggedObject (symbolVal @s Proxy) (symbolVal @t Proxy) + +instance Demotable 'UntaggedVal where + demote _ = Aeson.UntaggedValue + +instance Demotable 'ObjWithSingleField where + demote _ = Aeson.ObjectWithSingleField + +instance Demotable 'TwoElemArr where + demote _ = Aeson.TwoElemArray + +instance Demotable xs => Demotable ('FieldLabelModifier xs) where + demote _ o = o { fieldLabelModifier = foldr (.) id (demote (Proxy @xs)) } + +instance Demotable xs => Demotable ('ConstructorTagModifier xs) where + demote _ o = o { constructorTagModifier = foldr (.) id (demote (Proxy @xs)) } + +instance Demotable b => Demotable ('AllNullaryToStringTag b) where + demote _ o = o { allNullaryToStringTag = demote (Proxy @b) } + +instance Demotable b => Demotable ('OmitNothingFields b) where + demote _ o = o { omitNothingFields = demote (Proxy @b) } + +instance Demotable b => Demotable ('UnwrapUnaryRecords b) where + demote _ o = o { unwrapUnaryRecords = demote (Proxy @b) } + +instance Demotable b => Demotable ('TagSingleConstructors b) where + demote _ o = o { tagSingleConstructors = demote (Proxy @b) } + +instance Demotable b => Demotable ('SumEnc b) where + demote _ o = o { sumEncoding = demote (Proxy @b) } + +instance Demotable 'True where + demote _ = True + +instance Demotable 'False where + demote _ = False + +instance KnownNat n => Demotable ('Drop n) where + demote _ = drop (fromIntegral $ natVal (Proxy :: Proxy n)) + +instance KnownSymbol sym => Demotable ('CamelTo2 sym) where + demote _ = camelTo2 $ head $ symbolVal @sym Proxy + +instance {-# OVERLAPPING #-} Demotable ('[] :: [k]) where + demote _ = [] + +instance (Demotable (x :: k), Demotable (xs :: [k])) => Demotable (x ': xs) where + demote _ = demote (Proxy @x) : demote (Proxy @xs) + +type DefaultOptions = ('[] :: [Setting]) + +reflectOptions :: forall xs proxy. Demotable (xs :: [Setting]) => proxy xs -> Options +reflectOptions pxy = foldr (.) id (demote pxy) defaultOptions + +instance (Demotable (options :: [Setting])) => Reifies options Options where + reflect = reflectOptions + +instance (Generic a, GToJSON Zero (Rep a), Reifies (options :: k) Options) + => ToJSON (WithOptions options a) where + toJSON = genericToJSON (reflect (Proxy @options)) . runWithOptions + +instance (Generic a, GFromJSON Zero (Rep a), Reifies (options :: k) Options) + => FromJSON (WithOptions options a) where + parseJSON = fmap WithOptions . genericParseJSON (reflect (Proxy @options)) diff --git a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs new file mode 100644 index 000000000000..1f2b513ffe0e --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs @@ -0,0 +1,201 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} +-------------------------------------------------------------------------------- +module Xanthous.AI.Gormlak + ( HasVisionRadius(..) + , GormlakBrain(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lines) +-------------------------------------------------------------------------------- +import Control.Monad.State +import Control.Monad.Random +import Data.Aeson (object) +import qualified Data.Aeson as A +import Data.Generics.Product.Fields +-------------------------------------------------------------------------------- +import Xanthous.Data + ( Positioned(..), positioned, position, _Position + , diffPositions, stepTowards, isUnit + , Ticks, (|*|), invertedRate + ) +import Xanthous.Data.EntityMap +import Xanthous.Entities.Creature.Hippocampus +import Xanthous.Entities.Character (Character) +import qualified Xanthous.Entities.Character as Character +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Entities.RawTypes + ( CreatureType, HasLanguage(language), getLanguage + , HasAttacks (attacks), creatureAttackMessage + ) +import Xanthous.Entities.Common + ( wielded, Inventory, wieldedItems, WieldedItem (WieldedItem) ) +import Xanthous.Game.State +import Xanthous.Game.Lenses + ( entitiesCollision, collisionAt + , character, characterPosition, positionIsCharacterVisible + , hearingRadius + ) +import Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee) +import Xanthous.Random +import Xanthous.Monad (say, message) +import Xanthous.Generators.Speech (word) +import qualified Linear.Metric as Metric +import qualified Xanthous.Messages as Messages +-------------------------------------------------------------------------------- + +-- TODO move the following two classes to a more central location + +class HasVisionRadius a where visionRadius :: a -> Word + +type IsCreature entity = + ( HasVisionRadius entity + , HasField "_hippocampus" entity entity Hippocampus Hippocampus + , HasField "_creatureType" entity entity CreatureType CreatureType + , HasField "_inventory" entity entity Inventory Inventory + , A.ToJSON entity + ) + +-------------------------------------------------------------------------------- + +stepGormlak + :: forall entity m. + ( MonadState GameState m, MonadRandom m + , IsCreature entity + ) + => Ticks + -> Positioned entity + -> m (Positioned entity) +stepGormlak ticks pe@(Positioned pos creature) = do + canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos vision + + let selectDestination pos' creature' = destinationFromPos <$> do + if canSeeCharacter + then do + charPos <- use characterPosition + if isUnit (pos' `diffPositions` charPos) + then attackCharacter $> pos' + else pure $ pos' `stepTowards` charPos + else do + lines <- map (takeWhile (isNothing . entitiesCollision . map snd . snd) + -- the first item on these lines is always the creature itself + . fromMaybe mempty . tailMay) + . linesOfSight pos' (visionRadius creature') + <$> use entities + line <- choose $ weightedBy length lines + pure $ fromMaybe pos' $ fmap fst . headMay =<< line + + pe' <- if canSeeCharacter && not (creature ^. creatureGreeted) + then yellAtCharacter $> (pe & positioned . creatureGreeted .~ True) + else pure pe + + dest <- maybe (selectDestination pos creature) pure + . mfilter (\(Destination p _) -> p /= pos) + $ creature ^. hippocampus . destination + let progress' = + dest ^. destinationProgress + + creature ^. creatureType . Raw.speed . invertedRate |*| ticks + if progress' < 1 + then pure + $ pe' + & positioned . hippocampus . destination + ?~ (dest & destinationProgress .~ progress') + else do + let newPos = dest ^. destinationPosition + remainingSpeed = progress' - 1 + newDest <- selectDestination newPos creature + <&> destinationProgress +~ remainingSpeed + let pe'' = pe' & positioned . hippocampus . destination ?~ newDest + collisionAt newPos >>= \case + Nothing -> pure $ pe'' & position .~ newPos + Just Stop -> pure pe'' + Just Combat -> do + ents <- use $ entities . atPosition newPos + when (any (entityIs @Character) ents) attackCharacter + pure pe' + where + vision = visionRadius creature + attackCharacter = do + dmg <- case creature ^? inventory . wielded . wieldedItems of + Just (WieldedItem item wi) -> do + let msg = fromMaybe + (Messages.lookup ["combat", "creatureAttack", "genericWeapon"]) + $ wi ^. creatureAttackMessage + message msg $ object [ "creature" A..= creature + , "item" A..= item + ] + pure $ wi ^. Raw.damage + Nothing -> do + attack <- choose $ creature ^. creatureType . attacks + attackDescription <- Messages.render (attack ^. Raw.description) + $ object [] + say ["combat", "creatureAttack", "natural"] + $ object [ "creature" A..= creature + , "attackDescription" A..= attackDescription + ] + pure $ attack ^. Raw.damage + + character %= Character.damage dmg + + yellAtCharacter = for_ (creature ^. creatureType . language) + $ \lang -> do + utterance <- fmap (<> "!") . word $ getLanguage lang + creatureSaysText pe utterance + + creatureGreeted :: Lens' entity Bool + creatureGreeted = hippocampus . greetedCharacter + + +-- | A creature sends some text +-- +-- If that creature is visible to the character, its description will be +-- included, otherwise if it's within earshot the character will just hear the +-- sound +creatureSaysText + :: (MonadState GameState m, MonadRandom m, IsCreature entity) + => Positioned entity + -> Text + -> m () +creatureSaysText ent txt = do + let entPos = ent ^. position . _Position . to (fmap fromIntegral) + charPos <- use $ characterPosition . _Position . to (fmap fromIntegral) + let dist :: Int + dist = round $ Metric.distance @_ @Double entPos charPos + audible = dist <= fromIntegral hearingRadius + when audible $ do + visible <- positionIsCharacterVisible $ ent ^. position + let path = ["entities", "say", "creature"] + <> [if visible then "visible" else "invisible"] + params = object [ "creature" A..= (ent ^. positioned) + , "message" A..= txt + ] + say path params + +newtype GormlakBrain entity = GormlakBrain { _unGormlakBrain :: entity } + +instance (IsCreature entity) => Brain (GormlakBrain entity) where + step ticks + = fmap (fmap GormlakBrain) + . stepGormlak ticks + . fmap _unGormlakBrain + entityCanMove = const True + +hippocampus :: HasField "_hippocampus" s t a b => Lens s t a b +hippocampus = field @"_hippocampus" + +creatureType :: HasField "_creatureType" s t a b => Lens s t a b +creatureType = field @"_creatureType" + +inventory :: HasField "_inventory" s t a b => Lens s t a b +inventory = field @"_inventory" + +-------------------------------------------------------------------------------- + +-- instance Brain Creature where +-- step = brainVia GormlakBrain +-- entityCanMove = const True + +-- instance Entity Creature where +-- blocksVision _ = False +-- description = view $ Creature.creatureType . Raw.description +-- entityChar = view $ Creature.creatureType . char diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs new file mode 100644 index 000000000000..a251833955cd --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -0,0 +1,607 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} +module Xanthous.App + ( makeApp + , RunType(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Brick hiding (App, halt, continue, raw) +import qualified Brick +import Graphics.Vty.Attributes (defAttr) +import Graphics.Vty.Input.Events (Event(EvKey)) +import Control.Monad.State (get, gets) +import Control.Monad.State.Class (modify) +import Data.Aeson (object, ToJSON) +import qualified Data.Aeson as A +import qualified Data.Vector as V +import System.Exit +import System.Directory (doesFileExist) +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Vector.Lens (toVectorOf) +-------------------------------------------------------------------------------- +import Xanthous.App.Common +import Xanthous.App.Time +import Xanthous.App.Prompt +import Xanthous.App.Autocommands +import Xanthous.Command +import Xanthous.Data + ( move + , Dimensions'(Dimensions) + , positioned + , position + , Position + , (|*|) + , Tiles(..), Hitpoints, fromScalar + ) +import Xanthous.Data.App (ResourceName, Panel(..), AppEvent(..)) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Data.Levels (prevLevel, nextLevel) +import qualified Xanthous.Data.Levels as Levels +import Xanthous.Data.Entities (blocksObject) +import Xanthous.Game +import Xanthous.Game.State +import Xanthous.Game.Env +import Xanthous.Game.Draw (drawGame) +import Xanthous.Game.Prompt hiding (Fire) +import qualified Xanthous.Messages as Messages +import Xanthous.Random +import Xanthous.Util (removeVectorIndex, useListOf) +import Xanthous.Util.Inflection (toSentence) +import Xanthous.Physics (throwDistance, bluntThrowDamage) +import Xanthous.Data.EntityMap.Graphics (lineOfSight) +import Xanthous.Data.EntityMap (EntityID) +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- +import Xanthous.Entities.Common + ( InventoryPosition, describeInventoryPosition, backpack + , wieldableItem, wieldedItems, wielded, itemsWithPosition + , removeItemFromPosition, asWieldedItem, inRightHand + , wieldedItem, items + ) +import qualified Xanthous.Entities.Character as Character +import Xanthous.Entities.Character hiding (pickUpItem) +import Xanthous.Entities.Item (Item, weight) +import qualified Xanthous.Entities.Item as Item +import Xanthous.Entities.Creature (Creature) +import qualified Xanthous.Entities.Creature as Creature +import Xanthous.Entities.Environment + (Door, open, closed, locked, GroundMessage(..), Staircase(..)) +import Xanthous.Entities.RawTypes + ( edible, eatMessage, hitpointsHealed + , attackMessage + ) +import Xanthous.Generators.Level +import qualified Xanthous.Generators.Level.CaveAutomata as CaveAutomata +import qualified Xanthous.Generators.Level.Dungeon as Dungeon +-------------------------------------------------------------------------------- + +type App = Brick.App GameState AppEvent ResourceName + +data RunType = NewGame | LoadGame FilePath + deriving stock (Eq) + +makeApp :: GameEnv -> RunType -> IO App +makeApp env rt = pure $ Brick.App + { appDraw = drawGame + , appChooseCursor = const headMay + , appHandleEvent = \game event -> runAppM (handleEvent event) env game + , appStartEvent = case rt of + NewGame -> runAppM (startEvent >> get) env + LoadGame save -> pure . (savefile ?~ save) + , appAttrMap = const $ attrMap defAttr [] + } + +runAppM :: AppM a -> GameEnv -> GameState -> EventM ResourceName a +runAppM appm ge = fmap fst . runAppT appm ge + +startEvent :: AppM () +startEvent = do + initLevel + modify updateCharacterVision + use (character . characterName) >>= \case + Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable + $ \(StringResult s) -> do + character . characterName ?= s + say ["welcome"] =<< use character + Just n -> say ["welcome"] $ object [ "characterName" A..= n ] + +initLevel :: AppM () +initLevel = do + level <- genLevel 0 + entities <>= levelToEntityMap level + characterPosition .= level ^. levelCharacterPosition + +-------------------------------------------------------------------------------- + +handleEvent :: BrickEvent ResourceName AppEvent -> AppM (Next GameState) +handleEvent ev = use promptState >>= \case + NoPrompt -> handleNoPromptEvent ev + WaitingPrompt msg pr -> handlePromptEvent msg pr ev + + +handleNoPromptEvent :: BrickEvent ResourceName AppEvent -> AppM (Next GameState) +handleNoPromptEvent (VtyEvent (EvKey k mods)) + | Just command <- commandFromKey k mods + = do messageHistory %= nextTurn + cancelAutocommand + handleCommand command +handleNoPromptEvent (AppEvent AutoContinue) = do + preuse (autocommand . _ActiveAutocommand . _1) >>= traverse_ autoStep + continue +handleNoPromptEvent _ = continue + +handleCommand :: Command -> AppM (Next GameState) +handleCommand Quit = confirm_ ["quit", "confirm"] (liftIO exitSuccess) >> continue +handleCommand (Move dir) = do + newPos <- uses characterPosition $ move dir + collisionAt newPos >>= \case + Nothing -> do + characterPosition .= newPos + stepGameBy =<< uses (character . speed) (|*| Tiles 1) + describeEntitiesAt newPos + Just Combat -> attackAt newPos + Just Stop -> pure () + continue + +handleCommand PickUp = do + pos <- use characterPosition + uses entities (entitiesAtPositionWithType @Item pos) >>= \case + [] -> say_ ["pickUp", "nothingToPickUp"] + [item] -> pickUpItem item + items' -> + menu_ ["pickUp", "menu"] Cancellable (entityMenu_ items') + $ \(MenuResult item) -> pickUpItem item + continue + where + pickUpItem (itemID, item) = do + character %= Character.pickUpItem item + entities . at itemID .= Nothing + say ["pickUp", "pickUp"] $ object [ "item" A..= item ] + stepGameBy 100 -- TODO + +handleCommand Drop = do + takeItemFromInventory_ ["drop", "menu"] Cancellable id + (say_ ["drop", "nothing"]) + $ \(MenuResult item) -> do + entitiesAtCharacter %= (SomeEntity item <|) + say ["drop", "dropped"] $ object [ "item" A..= item ] + continue + +handleCommand PreviousMessage = do + messageHistory %= previousMessage + continue + +handleCommand Open = do + prompt_ @'DirectionPrompt ["open", "prompt"] Cancellable + $ \(DirectionResult dir) -> do + pos <- move dir <$> use characterPosition + doors <- uses entities $ entitiesAtPositionWithType @Door pos + if | null doors -> say_ ["open", "nothingToOpen"] + | any (view $ _2 . locked) doors -> say_ ["open", "locked"] + | all (view $ _2 . open) doors -> say_ ["open", "alreadyOpen"] + | otherwise -> do + for_ doors $ \(eid, _) -> + entities . ix eid . positioned . _SomeEntity . open .= True + say_ ["open", "success"] + pure () + stepGame -- TODO + continue + +handleCommand Close = do + prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable + $ \(DirectionResult dir) -> do + pos <- move dir <$> use characterPosition + (nonDoors, doors) <- uses entities + $ partitionEithers + . toList + . map ( (matching . aside $ _SomeEntity @Door) + . over _2 (view positioned) + ) + . EntityMap.atPositionWithIDs pos + if | null doors -> say_ ["close", "nothingToClose"] + | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"] + | any (view blocksObject . entityAttributes . snd) nonDoors -> + say ["close", "blocked"] + $ object [ "entityDescriptions" + A..= ( toSentence + . map description + . filter (view blocksObject . entityAttributes) + . map snd + ) nonDoors + , "blockOrBlocks" + A..= ( if length nonDoors == 1 + then "blocks" + else "block" + :: Text) + ] + | otherwise -> do + for_ doors $ \(eid, _) -> + entities . ix eid . positioned . _SomeEntity . closed .= True + for_ nonDoors $ \(eid, _) -> + entities . ix eid . position %= move dir + say_ ["close", "success"] + pure () + stepGame -- TODO + continue + +handleCommand Look = do + prompt_ @'PointOnMap ["look", "prompt"] Cancellable + $ \(PointOnMapResult pos) -> revealedEntitiesAtPosition pos >>= \case + Empty -> say_ ["look", "nothing"] + ents -> describeEntities ents + continue + +handleCommand Wait = stepGame >> continue + +handleCommand Eat = do + uses (character . inventory . backpack) + (V.mapMaybe (\item -> (item,) <$> item ^. Item.itemType . edible)) + >>= \case + Empty -> say_ ["eat", "noFood"] + food -> + let foodMenuItem idx (item, edibleItem) + = ( item ^. Item.itemType . char . char + , MenuOption (description item) (idx, item, edibleItem)) + -- TODO refactor to use entityMenu_ + menuItems = mkMenuItems $ imap foodMenuItem food + in menu_ ["eat", "menuPrompt"] Cancellable menuItems + $ \(MenuResult (idx, item, edibleItem)) -> do + character . inventory . backpack %= removeVectorIndex idx + let msg = fromMaybe (Messages.lookup ["eat", "eat"]) + $ edibleItem ^. eatMessage + character . characterHitpoints' += + edibleItem ^. hitpointsHealed . to fromIntegral + message msg $ object ["item" A..= item] + stepGame -- TODO + continue + +handleCommand Read = do + -- TODO allow reading things in the inventory (combo direction+menu prompt?) + prompt_ @'DirectionPrompt ["read", "prompt"] Cancellable + $ \(DirectionResult dir) -> do + pos <- uses characterPosition $ move dir + uses entities + (fmap snd . entitiesAtPositionWithType @GroundMessage pos) >>= \case + Empty -> say_ ["read", "nothing"] + GroundMessage msg :< Empty -> + say ["read", "result"] $ object ["message" A..= msg] + msgs -> + let readAndContinue Empty = pure () + readAndContinue (msg :< msgs') = + prompt @'Continue + ["read", "result"] + (object ["message" A..= msg]) + Cancellable + . const + $ readAndContinue msgs' + readAndContinue _ = error "this is total" + in readAndContinue msgs + continue + +handleCommand ShowInventory = showPanel InventoryPanel >> continue + +handleCommand DescribeInventory = do + selectItemFromInventory_ ["inventory", "describe", "select"] Cancellable id + (say_ ["inventory", "describe", "nothing"]) + $ \(MenuResult (invPos, item)) -> showPanel . ItemDescriptionPanel + $ Item.fullDescription item + <> "\n\n" <> describeInventoryPosition invPos + continue + + +handleCommand Wield = do + takeItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem + (say_ ["wield", "nothing"]) + $ \(MenuResult item) -> do + prevItems <- character . inventory . wielded <<.= inRightHand item + character . inventory . backpack + <>= fromList (prevItems ^.. wieldedItems . wieldedItem) + say ["wield", "wielded"] item + continue + +handleCommand Fire = do + selectItemFromInventory_ ["fire", "menu"] Cancellable id + (say_ ["fire", "nothing"]) + $ \(MenuResult (invPos, item)) -> + let wt = weight item + dist = throwDistance wt + dam = bluntThrowDamage wt + in if dist < fromScalar 1 + then say_ ["fire", "zeroRange"] + else firePrompt_ ["fire", "target"] Cancellable dist $ + \(FireResult targetPos) -> do + charPos <- use characterPosition + mTarget <- uses entities $ firstEnemy . lineOfSight charPos targetPos + case mTarget of + Just target -> do + creature' <- damageCreature target dam + unless (Creature.isDead creature') $ + let msgPath = ["fire", "fired"] <> [if dam == 0 + then "noDamage" + else "someDamage"] + in say msgPath $ object [ "item" A..= item + , "creature" A..= creature' + ] + Nothing -> + say ["fire", "fired", "noTarget"] $ object [ "item" A..= item ] + character . inventory %= removeItemFromPosition invPos item + entities . EntityMap.atPosition targetPos %= (SomeEntity item <|) + stepGame -- TODO(grfn): should this be based on distance? + continue + where + firstEnemy + :: [(Position, Vector (EntityID, SomeEntity))] + -> Maybe (EntityID, Creature) + firstEnemy los = + let enemies = los >>= \(_, es) -> toList $ headMay es + in enemies ^? folded . below _SomeEntity + +handleCommand Save = + view (config . disableSaving) >>= \case + True -> say_ ["save", "disabled"] >> continue + False -> do + -- TODO default save locations / config file? + use savefile >>= \case + Just filepath -> + stringPromptWithDefault_ + ["save", "location"] + Cancellable + (pack filepath) + promptCallback + Nothing -> prompt_ @'StringPrompt ["save", "location"] Cancellable promptCallback + continue + where + promptCallback :: PromptResult 'StringPrompt -> AppM () + promptCallback (StringResult filename) = do + sf <- use savefile + exists <- liftIO . doesFileExist $ unpack filename + if exists && sf /= Just (unpack filename) + then confirm ["save", "overwrite"] (object ["filename" A..= filename]) + $ doSave filename + else doSave filename + doSave filename = do + src <- gets saveGame + lift . liftIO $ do + writeFile (unpack filename) $ toStrict src + exitSuccess + +handleCommand GoUp = do + hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity UpStaircase) + if hasStairs + then uses levels prevLevel >>= \case + Just levs' -> do + cEID <- use characterEntityID + pCharacter <- entities . at cEID <<.= Nothing + levels .= levs' + charPos <- use characterPosition + entities . at cEID .= pCharacter + characterPosition .= charPos + Nothing -> + -- TODO in nethack, this leaves the game. Maybe something similar here? + say_ ["cant", "goUp"] + else say_ ["cant", "goUp"] + + continue + +handleCommand GoDown = do + hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity DownStaircase) + + if hasStairs + then do + levs <- use levels + let newLevelNum = Levels.pos levs + 1 + levs' <- nextLevel (levelToGameLevel <$> genLevel newLevelNum) levs + cEID <- use characterEntityID + pCharacter <- entities . at cEID <<.= Nothing + levels .= levs' + entities . at cEID .= pCharacter + characterPosition .= extract levs' ^. upStaircasePosition + else say_ ["cant", "goDown"] + + continue + +handleCommand (StartAutoMove dir) = do + runAutocommand $ AutoMove dir + continue + +handleCommand Rest = do + say_ ["autocommands", "resting"] + runAutocommand AutoRest + continue + +-- + +handleCommand ToggleRevealAll = do + val <- debugState . allRevealed <%= not + say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ] + continue + +-------------------------------------------------------------------------------- +attackAt :: Position -> AppM () +attackAt pos = + uses entities (entitiesAtPositionWithType @Creature pos) >>= \case + Empty -> say_ ["combat", "nothingToAttack"] + (creature :< Empty) -> attackCreature creature + creatures -> + menu_ ["combat", "menu"] Cancellable (entityMenu_ creatures) + $ \(MenuResult creature) -> attackCreature creature + where + attackCreature creature = do + charDamage <- uses character characterDamage + creature' <- damageCreature creature charDamage + msg <- uses character getAttackMessage + unless (Creature.isDead creature') + . message msg $ object ["creature" A..= creature'] + whenM (uses character $ isNothing . weapon) handleFists + stepGame + weapon chr = chr ^? inventory . wielded . wieldedItems . wieldableItem + getAttackMessage chr = + case weapon chr of + Just wi -> + fromMaybe (Messages.lookup ["combat", "hit", "generic"]) + $ wi ^. attackMessage + Nothing -> + Messages.lookup ["combat", "hit", "fists"] + + handleFists = do + damageChance <- use $ character . body . knuckles . to fistDamageChance + whenM (chance damageChance) $ do + damageAmount <- use $ character . body . knuckles . to fistfightingDamage + say_ [ "combat" , if damageAmount > 1 + then "fistExtraSelfDamage" + else "fistSelfDamage" ] + character %= Character.damage damageAmount + character . body . knuckles %= damageKnuckles + +damageCreature :: (EntityID, Creature) -> Hitpoints -> AppM Creature +damageCreature (creatureID, creature) dam = do + let creature' = Creature.damage dam creature + msgParams = object ["creature" A..= creature'] + if Creature.isDead creature' + then do + say ["combat", "killed"] msgParams + floorItems <- useListOf + $ entities + . ix creatureID + . positioned + . _SomeEntity @Creature + . inventory + . items + mCreaturePos <- preuse $ entities . ix creatureID . position + entities . at creatureID .= Nothing + for_ mCreaturePos $ \creaturePos -> + entities . EntityMap.atPosition creaturePos + %= (<> fromList (SomeEntity <$> floorItems)) + else entities . ix creatureID . positioned .= SomeEntity creature' + pure creature' + + +entityMenu_ + :: (Comonad w, Entity entity) + => [w entity] + -> Map Char (MenuOption (w entity)) +entityMenu_ = mkMenuItems @[_] . map entityMenuItem + where + entityMenuItem wentity + = let entity = extract wentity + in (entityMenuChar entity, MenuOption (description entity) wentity) + + +entityMenuChar :: Entity a => a -> Char +entityMenuChar entity + = let ec = entityChar entity ^. char + in if ec `elem` (['a'..'z'] ++ ['A'..'Z']) + then ec + else 'a' + +-- | Prompt with an item to select out of the inventory and call callback with +-- it +selectItemFromInventory + :: forall item params. + (ToJSON params) + => [Text] -- ^ Menu message + -> params -- ^ Menu message params + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu (InventoryPosition, item)) -> AppM ()) + -> AppM () +selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = do + uses (character . inventory) + (V.mapMaybe (_2 $ preview extraInfo) . toVectorOf itemsWithPosition) + >>= \case + Empty -> onEmpty + items' -> menu msgPath msgParams cancellable (itemMenu items') cb + where + itemMenu = mkMenuItems . map itemMenuItem + itemMenuItem (invPos, extraInfoItem) = + let item = extraInfo # extraInfoItem + in ( entityMenuChar item + , MenuOption + (description item <> " (" <> describeInventoryPosition invPos <> ")") + (invPos, extraInfoItem) + ) + +-- | Prompt with an item to select out of the inventory and call callback with +-- it +selectItemFromInventory_ + :: forall item. + [Text] -- ^ Menu message + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu (InventoryPosition, item)) -> AppM ()) + -> AppM () +selectItemFromInventory_ msgPath = selectItemFromInventory msgPath () + +-- | Prompt with an item to select out of the inventory, remove it from the +-- inventory, and call callback with it +takeItemFromInventory + :: forall item params. + (ToJSON params) + => [Text] -- ^ Menu message + -> params -- ^ Menu message params + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu item) -> AppM ()) + -> AppM () +takeItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = + selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty + $ \(MenuResult (invPos, item)) -> do + character . inventory + %= removeItemFromPosition invPos (item ^. re extraInfo) + cb $ MenuResult item + +takeItemFromInventory_ + :: forall item. + [Text] -- ^ Menu message + -> PromptCancellable -- ^ Is the menu cancellable? + -> Prism' Item item -- ^ Attach some extra information to the item, in a + -- recoverable fashion. Prism vs iso so we can discard + -- items. + -> AppM () -- ^ Action to take if there are no items matching + -> (PromptResult ('Menu item) -> AppM ()) + -> AppM () +takeItemFromInventory_ msgPath = takeItemFromInventory msgPath () + +-- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity) +-- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity + +showPanel :: Panel -> AppM () +showPanel panel = do + activePanel ?= panel + prompt_ @'Continue ["generic", "continue"] Uncancellable + . const + $ activePanel .= Nothing + +-------------------------------------------------------------------------------- + +genLevel + :: Word -- ^ Level number, starting at 0 + -> AppM Level +genLevel num = do + let dims = Dimensions 80 80 + generator <- choose $ CaveAutomata :| [Dungeon] + let + doGen = case generator of + CaveAutomata -> generateLevel SCaveAutomata CaveAutomata.defaultParams + Dungeon -> generateLevel SDungeon Dungeon.defaultParams + level <- doGen dims num + pure $!! level + +levelToGameLevel :: Level -> GameLevel +levelToGameLevel level = + let _levelEntities = levelToEntityMap level + _upStaircasePosition = level ^. levelCharacterPosition + _levelRevealedPositions = mempty + in GameLevel {..} diff --git a/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs b/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs new file mode 100644 index 000000000000..5d4db1a47465 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs @@ -0,0 +1,76 @@ +-------------------------------------------------------------------------------- +module Xanthous.App.Autocommands + ( runAutocommand + , autoStep + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Control.Concurrent (threadDelay) +import qualified Data.Aeson as A +import Data.Aeson (object) +import Data.List.NonEmpty (nonEmpty) +import qualified Data.List.NonEmpty as NE +import Control.Monad.State (gets) +-------------------------------------------------------------------------------- +import Xanthous.App.Common +import Xanthous.App.Time +import Xanthous.Data +import Xanthous.Data.App +import Xanthous.Entities.Character (speed, isFullyHealed) +import Xanthous.Entities.Creature (Creature, creatureType) +import Xanthous.Entities.RawTypes (hostile) +import Xanthous.Game.State +-------------------------------------------------------------------------------- + +-- | Step the given autocommand forward once +autoStep :: Autocommand -> AppM () +autoStep (AutoMove dir) = do + newPos <- uses characterPosition $ move dir + collisionAt newPos >>= \case + Nothing -> do + characterPosition .= newPos + stepGameBy =<< uses (character . speed) (|*| (1 :: Tiles)) + describeEntitiesAt newPos + cancelIfDanger + Just _ -> cancelAutocommand + +autoStep AutoRest = do + done <- uses character isFullyHealed + if done + then say_ ["autocommands", "doneResting"] >> cancelAutocommand + else stepGame >> cancelIfDanger + +-- | Cancel the autocommand if the character is in danger +cancelIfDanger :: AppM () +cancelIfDanger = do + maybeVisibleEnemies <- nonEmpty <$> enemiesInSight + for_ maybeVisibleEnemies $ \visibleEnemies -> do + say ["autocommands", "enemyInSight"] + $ object [ "firstEntity" A..= NE.head visibleEnemies ] + cancelAutocommand + where + enemiesInSight :: AppM [Creature] + enemiesInSight = do + ents <- gets characterVisibleEntities + pure $ ents + ^.. folded + . _SomeEntity @Creature + . filtered (view $ creatureType . hostile) + +-------------------------------------------------------------------------------- + +autocommandIntervalμs :: Int +autocommandIntervalμs = 1000 * 50 -- 50 ms + +runAutocommand :: Autocommand -> AppM () +runAutocommand ac = do + env <- ask + tid <- liftIO . async $ runReaderT go env + autocommand .= ActiveAutocommand ac tid + where + go = everyμs autocommandIntervalμs $ sendEvent AutoContinue + +-- | Perform 'act' every μs microseconds forever +everyμs :: MonadIO m => Int -> m () -> m () +everyμs μs act = act >> liftIO (threadDelay μs) >> everyμs μs act diff --git a/users/grfn/xanthous/src/Xanthous/App/Common.hs b/users/grfn/xanthous/src/Xanthous/App/Common.hs new file mode 100644 index 000000000000..69ba6f0e0596 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/App/Common.hs @@ -0,0 +1,67 @@ +-------------------------------------------------------------------------------- +module Xanthous.App.Common + ( describeEntities + , describeEntitiesAt + , entitiesAtPositionWithType + + -- * Re-exports + , MonadState + , MonadRandom + , EntityMap + , module Xanthous.Game.Lenses + , module Xanthous.Monad + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson (object) +import qualified Data.Aeson as A +import Control.Monad.State (MonadState) +import Control.Monad.Random (MonadRandom) +-------------------------------------------------------------------------------- +import Xanthous.Data (Position, positioned) +import Xanthous.Data.EntityMap (EntityMap) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Game +import Xanthous.Game.Lenses +import Xanthous.Game.State +import Xanthous.Monad +import Xanthous.Entities.Character (Character) +import Xanthous.Util.Inflection (toSentence) +-------------------------------------------------------------------------------- + +entitiesAtPositionWithType + :: forall a. (Entity a, Typeable a) + => Position + -> EntityMap SomeEntity + -> [(EntityMap.EntityID, a)] +entitiesAtPositionWithType pos em = + let someEnts = EntityMap.atPositionWithIDs pos em + in flip foldMap someEnts $ \(eid, view positioned -> se) -> + case downcastEntity @a se of + Just e -> [(eid, e)] + Nothing -> [] + +describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m () +describeEntitiesAt pos = + use ( entities + . EntityMap.atPosition pos + . to (filter (not . entityIs @Character)) + ) >>= \case + Empty -> pure () + ents -> describeEntities ents + +describeEntities + :: ( Entity entity + , MonadRandom m + , MonadState GameState m + , MonoFoldable (f Text) + , Functor f + , Element (f Text) ~ Text + ) + => f entity + -> m () +describeEntities ents = + let descriptions = description <$> ents + in say ["entities", "description"] + $ object ["entityDescriptions" A..= toSentence descriptions] diff --git a/users/grfn/xanthous/src/Xanthous/App/Prompt.hs b/users/grfn/xanthous/src/Xanthous/App/Prompt.hs new file mode 100644 index 000000000000..799281a1c2fd --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/App/Prompt.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE UndecidableInstances #-} +-------------------------------------------------------------------------------- +module Xanthous.App.Prompt + ( handlePromptEvent + , clearPrompt + , prompt + , prompt_ + , stringPromptWithDefault + , stringPromptWithDefault_ + , confirm_ + , confirm + , menu + , menu_ + , firePrompt_ + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick (BrickEvent(..), Next) +import Brick.Widgets.Edit (handleEditorEvent) +import Data.Aeson (ToJSON, object) +import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) +-------------------------------------------------------------------------------- +import Xanthous.App.Common +import Xanthous.Data (move, Tiles, Position, positioned, _Position) +import qualified Xanthous.Data as Data +import Xanthous.Command (directionFromChar) +import Xanthous.Data.App (ResourceName, AppEvent) +import Xanthous.Game.Prompt +import Xanthous.Game.State +import qualified Xanthous.Messages as Messages +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Entities.Creature (creatureType, Creature) +import Xanthous.Entities.RawTypes (hostile) +import qualified Linear.Metric as Metric +-------------------------------------------------------------------------------- + +handlePromptEvent + :: Text -- ^ Prompt message + -> Prompt AppM + -> BrickEvent ResourceName AppEvent + -> AppM (Next GameState) + +handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) + = clearPrompt >> continue +handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) + = clearPrompt >> submitPrompt pr >> continue + +handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') [])) + = clearPrompt >> submitPrompt pr >> continue + +handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') [])) + = clearPrompt >> continue + +handlePromptEvent + msg + (Prompt c SStringPrompt (StringPromptState edit) pri cb) + (VtyEvent ev) + = do + edit' <- lift $ handleEditorEvent ev edit + let prompt' = Prompt c SStringPrompt (StringPromptState edit') pri cb + promptState .= WaitingPrompt msg prompt' + continue + +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb) + (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) + = clearPrompt >> cb (DirectionResult dir) >> continue +handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue + +handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) [])) + | Just (MenuOption _ res) <- items' ^. at chr + = clearPrompt >> cb (MenuResult res) >> continue + | otherwise + = continue + +handlePromptEvent + msg + (Prompt c SPointOnMap (PointOnMapPromptState pos) pri cb) + (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) + = let pos' = move dir pos + prompt' = Prompt c SPointOnMap (PointOnMapPromptState pos') pri cb + in promptState .= WaitingPrompt msg prompt' + >> continue +handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue + +handlePromptEvent + msg + (Prompt c SFire (FirePromptState pos) pri@(origin, range) cb) + (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) [])) + = do + let pos' = move dir pos + prompt' = Prompt c SFire (FirePromptState pos') pri cb + when (Data.distance origin pos' <= range) $ + promptState .= WaitingPrompt msg prompt' + continue + +handlePromptEvent + _ + (Prompt Cancellable _ _ _ _) + (VtyEvent (EvKey (KChar 'q') [])) + = clearPrompt >> continue +handlePromptEvent _ _ _ = continue + +clearPrompt :: AppM () +clearPrompt = promptState .= NoPrompt + +type PromptParams :: PromptType -> Type +type family PromptParams pt where + PromptParams ('Menu a) = Map Char (MenuOption a) -- Menu items + PromptParams 'Fire = Tiles -- Range + PromptParams _ = () + +prompt + :: forall (pt :: PromptType) (params :: Type). + (ToJSON params, SingPromptType pt, PromptParams pt ~ ()) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler + -> AppM () +prompt msgPath params cancellable cb = do + let pt = singPromptType @pt + msg <- Messages.message msgPath params + mp :: Maybe (Prompt AppM) <- case pt of + SPointOnMap -> do + charPos <- use characterPosition + pure . Just $ mkPointOnMapPrompt cancellable charPos cb + SStringPrompt -> pure . Just $ mkStringPrompt cancellable cb + SConfirm -> pure . Just $ mkPrompt cancellable pt cb + SDirectionPrompt -> pure . Just $ mkPrompt cancellable pt cb + SContinue -> pure . Just $ mkPrompt cancellable pt cb + for_ mp $ \p -> promptState .= WaitingPrompt msg p + +prompt_ + :: forall (pt :: PromptType). + (SingPromptType pt, PromptParams pt ~ ()) + => [Text] -- ^ Message key + -> PromptCancellable + -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler + -> AppM () +prompt_ msg = prompt msg $ object [] + +stringPromptWithDefault + :: forall (params :: Type). (ToJSON params) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> Text -- ^ Prompt default + -> (PromptResult 'StringPrompt -> AppM ()) -- ^ Prompt promise handler + -> AppM () +stringPromptWithDefault msgPath params cancellable def cb = do + msg <- Messages.message msgPath params + let p = mkStringPromptWithDefault cancellable def cb + promptState .= WaitingPrompt msg p + +stringPromptWithDefault_ + :: [Text] -- ^ Message key + -> PromptCancellable + -> Text -- ^ Prompt default + -> (PromptResult 'StringPrompt -> AppM ()) -- ^ Prompt promise handler + -> AppM () +stringPromptWithDefault_ msg = stringPromptWithDefault msg $ object [] + +confirm + :: ToJSON params + => [Text] -- ^ Message key + -> params + -> AppM () + -> AppM () +confirm msgPath params + = prompt @'Confirm msgPath params Cancellable . const + +confirm_ :: [Text] -> AppM () -> AppM () +confirm_ msgPath = confirm msgPath $ object [] + +menu :: forall (a :: Type) (params :: Type). + (ToJSON params) + => [Text] -- ^ Message key + -> params -- ^ Message params + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu msgPath params cancellable items' cb = do + msg <- Messages.message msgPath params + let p = mkMenu cancellable items' cb + promptState .= WaitingPrompt msg p + +menu_ :: forall (a :: Type). + [Text] -- ^ Message key + -> PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler + -> AppM () +menu_ msgPath = menu msgPath $ object [] + +firePrompt_ + :: [Text] -- ^ Message key + -> PromptCancellable + -> Tiles -- ^ Range + -> (PromptResult 'Fire -> AppM ()) -- ^ Promise handler + -> AppM () +firePrompt_ msgPath cancellable range cb = do + msg <- Messages.message msgPath $ object [] + initialPos <- maybe (use characterPosition) pure =<< nearestEnemyPosition + let p = mkFirePrompt cancellable initialPos range cb + promptState .= WaitingPrompt msg p + +-- | Returns the position of the nearest visible hostile creature, if any +nearestEnemyPosition :: AppM (Maybe Position) +nearestEnemyPosition = do + charPos <- use characterPosition + em <- use entities + ps <- characterVisiblePositions + let candidates = toList ps >>= \p -> + let ents = EntityMap.atPositionWithIDs p em + in ents + ^.. folded + . _2 + . positioned + . _SomeEntity @Creature + . creatureType + . filtered (view hostile) + . to (const (distance charPos p, p)) + pure . headMay . fmap snd $ sortOn fst candidates + where + distance :: Position -> Position -> Double + distance = Metric.distance `on` (fmap fromIntegral . view _Position) diff --git a/users/grfn/xanthous/src/Xanthous/App/Time.hs b/users/grfn/xanthous/src/Xanthous/App/Time.hs new file mode 100644 index 000000000000..cca352858d9c --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/App/Time.hs @@ -0,0 +1,42 @@ +-------------------------------------------------------------------------------- +module Xanthous.App.Time + ( stepGame + , stepGameBy + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import System.Exit +-------------------------------------------------------------------------------- +import Xanthous.Data (Ticks) +import Xanthous.App.Prompt +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Entities.Character (isDead) +import Xanthous.Game.State +import Xanthous.Game.Prompt +import Xanthous.Game.Lenses +import Control.Monad.State (modify) +import qualified Xanthous.Game.Memo as Memo +-------------------------------------------------------------------------------- + + +stepGameBy :: Ticks -> AppM () +stepGameBy ticks = do + ents <- uses entities EntityMap.toEIDsAndPositioned + for_ ents $ \(eid, pEntity) -> do + pEntity' <- step ticks pEntity + entities . ix eid .= pEntity' + + clearMemo Memo.characterVisiblePositions + modify updateCharacterVision + + whenM (uses character isDead) + . prompt_ @'Continue ["dead"] Uncancellable + . const . lift . liftIO + $ exitSuccess + +ticksPerTurn :: Ticks +ticksPerTurn = 100 + +stepGame :: AppM () +stepGame = stepGameBy ticksPerTurn diff --git a/users/grfn/xanthous/src/Xanthous/Command.hs b/users/grfn/xanthous/src/Xanthous/Command.hs new file mode 100644 index 000000000000..187e5c16d7da --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Command.hs @@ -0,0 +1,84 @@ +-------------------------------------------------------------------------------- +module Xanthous.Command where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (Left, Right, Down) +-------------------------------------------------------------------------------- +import Graphics.Vty.Input (Key(..), Modifier(..)) +import qualified Data.Char as Char +-------------------------------------------------------------------------------- +import Xanthous.Data (Direction(..)) +-------------------------------------------------------------------------------- + +data Command + = Quit + | Move Direction + | StartAutoMove Direction + | PreviousMessage + | PickUp + | Drop + | Open + | Close + | Wait + | Eat + | Look + | Save + | Read + | ShowInventory + | DescribeInventory + | Wield + | Fire + | GoUp + | GoDown + | Rest + + -- | TODO replace with `:` commands + | ToggleRevealAll + +commandFromKey :: Key -> [Modifier] -> Maybe Command +commandFromKey (KChar 'q') [] = Just Quit +commandFromKey (KChar '.') [] = Just Wait +commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir +commandFromKey (KChar c) [] + | Char.isUpper c + , Just dir <- directionFromChar $ Char.toLower c + = Just $ StartAutoMove dir +commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage +commandFromKey (KChar ',') [] = Just PickUp +commandFromKey (KChar 'd') [] = Just Drop +commandFromKey (KChar 'o') [] = Just Open +commandFromKey (KChar 'c') [] = Just Close +commandFromKey (KChar ';') [] = Just Look +commandFromKey (KChar 'e') [] = Just Eat +commandFromKey (KChar 'S') [] = Just Save +commandFromKey (KChar 'r') [] = Just Read +commandFromKey (KChar 'i') [] = Just ShowInventory +commandFromKey (KChar 'I') [] = Just DescribeInventory +commandFromKey (KChar 'w') [] = Just Wield +commandFromKey (KChar 'f') [] = Just Fire +commandFromKey (KChar '<') [] = Just GoUp +commandFromKey (KChar '>') [] = Just GoDown +commandFromKey (KChar 'R') [] = Just Rest + +commandFromKey KUp [] = Just $ Move Up +commandFromKey KDown [] = Just $ Move Down +commandFromKey KLeft [] = Just $ Move Left +commandFromKey KRight [] = Just $ Move Right + +-- DEBUG COMMANDS -- +commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll + +commandFromKey _ _ = Nothing + +-------------------------------------------------------------------------------- + +directionFromChar :: Char -> Maybe Direction +directionFromChar 'h' = Just Left +directionFromChar 'j' = Just Down +directionFromChar 'k' = Just Up +directionFromChar 'l' = Just Right +directionFromChar 'y' = Just UpLeft +directionFromChar 'u' = Just UpRight +directionFromChar 'b' = Just DownLeft +directionFromChar 'n' = Just DownRight +directionFromChar '.' = Just Here +directionFromChar _ = Nothing diff --git a/users/grfn/xanthous/src/Xanthous/Data.hs b/users/grfn/xanthous/src/Xanthous/Data.hs new file mode 100644 index 000000000000..1b67e0f160db --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data.hs @@ -0,0 +1,818 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoTypeSynonymInstances #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- +-- | Common data types for Xanthous ------------------------------------------------------------------------------ +module Xanthous.Data + ( Opposite(..) + + -- * + , Position'(..) + , Position + , x + , y + + -- ** + , Positioned(..) + , _Positioned + , position + , positioned + , loc + , _Position + , positionFromPair + , positionFromV2 + , addPositions + , diffPositions + , stepTowards + , isUnit + , distance + + -- * Boxes + , Box(..) + , topLeftCorner + , bottomRightCorner + , setBottomRightCorner + , dimensions + , inBox + , boxIntersects + , boxCenter + , boxEdge + , module Linear.V2 + + -- * Unit math + , Scalar(..) + , Per(..) + , invertRate + , invertedRate + , (|+|) + , (|*|) + , (|/|) + , (:+:) + , (:*:) + , (:/:) + , (:**:)(..) + , Ticks(..) + , Tiles(..) + , TicksPerTile + , TilesPerTick + , timesTiles + , Square(..) + , squared + , Cubic(..) + , Grams + , Meters + , Uno(..) + , Unit(..) + , UnitSymbol(..) + + -- * + , Dimensions'(..) + , Dimensions + , HasWidth(..) + , HasHeight(..) + + -- * + , Direction(..) + , move + , asPosition + , directionOf + , Cardinal(..) + + -- * + , Corner(..) + , Edge(..) + , cornerEdges + + -- * + , Neighbors(..) + , edges + , neighborDirections + , neighborPositions + , neighborCells + , arrayNeighbors + , rotations + , HasTopLeft(..) + , HasTop(..) + , HasTopRight(..) + , HasLeft(..) + , HasRight(..) + , HasBottomLeft(..) + , HasBottom(..) + , HasBottomRight(..) + + -- * + , Hitpoints(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (Left, Down, Right, (.=), elements) +-------------------------------------------------------------------------------- +import Linear.V2 hiding (_x, _y) +import qualified Linear.V2 as L +import Linear.V4 hiding (_x, _y) +import Test.QuickCheck (CoArbitrary, Function, elements) +import Test.QuickCheck.Arbitrary.Generic +import Data.Group +import Brick (Location(Location), Edges(..)) +import Data.Monoid (Product(..), Sum(..)) +import Data.Array.IArray +import Data.Aeson.Generic.DerivingVia +import Data.Aeson + ( ToJSON(..), FromJSON(..), object, (.=), (.:), withObject) +import Data.Random (Distribution) +import Data.Coerce +import Data.Proxy (Proxy(Proxy)) +-------------------------------------------------------------------------------- +import Xanthous.Util (EqEqProp(..), EqProp, between) +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +import Xanthous.Orphans () +import Xanthous.Util.Graphics +import qualified Linear.Metric as Metric +-------------------------------------------------------------------------------- + +-- | opposite ∘ opposite ≡ id +class Opposite x where + opposite :: x -> x + +-------------------------------------------------------------------------------- + +-- fromScalar ∘ scalar ≡ id +class Scalar a where + scalar :: a -> Double + fromScalar :: Double -> a + +instance Scalar Double where + scalar = id + fromScalar = id + +newtype ScalarIntegral a = ScalarIntegral a + deriving newtype (Eq, Ord, Num, Enum, Real, Integral) +instance Integral a => Scalar (ScalarIntegral a) where + scalar = fromIntegral + fromScalar = floor + +deriving via (ScalarIntegral Integer) instance Scalar Integer +deriving via (ScalarIntegral Word) instance Scalar Word + +-- | Units of measure +class Unit a where + unitSuffix :: Text +type UnitSymbol :: Symbol -> Type -> Type +newtype UnitSymbol suffix a = UnitSymbol a +instance KnownSymbol suffix => Unit (UnitSymbol suffix a) where + unitSuffix = pack $ symbolVal @suffix Proxy + +newtype ShowUnitSuffix a b = ShowUnitSuffix a +instance (Show b, Unit a, Coercible a b) => Show (ShowUnitSuffix a b) where + show a = show (coerce @_ @b a) <> " " <> unpack (unitSuffix @a) + +-------------------------------------------------------------------------------- + +data Position' a where + Position :: { _x :: a + , _y :: a + } -> (Position' a) + deriving stock (Show, Eq, Generic, Ord, Functor, Foldable, Traversable) + deriving anyclass (NFData, Hashable, CoArbitrary, Function) + deriving EqProp via EqEqProp (Position' a) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + (Position' a) + +x, y :: Lens' (Position' a) a +x = lens (\(Position xx _) -> xx) (\(Position _ yy) xx -> Position xx yy) +y = lens (\(Position _ yy) -> yy) (\(Position xx _) yy -> Position xx yy) + +type Position = Position' Int + +instance Arbitrary a => Arbitrary (Position' a) where + arbitrary = genericArbitrary + shrink (Position px py) = Position <$> shrink px <*> shrink py + + +instance Num a => Semigroup (Position' a) where + (Position x₁ y₁) <> (Position x₂ y₂) = Position (x₁ + x₂) (y₁ + y₂) + +instance Num a => Monoid (Position' a) where + mempty = Position 0 0 + +instance Num a => Group (Position' a) where + invert (Position px py) = Position (negate px) (negate py) + +-- | Positions convert to scalars by discarding their orientation and just +-- measuring the length from the origin +instance (Ord a, Num a, Scalar a) => Scalar (Position' a) where + scalar = fromIntegral . length . line 0 . view _Position + fromScalar n = Position (fromScalar n) (fromScalar n) + +data Positioned a where + Positioned :: Position -> a -> Positioned a + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) + deriving anyclass (NFData, CoArbitrary, Function) +type role Positioned representational + +_Positioned :: Iso (Position, a) (Position, b) (Positioned a) (Positioned b) +_Positioned = iso hither yon + where + hither (pos, a) = Positioned pos a + yon (Positioned pos b) = (pos, b) + +instance Arbitrary a => Arbitrary (Positioned a) where + arbitrary = Positioned <$> arbitrary <*> arbitrary + +instance ToJSON a => ToJSON (Positioned a) where + toJSON (Positioned pos val) = object + [ "position" .= pos + , "data" .= val + ] + +instance FromJSON a => FromJSON (Positioned a) where + parseJSON = withObject "Positioned" $ \obj -> + Positioned <$> obj .: "position" <*> obj .: "data" + +position :: Lens' (Positioned a) Position +position = lens + (\(Positioned pos _) -> pos) + (\(Positioned _ a) pos -> Positioned pos a) + +positioned :: Lens (Positioned a) (Positioned b) a b +positioned = lens + (\(Positioned _ x') -> x') + (\(Positioned pos _) x' -> Positioned pos x') + +loc :: Iso' Position Location +loc = iso hither yon + where + hither (Position px py) = Location (px, py) + yon (Location (lx, ly)) = Position lx ly + +_Position :: Iso' (Position' a) (V2 a) +_Position = iso hither yon + where + hither (Position px py) = V2 px py + yon (V2 lx ly) = Position lx ly + +positionFromPair :: (Num a, Integral i, Integral j) => (i, j) -> Position' a +positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j) + +positionFromV2 :: (Num a, Integral i) => V2 i -> Position' a +positionFromV2 (V2 xx yy) = Position (fromIntegral xx) (fromIntegral yy) + +-- | Add two positions +-- +-- Operation for the additive group on positions +addPositions :: Num a => Position' a -> Position' a -> Position' a +addPositions = (<>) + +-- | Subtract two positions. +-- +-- diffPositions pos₁ pos₂ = pos₁ `addPositions` (invert pos₂) +diffPositions :: Num a => Position' a -> Position' a -> Position' a +diffPositions (Position x₁ y₁) (Position x₂ y₂) = Position (x₁ - x₂) (y₁ - y₂) + +-- | Is this position a unit position? or: When taken as a difference, does this +-- position represent a step of one tile? +-- +-- ∀ dir :: Direction. isUnit ('asPosition' dir) +isUnit :: (Eq a, Num a) => Position' a -> Bool +isUnit (Position px py) = + abs px `elem` [0,1] && abs py `elem` [0, 1] && (px, py) /= (0, 0) + +-------------------------------------------------------------------------------- + +data Dimensions' a = Dimensions + { _width :: a + , _height :: a + } + deriving stock (Show, Eq, Functor, Generic) + deriving anyclass (CoArbitrary, Function) +makeFieldsNoPrefix ''Dimensions' + +instance Arbitrary a => Arbitrary (Dimensions' a) where + arbitrary = Dimensions <$> arbitrary <*> arbitrary + +type Dimensions = Dimensions' Word + +-------------------------------------------------------------------------------- + +data Direction where + Up :: Direction + Down :: Direction + Left :: Direction + Right :: Direction + UpLeft :: Direction + UpRight :: Direction + DownLeft :: Direction + DownRight :: Direction + Here :: Direction + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function, NFData, ToJSON, FromJSON, Hashable) + deriving Arbitrary via GenericArbitrary Direction + +instance Opposite Direction where + opposite Up = Down + opposite Down = Up + opposite Left = Right + opposite Right = Left + opposite UpLeft = DownRight + opposite UpRight = DownLeft + opposite DownLeft = UpRight + opposite DownRight = UpLeft + opposite Here = Here + +move :: Num a => Direction -> Position' a -> Position' a +move Up = y -~ 1 +move Down = y +~ 1 +move Left = x -~ 1 +move Right = x +~ 1 +move UpLeft = move Up . move Left +move UpRight = move Up . move Right +move DownLeft = move Down . move Left +move DownRight = move Down . move Right +move Here = id + +asPosition :: Direction -> Position +asPosition dir = move dir mempty + +-- | Returns the direction that a given position is from a given source position +directionOf + :: Position -- ^ Source + -> Position -- ^ Target + -> Direction +directionOf (Position x₁ y₁) (Position x₂ y₂) = + case (x₁ `compare` x₂, y₁ `compare` y₂) of + (EQ, EQ) -> Here + (EQ, LT) -> Down + (EQ, GT) -> Up + (LT, EQ) -> Right + (GT, EQ) -> Left + + (LT, LT) -> DownRight + (GT, LT) -> DownLeft + + (LT, GT) -> UpRight + (GT, GT) -> UpLeft + +-- | Take one (potentially diagonal) step towards the given position +-- +-- ∀ src tgt. isUnit (src `diffPositions` (src `stepTowards tgt`)) +stepTowards + :: Position -- ^ Source + -> Position -- ^ Target + -> Position +stepTowards (view _Position -> p₁) (view _Position -> p₂) + | p₁ == p₂ = _Position # p₁ + | otherwise = + let (_:p:_) = line p₁ p₂ + in _Position # p + +-- | Newtype controlling arbitrary generation to only include cardinal +-- directions ('Up', 'Down', 'Left', 'Right') +newtype Cardinal = Cardinal { getCardinal :: Direction } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, Function, CoArbitrary) + deriving newtype (Opposite) + +instance Arbitrary Cardinal where + arbitrary = Cardinal <$> elements [Up, Down, Left, Right] + +-------------------------------------------------------------------------------- + +data Corner + = TopLeft + | TopRight + | BottomLeft + | BottomRight + deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + deriving Arbitrary via GenericArbitrary Corner + +instance Opposite Corner where + opposite TopLeft = BottomRight + opposite TopRight = BottomLeft + opposite BottomLeft = TopRight + opposite BottomRight = TopLeft + +data Edge + = TopEdge + | LeftEdge + | RightEdge + | BottomEdge + deriving stock (Show, Eq, Ord, Enum, Bounded, Generic) + deriving Arbitrary via GenericArbitrary Edge + +instance Opposite Edge where + opposite TopEdge = BottomEdge + opposite BottomEdge = TopEdge + opposite LeftEdge = RightEdge + opposite RightEdge = LeftEdge + +cornerEdges :: Corner -> (Edge, Edge) +cornerEdges TopLeft = (TopEdge, LeftEdge) +cornerEdges TopRight = (TopEdge, RightEdge) +cornerEdges BottomLeft = (BottomEdge, LeftEdge) +cornerEdges BottomRight = (BottomEdge, RightEdge) + +-------------------------------------------------------------------------------- + +data Neighbors a = Neighbors + { _topLeft + , _top + , _topRight + , _left + , _right + , _bottomLeft + , _bottom + , _bottomRight :: a + } + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) + deriving anyclass (NFData, CoArbitrary, Function, MonoFoldable) + deriving Arbitrary via GenericArbitrary (Neighbors a) + +type instance Element (Neighbors a) = a + +makeFieldsNoPrefix ''Neighbors + +instance Applicative Neighbors where + pure α = Neighbors + { _topLeft = α + , _top = α + , _topRight = α + , _left = α + , _right = α + , _bottomLeft = α + , _bottom = α + , _bottomRight = α + } + nf <*> nx = Neighbors + { _topLeft = nf ^. topLeft $ nx ^. topLeft + , _top = nf ^. top $ nx ^. top + , _topRight = nf ^. topRight $ nx ^. topRight + , _left = nf ^. left $ nx ^. left + , _right = nf ^. right $ nx ^. right + , _bottomLeft = nf ^. bottomLeft $ nx ^. bottomLeft + , _bottom = nf ^. bottom $ nx ^. bottom + , _bottomRight = nf ^. bottomRight $ nx ^. bottomRight + } + +edges :: Neighbors a -> Edges a +edges neighs = Edges + { eTop = neighs ^. top + , eBottom = neighs ^. bottom + , eLeft = neighs ^. left + , eRight = neighs ^. right + } + +neighborDirections :: Neighbors Direction +neighborDirections = Neighbors + { _topLeft = UpLeft + , _top = Up + , _topRight = UpRight + , _left = Left + , _right = Right + , _bottomLeft = DownLeft + , _bottom = Down + , _bottomRight = DownRight + } + +neighborPositions :: Num a => Position' a -> Neighbors (Position' a) +neighborPositions pos = (`move` pos) <$> neighborDirections + +neighborCells :: Num a => V2 a -> Neighbors (V2 a) +neighborCells = map (view _Position) . neighborPositions . review _Position + +arrayNeighbors + :: (IArray a e, Ix i, Num i) + => a (V2 i) e + -> V2 i + -> Neighbors (Maybe e) +arrayNeighbors arr center = arrLookup <$> neighborPositions (_Position # center) + where + arrLookup (view _Position -> pos) + | inRange (bounds arr) pos = Just $ arr ! pos + | otherwise = Nothing + +-- | Returns a list of all 4 90-degree rotations of the given neighbors +rotations :: Neighbors a -> V4 (Neighbors a) +rotations orig@(Neighbors tl t tr l r bl b br) = V4 + orig -- tl t tr + -- l r + -- bl b br + + (Neighbors bl l tl b t br r tr) -- bl l tl + -- b t + -- br r tr + + (Neighbors br b bl r l tr t tl) -- br b bl + -- r l + -- tr t tl + + (Neighbors tr r br t b tl l bl) -- tr r br + -- t b + -- tl l bl + +-------------------------------------------------------------------------------- + +newtype Per a b = Rate Double + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON) + via Double + deriving (Semigroup, Monoid) via Product Double + deriving Show via ShowUnitSuffix (Per a b) Double +deriving via Double + instance ( Distribution d Double + , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy) + ) + => Distribution d (Per a b) + +instance (Unit a, Unit b) => Unit (a `Per` b) where + unitSuffix = unitSuffix @a <> "/" <> unitSuffix @b + +invertRate :: a `Per` b -> b `Per` a +invertRate (Rate p) = Rate $ 1 / p + +invertedRate :: Iso (a `Per` b) (b' `Per` a') (b `Per` a) (a' `Per` b') +invertedRate = iso invertRate invertRate + +type (:+:) :: Type -> Type -> Type +type family (:+:) a b where + a :+: a = a + a :+: (Uno b) = a + +infixl 6 |+| +class AddUnit a b where + (|+|) :: a -> b -> a :+: b + +instance Scalar a => AddUnit a a where + x' |+| y' = fromScalar $ scalar x' + scalar y' + +instance (Scalar a, Scalar b) => AddUnit a (Uno b) where + x' |+| y' = fromScalar $ scalar x' + scalar y' + +type (:*:) :: Type -> Type -> Type +type family (:*:) a b where + (a `Per` b) :*: b = a + (Square a) :*: a = Cubic a + a :*: a = Square a + a :*: Uno b = a + a :*: b = a :**: b + +infixl 7 |*| +class MulUnit a b where + (|*|) :: a -> b -> a :*: b + +instance (Scalar a, Scalar b) => MulUnit (a `Per` b) b where + (Rate rate) |*| b = fromScalar $ rate * scalar b + +instance forall a. (Scalar a, a :*: a ~ Square a) => MulUnit a a where + x' |*| y' = Square @a . fromScalar $ scalar x' * scalar y' + +instance forall a. (Scalar a) => MulUnit (Square a) a where + x' |*| y' = Cubic @a . fromScalar $ scalar x' * scalar y' + +instance {-# INCOHERENT #-} forall a b. + (Scalar a, Scalar b, Scalar (a :*: Uno b)) + => MulUnit a (Uno b) where + x' |*| y' = fromScalar $ scalar x' * scalar y' + +type (:/:) :: Type -> Type -> Type +type family (:/:) a b where + (Square a) :/: a = a + (Cubic a) :/: a = Square a + (Cubic a) :/: (Square a) = a + (a :**: b) :/: b = a + (a :**: b) :/: a = b + a :/: Uno b = a + a :/: b = a `Per` b + +infixl 7 |/| +class DivUnit a b where + (|/|) :: a -> b -> a :/: b + +instance Scalar a => DivUnit (Square a) a where + (Square a) |/| b = fromScalar $ scalar a / scalar b + +instance Scalar a => DivUnit (Cubic a) a where + (Cubic a) |/| b = fromScalar $ scalar a / scalar b + +instance (Scalar a, Cubic a :/: Square a ~ a) + => DivUnit (Cubic a) (Square a) where + (Cubic a) |/| (Square b) = fromScalar $ scalar a / scalar b + +instance (Scalar a, Scalar b) => DivUnit (a :**: b) b where + (Times a) |/| b = fromScalar $ scalar a / scalar b + +instance (Scalar a, Scalar b) => DivUnit (a :**: b) a where + (Times a) |/| b = fromScalar $ scalar a / scalar b + +instance {-# INCOHERENT #-} forall a b. + (Scalar a, Scalar b, Scalar (a :/: Uno b)) + => DivUnit a (Uno b) where + x' |/| y' = fromScalar $ scalar x' / scalar y' + +-- | Dimensionless quantitites (mass per unit mass, radians, etc) +-- +-- see <https://en.wikipedia.org/wiki/Parts-per_notation#Uno> +newtype Uno a = Uno a + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON + , Scalar, Show + ) + via a + deriving Unit via UnitSymbol "" (Uno a) + +newtype Square a = Square a + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON + , Scalar + ) + via a +deriving via (a :: Type) + instance ( Distribution d a + , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy) + ) + => Distribution d (Square a) + +instance Unit a => Unit (Square a) where + unitSuffix = unitSuffix @a <> "²" + +instance Show a => Show (Square a) where + show (Square n) = show n <> "²" + +squared :: (Scalar a, a :*: a ~ Square a) => a -> Square a +squared v = v |*| v + +newtype Cubic a = Cubic a + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON + , Scalar + ) + via a +deriving via (a :: Type) + instance ( Distribution d a + , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy) + ) + => Distribution d (Cubic a) + +instance Unit a => Unit (Cubic a) where + unitSuffix = unitSuffix @a <> "³" + +instance Show a => Show (Cubic a) where + show (Cubic n) = show n <> "³" + +newtype (:**:) a b = Times Double + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON) + via Double + deriving (Semigroup, Monoid) via Sum Double + deriving Show via ShowUnitSuffix (a :**: b) Double +deriving via Double + instance ( Distribution d Double + , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy) + ) + => Distribution d (a :**: b) + +instance (Unit a, Unit b) => Unit (a :**: b) where + unitSuffix = unitSuffix @a <> " " <> unitSuffix @b + +-------------------------------------------------------------------------------- + +newtype Ticks = Ticks Word + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Num, Ord, Bounded, Enum, Integral, Real, ToJSON, FromJSON) via Word + deriving (Semigroup, Monoid) via (Sum Word) + deriving Scalar via ScalarIntegral Ticks + deriving Arbitrary via GenericArbitrary Ticks + deriving Unit via UnitSymbol "ticks" Ticks + deriving Show via ShowUnitSuffix Ticks Word +deriving via Word + instance ( Distribution d Word + , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy) + ) + => Distribution d Ticks + +newtype Tiles = Tiles Double + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Num, Ord, Enum, Real, ToJSON, FromJSON, Scalar) via Double + deriving (Semigroup, Monoid) via (Sum Double) + deriving Arbitrary via GenericArbitrary Tiles + deriving Unit via UnitSymbol "m" Tiles + deriving Show via ShowUnitSuffix Tiles Double +deriving via Double + instance ( Distribution d Double + , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy) + ) + => Distribution d Tiles + +type TicksPerTile = Ticks `Per` Tiles +type TilesPerTick = Tiles `Per` Ticks + +timesTiles :: TicksPerTile -> Tiles -> Ticks +timesTiles = (|*|) + +-- | Calculate the (cartesian) distance between two 'Position's, floored and +-- represented as a number of 'Tile's +-- +-- Note that this is imprecise, and may be different than the length of a +-- bresenham's line between the points +distance :: Position -> Position -> Tiles +distance + = (fromScalar .) . (Metric.distance `on` (fmap fromIntegral . view _Position)) + +-------------------------------------------------------------------------------- + +newtype Hitpoints = Hitpoints Word + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Bounded, Enum, Integral, Real, Scalar + , ToJSON, FromJSON + ) + via Word + deriving (Semigroup, Monoid) via Sum Word + deriving Unit via UnitSymbol "hp" Hitpoints + deriving Show via ShowUnitSuffix Hitpoints Word + +-------------------------------------------------------------------------------- + +-- | Grams, the fundamental measure of weight in Xanthous. +newtype Grams = Grams Double + deriving stock (Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Enum, Real, Floating, Fractional, RealFloat + , RealFrac, Scalar, ToJSON, FromJSON + ) + via Double + deriving (Semigroup, Monoid) via Sum Double + deriving Unit via UnitSymbol "g" Grams + deriving Show via ShowUnitSuffix Grams Double + +-- | Every tile is 1 meter +type Meters = Tiles + +-------------------------------------------------------------------------------- + +data Box a = Box + { _topLeftCorner :: V2 a + , _dimensions :: V2 a + } + deriving stock (Show, Eq, Ord, Functor, Generic) + deriving Arbitrary via GenericArbitrary (Box a) +makeFieldsNoPrefix ''Box + +bottomRightCorner :: Num a => Box a -> V2 a +bottomRightCorner box = + V2 (box ^. topLeftCorner . L._x + box ^. dimensions . L._x) + (box ^. topLeftCorner . L._y + box ^. dimensions . L._y) + +setBottomRightCorner :: (Num a, Ord a) => Box a -> V2 a -> Box a +setBottomRightCorner box br@(V2 brx bry) + | brx < box ^. topLeftCorner . L._x || bry < box ^. topLeftCorner . L._y + = box & topLeftCorner .~ br + & dimensions . L._x .~ ((box ^. topLeftCorner . L._x) - brx) + & dimensions . L._y .~ ((box ^. topLeftCorner . L._y) - bry) + | otherwise + = box & dimensions . L._x .~ (brx - (box ^. topLeftCorner . L._x)) + & dimensions . L._y .~ (bry - (box ^. topLeftCorner . L._y)) + +inBox :: (Ord a, Num a) => Box a -> V2 a -> Bool +inBox box pt = flip all [L._x, L._y] $ \component -> + between (box ^. topLeftCorner . component) + (box ^. to bottomRightCorner . component) + (pt ^. component) + +boxIntersects :: (Ord a, Num a) => Box a -> Box a -> Bool +boxIntersects box₁ box₂ + = any (inBox box₁) [box₂ ^. topLeftCorner, bottomRightCorner box₂] + +boxCenter :: (Fractional a) => Box a -> V2 a +boxCenter box = V2 cx cy + where + cx = box ^. topLeftCorner . L._x + (box ^. dimensions . L._x / 2) + cy = box ^. topLeftCorner . L._y + (box ^. dimensions . L._y / 2) + +boxEdge :: (Enum a, Num a) => Box a -> Edge -> [V2 a] +boxEdge box LeftEdge = + V2 (box ^. topLeftCorner . L._x) + <$> [box ^. topLeftCorner . L._y .. box ^. to bottomRightCorner . L._y] +boxEdge box RightEdge = + V2 (box ^. to bottomRightCorner . L._x) + <$> [box ^. to bottomRightCorner . L._y .. box ^. to bottomRightCorner . L._y] +boxEdge box TopEdge = + flip V2 (box ^. topLeftCorner . L._y) + <$> [box ^. topLeftCorner . L._x .. box ^. to bottomRightCorner . L._x] +boxEdge box BottomEdge = + flip V2 (box ^. to bottomRightCorner . L._y) + <$> [box ^. topLeftCorner . L._x .. box ^. to bottomRightCorner . L._x] diff --git a/users/grfn/xanthous/src/Xanthous/Data/App.hs b/users/grfn/xanthous/src/Xanthous/Data/App.hs new file mode 100644 index 000000000000..a2cfcb8001cb --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/App.hs @@ -0,0 +1,45 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.App + ( Panel(..) + , ResourceName(..) + , AppEvent(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import Test.QuickCheck.Instances.Text () +import Data.Aeson (ToJSON, FromJSON) +-------------------------------------------------------------------------------- +import Xanthous.Util.QuickCheck +-------------------------------------------------------------------------------- + +-- | Enum for "panels" displayed in the game's UI. +data Panel + = -- | A panel displaying the character's inventory + InventoryPanel + | -- | A panel describing an item in the inventory in detail + -- + -- The argument is the full description of the item + ItemDescriptionPanel Text + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Panel + + +data ResourceName + = MapViewport -- ^ The main viewport where we display the game content + | Character -- ^ The character + | MessageBox -- ^ The box where we display messages to the user + | Prompt -- ^ The game's prompt + | Panel Panel -- ^ A panel in the game + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary ResourceName + +data AppEvent + = AutoContinue -- ^ Continue whatever autocommand has been requested by the + -- user + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary AppEvent diff --git a/users/grfn/xanthous/src/Xanthous/Data/Entities.hs b/users/grfn/xanthous/src/Xanthous/Data/Entities.hs new file mode 100644 index 000000000000..39953410f2f3 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/Entities.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.Entities + ( -- * Collisions + Collision(..) + , _Stop + , _Combat + -- * Entity Attributes + , EntityAttributes(..) + , blocksVision + , blocksObject + , collision + , defaultEntityAttributes + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson (ToJSON(..), FromJSON(..), (.:?), (.!=), withObject) +import Data.Aeson.Generic.DerivingVia +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +import Test.QuickCheck +-------------------------------------------------------------------------------- + +data Collision + = Stop -- ^ Can't move through this + | Combat -- ^ Moving into this equates to hitting it with a stick + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Collision + deriving (ToJSON, FromJSON) + via WithOptions '[ AllNullaryToStringTag 'True ] + Collision +makePrisms ''Collision + +-- | Attributes of an entity +data EntityAttributes = EntityAttributes + { _blocksVision :: Bool + -- | Does this entity block a large object from being put in the same tile as + -- it - eg a a door being closed on it + , _blocksObject :: Bool + -- | What type of collision happens when moving into this entity? + , _collision :: Collision + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary EntityAttributes + deriving (ToJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + EntityAttributes +makeLenses ''EntityAttributes + +instance FromJSON EntityAttributes where + parseJSON = withObject "EntityAttributes" $ \o -> do + _blocksVision <- o .:? "blocksVision" + .!= _blocksVision defaultEntityAttributes + _blocksObject <- o .:? "blocksObject" + .!= _blocksObject defaultEntityAttributes + _collision <- o .:? "collision" + .!= _collision defaultEntityAttributes + pure EntityAttributes {..} + +defaultEntityAttributes :: EntityAttributes +defaultEntityAttributes = EntityAttributes + { _blocksVision = False + , _blocksObject = False + , _collision = Stop + } diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs new file mode 100644 index 000000000000..855a3462daee --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityChar + ( EntityChar(..) + , HasChar(..) + , HasStyle(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding ((.=)) +-------------------------------------------------------------------------------- +import qualified Graphics.Vty.Attributes as Vty +import Test.QuickCheck +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Orphans () +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +-------------------------------------------------------------------------------- + + +class HasChar s a | s -> a where + char :: Lens' s a + {-# MINIMAL char #-} + +data EntityChar = EntityChar + { _char :: Char + , _style :: Vty.Attr + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary EntityChar +makeFieldsNoPrefix ''EntityChar + +instance FromJSON EntityChar where + parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr + parseJSON (Object o) = do + (EntityChar _char _) <- o .: "char" + _style <- o .:? "style" .!= Vty.defAttr + pure EntityChar {..} + parseJSON _ = fail "Invalid type, expected string or object" + +instance ToJSON EntityChar where + toJSON (EntityChar chr styl) + | styl == Vty.defAttr = String $ chr <| Empty + | otherwise = object + [ "char" .= chr + , "style" .= styl + ] + +instance IsString EntityChar where + fromString [ch] = EntityChar ch Vty.defAttr + fromString _ = error "Entity char must only be a single character" diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs new file mode 100644 index 000000000000..1d9c4d46cdc9 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs @@ -0,0 +1,277 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveFunctor #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityMap + ( EntityMap + , _EntityMap + , EntityID + , emptyEntityMap + , insertAt + , insertAtReturningID + , fromEIDsAndPositioned + , toEIDsAndPositioned + , atPosition + , atPositionWithIDs + , positions + , lookup + , lookupWithPosition + , positionOf + -- , positionedEntities + , neighbors + , Deduplicate(..) + + -- * debug + , byID + , byPosition + , lastID + + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lookup) +import Xanthous.Data + ( Position + , Positioned(..) + , positioned + , Neighbors(..) + , neighborPositions, position + ) +import Xanthous.Data.VectorBag +import Xanthous.Orphans () +import Xanthous.Util (EqEqProp(..)) +-------------------------------------------------------------------------------- +import Data.Monoid (Endo(..)) +import Test.QuickCheck (Arbitrary(..), CoArbitrary, Function) +import Test.QuickCheck.Checkers (EqProp) +import Test.QuickCheck.Instances.UnorderedContainers () +import Test.QuickCheck.Instances.Vector () +import Text.Show (showString, showParen) +import Data.Aeson +-------------------------------------------------------------------------------- + +type EntityID = Word32 +type NonNullSet a = NonNull (Set a) + +data EntityMap a where + EntityMap :: + { _byPosition :: Map Position (NonNullSet EntityID) + , _byID :: HashMap EntityID (Positioned a) + , _lastID :: EntityID + } -> EntityMap a + deriving stock (Functor, Foldable, Traversable, Generic) + deriving anyclass (NFData, CoArbitrary, Function) +deriving via (EqEqProp (EntityMap a)) instance (Eq a, Ord a) => EqProp (EntityMap a) +makeLenses ''EntityMap + +instance ToJSON a => ToJSON (EntityMap a) where + toJSON = toJSON . toEIDsAndPositioned + + +instance FromJSON a => FromJSON (EntityMap a) where + parseJSON = fmap (fromEIDsAndPositioned @[_]) . parseJSON + +byIDInvariantError :: forall a. a +byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition " + <> "must point to entityIDs in byID" + +instance (Ord a, Eq a) => Eq (EntityMap a) where + -- em₁ == em₂ = em₁ ^. _EntityMap == em₂ ^. _EntityMap + (==) = (==) `on` view (_EntityMap . to sort) + +deriving stock instance (Ord a) => Ord (EntityMap a) + +instance Show a => Show (EntityMap a) where + showsPrec pr em + = showParen (pr > 10) + $ showString + . ("fromEIDsAndPositioned " <>) + . show + . toEIDsAndPositioned + $ em + +instance Arbitrary a => Arbitrary (EntityMap a) where + arbitrary = review _EntityMap <$> arbitrary + shrink em = review _EntityMap <$> shrink (em ^. _EntityMap) + +type instance Index (EntityMap a) = EntityID +type instance IxValue (EntityMap a) = (Positioned a) +instance Ixed (EntityMap a) where ix eid = at eid . traverse + +instance At (EntityMap a) where + at eid = lens (view $ byID . at eid) setter + where + setter :: EntityMap a -> Maybe (Positioned a) -> EntityMap a + setter m Nothing = fromMaybe m $ do + Positioned pos _ <- m ^. byID . at eid + pure $ m + & removeEIDAtPos pos + & byID . at eid .~ Nothing + setter m (Just pe@(Positioned pos _)) = m + & (case lookupWithPosition eid m of + Nothing -> id + Just (Positioned origPos _) -> removeEIDAtPos origPos + ) + & byID . at eid ?~ pe + & byPosition . at pos %~ \case + Nothing -> Just $ opoint eid + Just es -> Just $ ninsertSet eid es + removeEIDAtPos pos = + byPosition . at pos %~ (>>= fromNullable . ndeleteSet eid) + +instance Semigroup (EntityMap a) where + em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁ + +instance Monoid (EntityMap a) where + mempty = emptyEntityMap + +instance FunctorWithIndex EntityID EntityMap + +instance FoldableWithIndex EntityID EntityMap + +instance TraversableWithIndex EntityID EntityMap where + itraversed = byID . itraversed . rmap sequenceA . distrib + itraverse = itraverseOf itraversed + +type instance Element (EntityMap a) = a +instance MonoFoldable (EntityMap a) + +emptyEntityMap :: EntityMap a +emptyEntityMap = EntityMap mempty mempty 0 + +newtype Deduplicate a = Deduplicate (EntityMap a) + deriving stock (Show, Traversable, Generic) + deriving newtype (Eq, Functor, Foldable, EqProp, Arbitrary) + +instance Semigroup (Deduplicate a) where + (Deduplicate em₁) <> (Deduplicate em₂) = + let _byID = em₁ ^. byID <> em₂ ^. byID + _byPosition = mempty &~ do + ifor_ _byID $ \eid (Positioned pos _) -> + at pos %= \case + Just eids -> Just $ ninsertSet eid eids + Nothing -> Just $ opoint eid + _lastID = fromMaybe 1 $ maximumOf (ifolded . asIndex) _byID + in Deduplicate EntityMap{..} + + +-------------------------------------------------------------------------------- + +_EntityMap :: Iso' (EntityMap a) [(Position, a)] +_EntityMap = iso hither yon + where + hither :: EntityMap a -> [(Position, a)] + hither em = do + (pos, eids) <- em ^. byPosition . _Wrapped + eid <- toList eids + ent <- em ^.. byID . at eid . folded . positioned + pure (pos, ent) + yon :: [(Position, a)] -> EntityMap a + yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap + + +insertAtReturningID :: forall a. Position -> a -> EntityMap a -> (EntityID, EntityMap a) +insertAtReturningID pos e em = + let (eid, em') = em & lastID <+~ 1 + in em' + & byID . at eid ?~ Positioned pos e + & byPosition . at pos %~ \case + Nothing -> Just $ opoint eid + Just es -> Just $ ninsertSet eid es + & (eid, ) + +insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a +insertAt pos e = snd . insertAtReturningID pos e + +atPosition :: forall a. (Ord a, Show a) => Position -> Lens' (EntityMap a) (VectorBag a) +atPosition pos = lens getter setter + where + getter em = + let eids :: VectorBag EntityID + eids = maybe mempty (VectorBag . toVector . toNullable) + $ em ^. byPosition . at pos + in getEIDAssume em <$> eids + setter em Empty = em & byPosition . at pos .~ Nothing + setter em (sort -> entities) = + let origEIDs = maybe Empty toNullable $ em ^. byPosition . at pos + origEntitiesWithIDs = + sortOn snd $ toList origEIDs <&> \eid -> (eid, getEIDAssume em eid) + go alles₁@((eid, e₁) :< es₁) -- orig + (e₂ :< es₂) -- new + | e₁ == e₂ + -- same, do nothing + = let (eids, lastEID, byID') = go es₁ es₂ + in (insertSet eid eids, lastEID, byID') + | otherwise + -- e₂ is new, generate a new ID for it + = let (eids, lastEID, byID') = go alles₁ es₂ + eid' = succ lastEID + in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos e₂) + go Empty Empty = (mempty, em ^. lastID, em ^. byID) + go orig Empty = + let byID' = foldr deleteMap (em ^. byID) $ map fst orig + in (mempty, em ^. lastID, byID') + go Empty (new :< news) = + let (eids, lastEID, byID') = go Empty news + eid' = succ lastEID + in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos new) + go _ _ = error "unreachable" + (eidsAtPosition, newLastID, newByID) = go origEntitiesWithIDs entities + in em & byPosition . at pos .~ fromNullable eidsAtPosition + & byID .~ newByID + & lastID .~ newLastID + +getEIDAssume :: EntityMap a -> EntityID -> a +getEIDAssume em eid = fromMaybe byIDInvariantError + $ em ^? byID . ix eid . positioned + +atPositionWithIDs :: Position -> EntityMap a -> Vector (EntityID, Positioned a) +atPositionWithIDs pos em = + let eids = maybe mempty (toVector . toNullable) + $ em ^. byPosition . at pos + in (id &&& Positioned pos . getEIDAssume em) <$> eids + +fromEIDsAndPositioned + :: forall mono a. (MonoFoldable mono, Element mono ~ (EntityID, Positioned a)) + => mono + -> EntityMap a +fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty + where + insert' (eid, pe@(Positioned pos _)) + = (byID . at eid ?~ pe) + . (byPosition . at pos %~ \case + Just eids -> Just $ ninsertSet eid eids + Nothing -> Just $ opoint eid + ) + newLastID em = em & lastID + .~ fromMaybe 1 + (maximumOf (ifolded . asIndex) (em ^. byID)) + +toEIDsAndPositioned :: EntityMap a -> [(EntityID, Positioned a)] +toEIDsAndPositioned = itoListOf $ byID . ifolded + +positions :: EntityMap a -> [Position] +positions = toListOf $ byPosition . to keys . folded + +lookupWithPosition :: EntityID -> EntityMap a -> Maybe (Positioned a) +lookupWithPosition eid = view $ byID . at eid + +lookup :: EntityID -> EntityMap a -> Maybe a +lookup eid = fmap (view positioned) . lookupWithPosition eid + +-- unlawful :( +-- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b) +-- positionedEntities = byID . itraversed + +neighbors :: (Ord a, Show a) => Position -> EntityMap a -> Neighbors (VectorBag a) +neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos + +-- | Traversal to the position of the entity with the given ID +positionOf :: EntityID -> Traversal' (EntityMap a) Position +positionOf eid = ix eid . position + +-------------------------------------------------------------------------------- +makeWrapped ''Deduplicate diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs new file mode 100644 index 000000000000..1398c611cf20 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs @@ -0,0 +1,72 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityMap.Graphics + ( visiblePositions + , visibleEntities + , lineOfSight + , linesOfSight + , canSee + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lines) +-------------------------------------------------------------------------------- +import Xanthous.Util (takeWhileInclusive) +import Xanthous.Data +import Xanthous.Data.Entities +import Xanthous.Data.EntityMap +import Xanthous.Game.State +import Xanthous.Util.Graphics (circle, line) +-------------------------------------------------------------------------------- + +-- | Returns a set of positions that are visible, when taking into account +-- 'blocksVision', from the given position, within the given radius. +visiblePositions + :: Entity e + => Position + -> Word -- ^ Vision radius + -> EntityMap e + -> Set Position +visiblePositions pos radius + = setFromList . positions . visibleEntities pos radius + +-- | Returns a list of entities on the *line of sight* from the first position +-- to the second position +lineOfSight + :: forall e. Entity e + => Position -- ^ Origin + -> Position -- ^ Destination + -> EntityMap e + -> [(Position, Vector (EntityID, e))] +lineOfSight (view _Position -> origin) (view _Position -> destination) em = + takeWhileInclusive (none (view blocksVision . entityAttributes . snd) . snd) + $ getPositionedAt <$> line origin destination + where + getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e)) + getPositionedAt (review _Position -> p) = + (p, over _2 (view positioned) <$> atPositionWithIDs p em) + +-- | Returns a list of individual lines of sight, each of which is a list of +-- entities at positions on that line of sight +linesOfSight + :: forall e. Entity e + => Position -- ^ Centerpoint + -> Word -- ^ Radius + -> EntityMap e + -> [[(Position, Vector (EntityID, e))]] +linesOfSight pos visionRadius em = + radius <&> \edge -> lineOfSight pos (_Position # edge) em + where + radius = circle (pos ^. _Position) $ fromIntegral visionRadius + +-- | Given a point and a radius of vision, returns a list of all entities that +-- are *visible* (eg, not blocked by an entity that obscures vision) from that +-- point +visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e +visibleEntities pos visionRadius + = fromEIDsAndPositioned + . foldMap (\(p, es) -> over _2 (Positioned p) <$> es) + . fold + . linesOfSight pos visionRadius + +canSee :: Entity e => (e -> Bool) -> Position -> Word -> EntityMap e -> Bool +canSee match pos radius = any match . visibleEntities pos radius +-- ^ this might be optimizable diff --git a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs b/users/grfn/xanthous/src/Xanthous/Data/Levels.hs new file mode 100644 index 000000000000..13251d8afdf2 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/Levels.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.Levels + ( Levels + , allLevels + , numLevels + , nextLevel + , prevLevel + , mkLevels1 + , mkLevels + , oneLevel + , current + , ComonadStore(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding ((<.>), Empty, foldMap) +import Xanthous.Util (between, EqProp, EqEqProp(..)) +import Xanthous.Util.Comonad (current) +import Xanthous.Orphans () +-------------------------------------------------------------------------------- +import Control.Comonad.Store +import Control.Comonad.Store.Zipper +import Data.Aeson (ToJSON(..), FromJSON(..)) +import Data.Aeson.Generic.DerivingVia +import Data.Functor.Apply +import Data.Foldable (foldMap) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromJust) +import Data.Sequence (Seq((:<|), Empty)) +import Data.Semigroup.Foldable.Class +import Data.Text (replace) +import Test.QuickCheck +-------------------------------------------------------------------------------- + +-- | Collection of levels plus a pointer to the current level +-- +-- Navigation is via the 'Comonad' instance. We can get the current level with +-- 'extract': +-- +-- extract @Levels :: Levels level -> level +-- +-- For access to and modification of the level, use +-- 'Xanthous.Util.Comonad.current' +newtype Levels a = Levels { levelZipper :: Zipper Seq a } + deriving stock (Generic) + deriving (Functor, Comonad, Foldable) via (Zipper Seq) + +type instance Element (Levels a) = a +instance MonoFoldable (Levels a) +instance MonoFunctor (Levels a) +instance MonoTraversable (Levels a) + +instance ComonadStore Word Levels where + pos = toEnum . pos . levelZipper + peek i = peek (fromEnum i) . levelZipper + +instance Traversable Levels where + traverse f (Levels z) = Levels <$> traverse f z + +instance Foldable1 Levels + +instance Traversable1 Levels where + traverse1 f levs@(Levels z) = seek (pos levs) . partialMkLevels <$> go (unzipper z) + where + go Empty = error "empty seq, unreachable" + go (x :<| xs) = (<|) <$> f x <.> go xs + +-- | Always takes the position of the latter element +instance Semigroup (Levels a) where + levs₁ <> levs₂ + = seek (pos levs₂) + . partialMkLevels + $ allLevels levs₁ <> allLevels levs₂ + +-- | The number of levels stored in 'Levels' +-- +-- Equivalent to 'Data.Foldable.length', but likely faster +numLevels :: Levels a -> Word +numLevels = toEnum . size . levelZipper + +-- | Make Levels from a Seq. Throws an error if the seq is not empty +partialMkLevels :: Seq a -> Levels a +partialMkLevels = Levels . fromJust . zipper + +-- | Make Levels from a possibly-empty structure +mkLevels :: Foldable1 f => f level -> Maybe (Levels level) +mkLevels = fmap Levels . zipper . foldMap pure + +-- | Make Levels from a non-empty structure +mkLevels1 :: Foldable1 f => f level -> Levels level +mkLevels1 = fromJust . mkLevels + +oneLevel :: a -> Levels a +oneLevel = mkLevels1 . Identity + +-- | Get a sequence of all the levels +allLevels :: Levels a -> Seq a +allLevels = unzipper . levelZipper + +-- | Step to the next level, generating a new level if necessary using the given +-- applicative action +nextLevel + :: Applicative m + => m level -- ^ Generate a new level, if necessary + -> Levels level + -> m (Levels level) +nextLevel genLevel levs + | succ (pos levs) < numLevels levs + = pure $ seeks succ levs + | otherwise + = genLevel <&> \level -> + seek (pos levs + 1) . partialMkLevels $ allLevels levs |> level + +-- | Go to the previous level. Returns Nothing if 'pos' is 0 +prevLevel :: Levels level -> Maybe (Levels level) +prevLevel levs | pos levs == 0 = Nothing + | otherwise = Just $ seeks pred levs + +-------------------------------------------------------------------------------- + +-- | alternate, slower representation of Levels we can Iso into to perform +-- various operations +data AltLevels a = AltLevels + { _levels :: NonEmpty a + , _currentLevel :: Word -- ^ invariant: is within the bounds of _levels + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + (AltLevels a) +makeLenses ''AltLevels + +alt :: Iso (Levels a) (Levels b) (AltLevels a) (AltLevels b) +alt = iso hither yon + where + hither levs = AltLevels (NE.fromList . toList $ allLevels levs) (pos levs) + yon (AltLevels levs curr) = seek curr $ mkLevels1 levs + +instance Eq a => Eq (Levels a) where + (==) = (==) `on` view alt + +deriving via EqEqProp (Levels a) instance Eq a => EqProp (Levels a) + +instance Show a => Show (Levels a) where + show = unpack . replace "AltLevels" "Levels" . pack . show . view alt + +instance NFData a => NFData (Levels a) where + rnf = rnf . view alt + +instance ToJSON a => ToJSON (Levels a) where + toJSON = toJSON . view alt + +instance FromJSON a => FromJSON (Levels a) where + parseJSON = fmap (review alt) . parseJSON + +instance Arbitrary a => Arbitrary (AltLevels a) where + arbitrary = do + _levels <- arbitrary + _currentLevel <- choose (0, pred . toEnum . length $ _levels) + pure AltLevels {..} + shrink als = do + _levels <- shrink $ als ^. levels + _currentLevel <- filter (between 0 $ pred . toEnum . length $ _levels) + $ shrink $ als ^. currentLevel + pure AltLevels {..} + + +instance Arbitrary a => Arbitrary (Levels a) where + arbitrary = review alt <$> arbitrary + shrink = fmap (review alt) . shrink . view alt + +instance CoArbitrary a => CoArbitrary (Levels a) where + coarbitrary = coarbitrary . view alt + +instance Function a => Function (Levels a) where + function = functionMap (view alt) (review alt) diff --git a/users/grfn/xanthous/src/Xanthous/Data/Memo.hs b/users/grfn/xanthous/src/Xanthous/Data/Memo.hs new file mode 100644 index 000000000000..2b2ee0f96028 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/Memo.hs @@ -0,0 +1,98 @@ +-------------------------------------------------------------------------------- +-- | Memoized values +-------------------------------------------------------------------------------- +module Xanthous.Data.Memo + ( Memoized(UnMemoized) + , memoizeWith + , getMemoized + , runMemoized + , fillWith + , fillWithM + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Data.Aeson (FromJSON, ToJSON) +import Test.QuickCheck (Arbitrary (arbitrary), oneof, CoArbitrary, Function) +import Test.QuickCheck.Checkers (EqProp) +import Xanthous.Util (EqEqProp(EqEqProp)) +import Control.Monad.State.Class (MonadState) +-------------------------------------------------------------------------------- + +-- | A memoized value, keyed by a key +-- +-- If key is different than what is stored here, then val is invalid +data Memoized key val = Memoized key val | UnMemoized + deriving stock (Show, Eq, Generic) + deriving anyclass (Hashable, FromJSON, ToJSON, NFData, CoArbitrary, Function) + deriving EqProp via EqEqProp (Memoized key val) + +instance (Arbitrary k, Arbitrary v) => Arbitrary (Memoized k v) where + arbitrary = oneof [ pure UnMemoized + , Memoized <$> arbitrary <*> arbitrary + ] + +-- | Construct a memoized value with the given key +memoizeWith :: forall key val. key -> val -> Memoized key val +memoizeWith = Memoized +{-# INLINE memoizeWith #-} + +-- | Retrieve a memoized value providing the key. If the value is unmemoized or +-- the keys do not match, returns Nothing. +-- +-- >>> getMemoized 1 (memoizeWith @Int @Int 1 2) +-- Just 2 +-- +-- >>> getMemoized 2 (memoizeWith @Int @Int 1 2) +-- Nothing +-- +-- >>> getMemoized 1 (UnMemoized :: Memoized Int Int) +-- Nothing +getMemoized :: Eq key => key -> Memoized key val -> Maybe val +getMemoized key (Memoized key' v) + | key == key' = Just v + | otherwise = Nothing +getMemoized _ UnMemoized = Nothing +{-# INLINE getMemoized #-} + +-- | Get a memoized value using an applicative action to obtain the key +runMemoized + :: (Eq key, Applicative m) + => Memoized key val + -> m key + -> m (Maybe val) +runMemoized m mk = getMemoized <$> mk <*> pure m + +-- | In a monadic state containing a 'MemoState', look up the current memoized +-- target of some lens keyed by k, filling it with v if not present and +-- returning either the new or old value +fillWith + :: forall m s k v. + (MonadState s m, Eq k) + => Lens' s (Memoized k v) + -> k + -> v + -> m v +fillWith l k v' = do + uses l (getMemoized k) >>= \case + Just v -> pure v + Nothing -> do + l .= memoizeWith k v' + pure v' + +-- | In a monadic state, look up the current memoized target of some lens keyed +-- by k, filling it with the result of some monadic action v if not present and +-- returning either the new or old value +fillWithM + :: forall m s k v. + (MonadState s m, Eq k) + => Lens' s (Memoized k v) + -> k + -> m v + -> m v +fillWithM l k mv = do + uses l (getMemoized k) >>= \case + Just v -> pure v + Nothing -> do + v' <- mv + l .= memoizeWith k v' + pure v' diff --git a/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs b/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs new file mode 100644 index 000000000000..1b875d448302 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE PolyKinds #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.NestedMap + ( NestedMapVal(..) + , NestedMap(..) + , lookup + , lookupVal + , insert + + -- * + , (:->) + , BifunctorFunctor'(..) + , BifunctorMonad'(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lookup, foldMap) +import qualified Xanthous.Prelude as P +-------------------------------------------------------------------------------- +import Test.QuickCheck +import Data.Aeson +import Data.Function (fix) +import Data.Foldable (Foldable(..)) +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NE +-------------------------------------------------------------------------------- + +-- | Natural transformations on bifunctors +type (:->) p q = forall a b. p a b -> q a b +infixr 0 :-> + +class (forall b. Bifunctor b => Bifunctor (t b)) => BifunctorFunctor' t where + bifmap' :: (Bifunctor p, Bifunctor q) => (p :-> q) -> t p :-> t q + +class BifunctorFunctor' t => BifunctorMonad' t where + bireturn' :: (Bifunctor p) => p :-> t p + + bibind' :: (Bifunctor p, Bifunctor q) => (p :-> t q) -> t p :-> t q + bibind' f = bijoin' . bifmap' f + + bijoin' :: (Bifunctor p) => t (t p) :-> t p + bijoin' = bibind' id + + {-# MINIMAL bireturn', (bibind' | bijoin') #-} + +-------------------------------------------------------------------------------- + +data NestedMapVal m k v = Val v | Nested (NestedMap m k v) + +deriving stock instance + ( forall k' v'. (Show k', Show v') => Show (m k' v') + , Show k + , Show v + ) => Show (NestedMapVal m k v) + +deriving stock instance + ( forall k' v'. (Eq k', Eq v') => Eq (m k' v') + , Eq k + , Eq v + ) => Eq (NestedMapVal m k v) + +instance + forall m k v. + ( Arbitrary (m k v) + , Arbitrary (m k (NestedMapVal m k v)) + , Arbitrary k + , Arbitrary v + , IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) => Arbitrary (NestedMapVal m k v) where + arbitrary = sized . fix $ \gen n -> + let nst = fmap (NestedMap . mapFromList) + . listOf + $ (,) <$> arbitrary @k <*> gen (n `div` 2) + in if n == 0 + then Val <$> arbitrary + else oneof [ Val <$> arbitrary + , Nested <$> nst] + shrink (Val v) = Val <$> shrink v + shrink (Nested mkv) = Nested <$> shrink mkv + +instance Functor (m k) => Functor (NestedMapVal m k) where + fmap f (Val v) = Val $ f v + fmap f (Nested m) = Nested $ fmap f m + +instance Bifunctor m => Bifunctor (NestedMapVal m) where + bimap _ g (Val v) = Val $ g v + bimap f g (Nested m) = Nested $ bimap f g m + +instance BifunctorFunctor' NestedMapVal where + bifmap' _ (Val v) = Val v + bifmap' f (Nested m) = Nested $ bifmap' f m + +instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v))) + => ToJSON (NestedMapVal m k v) where + toJSON (Val v) = toJSON v + toJSON (Nested m) = toJSON m + +instance Foldable (m k) => Foldable (NestedMapVal m k) where + foldMap f (Val v) = f v + foldMap f (Nested m) = foldMap f m + +-- _NestedMapVal +-- :: forall m k v m' k' v'. +-- ( IsMap (m k v), IsMap (m' k' v') +-- , IsMap (m [k] v), IsMap (m' [k'] v') +-- , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k' +-- , ContainerKey (m [k] v) ~ [k], ContainerKey (m' [k'] v') ~ [k'] +-- , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v' +-- , MapValue (m [k] v) ~ v, MapValue (m' [k'] v') ~ v' +-- ) +-- => Iso (NestedMapVal m k v) +-- (NestedMapVal m' k' v') +-- (m [k] v) +-- (m' [k'] v') +-- _NestedMapVal = iso hither yon +-- where +-- hither :: NestedMapVal m k v -> m [k] v +-- hither (Val v) = singletonMap [] v +-- hither (Nested m) = bimap _ _ $ m ^. _NestedMap +-- yon = _ + +-------------------------------------------------------------------------------- + +newtype NestedMap m k v = NestedMap (m k (NestedMapVal m k v)) + +deriving stock instance + ( forall k' v'. (Eq k', Eq v') => Eq (m k' v') + , Eq k + , Eq v + ) => Eq (NestedMap m k v) + +deriving stock instance + ( forall k' v'. (Show k', Show v') => Show (m k' v') + , Show k + , Show v + ) => Show (NestedMap m k v) + +instance Arbitrary (m k (NestedMapVal m k v)) + => Arbitrary (NestedMap m k v) where + arbitrary = NestedMap <$> arbitrary + shrink (NestedMap m) = NestedMap <$> shrink m + +instance Functor (m k) => Functor (NestedMap m k) where + fmap f (NestedMap m) = NestedMap $ fmap (fmap f) m + +instance Bifunctor m => Bifunctor (NestedMap m) where + bimap f g (NestedMap m) = NestedMap $ bimap f (bimap f g) m + +instance BifunctorFunctor' NestedMap where + bifmap' f (NestedMap m) = NestedMap . f $ bimap id (bifmap' f) m + +instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v))) + => ToJSON (NestedMap m k v) where + toJSON (NestedMap m) = toJSON m + +instance Foldable (m k) => Foldable (NestedMap m k) where + foldMap f (NestedMap m) = foldMap (foldMap f) m + +-------------------------------------------------------------------------------- + +lookup + :: ( IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) + => NonEmpty k + -> NestedMap m k v + -> Maybe (NestedMapVal m k v) +lookup (p :| []) (NestedMap vs) = P.lookup p vs +lookup (p :| (p₁ : ps)) (NestedMap vs) = P.lookup p vs >>= \case + (Val _) -> Nothing + (Nested vs') -> lookup (p₁ :| ps) vs' + +lookupVal + :: ( IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) + => NonEmpty k + -> NestedMap m k v + -> Maybe v +lookupVal ks m + | Just (Val v) <- lookup ks m = Just v + | otherwise = Nothing + +insert + :: ( IsMap (m k (NestedMapVal m k v)) + , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v) + , ContainerKey (m k (NestedMapVal m k v)) ~ k + ) + => NonEmpty k + -> v + -> NestedMap m k v + -> NestedMap m k v +insert (k :| []) v (NestedMap m) = NestedMap $ P.insertMap k (Val v) m +insert (k₁ :| (k₂ : ks)) v (NestedMap m) = NestedMap $ alterMap upd k₁ m + where + upd (Just (Nested nm)) = Just . Nested $ insert (k₂ :| ks) v nm + upd _ = Just $ + let (kΩ :| ks') = NE.reverse (k₂ :| ks) + in P.foldl' + (\m' k -> Nested . NestedMap . singletonMap k $ m') + (Nested . NestedMap . singletonMap kΩ $ Val v) + ks' + +-- _NestedMap +-- :: ( IsMap (m k v), IsMap (m' k' v') +-- , IsMap (m (NonEmpty k) v), IsMap (m' (NonEmpty k') v') +-- , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k' +-- , ContainerKey (m (NonEmpty k) v) ~ (NonEmpty k) +-- , ContainerKey (m' (NonEmpty k') v') ~ (NonEmpty k') +-- , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v' +-- , MapValue (m (NonEmpty k) v) ~ v, MapValue (m' (NonEmpty k') v') ~ v' +-- ) +-- => Iso (NestedMap m k v) +-- (NestedMap m' k' v') +-- (m (NonEmpty k) v) +-- (m' (NonEmpty k') v') +-- _NestedMap = iso undefined yon +-- where +-- hither (NestedMap m) = undefined . mapToList $ m +-- yon mkv = undefined diff --git a/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs b/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs new file mode 100644 index 000000000000..2e6d48062a45 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.VectorBag + (VectorBag(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Data.Aeson +import qualified Data.Vector as V +import Test.QuickCheck +import Test.QuickCheck.Instances.Vector () +-------------------------------------------------------------------------------- + +-- | Acts exactly like a Vector, except ignores order when testing for equality +newtype VectorBag a = VectorBag (Vector a) + deriving stock + ( Traversable + , Generic + ) + deriving newtype + ( Show + , Read + , Foldable + , FromJSON + , FromJSON1 + , ToJSON + , Reversing + , Applicative + , Functor + , Monad + , Monoid + , Semigroup + , Arbitrary + , CoArbitrary + , Filterable + ) +makeWrapped ''VectorBag + +instance Function a => Function (VectorBag a) where + function = functionMap (\(VectorBag v) -> v) VectorBag + +type instance Element (VectorBag a) = a +deriving via (Vector a) instance MonoFoldable (VectorBag a) +deriving via (Vector a) instance GrowingAppend (VectorBag a) +deriving via (Vector a) instance SemiSequence (VectorBag a) +deriving via (Vector a) instance MonoPointed (VectorBag a) +deriving via (Vector a) instance MonoFunctor (VectorBag a) + +instance Cons (VectorBag a) (VectorBag b) a b where + _Cons = prism (\(x, VectorBag xs) -> VectorBag $ x <| xs) $ \(VectorBag v) -> + if V.null v + then Left (VectorBag mempty) + else Right (V.unsafeHead v, VectorBag $ V.unsafeTail v) + +instance AsEmpty (VectorBag a) where + _Empty = prism' (const $ VectorBag Empty) $ \case + (VectorBag Empty) -> Just () + _ -> Nothing + +instance Witherable VectorBag where + wither f (VectorBag v) = VectorBag <$> wither f v + witherM f (VectorBag v) = VectorBag <$> witherM f v + filterA p (VectorBag v) = VectorBag <$> filterA p v + +{- + TODO: + , Ixed + , FoldableWithIndex + , FunctorWithIndex + , TraversableWithIndex + , Snoc + , Each +-} + +instance Ord a => Eq (VectorBag a) where + (==) = (==) `on` (view _Wrapped . sort) + +instance Ord a => Ord (VectorBag a) where + compare = compare `on` (view _Wrapped . sort) + +instance MonoTraversable (VectorBag a) where + otraverse f (VectorBag v) = VectorBag <$> otraverse f v + +instance IsSequence (VectorBag a) where + fromList = VectorBag . fromList + break prd (VectorBag v) = bimap VectorBag VectorBag $ break prd v + span prd (VectorBag v) = bimap VectorBag VectorBag $ span prd v + dropWhile prd (VectorBag v) = VectorBag $ dropWhile prd v + takeWhile prd (VectorBag v) = VectorBag $ takeWhile prd v + splitAt idx (VectorBag v) = bimap VectorBag VectorBag $ splitAt idx v + unsafeSplitAt idx (VectorBag v) = + bimap VectorBag VectorBag $ unsafeSplitAt idx v + take n (VectorBag v) = VectorBag $ take n v + unsafeTake n (VectorBag v) = VectorBag $ unsafeTake n v + drop n (VectorBag v) = VectorBag $ drop n v + unsafeDrop n (VectorBag v) = VectorBag $ unsafeDrop n v + partition p (VectorBag v) = bimap VectorBag VectorBag $ partition p v diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs new file mode 100644 index 000000000000..d405cb40d3eb --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs @@ -0,0 +1,240 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Character + + ( -- * Character datatype + Character(..) + , characterName + , HasInventory(..) + , characterDamage + , characterHitpoints' + , characterHitpoints + , hitpointRecoveryRate + , speed + , body + + -- *** Body + , Body(..) + , initialBody + , knuckles + , Knuckles(..) + , fistDamageChance + , damageKnuckles + , fistfightingDamage + + -- * Character functions + , mkCharacter + , pickUpItem + , isDead + , isFullyHealed + , damage + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) +import Data.Coerce (coerce) +import Test.QuickCheck +import Test.QuickCheck.Instances.Vector () +import Test.QuickCheck.Arbitrary.Generic +import Test.QuickCheck.Gen (chooseUpTo) +import Test.QuickCheck.Checkers (EqProp) +import Control.Monad.State.Lazy (execState) +import Control.Monad.Trans.State.Lazy (execStateT) +-------------------------------------------------------------------------------- +import Xanthous.Util.QuickCheck +import Xanthous.Game.State +import Xanthous.Entities.Item +import Xanthous.Entities.Common +import Xanthous.Data + ( TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned ) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Util (EqEqProp(EqEqProp), modifyKL) +import Xanthous.Monad (say_) +-------------------------------------------------------------------------------- + +-- | The status of the character's knuckles +-- +-- This struct is used to track the damage and then eventual build-up of +-- calluses when the character is fighting with their fists +data Knuckles = Knuckles + { -- | How damaged are the knuckles currently, from 0 to 5? + -- + -- At 0, no calluses will form + -- At 1 and up, the character will form calluses after a while + -- At 5, continuing to fistfight will deal the character even more damage + _knuckleDamage :: !Word + -- | How built-up are the character's calluses, from 0 to 5? + -- + -- Each level of calluses decreases the likelihood of being damaged when + -- fistfighting by 1%, up to 5 where the character will never be damaged + -- fistfighting + , _knuckleCalluses :: !Word + + -- | Number of turns that have passed since the last time the knuckles were + -- damaged + , _ticksSinceDamaged :: Ticks + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving EqProp via EqEqProp Knuckles + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Knuckles +makeLenses ''Knuckles + +instance Semigroup Knuckles where + (Knuckles d₁ c₁ t₁) <> (Knuckles d₂ c₂ t₂) = Knuckles + (min (d₁ + d₂) 5) + (min (c₁ + c₂) 5) + (max t₁ t₂) + +instance Monoid Knuckles where + mempty = Knuckles 0 0 0 + +instance Arbitrary Knuckles where + arbitrary = do + _knuckleDamage <- fromIntegral <$> chooseUpTo 5 + _knuckleCalluses <- fromIntegral <$> chooseUpTo 5 + _ticksSinceDamaged <- arbitrary + pure Knuckles{..} + +-- | Likelihood that the character fighting with their fists will damage +-- themselves +fistDamageChance :: Knuckles -> Float +fistDamageChance knuckles + | calluses == 5 = 0 + | otherwise = baseChance - (0.01 * fromIntegral calluses) + where + baseChance = 0.08 + calluses = knuckles ^. knuckleCalluses + +-- | Damage the knuckles by a level (capping at the max knuckle damage) +damageKnuckles :: Knuckles -> Knuckles +damageKnuckles = execState $ do + knuckleDamage %= min 5 . succ + ticksSinceDamaged .= 0 + +-- | Damage taken when fistfighting and 'fistDamageChance' has occurred +fistfightingDamage :: Knuckles -> Hitpoints +fistfightingDamage knuckles + | knuckles ^. knuckleDamage == 5 = 2 + | otherwise = 1 + +stepKnuckles :: Ticks -> Knuckles -> AppM Knuckles +stepKnuckles ticks = execStateT . whenM (uses knuckleDamage (> 0)) $ do + ticksSinceDamaged += ticks + whenM (uses ticksSinceDamaged (>= 2000)) $ do + dam <- knuckleDamage <<.= 0 + knuckleCalluses %= min 5 . (+ dam) + ticksSinceDamaged .= 0 + lift $ say_ ["character", "body", "knuckles", "calluses"] + + +-- | Status of the character's body +data Body = Body + { _knuckles :: !Knuckles + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Body + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Body +makeLenses ''Body + +initialBody :: Body +initialBody = Body { _knuckles = mempty } + +-------------------------------------------------------------------------------- + +data Character = Character + { _inventory :: !Inventory + , _characterName :: !(Maybe Text) + , _characterHitpoints' :: !Double + , _speed :: !TicksPerTile + , _body :: !Body + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Character +makeFieldsNoPrefix ''Character + +characterHitpoints :: Character -> Hitpoints +characterHitpoints = views characterHitpoints' floor + +scrollOffset :: Int +scrollOffset = 5 + +instance Draw Character where + draw _ = visibleRegion rloc rreg $ str "@" + where + rloc = Location (negate scrollOffset, negate scrollOffset) + rreg = (2 * scrollOffset, 2 * scrollOffset) + drawPriority = const maxBound -- Character should always be on top, for now + +instance Brain Character where + step ticks = execStateT $ do + positioned . characterHitpoints' %= \hp -> + if hp > fromIntegral initialHitpoints + then hp + else hp + hitpointRecoveryRate |*| ticks + modifyKL (positioned . body . knuckles) $ lift . stepKnuckles ticks + +instance Entity Character where + description _ = "yourself" + entityChar _ = "@" + +instance Arbitrary Character where + arbitrary = genericArbitrary + +initialHitpoints :: Hitpoints +initialHitpoints = 10 + +hitpointRecoveryRate :: Double `Per` Ticks +hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed) + +defaultSpeed :: TicksPerTile +defaultSpeed = 100 + +mkCharacter :: Character +mkCharacter = Character + { _inventory = mempty + , _characterName = Nothing + , _characterHitpoints' = fromIntegral initialHitpoints + , _speed = defaultSpeed + , _body = initialBody + } + +defaultCharacterDamage :: Hitpoints +defaultCharacterDamage = 1 + +-- | Returns the damage that the character currently does with an attack +-- TODO use double-handed/left-hand/right-hand here +characterDamage :: Character -> Hitpoints +characterDamage + = fromMaybe defaultCharacterDamage + . preview (inventory . wielded . wieldedItems . wieldableItem . Raw.damage) + +-- | Is the character fully healed up to or past their initial hitpoints? +isFullyHealed :: Character -> Bool +isFullyHealed = (>= initialHitpoints) . characterHitpoints + +-- | Is the character dead? +isDead :: Character -> Bool +isDead = (== 0) . characterHitpoints + +pickUpItem :: Item -> Character -> Character +pickUpItem it = inventory . backpack %~ (it <|) + +damage :: Hitpoints -> Character -> Character +damage (fromIntegral -> amount) = characterHitpoints' %~ \case + n | n <= amount -> 0 + | otherwise -> n - amount + +{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-} diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs new file mode 100644 index 000000000000..becd1b1ef62e --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs @@ -0,0 +1,250 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +-- | +-- Module : Xanthous.Entities.Common +-- Description : Common data type definitions and utilities for entities +-- +-------------------------------------------------------------------------------- +module Xanthous.Entities.Common + ( -- * Inventory + Inventory(..) + , HasInventory(..) + , backpack + , wielded + , items + , InventoryPosition(..) + , describeInventoryPosition + , inventoryPosition + , itemsWithPosition + , removeItemFromPosition + + -- ** Wielded items + , Wielded(..) + , hands + , leftHand + , rightHand + , inLeftHand + , inRightHand + , doubleHanded + , wieldedItems + , WieldedItem(..) + , wieldedItem + , wieldableItem + , asWieldedItem + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson.Generic.DerivingVia +import Test.QuickCheck +import Test.QuickCheck.Checkers (EqProp) +-------------------------------------------------------------------------------- +import Xanthous.Data (Positioned(..), positioned) +import Xanthous.Util.QuickCheck +import Xanthous.Game.State +import Xanthous.Entities.Item +import Xanthous.Entities.RawTypes (WieldableItem, wieldable) +import Xanthous.Util (removeFirst, EqEqProp(..)) +-------------------------------------------------------------------------------- + +data WieldedItem = WieldedItem + { _wieldedItem :: Item + , _wieldableItem :: WieldableItem + -- ^ Invariant: item ^. itemType . wieldable ≡ Just wieldableItem + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + WieldedItem +makeFieldsNoPrefix ''WieldedItem + +asWieldedItem :: Prism' Item WieldedItem +asWieldedItem = prism' hither yon + where + yon item = WieldedItem item <$> item ^. itemType . wieldable + hither (WieldedItem item _) = item + +instance Brain WieldedItem where + step ticks (Positioned p wi) = + over positioned (\i -> WieldedItem i $ wi ^. wieldableItem) + <$> step ticks (Positioned p $ wi ^. wieldedItem) + +instance Draw WieldedItem where + draw = draw . view wieldedItem + +instance Entity WieldedItem where + entityAttributes = entityAttributes . view wieldedItem + description = description . view wieldedItem + entityChar = entityChar . view wieldedItem + +instance Arbitrary WieldedItem where + arbitrary = genericArbitrary <&> \wi -> + wi & wieldedItem . itemType . wieldable ?~ wi ^. wieldableItem + +data Wielded + = DoubleHanded WieldedItem + | Hands { _leftHand :: !(Maybe WieldedItem) + , _rightHand :: !(Maybe WieldedItem) + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Wielded + deriving (ToJSON, FromJSON) + via WithOptions '[ 'SumEnc 'ObjWithSingleField ] + Wielded + +nothingWielded :: Wielded +nothingWielded = Hands Nothing Nothing + +hands :: Prism' Wielded (Maybe WieldedItem, Maybe WieldedItem) +hands = prism' (uncurry Hands) $ \case + Hands l r -> Just (l, r) + _ -> Nothing + +leftHand :: Traversal' Wielded (Maybe WieldedItem) +leftHand = hands . _1 + +inLeftHand :: WieldedItem -> Wielded +inLeftHand wi = Hands (Just wi) Nothing + +rightHand :: Traversal' Wielded (Maybe WieldedItem) +rightHand = hands . _2 + +inRightHand :: WieldedItem -> Wielded +inRightHand wi = Hands Nothing (Just wi) + +doubleHanded :: Prism' Wielded WieldedItem +doubleHanded = prism' DoubleHanded $ \case + DoubleHanded i -> Just i + _ -> Nothing + +wieldedItems :: Traversal' Wielded WieldedItem +wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> k wielded +wieldedItems k (Hands l r) = Hands <$> _Just k l <*> _Just k r + +data Inventory = Inventory + { _backpack :: Vector Item + , _wielded :: Wielded + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Inventory + deriving EqProp via EqEqProp Inventory + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Inventory +makeFieldsNoPrefix ''Inventory + +items :: Traversal' Inventory Item +items k (Inventory bp w) = Inventory + <$> traversed k bp + <*> (wieldedItems . wieldedItem) k w + +type instance Element Inventory = Item + +instance MonoFunctor Inventory where + omap = over items + +instance MonoFoldable Inventory where + ofoldMap = foldMapOf items + ofoldr = foldrOf items + ofoldl' = foldlOf' items + otoList = toListOf items + oall = allOf items + oany = anyOf items + onull = nullOf items + ofoldr1Ex = foldr1Of items + ofoldl1Ex' = foldl1Of' items + headEx = headEx . toListOf items + lastEx = lastEx . toListOf items + +instance MonoTraversable Inventory where + otraverse = traverseOf items + +instance Semigroup Inventory where + inv₁ <> inv₂ = + let backpack' = inv₁ ^. backpack <> inv₂ ^. backpack + (wielded', backpack'') = case (inv₁ ^. wielded, inv₂ ^. wielded) of + (wielded₁, wielded₂@(DoubleHanded _)) -> + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem)) + (wielded₁, wielded₂@(Hands (Just _) (Just _))) -> + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem)) + (wielded₁, Hands Nothing Nothing) -> (wielded₁, backpack') + (Hands Nothing Nothing, wielded₂) -> (wielded₂, backpack') + (Hands (Just l₁) Nothing, Hands Nothing (Just r₂)) -> + (Hands (Just l₁) (Just r₂), backpack') + (wielded₁@(DoubleHanded _), wielded₂) -> + (wielded₁, backpack' <> fromList (wielded₂ ^.. wieldedItems . wieldedItem)) + (Hands Nothing (Just r₁), Hands Nothing (Just r₂)) -> + (Hands Nothing (Just r₂), r₁ ^. wieldedItem <| backpack') + (Hands Nothing r₁, Hands (Just l₂) Nothing) -> + (Hands (Just l₂) r₁, backpack') + (Hands (Just l₁) Nothing, Hands (Just l₂) Nothing) -> + (Hands (Just l₂) Nothing, l₁ ^. wieldedItem <| backpack') + (Hands (Just l₁) (Just r₁), Hands Nothing (Just r₂)) -> + (Hands (Just l₁) (Just r₂), r₁ ^. wieldedItem <| backpack') + (Hands (Just l₁) (Just r₁), Hands (Just l₂) Nothing) -> + (Hands (Just l₂) (Just r₁), l₁ ^. wieldedItem <| backpack') + in Inventory backpack'' wielded' + +instance Monoid Inventory where + mempty = Inventory mempty $ Hands Nothing Nothing + +class HasInventory s a | s -> a where + inventory :: Lens' s a + {-# MINIMAL inventory #-} + +-- | Representation for where in the inventory an item might be +data InventoryPosition + = Backpack + | LeftHand + | RightHand + | BothHands + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary InventoryPosition + +-- | Return a human-readable description of the given 'InventoryPosition' +describeInventoryPosition :: InventoryPosition -> Text +describeInventoryPosition Backpack = "In backpack" +describeInventoryPosition LeftHand = "Wielded, in left hand" +describeInventoryPosition RightHand = "Wielded, in right hand" +describeInventoryPosition BothHands = "Wielded, in both hands" + +-- | Given a position in the inventory, return a traversal on the inventory over +-- all the items in that position +inventoryPosition :: InventoryPosition -> Traversal' Inventory Item +inventoryPosition Backpack = backpack . traversed +inventoryPosition LeftHand = wielded . leftHand . _Just . wieldedItem +inventoryPosition RightHand = wielded . leftHand . _Just . wieldedItem +inventoryPosition BothHands = wielded . doubleHanded . wieldedItem + +-- | A fold over all the items in the inventory accompanied by their position in +-- the inventory +-- +-- Invariant: This will return items in the same order as 'items' +itemsWithPosition :: Fold Inventory (InventoryPosition, Item) +itemsWithPosition = folding $ (<>) <$> backpackItems <*> handItems + where + backpackItems = toListOf $ backpack . folded . to (Backpack ,) + handItems inv = case inv ^. wielded of + DoubleHanded i -> pure (BothHands, i ^. wieldedItem) + Hands l r -> (l ^.. folded . wieldedItem . to (LeftHand ,)) + <> (r ^.. folded . wieldedItem . to (RightHand ,)) + +-- | Remove the first item equal to 'Item' from the given position in the +-- inventory +removeItemFromPosition :: InventoryPosition -> Item -> Inventory -> Inventory +removeItemFromPosition Backpack item inv + = inv & backpack %~ removeFirst (== item) +removeItemFromPosition LeftHand item inv + = inv & wielded . leftHand %~ filter ((/= item) . view wieldedItem) +removeItemFromPosition RightHand item inv + = inv & wielded . rightHand %~ filter ((/= item) . view wieldedItem) +removeItemFromPosition BothHands item inv + | has (wielded . doubleHanded . wieldedItem . filtered (== item)) inv + = inv & wielded .~ nothingWielded + | otherwise + = inv diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs new file mode 100644 index 000000000000..3ea610795e98 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Creature + ( -- * Creature + Creature(..) + -- ** Lenses + , creatureType + , hitpoints + , hippocampus + , inventory + + -- ** Creature functions + , damage + , isDead + , visionRadius + + -- * Hippocampus + , Hippocampus(..) + -- ** Lenses + , destination + -- ** Destination + , Destination(..) + , destinationFromPos + -- *** Lenses + , destinationPosition + , destinationProgress + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) +-------------------------------------------------------------------------------- +import Xanthous.AI.Gormlak +import Xanthous.Entities.RawTypes hiding + (Creature, description, damage) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Game.State +import Xanthous.Data +import Xanthous.Data.Entities +import Xanthous.Entities.Creature.Hippocampus +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +import Xanthous.Entities.Common (Inventory, HasInventory(..)) +-------------------------------------------------------------------------------- + +data Creature = Creature + { _creatureType :: !CreatureType + , _hitpoints :: !Hitpoints + , _hippocampus :: !Hippocampus + , _inventory :: !Inventory + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature + deriving Arbitrary via GenericArbitrary Creature + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Creature +makeFieldsNoPrefix ''Creature + +instance HasVisionRadius Creature where + visionRadius = const 50 -- TODO + +instance Brain Creature where + step = brainVia GormlakBrain + entityCanMove = const True + +instance Entity Creature where + entityAttributes _ = defaultEntityAttributes + & blocksObject .~ True + description = view $ creatureType . Raw.description + entityChar = view $ creatureType . char + entityCollision = const $ Just Combat + +-------------------------------------------------------------------------------- + +damage :: Hitpoints -> Creature -> Creature +damage amount = hitpoints %~ \hp -> + if hp <= amount + then 0 + else hp - amount + +isDead :: Creature -> Bool +isDead = views hitpoints (== 0) + +{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-} diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs new file mode 100644 index 000000000000..9d5cc134517f --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Creature.Hippocampus + (-- * Hippocampus + Hippocampus(..) + , initialHippocampus + -- ** Lenses + , destination + , greetedCharacter + -- ** Destination + , Destination(..) + , destinationFromPos + -- *** Lenses + , destinationPosition + , destinationProgress + ) +where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +-------------------------------------------------------------------------------- +import Xanthous.Data +import Xanthous.Util.QuickCheck +-------------------------------------------------------------------------------- + + +data Destination = Destination + { _destinationPosition :: !Position + -- | The progress towards the destination, tracked as an offset from the + -- creature's original position. + -- + -- When this value reaches >= 1, the creature has reached their destination + , _destinationProgress :: !Tiles + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Destination +instance Arbitrary Destination where arbitrary = genericArbitrary +makeLenses ''Destination + +destinationFromPos :: Position -> Destination +destinationFromPos _destinationPosition = + let _destinationProgress = 0 + in Destination{..} + +data Hippocampus = Hippocampus + { _destination :: !(Maybe Destination) + , -- | Has this creature greeted the character in any way yet? + -- + -- Some creature types ignore this field + _greetedCharacter :: !Bool + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Hippocampus + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Hippocampus +makeLenses ''Hippocampus + +initialHippocampus :: Hippocampus +initialHippocampus = Hippocampus + { _destination = Nothing + , _greetedCharacter = False + } diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs b/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs new file mode 100644 index 000000000000..aa6c5fa4fc47 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs @@ -0,0 +1,31 @@ +module Xanthous.Entities.Draw.Util where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick.Widgets.Border.Style +import Brick.Types (Edges(..)) +-------------------------------------------------------------------------------- + +borderFromEdges :: BorderStyle -> Edges Bool -> Char +borderFromEdges bstyle edges = ($ bstyle) $ case edges of + Edges False False False False -> const '☐' + + Edges True False False False -> bsVertical + Edges False True False False -> bsVertical + Edges False False True False -> bsHorizontal + Edges False False False True -> bsHorizontal + + Edges True True False False -> bsVertical + Edges True False True False -> bsCornerBR + Edges True False False True -> bsCornerBL + + Edges False True True False -> bsCornerTR + Edges False True False True -> bsCornerTL + Edges False False True True -> bsHorizontal + + Edges False True True True -> bsIntersectT + Edges True False True True -> bsIntersectB + Edges True True False True -> bsIntersectL + Edges True True True False -> bsIntersectR + + Edges True True True True -> bsIntersectFull diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs new file mode 100644 index 000000000000..a0c037a1b4ed --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Entities () where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import qualified Test.QuickCheck.Gen as Gen +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Entities.Character +import Xanthous.Entities.Item +import Xanthous.Entities.Creature +import Xanthous.Entities.Environment +import Xanthous.Entities.Marker +import Xanthous.Game.State +import Xanthous.Util.QuickCheck +import Data.Aeson.Generic.DerivingVia +-------------------------------------------------------------------------------- + +instance Arbitrary SomeEntity where + arbitrary = Gen.oneof + [ SomeEntity <$> arbitrary @Character + , SomeEntity <$> arbitrary @Item + , SomeEntity <$> arbitrary @Creature + , SomeEntity <$> arbitrary @Wall + , SomeEntity <$> arbitrary @Door + , SomeEntity <$> arbitrary @GroundMessage + , SomeEntity <$> arbitrary @Staircase + , SomeEntity <$> arbitrary @Marker + ] + +instance FromJSON SomeEntity where + parseJSON = withObject "Entity" $ \obj -> do + (entityType :: Text) <- obj .: "type" + case entityType of + "Character" -> SomeEntity @Character <$> obj .: "data" + "Item" -> SomeEntity @Item <$> obj .: "data" + "Creature" -> SomeEntity @Creature <$> obj .: "data" + "Wall" -> SomeEntity @Wall <$> obj .: "data" + "Door" -> SomeEntity @Door <$> obj .: "data" + "GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data" + "Staircase" -> SomeEntity @Staircase <$> obj .: "data" + "Marker" -> SomeEntity @Marker <$> obj .: "data" + _ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\"" + +deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel + instance FromJSON GameLevel +deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState + instance FromJSON GameState + +instance Entity SomeEntity where + entityAttributes (SomeEntity ent) = entityAttributes ent + description (SomeEntity ent) = description ent + entityChar (SomeEntity ent) = entityChar ent + entityCollision (SomeEntity ent) = entityCollision ent + +instance Function SomeEntity where + function = functionJSON + +instance CoArbitrary SomeEntity where + coarbitrary = coarbitrary . encode diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot new file mode 100644 index 000000000000..519a862c6a5a --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Xanthous.Entities.Entities where + +import Test.QuickCheck +import Data.Aeson +import Xanthous.Game.State (SomeEntity, GameState, Entity) + +instance Arbitrary SomeEntity +instance Function SomeEntity +instance CoArbitrary SomeEntity +instance FromJSON SomeEntity +instance Entity SomeEntity + +instance FromJSON GameState diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs b/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs new file mode 100644 index 000000000000..b45a91eabed2 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE TemplateHaskell #-} +module Xanthous.Entities.Environment + ( + -- * Walls + Wall(..) + + -- * Doors + , Door(..) + , open + , closed + , locked + , unlockedDoor + + -- * Messages + , GroundMessage(..) + + -- * Stairs + , Staircase(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import Brick (str) +import Brick.Widgets.Border.Style (unicode) +import Brick.Types (Edges(..)) +import Data.Aeson +import Data.Aeson.Generic.DerivingVia +-------------------------------------------------------------------------------- +import Xanthous.Entities.Draw.Util +import Xanthous.Data +import Xanthous.Data.Entities +import Xanthous.Game.State +import Xanthous.Util.QuickCheck +-------------------------------------------------------------------------------- + +data Wall = Wall + deriving stock (Show, Eq, Ord, Generic, Enum) + deriving anyclass (NFData, CoArbitrary, Function) + +instance ToJSON Wall where + toJSON = const $ String "Wall" + +instance FromJSON Wall where + parseJSON = withText "Wall" $ \case + "Wall" -> pure Wall + _ -> fail "Invalid Wall: expected Wall" + +instance Brain Wall where step = brainVia Brainless + +instance Entity Wall where + entityAttributes _ = defaultEntityAttributes + & blocksVision .~ True + & blocksObject .~ True + description _ = "a wall" + entityChar _ = "┼" + +instance Arbitrary Wall where + arbitrary = pure Wall + +wallEdges :: (MonoFoldable mono, Element mono ~ SomeEntity) + => Neighbors mono -> Edges Bool +wallEdges neighs = any (entityIs @Wall) <$> edges neighs + +instance Draw Wall where + drawWithNeighbors neighs _wall = + str . pure . borderFromEdges unicode $ wallEdges neighs + +data Door = Door + { _open :: Bool + , _locked :: Bool + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON) + deriving Arbitrary via GenericArbitrary Door +makeLenses ''Door + +instance Draw Door where + drawWithNeighbors neighs door + = str . pure . ($ door ^. open) $ case wallEdges neighs of + Edges True False False False -> vertDoor + Edges False True False False -> vertDoor + Edges True True False False -> vertDoor + Edges False False True False -> horizDoor + Edges False False False True -> horizDoor + Edges False False True True -> horizDoor + _ -> allsidesDoor + where + horizDoor True = '␣' + horizDoor False = 'ᚔ' + vertDoor True = '[' + vertDoor False = 'ǂ' + allsidesDoor True = '+' + allsidesDoor False = '▥' + +instance Brain Door where step = brainVia Brainless + +instance Entity Door where + entityAttributes door = defaultEntityAttributes + & blocksVision .~ not (door ^. open) + description door | door ^. open = "an open door" + | otherwise = "a closed door" + entityChar _ = "d" + entityCollision door | door ^. open = Nothing + | otherwise = Just Stop + +closed :: Lens' Door Bool +closed = open . involuted not + +-- | A closed, unlocked door +unlockedDoor :: Door +unlockedDoor = Door + { _open = False + , _locked = False + } + +-------------------------------------------------------------------------------- + +newtype GroundMessage = GroundMessage Text + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary GroundMessage + deriving (ToJSON, FromJSON) + via WithOptions '[ 'TagSingleConstructors 'True + , 'SumEnc 'ObjWithSingleField + ] + GroundMessage + deriving Draw + via DrawStyledCharacter ('Just 'Yellow) 'Nothing "≈" + GroundMessage +instance Brain GroundMessage where step = brainVia Brainless + +instance Entity GroundMessage where + description = const "a message on the ground. Press r. to read it." + entityChar = const "≈" + entityCollision = const Nothing + +-------------------------------------------------------------------------------- + +data Staircase = UpStaircase | DownStaircase + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Staircase + deriving (ToJSON, FromJSON) + via WithOptions '[ 'TagSingleConstructors 'True + , 'SumEnc 'ObjWithSingleField + ] + Staircase +instance Brain Staircase where step = brainVia Brainless + +instance Draw Staircase where + draw UpStaircase = str "<" + draw DownStaircase = str ">" + +instance Entity Staircase where + description UpStaircase = "a staircase leading upwards" + description DownStaircase = "a staircase leading downwards" + entityChar UpStaircase = "<" + entityChar DownStaircase = ">" + entityCollision = const Nothing diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Item.hs b/users/grfn/xanthous/src/Xanthous/Entities/Item.hs new file mode 100644 index 000000000000..eadd62569663 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Item.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Item + ( Item(..) + , itemType + , density + , volume + , newWithType + , isEdible + , weight + , fullDescription + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Test.QuickCheck (Arbitrary, CoArbitrary, Function) +import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson.Generic.DerivingVia +import Control.Monad.Random (MonadRandom) +-------------------------------------------------------------------------------- +import Xanthous.Entities.RawTypes (ItemType) +import qualified Xanthous.Entities.RawTypes as Raw +import Xanthous.Game.State +import Xanthous.Data (Grams, Per, Cubic, Meters, (|*|)) +import Xanthous.Util.QuickCheck (GenericArbitrary(GenericArbitrary)) +import Xanthous.Random (choose, FiniteInterval(..)) +-------------------------------------------------------------------------------- + +data Item = Item + { _itemType :: ItemType + , _density :: Grams `Per` Cubic Meters + , _volume :: Cubic Meters + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Draw via DrawRawChar "_itemType" Item + deriving Arbitrary via GenericArbitrary Item + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Item +makeLenses ''Item + +-- deriving via (Brainless Item) instance Brain Item +instance Brain Item where step = brainVia Brainless + +instance Entity Item where + description = view $ itemType . Raw.description + entityChar = view $ itemType . Raw.char + entityCollision = const Nothing + +newWithType :: MonadRandom m => ItemType -> m Item +newWithType _itemType = do + _density <- choose . FiniteInterval $ _itemType ^. Raw.density + _volume <- choose . FiniteInterval $ _itemType ^. Raw.volume + pure Item {..} + +isEdible :: Item -> Bool +isEdible = Raw.isEdible . view itemType + +-- | The weight of this item, calculated by multiplying its volume by the +-- density of its material +weight :: Item -> Grams +weight item = (item ^. density) |*| (item ^. volume) + +-- | Describe the item in full detail +fullDescription :: Item -> Text +fullDescription item = unlines + [ item ^. itemType . Raw.description + , "" + , item ^. itemType . Raw.longDescription + , "" + , "volume: " <> tshow (item ^. volume) + , "density: " <> tshow (item ^. density) + , "weight: " <> tshow (weight item) + ] diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs b/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs new file mode 100644 index 000000000000..14d02872ed4e --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs @@ -0,0 +1,41 @@ +-------------------------------------------------------------------------------- +module Xanthous.Entities.Marker ( Marker(..) ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson +import Test.QuickCheck +import qualified Graphics.Vty.Attributes as Vty +import qualified Graphics.Vty.Image as Vty +import Brick.Widgets.Core (raw) +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Data.Entities (EntityAttributes(..)) +-------------------------------------------------------------------------------- + +-- | Mark on the map - for use in debugging / development only. +newtype Marker = Marker Text + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (Semigroup, Monoid, ToJSON, FromJSON, Arbitrary) via Text + +instance Brain Marker where step = brainVia Brainless + +instance Entity Marker where + entityAttributes = const EntityAttributes + { _blocksVision = False + , _blocksObject = False + , _collision = Stop + } + description (Marker m) = "[M] " <> m + entityChar = const $ "X" & style .~ markerStyle + entityCollision = const Nothing + +instance Draw Marker where + draw = const . raw $ Vty.char markerStyle 'X' + drawPriority = const maxBound + +markerStyle :: Vty.Attr +markerStyle = Vty.defAttr + `Vty.withForeColor` Vty.red + `Vty.withBackColor` Vty.black diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs new file mode 100644 index 000000000000..9f5cabecdca7 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs @@ -0,0 +1,277 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DuplicateRecordFields #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.RawTypes + ( + EntityRaw(..) + , _Creature + , _Item + + -- * Creatures + , CreatureType(..) + , hostile + -- ** Generation parameters + , CreatureGenerateParams(..) + , canGenerate + -- ** Language + , LanguageName(..) + , getLanguage + -- ** Attacks + , Attack(..) + + -- * Items + , ItemType(..) + -- ** Item sub-types + -- *** Edible + , EdibleItem(..) + , isEdible + -- *** Wieldable + , WieldableItem(..) + , isWieldable + + -- * Lens classes + , HasAttackMessage(..) + , HasAttacks(..) + , HasChance(..) + , HasChar(..) + , HasCreatureAttackMessage(..) + , HasDamage(..) + , HasDensity(..) + , HasDescription(..) + , HasEatMessage(..) + , HasEdible(..) + , HasEntityName(..) + , HasEquippedItem(..) + , HasFriendly(..) + , HasGenerateParams(..) + , HasHitpointsHealed(..) + , HasLanguage(..) + , HasLevelRange(..) + , HasLongDescription(..) + , HasMaxHitpoints(..) + , HasName(..) + , HasSayVerb(..) + , HasSpeed(..) + , HasVolume(..) + , HasWieldable(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Test.QuickCheck +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) +import Data.Interval (Interval, lowerBound', upperBound') +import qualified Data.Interval as Interval +-------------------------------------------------------------------------------- +import Xanthous.Messages (Message(..)) +import Xanthous.Data (TicksPerTile, Hitpoints, Per, Grams, Cubic, Meters) +import Xanthous.Data.EntityChar +import Xanthous.Util.QuickCheck +import Xanthous.Generators.Speech (Language, gormlak, english) +import Xanthous.Orphans () +import Xanthous.Util (EqProp, EqEqProp(..)) +-------------------------------------------------------------------------------- + +-- | Identifiers for languages that creatures can speak. +-- +-- Non-verbal or non-sentient creatures have Nothing as their language +-- +-- At some point, we will likely want to make languages be defined in data files +-- somewhere, and reference them that way instead. +data LanguageName = Gormlak | English + deriving stock (Show, Eq, Ord, Generic, Enum, Bounded) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary LanguageName + deriving (ToJSON, FromJSON) + via WithOptions '[ AllNullaryToStringTag 'True ] + LanguageName + +-- | Resolve a 'LanguageName' into an actual 'Language' +getLanguage :: LanguageName -> Language +getLanguage Gormlak = gormlak +getLanguage English = english + +-- | Natural attacks for creature types +data Attack = Attack + { -- | the @{{creature}}@ @{{description}}@ + _description :: !Message + -- | Damage dealt + , _damage :: !Hitpoints + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Attack + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] + , OmitNothingFields 'True + ] + Attack +makeFieldsNoPrefix ''Attack + +-- | Description for generating an item equipped to a creature +data CreatureEquippedItem = CreatureEquippedItem + { -- | Name of the entity type to generate + _entityName :: !Text + -- | Chance of generating the item when generating the creature + -- + -- A chance of 1.0 will always generate the item + , _chance :: !Double + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary CreatureEquippedItem + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] + , OmitNothingFields 'True + ] + CreatureEquippedItem +makeFieldsNoPrefix ''CreatureEquippedItem + + +data CreatureGenerateParams = CreatureGenerateParams + { -- | Range of dungeon levels at which to generate this creature + _levelRange :: !(Interval Word) + -- | Item equipped to the creature + , _equippedItem :: !(Maybe CreatureEquippedItem) + } + deriving stock (Eq, Show, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary CreatureGenerateParams + deriving EqProp via EqEqProp CreatureGenerateParams + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + CreatureGenerateParams +makeFieldsNoPrefix ''CreatureGenerateParams + +instance Ord CreatureGenerateParams where + compare + = (compare `on` lowerBound' . _levelRange) + <> (compare `on` upperBound' . _levelRange) + <> (compare `on` _equippedItem) + +-- | Can a creature with these generate params be generated on this level? +canGenerate + :: Word -- ^ Level number + -> CreatureGenerateParams + -> Bool +canGenerate levelNumber gps = Interval.member levelNumber $ gps ^. levelRange + +data CreatureType = CreatureType + { _name :: !Text + , _description :: !Text + , _char :: !EntityChar + , _maxHitpoints :: !Hitpoints + , _friendly :: !Bool + , _speed :: !TicksPerTile + , _language :: !(Maybe LanguageName) + , -- | The verb, in present tense, for when the creature says something + _sayVerb :: !(Maybe Text) + , -- | The creature's natural attacks + _attacks :: !(NonNull (Vector Attack)) + -- | Parameters for generating the creature in levels + , _generateParams :: !(Maybe CreatureGenerateParams) + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary CreatureType + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] + , OmitNothingFields 'True + ] + CreatureType +makeFieldsNoPrefix ''CreatureType + +hostile :: Lens' CreatureType Bool +hostile = friendly . involuted not + +-------------------------------------------------------------------------------- + +data EdibleItem = EdibleItem + { _hitpointsHealed :: !Int + , _eatMessage :: !(Maybe Message) + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary EdibleItem + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + EdibleItem +makeFieldsNoPrefix ''EdibleItem + +data WieldableItem = WieldableItem + { _damage :: !Hitpoints + , _attackMessage :: !(Maybe Message) + -- | Message to use when a creature is using this item to attack the + -- character. + -- + -- Grammatically, should be of the form "The creature slashes you with its + -- dagger". + -- + -- = Parameters + -- + -- [@creature@ (type: 'Creature')] The creature doing the attacking + -- [@item@ (type: 'Item')] The item itself + , _creatureAttackMessage :: !(Maybe Message) + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary WieldableItem + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + WieldableItem +makeFieldsNoPrefix ''WieldableItem + +-------------------------------------------------------------------------------- + +data ItemType = ItemType + { _name :: !Text + , _description :: !Text + , _longDescription :: !Text + , _char :: !EntityChar + , _density :: !(Interval (Grams `Per` Cubic Meters)) + , _volume :: !(Interval (Cubic Meters)) + , _edible :: !(Maybe EdibleItem) + , _wieldable :: !(Maybe WieldableItem) + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary ItemType + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + ItemType +makeFieldsNoPrefix ''ItemType + +instance Ord ItemType where + compare x y + = compareOf name x y + <> compareOf description x y + <> compareOf longDescription x y + <> compareOf char x y + <> compareOf (density . to extractInterval) x y + <> compareOf (volume . to extractInterval) x y + <> compareOf edible x y + <> compareOf wieldable x y + where + compareOf l = comparing (view l) + extractInterval = lowerBound' &&& upperBound' + +-- | Can this item be eaten? +isEdible :: ItemType -> Bool +isEdible = has $ edible . _Just + +-- | Can this item be used as a weapon? +isWieldable :: ItemType -> Bool +isWieldable = has $ wieldable . _Just + +-------------------------------------------------------------------------------- + +data EntityRaw + = Creature !CreatureType + | Item !ItemType + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving Arbitrary via GenericArbitrary EntityRaw + deriving (FromJSON) + via WithOptions '[ SumEnc ObjWithSingleField ] + EntityRaw +makePrisms ''EntityRaw diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs new file mode 100644 index 000000000000..10f0d831934e --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Raws + ( raws + , raw + , RawType(..) + , rawsWithType + ) where +-------------------------------------------------------------------------------- +import Data.FileEmbed +import qualified Data.Yaml as Yaml +import Xanthous.Prelude +import System.FilePath.Posix +-------------------------------------------------------------------------------- +import Xanthous.Entities.RawTypes +import Xanthous.AI.Gormlak () +-------------------------------------------------------------------------------- +rawRaws :: [(FilePath, ByteString)] +rawRaws = $(embedDir "src/Xanthous/Entities/Raws") + +raws :: HashMap Text EntityRaw +raws + = mapFromList + . map (bimap + (pack . takeBaseName) + (either (error . Yaml.prettyPrintParseException) id + . Yaml.decodeEither')) + $ rawRaws + +raw :: Text -> Maybe EntityRaw +raw n = raws ^. at n + +class RawType (a :: Type) where + _RawType :: Prism' EntityRaw a + +instance RawType CreatureType where + _RawType = prism' Creature $ \case + Creature c -> Just c + _ -> Nothing + +instance RawType ItemType where + _RawType = prism' Item $ \case + Item i -> Just i + _ -> Nothing + +rawsWithType :: forall a. RawType a => HashMap Text a +rawsWithType = mapFromList . itoListOf (ifolded . _RawType) $ raws + +-------------------------------------------------------------------------------- diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml new file mode 100644 index 000000000000..2d30e6986b6e --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml @@ -0,0 +1,24 @@ +Item: + name: broken dagger + description: a short, broken dagger + longDescription: A short dagger with a twisted, chipped blade + char: + char: † + style: + foreground: black + wieldable: + damage: 3 + attackMessage: + - You slash at the {{creature.creatureType.name}} with your dagger. + - You stab the {{creature.creatureType.name}} with your dagger. + creatureAttackMessage: + - The {{creature.creatureType.name}} slashes at you with its dagger. + - The {{creature.creatureType.name}} stabs you with its dagger. + # Just the steel, not the handle, for now + density: [7750 , 8050000] + # 15cm – 45cm + # × + # 2cm – 3cm + # × + # .5cm – 1cm + volume: [0.15, 1.35] diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml new file mode 100644 index 000000000000..ad3d9cb147da --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml @@ -0,0 +1,20 @@ +Creature: + name: gormlak + description: a gormlak + longDescription: | + A chittering imp-like creature with bright yellow horns and sharp claws. It + adores shiny objects and gathers in swarms. + char: + char: g + style: + foreground: red + maxHitpoints: 5 + speed: 125 + friendly: false + language: Gormlak + sayVerb: yells + attacks: + - description: + - claws you + - slashes you with its claws + damage: 1 diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml new file mode 100644 index 000000000000..cdfcde616d21 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml @@ -0,0 +1,26 @@ +Creature: + name: husk + description: an empty husk of some humanoid creature + longDescription: | + An empty husk of a humanoid creature. All semblance of sentience has long + left its eyes; instead it shambles about aimlessly, always hungering for the + warmth of life. + char: + char: h + style: + foreground: black + maxHitpoints: 6 + speed: 110 + friendly: false + attacks: + - description: + - swings its arms at you + - elbows you + damage: 1 + - description: kicks you + damage: 2 + generateParams: + levelRange: [1, PosInf] + equippedItem: + entityName: broken-dagger + chance: 0.9 diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml new file mode 100644 index 000000000000..c0501a18a8e0 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml @@ -0,0 +1,14 @@ +Item: + name: noodles + description: "a big bowl o' noodles" + longDescription: You know exactly what kind of noodles + char: + char: 'n' + style: + foreground: yellow + edible: + hitpointsHealed: 2 + eatMessage: + - You slurp up the noodles. Yumm! + density: 500000 + volume: 0.001 diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml new file mode 100644 index 000000000000..fe427c94abf7 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml @@ -0,0 +1,15 @@ +Creature: + name: ooze + description: an ooze + longDescription: | + A jiggling, amorphous, bright green caustic blob + char: + char: o + style: + foreground: green + maxHitpoints: 3 + speed: 100 + friendly: false + attacks: + - description: slams into you + damage: 1 diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml new file mode 100644 index 000000000000..e7492bf5fb6f --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml @@ -0,0 +1,10 @@ +Item: + name: rock + description: a rock + longDescription: a medium-sized rock made out of some unknown stone + char: . + wieldable: + damage: 1 + attackMessage: you hit the {{creature.creatureType.name}} in the head with your rock. + density: [ 1500000, 2500000 ] + volume: [ 0.000125, 0.001 ] diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml new file mode 100644 index 000000000000..a7eae9c36666 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml @@ -0,0 +1,22 @@ +Item: + name: stick + description: a wooden stick + longDescription: A sturdy branch broken off from some sort of tree + char: + char: ∤ + style: + foreground: yellow + wieldable: + damage: 2 + attackMessage: + - You bonk the {{creature.creatureType.name}} over the head with your stick. + - You bash the {{creature.creatureType.name}} on the noggin with your stick. + - You whack the {{creature.creatureType.name}} with your stick. + creatureAttackMessage: + - The {{creature.creatureType.name}} bonks you over the head with its stick. + - The {{creature.creatureType.name}} bashes you on the noggin with its stick. + - The {{creature.creatureType.name}} whacks you with its stick. + # https://www.sciencedirect.com/topics/agricultural-and-biological-sciences/wood-density + # it's a hard stick. so it's dense wood. + density: 890000 # g/m³ + volume: [ 0.003, 0.006 ] # ≈3.5 cm radius × ≈1m length diff --git a/users/grfn/xanthous/src/Xanthous/Game.hs b/users/grfn/xanthous/src/Xanthous/Game.hs new file mode 100644 index 000000000000..89c23f0de850 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game.hs @@ -0,0 +1,73 @@ +module Xanthous.Game + ( GameState(..) + , levels + , entities + , revealedPositions + , messageHistory + , randomGen + , promptState + , GamePromptState(..) + + , getInitialState + , initialStateFromSeed + + , positionedCharacter + , character + , characterPosition + , updateCharacterVision + , characterVisiblePositions + , entitiesAtCharacter + , revealedEntitiesAtPosition + + -- * Messages + , MessageHistory(..) + , HasMessages(..) + , HasTurn(..) + , HasDisplayedTurn(..) + , pushMessage + , previousMessage + , nextTurn + + -- * Collisions + , Collision(..) + , collisionAt + + -- * App monad + , AppT(..) + + -- * Saving the game + , saveGame + , loadGame + , saved + + -- * Debug State + , DebugState(..) + , debugState + , allRevealed + ) where +-------------------------------------------------------------------------------- +import qualified Codec.Compression.Zlib as Zlib +import Codec.Compression.Zlib.Internal (DecompressError) +import qualified Data.Aeson as JSON +import System.IO.Unsafe +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Xanthous.Game.State +import Xanthous.Game.Lenses +import Xanthous.Game.Arbitrary () +import Xanthous.Entities.Entities () +-------------------------------------------------------------------------------- + +saveGame :: GameState -> LByteString +saveGame = Zlib.compress . JSON.encode + +loadGame :: LByteString -> Maybe GameState +loadGame = JSON.decode <=< decompressZlibMay + where + decompressZlibMay bs + = unsafeDupablePerformIO + $ (let r = Zlib.decompress bs in r `seq` pure (Just r)) + `catch` \(_ :: DecompressError) -> pure Nothing + +saved :: Prism' LByteString GameState +saved = prism' saveGame loadGame diff --git a/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs b/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs new file mode 100644 index 000000000000..679bfe54597f --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Arbitrary where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (foldMap) +-------------------------------------------------------------------------------- +import Test.QuickCheck +import System.Random +import Data.Foldable (foldMap) +-------------------------------------------------------------------------------- +import Xanthous.Data.Levels +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Entities.Entities () +import Xanthous.Entities.Character +import Xanthous.Game.State +import Xanthous.Orphans () +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +-------------------------------------------------------------------------------- + +deriving via GenericArbitrary GameLevel instance Arbitrary GameLevel + +instance Arbitrary GameState where + arbitrary = do + chr <- arbitrary @Character + _upStaircasePosition <- arbitrary + _messageHistory <- arbitrary + levs <- arbitrary @(Levels GameLevel) + _levelRevealedPositions <- + fmap setFromList + . sublistOf + . foldMap (EntityMap.positions . _levelEntities) + $ levs + let (_characterEntityID, _levelEntities) = + EntityMap.insertAtReturningID _upStaircasePosition (SomeEntity chr) + $ levs ^. current . levelEntities + _levels = levs & current .~ GameLevel {..} + _randomGen <- mkStdGen <$> arbitrary + let _promptState = NoPrompt -- TODO + _activePanel <- arbitrary + _debugState <- arbitrary + let _autocommand = NoAutocommand + _memo <- arbitrary + _savefile <- arbitrary + pure $ GameState {..} + + +instance CoArbitrary GameLevel +instance Function GameLevel +instance CoArbitrary GameState +instance Function GameState diff --git a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs new file mode 100644 index 000000000000..53ea1c96f8af --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs @@ -0,0 +1,151 @@ +-------------------------------------------------------------------------------- +module Xanthous.Game.Draw + ( drawGame + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick hiding (loc, on) +import Brick.Widgets.Border +import Brick.Widgets.Border.Style +import Brick.Widgets.Edit +import Control.Monad.State.Lazy (evalState) +import Control.Monad.State.Class ( get, MonadState, gets ) +-------------------------------------------------------------------------------- +import Xanthous.Data +import Xanthous.Data.App (ResourceName, Panel(..)) +import qualified Xanthous.Data.App as Resource +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Game.State +import Xanthous.Entities.Common (Wielded(..), wielded, backpack) +import Xanthous.Entities.Character +import Xanthous.Entities.Item (Item) +import Xanthous.Game + ( characterPosition + , character + , revealedEntitiesAtPosition + ) +import Xanthous.Game.Prompt +import Xanthous.Orphans () +-------------------------------------------------------------------------------- + +cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName +cursorPosition game + | WaitingPrompt _ (Prompt _ _ (preview promptStatePosition -> Just pos) _ _) + <- game ^. promptState + = showCursor Resource.Prompt (pos ^. loc) + | otherwise + = showCursor Resource.Character (game ^. characterPosition . loc) + +drawMessages :: MessageHistory -> Widget ResourceName +drawMessages = txtWrap . (<> " ") . unwords . reverse . oextract + +drawPromptState :: GamePromptState m -> Widget ResourceName +drawPromptState NoPrompt = emptyWidget +drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = + case (pt, ps, pri) of + (SStringPrompt, StringPromptState edit, mDef) -> + txt msg + <+> txt (maybe "" (\def -> "(default: " <> def <> ") ") mDef) + <+> renderEditor (txt . fold) True edit + (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg + (SMenu, _, menuItems) -> + txtWrap msg + <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) + _ -> txtWrap msg + where + drawMenuItem (chr, MenuOption m _) = + str ("[" <> pure chr <> "] ") <+> txtWrap m + +drawEntities + :: forall m. MonadState GameState m + => m (Widget ResourceName) +drawEntities = do + allEnts <- use entities + let entityPositions = EntityMap.positions allEnts + maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions + maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions + rows = traverse mkRow [0..maxY] + mkRow rowY = hBox <$> traverse (renderEntityAt . flip Position rowY) [0..maxX] + renderEntityAt pos + = renderTopEntity pos <$> revealedEntitiesAtPosition pos + renderTopEntity pos ents + = let neighbors = EntityMap.neighbors pos allEnts + in maybe (str " ") (drawWithNeighbors neighbors) + $ maximumBy (compare `on` drawPriority) + <$> fromNullable ents + vBox <$> rows + +drawMap :: MonadState GameState m => m (Widget ResourceName) +drawMap = do + cursorPos <- gets cursorPosition + viewport Resource.MapViewport Both . cursorPos <$> drawEntities + +bullet :: Char +bullet = '•' + +drawInventoryPanel :: GameState -> Widget ResourceName +drawInventoryPanel game + = drawWielded (game ^. character . inventory . wielded) + <=> drawBackpack (game ^. character . inventory . backpack) + where + drawWielded (Hands Nothing Nothing) = emptyWidget + drawWielded (DoubleHanded i) = + txtWrap $ "You are holding " <> description i <> " in both hands" + drawWielded (Hands l r) = drawHand "left" l <=> drawHand "right" r + drawHand side = maybe emptyWidget $ \i -> + txtWrap ( "You are holding " + <> description i + <> " in your " <> side <> " hand" + ) + <=> txt " " + + drawBackpack :: Vector Item -> Widget ResourceName + drawBackpack Empty = txtWrap "Your backpack is empty right now." + drawBackpack backpackItems + = txtWrap ( "You are currently carrying the following items in your " + <> "backpack:") + <=> txt " " + <=> foldl' (<=>) emptyWidget + (map + (txtWrap . ((bullet <| " ") <>) . description) + backpackItems) + + +drawPanel :: GameState -> Panel -> Widget ResourceName +drawPanel game panel + = border + . hLimit 35 + . viewport (Resource.Panel panel) Vertical + . case panel of + InventoryPanel -> drawInventoryPanel + ItemDescriptionPanel desc -> const $ txtWrap desc + $ game + +drawCharacterInfo :: Character -> Widget ResourceName +drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints + where + charName | Just n <- ch ^. characterName + = txt $ n <> " " + | otherwise + = emptyWidget + charHitpoints + = txt "Hitpoints: " + <+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp) + +drawGame :: GameState -> [Widget ResourceName] +drawGame = evalState $ do + game <- get + drawnMap <- drawMap + pure + . pure + . withBorderStyle unicode + $ case game ^. promptState of + NoPrompt -> drawMessages (game ^. messageHistory) + _ -> emptyWidget + <=> drawPromptState (game ^. promptState) + <=> + (maybe emptyWidget (drawPanel game) (game ^. activePanel) + <+> border drawnMap + ) + <=> drawCharacterInfo (game ^. character) diff --git a/users/grfn/xanthous/src/Xanthous/Game/Env.hs b/users/grfn/xanthous/src/Xanthous/Game/Env.hs new file mode 100644 index 000000000000..5d7b275c8a0b --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game/Env.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Env + ( Config(..) + , defaultConfig + , disableSaving + , GameEnv(..) + , eventChan + , config + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick.BChan (BChan) +import Xanthous.Data.App (AppEvent) +-------------------------------------------------------------------------------- + +data Config = Config + { _disableSaving :: Bool + } + deriving stock (Generic, Show, Eq) +makeLenses ''Config +{-# ANN Config ("HLint: ignore Use newtype instead of data" :: String) #-} + +defaultConfig :: Config +defaultConfig = Config + { _disableSaving = False + } + +-------------------------------------------------------------------------------- + +data GameEnv = GameEnv + { _eventChan :: BChan AppEvent + , _config :: Config + } + deriving stock (Generic) +makeLenses ''GameEnv diff --git a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs new file mode 100644 index 000000000000..c692a3b47944 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Lenses + ( clearMemo + , positionedCharacter + , character + , characterPosition + , updateCharacterVision + , characterVisiblePositions + , characterVisibleEntities + , positionIsCharacterVisible + , getInitialState + , initialStateFromSeed + , entitiesAtCharacter + , revealedEntitiesAtPosition + , hearingRadius + + -- * Collisions + , Collision(..) + , entitiesCollision + , collisionAt + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import System.Random +import Control.Monad.State +import Control.Monad.Random (getRandom) +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import qualified Xanthous.Game.Memo as Memo +import Xanthous.Data +import Xanthous.Data.Levels +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Data.EntityMap.Graphics + (visiblePositions, visibleEntities) +import Xanthous.Data.VectorBag +import Xanthous.Entities.Character (Character, mkCharacter) +import {-# SOURCE #-} Xanthous.Entities.Entities () +import Xanthous.Game.Memo (emptyMemoState, MemoState) +import Xanthous.Data.Memo (fillWithM, Memoized) +-------------------------------------------------------------------------------- + +getInitialState :: IO GameState +getInitialState = initialStateFromSeed <$> getRandom + +initialStateFromSeed :: Int -> GameState +initialStateFromSeed seed = + let _randomGen = mkStdGen seed + chr = mkCharacter + _upStaircasePosition = Position 0 0 + (_characterEntityID, _levelEntities) + = EntityMap.insertAtReturningID + _upStaircasePosition + (SomeEntity chr) + mempty + _levelRevealedPositions = mempty + level = GameLevel {..} + _levels = oneLevel level + _messageHistory = mempty + _promptState = NoPrompt + _activePanel = Nothing + _debugState = DebugState + { _allRevealed = False + } + _savefile = Nothing + _autocommand = NoAutocommand + _memo = emptyMemoState + in GameState {..} + +clearMemo :: MonadState GameState m => Lens' MemoState (Memoized k v) -> m () +clearMemo l = memo %= Memo.clear l + +positionedCharacter :: Lens' GameState (Positioned Character) +positionedCharacter = lens getPositionedCharacter setPositionedCharacter + where + setPositionedCharacter :: GameState -> Positioned Character -> GameState + setPositionedCharacter game chr + = game + & entities . at (game ^. characterEntityID) + ?~ fmap SomeEntity chr + + getPositionedCharacter :: GameState -> Positioned Character + getPositionedCharacter game + = over positioned + ( fromMaybe (error "Invariant error: Character was not a character!") + . downcastEntity + ) + . fromMaybe (error "Invariant error: Character not found!") + $ EntityMap.lookupWithPosition + (game ^. characterEntityID) + (game ^. entities) + + +character :: Lens' GameState Character +character = positionedCharacter . positioned + +characterPosition :: Lens' GameState Position +characterPosition = positionedCharacter . position + +-- TODO make this dynamic +visionRadius :: Word +visionRadius = 12 + +-- TODO make this dynamic +hearingRadius :: Word +hearingRadius = 12 + +-- | Update the revealed entities at the character's position based on their +-- vision +updateCharacterVision :: GameState -> GameState +updateCharacterVision = execState $ do + positions <- characterVisiblePositions + revealedPositions <>= positions + +characterVisiblePositions :: MonadState GameState m => m (Set Position) +characterVisiblePositions = do + charPos <- use characterPosition + fillWithM + (memo . Memo.characterVisiblePositions) + charPos + (uses entities $ visiblePositions charPos visionRadius) + +characterVisibleEntities :: GameState -> EntityMap.EntityMap SomeEntity +characterVisibleEntities game = + let charPos = game ^. characterPosition + in visibleEntities charPos visionRadius $ game ^. entities + +positionIsCharacterVisible :: MonadState GameState m => Position -> m Bool +positionIsCharacterVisible p = (p `elem`) <$> characterVisiblePositions +-- ^ TODO optimize + +entitiesCollision + :: ( Functor f + , forall xx. MonoFoldable (f xx) + , Element (f SomeEntity) ~ SomeEntity + , Element (f (Maybe Collision)) ~ Maybe Collision + , Show (f (Maybe Collision)) + , Show (f SomeEntity) + ) + => f SomeEntity + -> Maybe Collision +entitiesCollision = join . maximumMay . fmap entityCollision + +collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) +collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision + +entitiesAtCharacter :: Lens' GameState (VectorBag SomeEntity) +entitiesAtCharacter = lens getter setter + where + getter gs = gs ^. entities . EntityMap.atPosition (gs ^. characterPosition) + setter gs ents = gs + & entities . EntityMap.atPosition (gs ^. characterPosition) .~ ents + +-- | Returns all entities at the given position that are revealed to the +-- character. +-- +-- Concretely, this is either entities that are *currently* visible to the +-- character, or entities, that are immobile and that the character has seen +-- before +revealedEntitiesAtPosition + :: MonadState GameState m + => Position + -> m (VectorBag SomeEntity) +revealedEntitiesAtPosition p = do + allRev <- use $ debugState . allRevealed + cvps <- characterVisiblePositions + entitiesAtPosition <- use $ entities . EntityMap.atPosition p + revealed <- use revealedPositions + let immobileEntitiesAtPosition = filter (not . entityCanMove) entitiesAtPosition + pure $ if | allRev || p `member` cvps + -> entitiesAtPosition + | p `member` revealed + -> immobileEntitiesAtPosition + | otherwise + -> mempty diff --git a/users/grfn/xanthous/src/Xanthous/Game/Memo.hs b/users/grfn/xanthous/src/Xanthous/Game/Memo.hs new file mode 100644 index 000000000000..9e483a8d4af7 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game/Memo.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +-- | Memoized versions of calculations +-------------------------------------------------------------------------------- +module Xanthous.Game.Memo + ( MemoState + , emptyMemoState + , clear + -- ** Memo lenses + , characterVisiblePositions + + -- * Memoized values + , Memoized(UnMemoized) + , memoizeWith + , getMemoized + , runMemoized + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson.Generic.DerivingVia +import Test.QuickCheck (CoArbitrary, Function, Arbitrary) +-------------------------------------------------------------------------------- +import Xanthous.Data (Position) +import Xanthous.Data.Memo +import Xanthous.Util.QuickCheck (GenericArbitrary(GenericArbitrary)) +-------------------------------------------------------------------------------- + +-- | Memoized calculations on the game state +data MemoState = MemoState + { -- | Memoized version of 'Xanthous.Game.Lenses.characterVisiblePositions', + -- memoized with the position of the character + _characterVisiblePositions :: Memoized Position (Set Position) + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary MemoState + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + MemoState +makeLenses ''MemoState + +emptyMemoState :: MemoState +emptyMemoState = MemoState { _characterVisiblePositions = UnMemoized } +{-# INLINE emptyMemoState #-} + +clear :: Lens' MemoState (Memoized k v) -> MemoState -> MemoState +clear = flip set UnMemoized +{-# INLINE clear #-} + +{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-} diff --git a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs new file mode 100644 index 000000000000..2d6c0a280f41 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs @@ -0,0 +1,359 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE GADTs #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.Prompt + ( PromptType(..) + , SPromptType(..) + , SingPromptType(..) + , PromptCancellable(..) + , PromptResult(..) + , PromptState(..) + , promptStatePosition + , MenuOption(..) + , mkMenuItems + , PromptInput + , Prompt(..) + , mkPrompt + , mkStringPrompt + , mkStringPromptWithDefault + , mkMenu + , mkPointOnMapPrompt + , mkFirePrompt + , isCancellable + , submitPrompt + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick.Widgets.Edit (Editor, editorText, getEditContents) +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +-------------------------------------------------------------------------------- +import Xanthous.Util (smallestNotIn, AlphaChar (..)) +import Xanthous.Data (Direction, Position, Tiles) +import Xanthous.Data.App (ResourceName) +import qualified Xanthous.Data.App as Resource +-------------------------------------------------------------------------------- + +data PromptType where + StringPrompt :: PromptType + Confirm :: PromptType + Menu :: Type -> PromptType + DirectionPrompt :: PromptType + PointOnMap :: PromptType + -- | Throw an item or fire a projectile weapon. Prompt is to select the + -- direction + Fire :: PromptType + Continue :: PromptType + deriving stock (Generic) + +instance Show PromptType where + show StringPrompt = "StringPrompt" + show Confirm = "Confirm" + show (Menu _) = "Menu" + show DirectionPrompt = "DirectionPrompt" + show PointOnMap = "PointOnMap" + show Continue = "Continue" + show Fire = "Fire" + +data SPromptType :: PromptType -> Type where + SStringPrompt :: SPromptType 'StringPrompt + SConfirm :: SPromptType 'Confirm + SMenu :: SPromptType ('Menu a) + SDirectionPrompt :: SPromptType 'DirectionPrompt + SPointOnMap :: SPromptType 'PointOnMap + SContinue :: SPromptType 'Continue + SFire :: SPromptType 'Fire + +instance NFData (SPromptType pt) where + rnf SStringPrompt = () + rnf SConfirm = () + rnf SMenu = () + rnf SDirectionPrompt = () + rnf SPointOnMap = () + rnf SContinue = () + rnf SFire = () + +class SingPromptType pt where singPromptType :: SPromptType pt +instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt +instance SingPromptType 'Confirm where singPromptType = SConfirm +instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt +instance SingPromptType 'PointOnMap where singPromptType = SPointOnMap +instance SingPromptType 'Continue where singPromptType = SContinue +instance SingPromptType 'Fire where singPromptType = SFire + +instance Show (SPromptType pt) where + show SStringPrompt = "SStringPrompt" + show SConfirm = "SConfirm" + show SMenu = "SMenu" + show SDirectionPrompt = "SDirectionPrompt" + show SPointOnMap = "SPointOnMap" + show SContinue = "SContinue" + show SFire = "SFire" + +data PromptCancellable + = Cancellable + | Uncancellable + deriving stock (Show, Eq, Ord, Enum, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary PromptCancellable where + arbitrary = genericArbitrary + +data PromptResult (pt :: PromptType) where + StringResult :: Text -> PromptResult 'StringPrompt + ConfirmResult :: Bool -> PromptResult 'Confirm + MenuResult :: forall a. a -> PromptResult ('Menu a) + DirectionResult :: Direction -> PromptResult 'DirectionPrompt + PointOnMapResult :: Position -> PromptResult 'PointOnMap + FireResult :: Position -> PromptResult 'Fire + ContinueResult :: PromptResult 'Continue + +instance Arbitrary (PromptResult 'StringPrompt) where + arbitrary = StringResult <$> arbitrary + +instance Arbitrary (PromptResult 'Confirm) where + arbitrary = ConfirmResult <$> arbitrary + +instance Arbitrary a => Arbitrary (PromptResult ('Menu a)) where + arbitrary = MenuResult <$> arbitrary + +instance Arbitrary (PromptResult 'DirectionPrompt) where + arbitrary = DirectionResult <$> arbitrary + +instance Arbitrary (PromptResult 'PointOnMap) where + arbitrary = PointOnMapResult <$> arbitrary + +instance Arbitrary (PromptResult 'Continue) where + arbitrary = pure ContinueResult + +instance Arbitrary (PromptResult 'Fire) where + arbitrary = FireResult <$> arbitrary + +-------------------------------------------------------------------------------- + +data PromptState pt where + StringPromptState + :: Editor Text ResourceName -> PromptState 'StringPrompt + DirectionPromptState :: PromptState 'DirectionPrompt + ContinuePromptState :: PromptState 'Continue + ConfirmPromptState :: PromptState 'Confirm + MenuPromptState :: forall a. PromptState ('Menu a) + PointOnMapPromptState :: Position -> PromptState 'PointOnMap + FirePromptState :: Position -> PromptState 'Fire + +instance NFData (PromptState pt) where + rnf sps@(StringPromptState ed) = sps `deepseq` ed `deepseq` () + rnf DirectionPromptState = () + rnf ContinuePromptState = () + rnf ConfirmPromptState = () + rnf MenuPromptState = () + rnf pomps@(PointOnMapPromptState pos) = pomps `deepseq` pos `deepseq` () + rnf fps@(FirePromptState pos) = fps `deepseq` pos `deepseq` () + +instance Arbitrary (PromptState 'StringPrompt) where + arbitrary = StringPromptState <$> arbitrary + +instance Arbitrary (PromptState 'DirectionPrompt) where + arbitrary = pure DirectionPromptState + +instance Arbitrary (PromptState 'Continue) where + arbitrary = pure ContinuePromptState + +instance Arbitrary (PromptState ('Menu a)) where + arbitrary = pure MenuPromptState + +instance Arbitrary (PromptState 'Fire) where + arbitrary = FirePromptState <$> arbitrary + +instance CoArbitrary (PromptState 'StringPrompt) where + coarbitrary (StringPromptState ed) = coarbitrary ed + +instance CoArbitrary (PromptState 'DirectionPrompt) where + coarbitrary DirectionPromptState = coarbitrary () + +instance CoArbitrary (PromptState 'Continue) where + coarbitrary ContinuePromptState = coarbitrary () + +instance CoArbitrary (PromptState ('Menu a)) where + coarbitrary MenuPromptState = coarbitrary () + +instance CoArbitrary (PromptState 'Fire) where + coarbitrary (FirePromptState pos) = coarbitrary pos + +deriving stock instance Show (PromptState pt) + +-- | Traversal over the position for the prompt types with positions in their +-- prompt state (currently 'Fire' and 'PointOnMap') +promptStatePosition :: forall pt. Traversal' (PromptState pt) Position +promptStatePosition _ ps@(StringPromptState _) = pure ps +promptStatePosition _ DirectionPromptState = pure DirectionPromptState +promptStatePosition _ ContinuePromptState = pure ContinuePromptState +promptStatePosition _ ConfirmPromptState = pure ConfirmPromptState +promptStatePosition _ MenuPromptState = pure MenuPromptState +promptStatePosition f (PointOnMapPromptState p) = PointOnMapPromptState <$> f p +promptStatePosition f (FirePromptState p) = FirePromptState <$> f p + +data MenuOption a = MenuOption Text a + deriving stock (Eq, Generic, Functor) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Comonad MenuOption where + extract (MenuOption _ x) = x + extend cok mo@(MenuOption text _) = MenuOption text (cok mo) + +mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a)) + => f + -> Map Char (MenuOption a) +mkMenuItems = flip foldl' mempty $ \items (chr, option) -> + let chr' = if has (ix chr) items + then getAlphaChar . smallestNotIn . map AlphaChar $ keys items + else chr + in items & at chr' ?~ option + +instance Show (MenuOption a) where + show (MenuOption m _) = show m + +type family PromptInput (pt :: PromptType) :: Type where + PromptInput ('Menu a) = Map Char (MenuOption a) + PromptInput 'PointOnMap = Position -- Character pos + PromptInput 'Fire = (Position, Tiles) -- Nearest enemy, range + PromptInput 'StringPrompt = Maybe Text -- Default value + PromptInput _ = () + +data Prompt (m :: Type -> Type) where + Prompt + :: forall (pt :: PromptType) + (m :: Type -> Type). + PromptCancellable + -> SPromptType pt + -> PromptState pt + -> PromptInput pt + -> (PromptResult pt -> m ()) + -> Prompt m + +instance Show (Prompt m) where + show (Prompt c pt ps pri _) + = "(Prompt " + <> show c <> " " + <> show pt <> " " + <> show ps <> " " + <> showPri + <> " <function>)" + where showPri = case pt of + SMenu -> show pri + _ -> "()" + +instance NFData (Prompt m) where + rnf (Prompt c SMenu ps pri cb) + = c + `deepseq` ps + `deepseq` pri + `seq` cb + `seq` () + rnf (Prompt c spt ps pri cb) + = c + `deepseq` spt + `deepseq` ps + `deepseq` pri + `seq` cb + `seq` () + +instance CoArbitrary (m ()) => CoArbitrary (Prompt m) where + coarbitrary (Prompt c SStringPrompt ps pri cb) = + variant @Int 1 . coarbitrary (c, ps, pri, cb) + coarbitrary (Prompt c SConfirm _ pri cb) = -- TODO fill in prompt state + variant @Int 2 . coarbitrary (c, pri, cb) + coarbitrary (Prompt c SMenu _ps _pri _cb) = + variant @Int 3 . coarbitrary c {-, ps, pri, cb -} + coarbitrary (Prompt c SDirectionPrompt ps pri cb) = + variant @Int 4 . coarbitrary (c, ps, pri, cb) + coarbitrary (Prompt c SPointOnMap _ pri cb) = -- TODO fill in prompt state + variant @Int 5 . coarbitrary (c, pri, cb) + coarbitrary (Prompt c SContinue ps pri cb) = + variant @Int 6 . coarbitrary (c, ps, pri, cb) + coarbitrary (Prompt c SFire ps pri cb) = + variant @Int 7 . coarbitrary (c, ps, pri, cb) + +-- instance Function (Prompt m) where +-- function = functionMap toTuple _fromTuple +-- where +-- toTuple (Prompt c pt ps pri cb) = (c, pt, ps, pri, cb) + + +mkPrompt + :: (PromptInput pt ~ ()) + => PromptCancellable -- ^ Is the prompt cancellable or not? + -> SPromptType pt -- ^ The type of the prompt + -> (PromptResult pt -> m ()) -- ^ Function to call when the prompt is complete + -> Prompt m +mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb +mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb +mkPrompt c pt@SConfirm cb = Prompt c pt ConfirmPromptState () cb + +mkStringPrompt + :: PromptCancellable -- ^ Is the prompt cancellable or not? + -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete + -> Prompt m +mkStringPrompt c = + let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" + in Prompt c SStringPrompt ps Nothing + +mkStringPromptWithDefault + :: PromptCancellable -- ^ Is the prompt cancellable or not? + -> Text -- ^ Default value for the prompt + -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete + -> Prompt m +mkStringPromptWithDefault c def = + let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" + in Prompt c SStringPrompt ps (Just def) + +mkMenu + :: forall a m. + PromptCancellable + -> Map Char (MenuOption a) -- ^ Menu items + -> (PromptResult ('Menu a) -> m ()) + -> Prompt m +mkMenu c = Prompt c SMenu MenuPromptState + +mkPointOnMapPrompt + :: PromptCancellable + -> Position + -> (PromptResult 'PointOnMap -> m ()) + -> Prompt m +mkPointOnMapPrompt c pos = Prompt c SPointOnMap (PointOnMapPromptState pos) pos + +mkFirePrompt + :: PromptCancellable + -> Position -- ^ Initial position + -> Tiles -- ^ Range + -> (PromptResult 'Fire -> m ()) + -> Prompt m +mkFirePrompt c pos range = Prompt c SFire (FirePromptState pos) (pos, range) + +isCancellable :: Prompt m -> Bool +isCancellable (Prompt Cancellable _ _ _ _) = True +isCancellable (Prompt Uncancellable _ _ _ _) = False + +submitPrompt :: Applicative m => Prompt m -> m () +submitPrompt (Prompt _ pt ps pri cb) = + case (pt, ps, pri) of + (SStringPrompt, StringPromptState edit, mDef) -> + let inputVal = mconcat . getEditContents $ edit + val | null inputVal, Just def <- mDef = def + | otherwise = inputVal + in cb $ StringResult val + (SDirectionPrompt, DirectionPromptState, _) -> + pure () -- Don't use submit with a direction prompt + (SContinue, ContinuePromptState, _) -> + cb ContinueResult + (SMenu, MenuPromptState, _) -> + pure () -- Don't use submit with a menu prompt + (SPointOnMap, PointOnMapPromptState pos, _) -> + cb $ PointOnMapResult pos + (SConfirm, ConfirmPromptState, _) -> + cb $ ConfirmResult True + (SFire, FirePromptState pos, _) -> + cb $ FireResult pos diff --git a/users/grfn/xanthous/src/Xanthous/Game/State.hs b/users/grfn/xanthous/src/Xanthous/Game/State.hs new file mode 100644 index 000000000000..3025eb15be5a --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Game/State.hs @@ -0,0 +1,573 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- +module Xanthous.Game.State + ( GameState(..) + , entities + , levels + , revealedPositions + , messageHistory + , randomGen + , activePanel + , promptState + , characterEntityID + , autocommand + , savefile + , memo + , GamePromptState(..) + + -- * Game Level + , GameLevel(..) + , levelEntities + , upStaircasePosition + , levelRevealedPositions + + -- * Messages + , MessageHistory(..) + , HasMessages(..) + , HasTurn(..) + , HasDisplayedTurn(..) + , pushMessage + , previousMessage + , nextTurn + + -- * Autocommands + , Autocommand(..) + , AutocommandState(..) + , _NoAutocommand + , _ActiveAutocommand + + -- * App monad + , AppT(..) + , AppM + , runAppT + + -- * Entities + , Draw(..) + , Brain(..) + , Brainless(..) + , brainVia + , Collision(..) + , Entity(..) + , SomeEntity(..) + , downcastEntity + , _SomeEntity + , entityIs + , entityTypeName + + -- ** Vias + , Color(..) + , DrawNothing(..) + , DrawRawChar(..) + , DrawRawCharPriority(..) + , DrawCharacter(..) + , DrawStyledCharacter(..) + , DeriveEntity(..) + -- ** Field classes + , HasChar(..) + , HasStyle(..) + + -- * Debug State + , DebugState(..) + , debugState + , allRevealed + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.List.NonEmpty ( NonEmpty((:|))) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Typeable +import Data.Coerce +import System.Random +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +import Control.Monad.Random.Class +import Control.Monad.State +import Control.Monad.Trans.Control (MonadTransControl(..)) +import Control.Monad.Trans.Compose +import Control.Monad.Morph (MFunctor(..)) +import Brick (EventM, Widget, raw, str, emptyWidget) +import Data.Aeson (ToJSON(..), FromJSON(..), Value(Null)) +import qualified Data.Aeson as JSON +import Data.Aeson.Generic.DerivingVia +import Data.Generics.Product.Fields +import qualified Graphics.Vty.Attributes as Vty +import qualified Graphics.Vty.Image as Vty +-------------------------------------------------------------------------------- +import Xanthous.Util (KnownBool(..)) +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +import Xanthous.Data +import Xanthous.Data.App +import Xanthous.Data.Levels +import Xanthous.Data.EntityMap (EntityMap, EntityID) +import Xanthous.Data.EntityChar +import Xanthous.Data.VectorBag +import Xanthous.Data.Entities +import Xanthous.Orphans () +import Xanthous.Game.Prompt +import Xanthous.Game.Env +import Xanthous.Game.Memo (MemoState) +-------------------------------------------------------------------------------- + +data MessageHistory + = MessageHistory + { _messages :: Map Word (NonEmpty Text) + , _turn :: Word + , _displayedTurn :: Maybe Word + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary MessageHistory + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + MessageHistory +makeFieldsNoPrefix ''MessageHistory + +instance Semigroup MessageHistory where + (MessageHistory msgs₁ turn₁ dt₁) <> (MessageHistory msgs₂ turn₂ dt₂) = + MessageHistory (msgs₁ <> msgs₂) (max turn₁ turn₂) $ case (dt₁, dt₂) of + (_, Nothing) -> Nothing + (Just t, _) -> Just t + (Nothing, Just t) -> Just t + +instance Monoid MessageHistory where + mempty = MessageHistory mempty 0 Nothing + +type instance Element MessageHistory = [Text] +instance MonoFunctor MessageHistory where + omap f mh@(MessageHistory _ t _) = + mh & messages . at t %~ (NonEmpty.nonEmpty . f . toList =<<) + +instance MonoComonad MessageHistory where + oextract (MessageHistory ms t dt) = maybe [] toList $ ms ^. at (fromMaybe t dt) + oextend cok mh@(MessageHistory _ t dt) = + mh & messages . at (fromMaybe t dt) .~ NonEmpty.nonEmpty (cok mh) + +pushMessage :: Text -> MessageHistory -> MessageHistory +pushMessage msg mh@(MessageHistory _ turn' _) = + mh + & messages . at turn' %~ \case + Nothing -> Just $ msg :| mempty + Just msgs -> Just $ msg <| msgs + & displayedTurn .~ Nothing + +nextTurn :: MessageHistory -> MessageHistory +nextTurn = (turn +~ 1) . (displayedTurn .~ Nothing) + +previousMessage :: MessageHistory -> MessageHistory +previousMessage mh = mh & displayedTurn .~ maximumOf + (messages . ifolded . asIndex . filtered (< mh ^. turn)) + mh + + +-------------------------------------------------------------------------------- + +data GamePromptState m where + NoPrompt :: GamePromptState m + WaitingPrompt :: Text -> Prompt m -> GamePromptState m + deriving stock (Show, Generic) + deriving anyclass (NFData) + +-- | Non-injective! We never try to serialize waiting prompts, since: +-- +-- * they contain callback functions +-- * we can't save the game when in a prompt anyway +instance ToJSON (GamePromptState m) where + toJSON _ = Null + +-- | Always expects Null +instance FromJSON (GamePromptState m) where + parseJSON Null = pure NoPrompt + parseJSON _ = fail "Invalid GamePromptState; expected null" + +instance CoArbitrary (GamePromptState m) where + coarbitrary NoPrompt = variant @Int 1 + coarbitrary (WaitingPrompt txt _) = variant @Int 2 . coarbitrary txt + +instance Function (GamePromptState m) where + function = functionMap onlyNoPrompt (const NoPrompt) + where + onlyNoPrompt NoPrompt = () + onlyNoPrompt (WaitingPrompt _ _) = + error "Can't handle prompts in Function!" + +-------------------------------------------------------------------------------- + +newtype AppT m a + = AppT { unAppT :: ReaderT GameEnv (StateT GameState m) a } + deriving ( Functor + , Applicative + , Monad + , MonadState GameState + , MonadReader GameEnv + , MonadIO + ) + via (ReaderT GameEnv (StateT GameState m)) + deriving ( MonadTrans + , MFunctor + ) + via (ReaderT GameEnv `ComposeT` StateT GameState) + +type AppM = AppT (EventM ResourceName) + +-------------------------------------------------------------------------------- + +class Draw a where + drawWithNeighbors :: Neighbors (VectorBag SomeEntity) -> a -> Widget n + drawWithNeighbors = const draw + + draw :: a -> Widget n + draw = drawWithNeighbors $ pure mempty + + -- | higher priority gets drawn on top + drawPriority :: a -> Word + drawPriority = const minBound + +instance Draw a => Draw (Positioned a) where + drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a + draw (Positioned _ a) = draw a + +newtype DrawCharacter (char :: Symbol) (a :: Type) where + DrawCharacter :: a -> DrawCharacter char a + +instance KnownSymbol char => Draw (DrawCharacter char a) where + draw _ = str $ symbolVal @char Proxy + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White + +class KnownColor (color :: Color) where + colorVal :: forall proxy. proxy color -> Vty.Color + +instance KnownColor 'Black where colorVal _ = Vty.black +instance KnownColor 'Red where colorVal _ = Vty.red +instance KnownColor 'Green where colorVal _ = Vty.green +instance KnownColor 'Yellow where colorVal _ = Vty.yellow +instance KnownColor 'Blue where colorVal _ = Vty.blue +instance KnownColor 'Magenta where colorVal _ = Vty.magenta +instance KnownColor 'Cyan where colorVal _ = Vty.cyan +instance KnownColor 'White where colorVal _ = Vty.white + +class KnownMaybeColor (maybeColor :: Maybe Color) where + maybeColorVal :: forall proxy. proxy maybeColor -> Maybe Vty.Color + +instance KnownMaybeColor 'Nothing where maybeColorVal _ = Nothing +instance KnownColor color => KnownMaybeColor ('Just color) where + maybeColorVal _ = Just $ colorVal @color Proxy + +newtype DrawStyledCharacter (fg :: Maybe Color) (bg :: Maybe Color) (char :: Symbol) (a :: Type) where + DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a + +instance + ( KnownMaybeColor fg + , KnownMaybeColor bg + , KnownSymbol char + ) + => Draw (DrawStyledCharacter fg bg char a) where + draw _ = raw $ Vty.string attr $ symbolVal @char Proxy + where attr = Vty.Attr + { Vty.attrStyle = Vty.Default + , Vty.attrForeColor = maybe Vty.Default Vty.SetTo + $ maybeColorVal @fg Proxy + , Vty.attrBackColor = maybe Vty.Default Vty.SetTo + $ maybeColorVal @bg Proxy + , Vty.attrURL = Vty.Default + } + +instance Draw EntityChar where + draw EntityChar{..} = raw $ Vty.string _style [_char] + +-------------------------------------------------------------------------------- + +newtype DrawNothing (a :: Type) = DrawNothing a + +instance Draw (DrawNothing a) where + draw = const emptyWidget + drawPriority = const 0 + +newtype DrawRawChar (rawField :: Symbol) (a :: Type) = DrawRawChar a + +instance + forall rawField a raw. + ( HasField rawField a a raw raw + , HasChar raw EntityChar + ) => Draw (DrawRawChar rawField a) where + draw (DrawRawChar e) = draw $ e ^. field @rawField . char + +newtype DrawRawCharPriority + (rawField :: Symbol) + (priority :: Nat) + (a :: Type) + = DrawRawCharPriority a + +instance + forall rawField priority a raw. + ( HasField rawField a a raw raw + , KnownNat priority + , HasChar raw EntityChar + ) => Draw (DrawRawCharPriority rawField priority a) where + draw (DrawRawCharPriority e) = draw $ e ^. field @rawField . char + drawPriority = const . fromIntegral $ natVal @priority Proxy + + +-------------------------------------------------------------------------------- + +class Brain a where + step :: Ticks -> Positioned a -> AppM (Positioned a) + -- | Does this entity ever move on its own? + entityCanMove :: a -> Bool + entityCanMove = const False + +newtype Brainless a = Brainless a + +instance Brain (Brainless a) where + step = const pure + +-- | Workaround for the inability to use DerivingVia on Brain due to the lack of +-- higher-order roles (specifically AppT not having its last type argument have +-- role representational bc of StateT) +brainVia + :: forall brain entity. (Coercible entity brain, Brain brain) + => (entity -> brain) -- ^ constructor, ignored + -> (Ticks -> Positioned entity -> AppM (Positioned entity)) +brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain) + +-------------------------------------------------------------------------------- + +class ( Show a, Eq a, Ord a, NFData a + , ToJSON a, FromJSON a + , Draw a, Brain a + ) => Entity a where + entityAttributes :: a -> EntityAttributes + entityAttributes = const defaultEntityAttributes + description :: a -> Text + entityChar :: a -> EntityChar + entityCollision :: a -> Maybe Collision + entityCollision = const $ Just Stop + +data SomeEntity where + SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity + +instance Show SomeEntity where + show (SomeEntity e) = "SomeEntity (" <> show e <> ")" + +instance Eq SomeEntity where + (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of + Just Refl -> a == b + _ -> False + +instance Ord SomeEntity where + compare (SomeEntity (a :: ea)) (SomeEntity (b :: eb)) = case eqT @ea @eb of + Just Refl -> compare a b + _ -> compare (typeRep $ Proxy @ea) (typeRep $ Proxy @eb) + + +instance NFData SomeEntity where + rnf (SomeEntity ent) = ent `deepseq` () + +instance ToJSON SomeEntity where + toJSON (SomeEntity ent) = entityToJSON ent + where + entityToJSON :: forall entity. (Entity entity, Typeable entity) + => entity -> JSON.Value + entityToJSON entity = JSON.object + [ "type" JSON..= tshow (typeRep @_ @entity Proxy) + , "data" JSON..= toJSON entity + ] + +instance Draw SomeEntity where + drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent + drawPriority (SomeEntity ent) = drawPriority ent + +instance Brain SomeEntity where + step ticks (Positioned p (SomeEntity ent)) = + fmap SomeEntity <$> step ticks (Positioned p ent) + entityCanMove (SomeEntity ent) = entityCanMove ent + +downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a +downcastEntity (SomeEntity e) = cast e + +entityIs :: forall (a :: Type). (Typeable a) => SomeEntity -> Bool +entityIs = isJust . downcastEntity @a + +_SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a +_SomeEntity = prism' SomeEntity downcastEntity + +-- | Get the name of the type of 'SomeEntity' as a string +entityTypeName :: SomeEntity -> Text +entityTypeName (SomeEntity e) = pack . tyConName . typeRepTyCon $ typeOf e + +newtype DeriveEntity + (blocksVision :: Bool) + (description :: Symbol) + (entityChar :: Symbol) + (entity :: Type) + = DeriveEntity entity + deriving newtype (Show, Eq, Ord, NFData, ToJSON, FromJSON, Draw) + +instance Brain entity => Brain (DeriveEntity b d c entity) where + step = brainVia $ \(DeriveEntity e) -> e + +instance + ( KnownBool blocksVision + , KnownSymbol description + , KnownSymbol entityChar + , Show entity, Eq entity, Ord entity, NFData entity + , ToJSON entity, FromJSON entity + , Draw entity, Brain entity + ) + => Entity (DeriveEntity blocksVision description entityChar entity) where + entityAttributes _ = defaultEntityAttributes + & blocksVision .~ boolVal @blocksVision + description _ = pack . symbolVal $ Proxy @description + entityChar _ = fromString . symbolVal $ Proxy @entityChar + +-------------------------------------------------------------------------------- + +data GameLevel = GameLevel + { _levelEntities :: !(EntityMap SomeEntity) + , _upStaircasePosition :: !Position + , _levelRevealedPositions :: !(Set Position) + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving (ToJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + GameLevel + +-------------------------------------------------------------------------------- + +data Autocommand + = AutoMove Direction + | AutoRest + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, Hashable, ToJSON, FromJSON, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Autocommand +{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-} + +data AutocommandState + = NoAutocommand + | ActiveAutocommand Autocommand (Async ()) + deriving stock (Eq, Ord, Generic) + deriving anyclass (Hashable) + +instance Show AutocommandState where + show NoAutocommand = "NoAutocommand" + show (ActiveAutocommand ac _) = + "(ActiveAutocommand " <> show ac <> " <Async>)" + +instance ToJSON AutocommandState where + toJSON = const Null + +instance FromJSON AutocommandState where + parseJSON Null = pure NoAutocommand + parseJSON _ = fail "Invalid AutocommandState; expected null" + +instance NFData AutocommandState where + rnf NoAutocommand = () + rnf (ActiveAutocommand ac t) = ac `deepseq` t `seq` () + +instance CoArbitrary AutocommandState where + coarbitrary NoAutocommand = variant @Int 1 + coarbitrary (ActiveAutocommand ac t) + = variant @Int 2 + . coarbitrary ac + . coarbitrary (hash t) + +instance Function AutocommandState where + function = functionMap onlyNoAC (const NoAutocommand) + where + onlyNoAC NoAutocommand = () + onlyNoAC _ = error "Can't handle autocommands in Function" + +-------------------------------------------------------------------------------- + + +data DebugState = DebugState + { _allRevealed :: !Bool + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + DebugState +{-# ANN DebugState ("HLint: ignore Use newtype instead of data" :: String) #-} + +instance Arbitrary DebugState where + arbitrary = genericArbitrary + +data GameState = GameState + { _levels :: !(Levels GameLevel) + , _characterEntityID :: !EntityID + , _messageHistory :: !MessageHistory + , _randomGen :: !StdGen + + -- | The active panel displayed in the UI, if any + , _activePanel :: !(Maybe Panel) + + , _promptState :: !(GamePromptState AppM) + , _debugState :: !DebugState + , _autocommand :: !AutocommandState + + -- | The path to the savefile that was loaded for this game, if any + , _savefile :: !(Maybe FilePath) + + , _memo :: MemoState + } + deriving stock (Show, Generic) + deriving anyclass (NFData) + deriving (ToJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + GameState + +makeLenses ''GameLevel +makeLenses ''GameState + +entities :: Lens' GameState (EntityMap SomeEntity) +entities = levels . current . levelEntities + +revealedPositions :: Lens' GameState (Set Position) +revealedPositions = levels . current . levelRevealedPositions + +instance Eq GameState where + (==) = (==) `on` \gs -> + ( gs ^. entities + , gs ^. revealedPositions + , gs ^. characterEntityID + , gs ^. messageHistory + , gs ^. activePanel + , gs ^. debugState + ) + +-------------------------------------------------------------------------------- + +runAppT :: Monad m => AppT m a -> GameEnv -> GameState -> m (a, GameState) +runAppT appt env initialState + = flip runStateT initialState + . flip runReaderT env + . unAppT + $ appt + +instance (Monad m) => MonadRandom (AppT m) where + getRandomR rng = randomGen %%= randomR rng + getRandom = randomGen %%= random + getRandomRs rng = uses randomGen $ randomRs rng + getRandoms = uses randomGen randoms + +instance MonadTransControl AppT where + type StT AppT a = (a, GameState) + liftWith f + = AppT + . ReaderT $ \e + -> StateT $ \s + -> (,s) <$> f (\action -> runAppT action e s) + restoreT = AppT . ReaderT . const . StateT . const + +-------------------------------------------------------------------------------- + +makeLenses ''DebugState +makePrisms ''AutocommandState diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level.hs new file mode 100644 index 000000000000..fc57402e7d8e --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Generators/Level.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Level + ( generate + , Generator(..) + , SGenerator(..) + , GeneratorInput(..) + , generateFromInput + , parseGeneratorInput + , showCells + , Level(..) + , levelWalls + , levelItems + , levelCreatures + , levelDoors + , levelCharacterPosition + , levelTutorialMessage + , levelExtra + , generateLevel + , levelToEntityMap + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Data.Array.Unboxed +import qualified Options.Applicative as Opt +import Control.Monad.Random +-------------------------------------------------------------------------------- +import qualified Xanthous.Generators.Level.CaveAutomata as CaveAutomata +import qualified Xanthous.Generators.Level.Dungeon as Dungeon +import Xanthous.Generators.Level.Util +import Xanthous.Generators.Level.LevelContents +import Xanthous.Generators.Level.Village as Village +import Xanthous.Data (Dimensions, Position'(Position), Position) +import Xanthous.Data.EntityMap (EntityMap, _EntityMap) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Entities.Environment +import Xanthous.Entities.Item (Item) +import Xanthous.Entities.Creature (Creature) +import Xanthous.Game.State (SomeEntity(..)) +import Linear.V2 +-------------------------------------------------------------------------------- + +data Generator + = CaveAutomata + | Dungeon + deriving stock (Show, Eq) + +data SGenerator (gen :: Generator) where + SCaveAutomata :: SGenerator 'CaveAutomata + SDungeon :: SGenerator 'Dungeon + +type family Params (gen :: Generator) :: Type where + Params 'CaveAutomata = CaveAutomata.Params + Params 'Dungeon = Dungeon.Params + +generate + :: RandomGen g + => SGenerator gen + -> Params gen + -> Dimensions + -> g + -> Cells +generate SCaveAutomata = CaveAutomata.generate +generate SDungeon = Dungeon.generate + +data GeneratorInput where + GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput + +generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> Cells +generateFromInput (GeneratorInput sg ps) = generate sg ps + +parseGeneratorInput :: Opt.Parser GeneratorInput +parseGeneratorInput = Opt.subparser + $ generatorCommand SCaveAutomata + "cave" + "Cellular-automata based cave generator" + CaveAutomata.parseParams + <> generatorCommand SDungeon + "dungeon" + "Classic dungeon map generator" + Dungeon.parseParams + where + generatorCommand sgen name desc parseParams = + Opt.command name + (Opt.info + (GeneratorInput sgen <$> parseParams) + (Opt.progDesc desc) + ) + + +showCells :: Cells -> Text +showCells arr = + let (V2 minX minY, V2 maxX maxY) = bounds arr + showCellVal True = "x" + showCellVal False = " " + showCell = showCellVal . (arr !) + row r = foldMap (showCell . (`V2` r)) [minX..maxX] + rows = row <$> [minY..maxY] + in intercalate "\n" rows + +cellsToWalls :: Cells -> EntityMap Wall +cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells + where + maybeInsertWall em (pos@(V2 x y), True) + | not (surroundedOnAllSides pos) = + let x' = fromIntegral x + y' = fromIntegral y + in EntityMap.insertAt (Position x' y') Wall em + maybeInsertWall em _ = em + surroundedOnAllSides pos = numAliveNeighbors cells pos == 8 + +-------------------------------------------------------------------------------- + +data Level = Level + { _levelWalls :: !(EntityMap Wall) + , _levelDoors :: !(EntityMap Door) + , _levelItems :: !(EntityMap Item) + , _levelCreatures :: !(EntityMap Creature) + , _levelTutorialMessage :: !(EntityMap GroundMessage) + , _levelStaircases :: !(EntityMap Staircase) + , _levelExtra :: !(EntityMap SomeEntity) -- ^ TODO this is a bit of a hack... + , _levelCharacterPosition :: !Position + } + deriving stock (Generic) + deriving anyclass (NFData) +makeLenses ''Level + +generateLevel + :: MonadRandom m + => SGenerator gen + -> Params gen + -> Dimensions + -> Word -- ^ Level number, starting at 0 + -> m Level +generateLevel gen ps dims num = do + rand <- mkStdGen <$> getRandom + let cells = generate gen ps dims rand + _levelWalls = cellsToWalls cells + village <- generateVillage cells gen + let _levelExtra = village + _levelItems <- randomItems cells + _levelCreatures <- randomCreatures num cells + _levelDoors <- randomDoors cells + _levelCharacterPosition <- chooseCharacterPosition cells + let upStaircase = _EntityMap # [(_levelCharacterPosition, UpStaircase)] + downStaircase <- placeDownStaircase cells + let _levelStaircases = upStaircase <> downStaircase + _levelTutorialMessage <- + if num == 0 + then tutorialMessage cells _levelCharacterPosition + else pure mempty + pure Level {..} + +levelToEntityMap :: Level -> EntityMap SomeEntity +levelToEntityMap level + = (SomeEntity <$> level ^. levelWalls) + <> (SomeEntity <$> level ^. levelDoors) + <> (SomeEntity <$> level ^. levelItems) + <> (SomeEntity <$> level ^. levelCreatures) + <> (SomeEntity <$> level ^. levelTutorialMessage) + <> (SomeEntity <$> level ^. levelStaircases) + <> (level ^. levelExtra) + +generateVillage + :: MonadRandom m + => Cells -- ^ Wall positions + -> SGenerator gen + -> m (EntityMap SomeEntity) +generateVillage wallPositions SCaveAutomata = Village.fromCave wallPositions +generateVillage _ _ = pure mempty diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs new file mode 100644 index 000000000000..03d534ca39b3 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Level.CaveAutomata + ( Params(..) + , defaultParams + , parseParams + , generate + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Control.Monad.Random (RandomGen, runRandT) +import Data.Array.ST +import Data.Array.Unboxed +import qualified Options.Applicative as Opt +-------------------------------------------------------------------------------- +import Xanthous.Util (between) +import Xanthous.Util.Optparse +import Xanthous.Data (Dimensions, width, height) +import Xanthous.Generators.Level.Util +import Linear.V2 +-------------------------------------------------------------------------------- + +data Params = Params + { _aliveStartChance :: Double + , _birthLimit :: Word + , _deathLimit :: Word + , _steps :: Word + } + deriving stock (Show, Eq, Generic) +makeLenses ''Params + +defaultParams :: Params +defaultParams = Params + { _aliveStartChance = 0.6 + , _birthLimit = 3 + , _deathLimit = 4 + , _steps = 4 + } + +parseParams :: Opt.Parser Params +parseParams = Params + <$> Opt.option parseChance + ( Opt.long "alive-start-chance" + <> Opt.value (defaultParams ^. aliveStartChance) + <> Opt.showDefault + <> Opt.help ( "Chance for each cell to start alive at the beginning of " + <> "the cellular automata" + ) + <> Opt.metavar "CHANCE" + ) + <*> Opt.option parseNeighbors + ( Opt.long "birth-limit" + <> Opt.value (defaultParams ^. birthLimit) + <> Opt.showDefault + <> Opt.help "Minimum neighbor count required for birth of a cell" + <> Opt.metavar "NEIGHBORS" + ) + <*> Opt.option parseNeighbors + ( Opt.long "death-limit" + <> Opt.value (defaultParams ^. deathLimit) + <> Opt.showDefault + <> Opt.help "Maximum neighbor count required for death of a cell" + <> Opt.metavar "NEIGHBORS" + ) + <*> Opt.option Opt.auto + ( Opt.long "steps" + <> Opt.value (defaultParams ^. steps) + <> Opt.showDefault + <> Opt.help "Number of generations to run the automata for" + <> Opt.metavar "STEPS" + ) + <**> Opt.helper + where + parseChance = readWithGuard + (between 0 1) + $ \res -> "Chance must be in the range [0,1], got: " <> show res + + parseNeighbors = readWithGuard + (between 0 8) + $ \res -> "Neighbors must be in the range [0,8], got: " <> show res + +generate :: RandomGen g => Params -> Dimensions -> g -> Cells +generate params dims gen + = runSTUArray + $ fmap fst + $ flip runRandT gen + $ generate' params dims + +generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s) +generate' params dims = do + cells <- randInitialize dims $ params ^. aliveStartChance + let steps' = params ^. steps + when (steps' > 0) + $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params + -- Remove all but the largest contiguous region of unfilled space + (_: smallerRegions) <- lift $ regions @UArray . amap not <$> freeze cells + lift $ fillAllM (fold smallerRegions) cells + lift $ fillOuterEdgesM cells + pure cells + +stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s () +stepAutomata cells dims params = do + origCells <- lift $ cloneMArray @_ @(STUArray s) cells + for_ (range (0, V2 (dims ^. width) (dims ^. height))) $ \pos -> do + neighs <- lift $ numAliveNeighborsM origCells pos + origValue <- lift $ readArray origCells pos + lift . writeArray cells pos + $ if origValue + then neighs >= params ^. deathLimit + else neighs > params ^. birthLimit diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs new file mode 100644 index 000000000000..0be7c0435c5a --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Level.Dungeon + ( Params(..) + , defaultParams + , parseParams + , generate + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding ((:>)) +-------------------------------------------------------------------------------- +import Control.Monad.Random +import Data.Array.ST +import Data.Array.IArray (amap) +import Data.Stream.Infinite (Stream(..)) +import qualified Data.Stream.Infinite as Stream +import qualified Data.Graph.Inductive.Graph as Graph +import Data.Graph.Inductive.PatriciaTree +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromJust) +import Linear.V2 +import Linear.Metric +import qualified Options.Applicative as Opt +-------------------------------------------------------------------------------- +import Xanthous.Random +import Xanthous.Data hiding (x, y, _x, _y, edges, distance) +import Xanthous.Generators.Level.Util +import Xanthous.Util.Graphics (delaunay, straightLine) +import Xanthous.Util.Graph (mstSubGraph) +-------------------------------------------------------------------------------- + +data Params = Params + { _numRoomsRange :: (Word, Word) + , _roomDimensionRange :: (Word, Word) + , _connectednessRatioRange :: (Double, Double) + } + deriving stock (Show, Eq, Ord, Generic) +makeLenses ''Params + +defaultParams :: Params +defaultParams = Params + { _numRoomsRange = (6, 8) + , _roomDimensionRange = (3, 12) + , _connectednessRatioRange = (0.1, 0.15) + } + +parseParams :: Opt.Parser Params +parseParams = Params + <$> parseRange + "num-rooms" + "number of rooms to generate in the dungeon" + "ROOMS" + (defaultParams ^. numRoomsRange) + <*> parseRange + "room-size" + "size in tiles of one of the sides of a room" + "TILES" + (defaultParams ^. roomDimensionRange) + <*> parseRange + "connectedness-ratio" + ( "ratio of edges from the delaunay triangulation to re-add to the " + <> "minimum-spanning-tree") + "RATIO" + (defaultParams ^. connectednessRatioRange) + <**> Opt.helper + where + parseRange name desc metavar (defMin, defMax) = + (,) + <$> Opt.option Opt.auto + ( Opt.long ("min-" <> name) + <> Opt.value defMin + <> Opt.showDefault + <> Opt.help ("Minimum " <> desc) + <> Opt.metavar metavar + ) + <*> Opt.option Opt.auto + ( Opt.long ("max-" <> name) + <> Opt.value defMax + <> Opt.showDefault + <> Opt.help ("Maximum " <> desc) + <> Opt.metavar metavar + ) + +generate :: RandomGen g => Params -> Dimensions -> g -> Cells +generate params dims gen + = amap not + $ runSTUArray + $ fmap fst + $ flip runRandT gen + $ generate' params dims + +-------------------------------------------------------------------------------- + +generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s) +generate' params dims = do + cells <- initializeEmpty dims + rooms <- genRooms params dims + for_ rooms $ fillRoom cells + + let fullRoomGraph = delaunayRoomGraph rooms + mst = mstSubGraph fullRoomGraph + mstEdges = Graph.edges mst + nonMSTEdges = filter (\(n₁, n₂, _) -> (n₁, n₂) `notElem` mstEdges) + $ Graph.labEdges fullRoomGraph + + reintroEdgeCount <- floor . (* fromIntegral (length nonMSTEdges)) + <$> getRandomR (params ^. connectednessRatioRange) + let reintroEdges = take reintroEdgeCount nonMSTEdges + corridorGraph = Graph.insEdges reintroEdges mst + + corridors <- traverse + ( uncurry corridorBetween + . over both (fromJust . Graph.lab corridorGraph) + ) $ Graph.edges corridorGraph + + for_ (join corridors) $ \pt -> lift $ writeArray cells pt True + + pure cells + +type Room = Box Word + +genRooms :: MonadRandom m => Params -> Dimensions -> m [Room] +genRooms params dims = do + numRooms <- fromIntegral <$> getRandomR (params ^. numRoomsRange) + subRand . fmap (Stream.take numRooms . removeIntersecting []) . infinitely $ do + roomWidth <- getRandomR $ params ^. roomDimensionRange + roomHeight <- getRandomR $ params ^. roomDimensionRange + xPos <- getRandomR (0, dims ^. width - roomWidth) + yPos <- getRandomR (0, dims ^. height - roomHeight) + pure Box + { _topLeftCorner = V2 xPos yPos + , _dimensions = V2 roomWidth roomHeight + } + where + removeIntersecting seen (room :> rooms) + | any (boxIntersects room) seen + = removeIntersecting seen rooms + | otherwise + = room :> removeIntersecting (room : seen) rooms + streamRepeat x = x :> streamRepeat x + infinitely = sequence . streamRepeat + +delaunayRoomGraph :: [Room] -> Gr Room Double +delaunayRoomGraph rooms = + Graph.insEdges edges . Graph.insNodes nodes $ Graph.empty + where + edges = map (\((n₁, room₁), (n₂, room₂)) -> (n₁, n₂, roomDist room₁ room₂)) + . over (mapped . both) snd + . delaunay @Double + . NE.fromList + . map (\p@(_, room) -> (boxCenter $ fromIntegral <$> room, p)) + $ nodes + nodes = zip [0..] rooms + roomDist = distance `on` (boxCenter . fmap fromIntegral) + +fillRoom :: MCells s -> Room -> CellM g s () +fillRoom cells room = + let V2 posx posy = room ^. topLeftCorner + V2 dimx dimy = room ^. dimensions + in for_ [posx .. posx + dimx] $ \x -> + for_ [posy .. posy + dimy] $ \y -> + lift $ writeArray cells (V2 x y) True + +corridorBetween :: MonadRandom m => Room -> Room -> m [V2 Word] +corridorBetween originRoom destinationRoom + = straightLine <$> origin <*> destination + where + origin = choose . NE.fromList =<< originEdge + destination = choose . NE.fromList =<< destinationEdge + originEdge = pickEdge originRoom originCorner + destinationEdge = pickEdge destinationRoom destinationCorner + pickEdge room corner = choose . over both (boxEdge room) $ cornerEdges corner + originCorner = + case ( compare (originRoom ^. topLeftCorner . _x) + (destinationRoom ^. topLeftCorner . _x) + , compare (originRoom ^. topLeftCorner . _y) + (destinationRoom ^. topLeftCorner . _y) + ) of + (LT, LT) -> BottomRight + (LT, GT) -> TopRight + (GT, LT) -> BottomLeft + (GT, GT) -> TopLeft + + (EQ, LT) -> BottomLeft + (EQ, GT) -> TopRight + (GT, EQ) -> TopLeft + (LT, EQ) -> BottomRight + (EQ, EQ) -> TopLeft -- should never happen + + destinationCorner = opposite originCorner diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs new file mode 100644 index 000000000000..4f8a2f42ee16 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Level.LevelContents + ( chooseCharacterPosition + , randomItems + , randomCreatures + , randomDoors + , placeDownStaircase + , tutorialMessage + , entityFromRaw + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (any, toList) +-------------------------------------------------------------------------------- +import Control.Monad.Random +import Data.Array.IArray (amap, bounds, rangeSize, (!)) +import qualified Data.Array.IArray as Arr +import Data.Foldable (any, toList) +import Linear.V2 +-------------------------------------------------------------------------------- +import Xanthous.Generators.Level.Util +import Xanthous.Random hiding (chance) +import qualified Xanthous.Random as Random +import Xanthous.Data + ( positionFromV2, Position, _Position + , rotations, arrayNeighbors, Neighbors(..) + , neighborPositions + ) +import Xanthous.Data.EntityMap (EntityMap, _EntityMap) +import Xanthous.Entities.Raws (rawsWithType, RawType, raw) +import qualified Xanthous.Entities.Item as Item +import Xanthous.Entities.Item (Item) +import qualified Xanthous.Entities.Creature as Creature +import Xanthous.Entities.Creature (Creature) +import Xanthous.Entities.Environment + (GroundMessage(..), Door(..), unlockedDoor, Staircase(..)) +import Xanthous.Messages (message_) +import Xanthous.Util.Graphics (circle) +import Xanthous.Entities.RawTypes +import Xanthous.Entities.Creature.Hippocampus (initialHippocampus) +import Xanthous.Entities.Common (inRightHand, asWieldedItem, wielded) +import Xanthous.Game.State (SomeEntity(SomeEntity)) +-------------------------------------------------------------------------------- + +chooseCharacterPosition :: MonadRandom m => Cells -> m Position +chooseCharacterPosition = randomPosition + +randomItems :: MonadRandom m => Cells -> m (EntityMap Item) +randomItems = randomEntities (fmap Identity . Item.newWithType) (0.0004, 0.001) + +placeDownStaircase :: MonadRandom m => Cells -> m (EntityMap Staircase) +placeDownStaircase cells = do + pos <- randomPosition cells + pure $ _EntityMap # [(pos, DownStaircase)] + +randomDoors :: MonadRandom m => Cells -> m (EntityMap Door) +randomDoors cells = do + doorRatio <- getRandomR subsetRange + let numDoors = floor $ doorRatio * fromIntegral (length candidateCells) + doorPositions = + removeAdjacent . fmap positionFromV2 . take numDoors $ candidateCells + doors = zip doorPositions $ repeat unlockedDoor + pure $ _EntityMap # doors + where + removeAdjacent = + foldr (\pos acc -> + if pos `elem` (acc >>= toList . neighborPositions) + then acc + else pos : acc + ) [] + candidateCells = filter doorable $ Arr.indices cells + subsetRange = (0.8 :: Double, 1.0) + doorable pos = + not (fromMaybe True $ cells ^? ix pos) + && any (teeish . fmap (fromMaybe True)) + (rotations $ arrayNeighbors cells pos) + -- only generate doors at the *ends* of hallways, eg (where O is walkable, + -- X is a wall, and D is a door): + -- + -- O O O + -- X D X + -- O + teeish (fmap not -> (Neighbors tl t tr l r _ b _ )) = + and [tl, t, tr, b] && (and . fmap not) [l, r] + +randomCreatures + :: MonadRandom m + => Word -- ^ Level number, starting at 0 + -> Cells + -> m (EntityMap Creature) +randomCreatures levelNumber + = randomEntities maybeNewCreature (0.0007, 0.002) + where + maybeNewCreature cType + | maybe True (canGenerate levelNumber) $ cType ^. generateParams + = Just <$> newCreatureWithType cType + | otherwise + = pure Nothing + +newCreatureWithType :: MonadRandom m => CreatureType -> m Creature +newCreatureWithType _creatureType = do + let _hitpoints = _creatureType ^. maxHitpoints + _hippocampus = initialHippocampus + + equipped <- fmap join + . traverse genEquipped + $ _creatureType + ^.. generateParams . _Just . equippedItem . _Just + let _inventory = maybe id (\ei -> wielded .~ inRightHand ei) (headMay equipped) mempty + pure Creature.Creature {..} + where + genEquipped cei = do + doGen <- Random.chance $ cei ^. chance + let entName = cei ^. entityName + itemType = + fromMaybe (error $ "raw \"" <> unpack entName <> "\" not of type Item") + . preview _Item + . fromMaybe (error $ "Could not find raw: " <> unpack entName) + $ raw entName + item <- Item.newWithType itemType + if doGen + then pure [fromMaybe (error $ "raw \"" <> unpack entName <> "\" not wieldable") + $ preview asWieldedItem item] + else pure [] + + +tutorialMessage :: MonadRandom m + => Cells + -> Position -- ^ CharacterPosition + -> m (EntityMap GroundMessage) +tutorialMessage cells characterPosition = do + let distance = 2 + pos <- fmap (fromMaybe (error "No valid positions for tutorial message?")) + . choose . ChooseElement + $ accessiblePositionsWithin distance cells characterPosition + msg <- message_ ["tutorial", "message1"] + pure $ _EntityMap # [(pos, GroundMessage msg)] + where + accessiblePositionsWithin :: Int -> Cells -> Position -> [Position] + accessiblePositionsWithin dist valid pos = + review _Position + <$> filter + (\pt -> not $ valid ! (fromIntegral <$> pt)) + (circle (pos ^. _Position) dist) + +randomEntities + :: forall entity raw m t. (MonadRandom m, RawType raw, Functor t, Foldable t) + => (raw -> m (t entity)) + -> (Float, Float) + -> Cells + -> m (EntityMap entity) +randomEntities newWithType sizeRange cells = + case fromNullable $ rawsWithType @raw of + Nothing -> pure mempty + Just raws -> do + let len = rangeSize $ bounds cells + (numEntities :: Int) <- + floor . (* fromIntegral len) <$> getRandomR sizeRange + entities <- for [0..numEntities] $ const $ do + pos <- randomPosition cells + r <- choose raws + entities <- newWithType r + pure $ (pos, ) <$> entities + pure $ _EntityMap # (entities >>= toList) + +randomPosition :: MonadRandom m => Cells -> m Position +randomPosition = fmap positionFromV2 . choose . impureNonNull . cellCandidates + +-- cellCandidates :: Cells -> Cells +cellCandidates :: Cells -> Set (V2 Word) +cellCandidates + -- find the largest contiguous region of cells in the cave. + = maximumBy (compare `on` length) + . fromMaybe (error "No regions generated! this should never happen.") + . fromNullable + . regions + -- cells ends up with true = wall, we want true = can put an item here + . amap not + +entityFromRaw :: MonadRandom m => EntityRaw -> m SomeEntity +entityFromRaw (Creature ct) = SomeEntity <$> newCreatureWithType ct +entityFromRaw (Item it) = SomeEntity <$> Item.newWithType it diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs new file mode 100644 index 000000000000..0008eb965c42 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs @@ -0,0 +1,236 @@ +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Level.Util + ( MCells + , Cells + , CellM + , randInitialize + , initializeEmpty + , numAliveNeighborsM + , numAliveNeighbors + , fillOuterEdgesM + , cloneMArray + , floodFill + , regions + , fillAll + , fillAllM + , fromPoints + , fromPointsM + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (Foldable, toList, for_) +-------------------------------------------------------------------------------- +import Data.Array.ST +import Data.Array.Unboxed +import Control.Monad.ST +import Control.Monad.Random +import Data.Monoid +import Data.Foldable (Foldable, toList, for_) +import qualified Data.Set as Set +import Data.Semigroup.Foldable +import Linear.V2 +-------------------------------------------------------------------------------- +import Xanthous.Util (foldlMapM', maximum1, minimum1) +import Xanthous.Data (Dimensions, width, height) +-------------------------------------------------------------------------------- + +type MCells s = STUArray s (V2 Word) Bool +type Cells = UArray (V2 Word) Bool +type CellM g s a = RandT g (ST s) a + +randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (MCells s) +randInitialize dims aliveChance = do + res <- initializeEmpty dims + for_ [0..dims ^. width] $ \i -> + for_ [0..dims ^. height] $ \j -> do + val <- (>= aliveChance) <$> getRandomR (0, 1) + lift $ writeArray res (V2 i j) val + pure res + +initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s) +initializeEmpty dims = + lift $ newArray (0, V2 (dims ^. width) (dims ^. height)) False + +-- | Returns the number of neighbors of the given point in the given array that +-- are True. +-- +-- Behavior if point is out-of-bounds for the array is undefined, but will not +-- error +numAliveNeighborsM + :: forall a i m + . (MArray a Bool m, Ix i, Integral i) + => a (V2 i) Bool + -> V2 i + -> m Word +numAliveNeighborsM cells pt@(V2 x y) = do + cellBounds <- getBounds cells + getSum <$> foldlMapM' + (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds) + neighborPositions + + where + boundedGet :: (V2 i, V2 i) -> (Int, Int) -> m Bool + boundedGet bnds _ + | not (inRange bnds pt) + = pure True + boundedGet (V2 minX minY, V2 maxX maxY) (i, j) + | (x <= minX && i < 0) + || (y <= minY && j < 0) + || (x >= maxX && i > 0) + || (y >= maxY && j > 0) + = pure True + | otherwise = + let nx = fromIntegral $ fromIntegral x + i + ny = fromIntegral $ fromIntegral y + j + in readArray cells $ V2 nx ny + +-- | Returns the number of neighbors of the given point in the given array that +-- are True. +-- +-- Behavior if point is out-of-bounds for the array is undefined, but will not +-- error +numAliveNeighbors + :: forall a i + . (IArray a Bool, Ix i, Integral i) + => a (V2 i) Bool + -> V2 i + -> Word +numAliveNeighbors cells pt@(V2 x y) = + let cellBounds = bounds cells + in getSum $ foldMap + (Sum . fromIntegral . fromEnum . boundedGet cellBounds) + neighborPositions + + where + boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool + boundedGet bnds _ + | not (inRange bnds pt) + = True + boundedGet (V2 minX minY, V2 maxX maxY) (i, j) + | (x <= minX && i < 0) + || (y <= minY && j < 0) + || (x >= maxX && i > 0) + || (y >= maxY && j > 0) + = True + | otherwise = + let nx = fromIntegral $ fromIntegral x + i + ny = fromIntegral $ fromIntegral y + j + in cells ! V2 nx ny + +neighborPositions :: [(Int, Int)] +neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] + +fillOuterEdgesM :: (MArray a Bool m, Ix i) => a (V2 i) Bool -> m () +fillOuterEdgesM arr = do + (V2 minX minY, V2 maxX maxY) <- getBounds arr + for_ (range (minX, maxX)) $ \x -> do + writeArray arr (V2 x minY) True + writeArray arr (V2 x maxY) True + for_ (range (minY, maxY)) $ \y -> do + writeArray arr (V2 minX y) True + writeArray arr (V2 maxX y) True + +cloneMArray + :: forall a a' i e m. + ( Ix i + , MArray a e m + , MArray a' e m + , IArray UArray e + ) + => a i e + -> m (a' i e) +cloneMArray = thaw @_ @UArray <=< freeze + +-------------------------------------------------------------------------------- + +-- | Flood fill a cell array starting at a point, returning a list of all the +-- (true) cell locations reachable from that point +floodFill :: forall a i. + ( IArray a Bool + , Ix i + , Enum i + , Bounded i + , Eq i + ) + => a (V2 i) Bool -- ^ array + -> (V2 i) -- ^ position + -> Set (V2 i) +floodFill = go mempty + where + go :: Set (V2 i) -> a (V2 i) Bool -> (V2 i) -> Set (V2 i) + go res arr@(bounds -> arrBounds) idx@(V2 x y) + | not (inRange arrBounds idx) = res + | not (arr ! idx) = res + | otherwise = + let neighbors + = filter (inRange arrBounds) + . filter (/= idx) + . filter (`notMember` res) + $ V2 + <$> [(if x == minBound then x else pred x) + .. + (if x == maxBound then x else succ x)] + <*> [(if y == minBound then y else pred y) + .. + (if y == maxBound then y else succ y)] + in foldl' (\r idx' -> + if arr ! idx' + then r <> (let r' = r & contains idx' .~ True + in r' `seq` go r' arr idx') + else r) + (res & contains idx .~ True) neighbors +{-# SPECIALIZE floodFill :: UArray (V2 Word) Bool -> (V2 Word) -> Set (V2 Word) #-} + +-- | Gives a list of all the disconnected regions in a cell array, represented +-- each as lists of points +regions :: forall a i. + ( IArray a Bool + , Ix i + , Enum i + , Bounded i + , Eq i + ) + => a (V2 i) Bool + -> [Set (V2 i)] +regions arr + | Just firstPoint <- findFirstPoint arr = + let region = floodFill arr firstPoint + arr' = fillAll region arr + in region : regions arr' + | otherwise = [] + where + findFirstPoint :: a (V2 i) Bool -> Maybe (V2 i) + findFirstPoint = fmap fst . headMay . filter snd . assocs +{-# SPECIALIZE regions :: UArray (V2 Word) Bool -> [Set (V2 Word)] #-} + +fillAll :: (IArray a Bool, Ix i, Foldable f) => f i -> a i Bool -> a i Bool +fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes + +fillAllM :: (MArray a Bool m, Ix i, Foldable f) => f i -> a i Bool -> m () +fillAllM ixes a = for_ ixes $ \i -> writeArray a i False + +fromPoints + :: forall a f i. + ( IArray a Bool + , Ix i + , Functor f + , Foldable1 f + ) + => f (i, i) + -> a (i, i) Bool +fromPoints points = + let pts = Set.fromList $ toList points + dims = ( (minimum1 $ fst <$> points, minimum1 $ snd <$> points) + , (maximum1 $ fst <$> points, maximum1 $ snd <$> points) + ) + in array dims $ range dims <&> \i -> (i, i `member` pts) + +fromPointsM + :: (MArray a Bool m, Ix i, Element f ~ i, MonoFoldable f) + => NonNull f + -> m (a i Bool) +fromPointsM points = do + arr <- newArray (minimum points, maximum points) False + fillAllM (otoList points) arr + pure arr diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs new file mode 100644 index 000000000000..ab7de95e6806 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs @@ -0,0 +1,126 @@ +-------------------------------------------------------------------------------- +module Xanthous.Generators.Level.Village + ( fromCave + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (any, failing, toList) +-------------------------------------------------------------------------------- +import Control.Monad.Random (MonadRandom) +import Control.Monad.State (execStateT, MonadState, modify) +import Control.Monad.Trans.Maybe +import Control.Parallel.Strategies +import Data.Array.IArray +import Data.Foldable (any, toList) +-------------------------------------------------------------------------------- +import Xanthous.Data +import Xanthous.Data.EntityMap (EntityMap) +import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Entities.Environment +import Xanthous.Generators.Level.Util +import Xanthous.Game.State (SomeEntity(..)) +import Xanthous.Random +-------------------------------------------------------------------------------- + +fromCave :: MonadRandom m + => Cells -- ^ The positions of all the walls + -> m (EntityMap SomeEntity) +fromCave wallPositions = execStateT (fromCave' wallPositions) mempty + +fromCave' :: forall m. (MonadRandom m, MonadState (EntityMap SomeEntity) m) + => Cells + -> m () +fromCave' wallPositions = failing (pure ()) $ do + Just villageRegion <- + choose + . (`using` parTraversable rdeepseq) + . weightedBy (\reg -> let circSize = length $ circumference reg + in if circSize == 50 + then (1.0 :: Double) + else 1.0 / (fromIntegral . abs $ circSize - 50)) + $ regions closedHallways + + let circ = setFromList . circumference $ villageRegion + + centerPoints <- chooseSubset (0.1 :: Double) $ toList circ + + roomTiles <- foldM + (flip $ const $ stepOut circ) + (map pure centerPoints) + [0 :: Int ..2] + + let roomWalls = circumference . setFromList @(Set _) <$> roomTiles + allWalls = join roomWalls + + doorPositions <- fmap join . for roomWalls $ \room -> + let candidates = filter (`notMember` circ) room + in fmap toList . choose $ ChooseElement candidates + + let entryways = + filter (\pt -> + let ncs = neighborCells pt + in any ((&&) <$> (not . (wallPositions !)) + <*> (`notMember` villageRegion)) ncs + && any ((&&) <$> (`member` villageRegion) + <*> (`notElem` allWalls)) ncs) + $ toList villageRegion + + Just entryway <- choose $ ChooseElement entryways + + for_ (filter ((&&) <$> (`notElem` doorPositions) <*> (/= entryway)) allWalls) + $ insertEntity Wall + for_ (filter (/= entryway) doorPositions) $ insertEntity unlockedDoor + insertEntity unlockedDoor entryway + + + where + insertEntity e pt = modify $ EntityMap.insertAt (ptToPos pt) $ SomeEntity e + ptToPos pt = _Position # (fromIntegral <$> pt) + + stepOut :: Set (V2 Word) -> [[V2 Word]] -> MaybeT m [[V2 Word]] + stepOut circ rooms = for rooms $ \room -> + let nextLevels = hashNub $ toList . neighborCells =<< room + in pure + . (<> room) + $ filter ((&&) <$> (`notMember` circ) <*> (`notElem` join rooms)) + nextLevels + + circumference pts = + filter (any (`notMember` pts) . neighborCells) $ toList pts + closedHallways = closeHallways livePositions + livePositions = amap not wallPositions + +-------------------------------------------------------------------------------- + +closeHallways :: Cells -> Cells +closeHallways livePositions = + livePositions // mapMaybe closeHallway (assocs livePositions) + where + closeHallway (_, False) = Nothing + closeHallway (pos, _) + | isHallway pos = Just (pos, False) + | otherwise = Nothing + isHallway pos = any ((&&) <$> not . view left <*> not . view right) + . rotations + . fmap (fromMaybe False) + $ arrayNeighbors livePositions pos + +failing :: Monad m => m a -> MaybeT m a -> m a +failing result = (maybe result pure =<<) . runMaybeT + +{- + +import Xanthous.Generators.Village +import Xanthous.Generators +import Xanthous.Data +import System.Random +import qualified Data.Text +import qualified Xanthous.Generators.CaveAutomata as CA +let gi = GeneratorInput SCaveAutomata CA.defaultParams +wallPositions <- generateFromInput gi (Dimensions 80 50) <$> getStdGen +putStrLn . Data.Text.unpack $ showCells wallPositions + +import Data.Array.IArray +let closedHallways = closeHallways . amap not $ wallPositions +putStrLn . Data.Text.unpack . showCells $ amap not closedHallways + +-} diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs b/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs new file mode 100644 index 000000000000..8abc00b6a2fc --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedLists #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Speech + ( -- * Language definition + Language(..) + -- ** Lenses + , phonotactics + , syllablesPerWord + + -- ** Phonotactics + , Phonotactics(..) + -- *** Lenses + , onsets + , nuclei + , codas + , numOnsets + , numNuclei + , numCodas + + -- * Language generation + , syllable + , word + + -- * Languages + , english + , gormlak + + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (replicateM) +import Data.Interval (Interval, (<=..<=)) +import qualified Data.Interval as Interval +import Control.Monad.Random.Class (MonadRandom) +import Xanthous.Random (chooseRange, choose, ChooseElement (..), Weighted (Weighted)) +import Control.Monad (replicateM) +import Test.QuickCheck (Arbitrary, CoArbitrary, Function) +import Test.QuickCheck.Instances.Text () +import Data.List.NonEmpty (NonEmpty) +-------------------------------------------------------------------------------- + +newtype Phoneme = Phoneme Text + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving newtype (IsString, Semigroup, Monoid, Arbitrary) + +-- | The phonotactics of a language +-- +-- The phonotactics of a language represent the restriction on the phonemes in +-- the syllables of a language. +-- +-- Syllables in a language consist of an onset, a nucleus, and a coda (the +-- nucleus and the coda together representing the "rhyme" of the syllable). +data Phonotactics = Phonotactics + { _onsets :: [Phoneme] -- ^ The permissible onsets, or consonant clusters + -- at the beginning of a syllable + , _nuclei :: [Phoneme] -- ^ The permissible nuclei, or vowel clusters in + -- the middle of a syllable + , _codas :: [Phoneme] -- ^ The permissible codas, or consonant clusters at + -- the end of a syllable + , _numOnsets :: Interval Word -- ^ The range of number of allowable onsets + , _numNuclei :: Interval Word -- ^ The range of number of allowable nuclei + , _numCodas :: Interval Word -- ^ The range of number of allowable codas + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) +makeLenses ''Phonotactics + +-- | Randomly generate a syllable with the given 'Phonotactics' +syllable :: MonadRandom m => Phonotactics -> m Text +syllable phonotactics = do + let genPart num choices = do + n <- fromIntegral . fromMaybe 0 <$> chooseRange (phonotactics ^. num) + fmap (fromMaybe mempty . mconcat) + . replicateM n + . choose . ChooseElement + $ phonotactics ^. choices + + (Phoneme onset) <- genPart numOnsets onsets + (Phoneme nucleus) <- genPart numNuclei nuclei + (Phoneme coda) <- genPart numCodas codas + + pure $ onset <> nucleus <> coda + +-- | A definition for a language +-- +-- Currently this provides enough information to generate multi-syllabic words, +-- but in the future will likely also include grammar-related things. +data Language = Language + { _phonotactics :: Phonotactics + , _syllablesPerWord :: Weighted Int NonEmpty Int + } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) +makeLenses ''Language + +word :: MonadRandom m => Language -> m Text +word lang = do + numSyllables <- choose $ lang ^. syllablesPerWord + mconcat <$> replicateM numSyllables (syllable $ lang ^. phonotactics) + +-------------------------------------------------------------------------------- + +-- <https://en.wikipedia.org/wiki/English_phonology#Phonotactics> +englishPhonotactics :: Phonotactics +englishPhonotactics = Phonotactics + { _onsets = [ "pl" , "bl" , "kl" , "gl" , "pr" , "br" , "tr" , "dr" , "kr" + , "gr" , "tw" , "dw" , "gw" , "kw" , "pw" + + , "fl" , "sl" , {- "thl", -} "shl" {- , "vl" -} + , "p", "b", "t", "d", "k", "ɡ", "m", "n", "f", "v", "th", "s" + , "z", "h", "l", "w" + + , "sp", "st", "sk" + + , "sm", "sn" + + , "sf", "sth" + + , "spl", "skl", "spr", "str", "skr", "skw", "sm", "sp", "st", "sk" + ] + , _nuclei = [ "a", "e", "i", "o", "u", "ur", "ar", "or", "ear", "are", "ure" + , "oa", "ee", "oo", "ei", "ie", "oi", "ou" + ] + , _codas = [ "m", "n", "ng", "p", "t", "tsh", "k", "f", "sh", "s", "th", "x" + , "v", "z", "zh", "l", "r", "w" + + , "lk", "lb", "lt", "ld", "ltsh", "ldsh", "lk" + , "rp", "rb", "rt", "rd", "rtsh", "rdsh", "rk", "rɡ" + , "lf", "lv", "lth", "ls", "lz", "lsh", "lth" + , "rf", "rv", "rth", "rs", "rz", "rth" + , "lm", "ln" + , "rm", "rn", "rl" + , "mp", "nt", "nd", "nth", "nsh", "nk" + , "mf", "ms", "mth", "nf", "nth", "ns", "nz", "nth" + , "ft", "sp", "st", "sk" + , "fth" + , "pt", "kt" + , "pth", "ps", "th", "ts", "dth", "dz", "ks" + , "lpt", "lps", "lfth", "lts", "lst", "lkt", "lks" + , "rmth", "rpt", "rps", "rts", "rst", "rkt" + , "mpt", "mps", "ndth", "nkt", "nks", "nkth" + , "ksth", "kst" + ] + , _numOnsets = 0 <=..<= 1 + , _numNuclei = Interval.singleton 1 + , _numCodas = 0 <=..<= 1 + } + +english :: Language +english = Language + { _phonotactics = englishPhonotactics + , _syllablesPerWord = Weighted [(20, 1), + (7, 2), + (2, 3), + (1, 4)] + } + +gormlakPhonotactics :: Phonotactics +gormlakPhonotactics = Phonotactics + { _onsets = [ "h", "l", "g", "b", "m", "n", "ng" + , "gl", "bl", "fl" + ] + , _numOnsets = Interval.singleton 1 + , _nuclei = [ "a", "o", "aa", "u" ] + , _numNuclei = Interval.singleton 1 + , _codas = [ "r", "l", "g", "m", "n" + , "rl", "gl", "ml", "rm" + , "n", "k" + ] + , _numCodas = Interval.singleton 1 + } + +gormlak :: Language +gormlak = Language + { _phonotactics = gormlakPhonotactics + , _syllablesPerWord = Weighted [ (5, 2) + , (5, 1) + , (1, 3) + ] + } diff --git a/users/grfn/xanthous/src/Xanthous/Messages.hs b/users/grfn/xanthous/src/Xanthous/Messages.hs new file mode 100644 index 000000000000..c273d650821b --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Messages.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Messages + ( Message(..) + , resolve + , MessageMap(..) + , lookupMessage + + -- * Game messages + , messages + , render + , render_ + , lookup + , message + , message_ + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (lookup) +-------------------------------------------------------------------------------- +import Control.Monad.Random.Class (MonadRandom) +import Data.Aeson (FromJSON, ToJSON, toJSON, object) +import qualified Data.Aeson as JSON +import Data.Aeson.Generic.DerivingVia +import Data.FileEmbed +import Data.List.NonEmpty +import Test.QuickCheck hiding (choose) +import Test.QuickCheck.Instances.UnorderedContainers () +import Text.Mustache +import qualified Data.Yaml as Yaml +-------------------------------------------------------------------------------- +import Xanthous.Random +import Xanthous.Orphans () +-------------------------------------------------------------------------------- + +data Message = Single Template | Choice (NonEmpty Template) + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function, NFData) + deriving (ToJSON, FromJSON) + via WithOptions '[ SumEnc UntaggedVal ] + Message + +instance Arbitrary Message where + arbitrary = + frequency [ (10, Single <$> arbitrary) + , (1, Choice <$> arbitrary) + ] + shrink = genericShrink + +resolve :: MonadRandom m => Message -> m Template +resolve (Single t) = pure t +resolve (Choice ts) = choose ts + +data MessageMap = Direct Message | Nested (HashMap Text MessageMap) + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (CoArbitrary, Function, NFData) + deriving (ToJSON, FromJSON) + via WithOptions '[ SumEnc UntaggedVal ] + MessageMap + +instance Arbitrary MessageMap where + arbitrary = frequency [ (10, Direct <$> arbitrary) + , (1, Nested <$> arbitrary) + ] + +lookupMessage :: [Text] -> MessageMap -> Maybe Message +lookupMessage [] (Direct msg) = Just msg +lookupMessage (k:ks) (Nested m) = lookupMessage ks =<< m ^. at k +lookupMessage _ _ = Nothing + +type instance Index MessageMap = [Text] +type instance IxValue MessageMap = Message +instance Ixed MessageMap where + ix [] f (Direct msg) = Direct <$> f msg + ix (k:ks) f (Nested m) = case m ^. at k of + Just m' -> ix ks f m' <&> \m'' -> + Nested $ m & at k ?~ m'' + Nothing -> pure $ Nested m + ix _ _ m = pure m + +-------------------------------------------------------------------------------- + +rawMessages :: ByteString +rawMessages = $(embedFile "src/Xanthous/messages.yaml") + +messages :: MessageMap +messages + = either (error . Yaml.prettyPrintParseException) id + $ Yaml.decodeEither' rawMessages + +render :: (MonadRandom m, ToJSON params) => Message -> params -> m Text +render msg params = do + tpl <- resolve msg + pure . toStrict . renderMustache tpl $ toJSON params + +-- | Render a message with an empty set of params +render_ :: (MonadRandom m) => Message -> m Text +render_ msg = render msg $ object [] + +lookup :: [Text] -> Message +lookup path = fromMaybe notFound $ messages ^? ix path + where notFound + = Single + $ compileMustacheText "template" "Message not found" + ^?! _Right + +message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text +message path params = maybe notFound (`render` params) $ messages ^? ix path + where + notFound = pure "Message not found" + +message_ :: (MonadRandom m) => [Text] -> m Text +message_ path = maybe notFound (`render` JSON.object []) $ messages ^? ix path + where + notFound = pure "Message not found" diff --git a/users/grfn/xanthous/src/Xanthous/Messages/Template.hs b/users/grfn/xanthous/src/Xanthous/Messages/Template.hs new file mode 100644 index 000000000000..5176880355f4 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Messages/Template.hs @@ -0,0 +1,275 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-------------------------------------------------------------------------------- +module Xanthous.Messages.Template + ( -- * Template AST + Template(..) + , Substitution(..) + , Filter(..) + + -- ** Template AST transformations + , reduceTemplate + + -- * Template parser + , template + , runParser + , errorBundlePretty + + -- * Template pretty-printer + , ppTemplate + + -- * Rendering templates + , TemplateVar(..) + , nested + , TemplateVars(..) + , vars + , RenderError + , render + ) +where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding + (many, concat, try, elements, some, parts) +-------------------------------------------------------------------------------- +import Test.QuickCheck hiding (label) +import Test.QuickCheck.Instances.Text () +import Test.QuickCheck.Instances.Semigroup () +import Test.QuickCheck.Checkers (EqProp) +import Control.Monad.Combinators.NonEmpty +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Data +import Text.Megaparsec hiding (sepBy1, some) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import Data.Function (fix) +-------------------------------------------------------------------------------- +import Xanthous.Util (EqEqProp(..)) +-------------------------------------------------------------------------------- + +genIdentifier :: Gen Text +genIdentifier = pack <$> listOf1 (elements identifierChars) + +identifierChars :: String +identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_'] + +newtype Filter = FilterName Text + deriving stock (Show, Eq, Ord, Generic, Data) + deriving anyclass (NFData) + deriving (IsString) via Text + +instance Arbitrary Filter where + arbitrary = FilterName <$> genIdentifier + shrink (FilterName fn) = fmap FilterName . filter (not . null) $ shrink fn + +data Substitution + = SubstPath (NonEmpty Text) + | SubstFilter Substitution Filter + deriving stock (Show, Eq, Ord, Generic, Data) + deriving anyclass (NFData) + +instance Arbitrary Substitution where + arbitrary = sized . fix $ \gen n -> + let leaves = + [ SubstPath <$> ((:|) <$> genIdentifier <*> listOf genIdentifier)] + subtree = gen $ n `div` 2 + in if n == 0 + then oneof leaves + else oneof $ leaves <> [ SubstFilter <$> subtree <*> arbitrary ] + shrink (SubstPath pth) = + fmap SubstPath + . filter (not . any ((||) <$> null <*> any (`notElem` identifierChars))) + $ shrink pth + shrink (SubstFilter s f) + = shrink s + <> (uncurry SubstFilter <$> shrink (s, f)) + +data Template + = Literal Text + | Subst Substitution + | Concat Template Template + deriving stock (Show, Generic, Data) + deriving anyclass (NFData) + deriving EqProp via EqEqProp Template + +instance Plated Template where + plate _ tpl@(Literal _) = pure tpl + plate _ tpl@(Subst _) = pure tpl + plate f (Concat tpl₁ tpl₂) = Concat <$> f tpl₁ <*> f tpl₂ + +reduceTemplate :: Template -> Template +reduceTemplate = transform $ \case + (Concat (Literal t₁) (Literal t₂)) -> Literal (t₁ <> t₂) + (Concat (Literal "") t) -> t + (Concat t (Literal "")) -> t + (Concat t₁ (Concat t₂ t₃)) -> Concat (Concat t₁ t₂) t₃ + (Concat (Concat t₁ (Literal t₂)) (Literal t₃)) -> (Concat t₁ (Literal $ t₂ <> t₃)) + t -> t + +instance Eq Template where + tpl₁ == tpl₂ = case (reduceTemplate tpl₁, reduceTemplate tpl₂) of + (Literal t₁, Literal t₂) -> t₁ == t₂ + (Subst s₁, Subst s₂) -> s₁ == s₂ + (Concat ta₁ ta₂, Concat tb₁ tb₂) -> ta₁ == tb₁ && ta₂ == tb₂ + _ -> False + +instance Arbitrary Template where + arbitrary = sized . fix $ \gen n -> + let leaves = [ Literal . pack . filter (`notElem` ['\\', '{']) <$> arbitrary + , Subst <$> arbitrary + ] + subtree = gen $ n `div` 2 + genConcat = Concat <$> subtree <*> subtree + in if n == 0 + then oneof leaves + else oneof $ genConcat : leaves + shrink (Literal t) = Literal <$> shrink t + shrink (Subst s) = Subst <$> shrink s + shrink (Concat t₁ t₂) + = shrink t₁ + <> shrink t₂ + <> (Concat <$> shrink t₁ <*> shrink t₂) + +instance Semigroup Template where + (<>) = Concat + +instance Monoid Template where + mempty = Literal "" + +-------------------------------------------------------------------------------- + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space space1 empty empty + +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc + +symbol :: Text -> Parser Text +symbol = L.symbol sc + +identifier :: Parser Text +identifier = lexeme . label "identifier" $ do + firstChar <- letterChar <|> oneOf ['-', '_'] + restChars <- many $ alphaNumChar <|> oneOf ['-', '_'] + pure $ firstChar <| pack restChars + +filterName :: Parser Filter +filterName = FilterName <$> identifier + +substitutionPath :: Parser Substitution +substitutionPath = SubstPath <$> sepBy1 identifier (char '.') + +substitutionFilter :: Parser Substitution +substitutionFilter = do + path <- substitutionPath + fs <- some $ symbol "|" *> filterName + pure $ foldl' SubstFilter path fs + -- pure $ SubstFilter path f + +substitutionContents :: Parser Substitution +substitutionContents + = try substitutionFilter + <|> substitutionPath + +substitution :: Parser Substitution +substitution = between (string "{{") (string "}}") substitutionContents + +literal :: Parser Template +literal = Literal <$> + ( (string "\\{" $> "{") + <|> takeWhile1P Nothing (`notElem` ['\\', '{']) + ) + +subst :: Parser Template +subst = Subst <$> substitution + +template' :: Parser Template +template' = do + parts <- many $ literal <|> subst + pure $ foldr Concat (Literal "") parts + + +template :: Parser Template +template = reduceTemplate <$> template' <* eof + +-------------------------------------------------------------------------------- + +ppSubstitution :: Substitution -> Text +ppSubstitution (SubstPath substParts) = intercalate "." substParts +ppSubstitution (SubstFilter s (FilterName f)) = ppSubstitution s <> " | " <> f + +ppTemplate :: Template -> Text +ppTemplate (Literal txt) = txt +ppTemplate (Subst s) = "{{" <> ppSubstitution s <> "}}" +ppTemplate (Concat tpl₁ tpl₂) = ppTemplate tpl₁ <> ppTemplate tpl₂ + +-------------------------------------------------------------------------------- + +data TemplateVar + = Val Text + | Nested (Map Text TemplateVar) + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + +nested :: [(Text, TemplateVar)] -> TemplateVar +nested = Nested . mapFromList + +instance Arbitrary TemplateVar where + arbitrary = sized . fix $ \gen n -> + let nst = fmap mapFromList . listOf $ (,) <$> arbitrary <*> gen (n `div` 2) + in if n == 0 + then Val <$> arbitrary + else oneof [ Val <$> arbitrary + , Nested <$> nst] + +newtype TemplateVars = Vars { getTemplateVars :: Map Text TemplateVar } + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + deriving (Arbitrary) via (Map Text TemplateVar) + +type instance Index TemplateVars = Text +type instance IxValue TemplateVars = TemplateVar +instance Ixed TemplateVars where + ix k f (Vars vs) = Vars <$> ix k f vs +instance At TemplateVars where + at k f (Vars vs) = Vars <$> at k f vs + +vars :: [(Text, TemplateVar)] -> TemplateVars +vars = Vars . mapFromList + +lookupVar :: TemplateVars -> NonEmpty Text -> Maybe TemplateVar +lookupVar vs (p :| []) = vs ^. at p +lookupVar vs (p :| (p₁ : ps)) = vs ^. at p >>= \case + (Val _) -> Nothing + (Nested vs') -> lookupVar (Vars vs') $ p₁ :| ps + +data RenderError + = NoSuchVariable (NonEmpty Text) + | NestedFurther (NonEmpty Text) + | NoSuchFilter Filter + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) + +renderSubst + :: Map Filter (Text -> Text) -- ^ Filters + -> TemplateVars + -> Substitution + -> Either RenderError Text +renderSubst _ vs (SubstPath pth) = + case lookupVar vs pth of + Just (Val v) -> Right v + Just (Nested _) -> Left $ NestedFurther pth + Nothing -> Left $ NoSuchVariable pth +renderSubst fs vs (SubstFilter s fn) = + case fs ^. at fn of + Just filterFn -> filterFn <$> renderSubst fs vs s + Nothing -> Left $ NoSuchFilter fn + +render + :: Map Filter (Text -> Text) -- ^ Filters + -> TemplateVars -- ^ Template variables + -> Template -- ^ Template + -> Either RenderError Text +render _ _ (Literal s) = pure s +render fs vs (Concat t₁ t₂) = (<>) <$> render fs vs t₁ <*> render fs vs t₂ +render fs vs (Subst s) = renderSubst fs vs s diff --git a/users/grfn/xanthous/src/Xanthous/Monad.hs b/users/grfn/xanthous/src/Xanthous/Monad.hs new file mode 100644 index 000000000000..db602de56f3a --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Monad.hs @@ -0,0 +1,76 @@ +-------------------------------------------------------------------------------- +module Xanthous.Monad + ( AppT(..) + , AppM + , runAppT + , continue + , halt + + -- * Messages + , say + , say_ + , message + , message_ + , writeMessage + + -- * Autocommands + , cancelAutocommand + + -- * Events + , sendEvent + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Control.Monad.Random +import Control.Monad.State +import qualified Brick +import Brick (EventM, Next) +import Brick.BChan (writeBChan) +import Data.Aeson (ToJSON, object) +-------------------------------------------------------------------------------- +import Xanthous.Data.App (AppEvent) +import Xanthous.Game.State +import Xanthous.Game.Env +import Xanthous.Messages (Message) +import qualified Xanthous.Messages as Messages +-------------------------------------------------------------------------------- + +halt :: AppT (EventM n) (Next GameState) +halt = lift . Brick.halt =<< get + +continue :: AppT (EventM n) (Next GameState) +continue = lift . Brick.continue =<< get + +-------------------------------------------------------------------------------- + +say :: (MonadRandom m, ToJSON params, MonadState GameState m) + => [Text] -> params -> m () +say msgPath = writeMessage <=< Messages.message msgPath + +say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m () +say_ msgPath = say msgPath $ object [] + +message :: (MonadRandom m, ToJSON params, MonadState GameState m) + => Message -> params -> m () +message msg = writeMessage <=< Messages.render msg + +message_ :: (MonadRandom m, MonadState GameState m) + => Message -> m () +message_ msg = message msg $ object [] + +writeMessage :: MonadState GameState m => Text -> m () +writeMessage m = messageHistory %= pushMessage m + +-- | Cancel the currently active autocommand, if any +cancelAutocommand :: (MonadState GameState m, MonadIO m) => m () +cancelAutocommand = do + traverse_ (liftIO . cancel . snd) =<< preuse (autocommand . _ActiveAutocommand) + autocommand .= NoAutocommand + +-------------------------------------------------------------------------------- + +-- | Send an event to the app in an environment where the game env is available +sendEvent :: (MonadReader GameEnv m, MonadIO m) => AppEvent -> m () +sendEvent evt = do + ec <- view eventChan + liftIO $ writeBChan ec evt diff --git a/users/grfn/xanthous/src/Xanthous/Orphans.hs b/users/grfn/xanthous/src/Xanthous/Orphans.hs new file mode 100644 index 000000000000..e9cfddc0e69c --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Orphans.hs @@ -0,0 +1,483 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PackageImports #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-type-defaults #-} +-------------------------------------------------------------------------------- +module Xanthous.Orphans + ( ppTemplate + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (elements, (.=)) +-------------------------------------------------------------------------------- +import Data.Aeson +import Data.Aeson.Types (typeMismatch) +import Data.List.NonEmpty (NonEmpty(..)) +import Graphics.Vty.Attributes +import Brick.Widgets.Edit +import Data.Text.Zipper.Generic (GenericTextZipper) +import Brick.Widgets.Core (getName) +import System.Random.Internal (StdGen (..)) +import System.Random.SplitMix (SMGen ()) +import Test.QuickCheck +import "quickcheck-instances" Test.QuickCheck.Instances () +import Text.Megaparsec (errorBundlePretty) +import Text.Megaparsec.Pos +import Text.Mustache +import Text.Mustache.Type ( showKey ) +import Control.Monad.State +import Linear +import qualified Data.Interval as Interval +import Data.Interval ( Interval, Extended (..), Boundary (..) + , lowerBound', upperBound', (<=..<), (<=..<=) + , interval) +import Test.QuickCheck.Checkers (EqProp ((=-=))) +-------------------------------------------------------------------------------- +import Xanthous.Util.JSON +import Xanthous.Util.QuickCheck +import Xanthous.Util (EqEqProp(EqEqProp)) +-------------------------------------------------------------------------------- + +instance forall s a. + ( Cons s s a a + , IsSequence s + , Element s ~ a + ) => Cons (NonNull s) (NonNull s) a a where + _Cons = prism hither yon + where + hither :: (a, NonNull s) -> NonNull s + hither (a, ns) = + let s = toNullable ns + in impureNonNull $ a <| s + + yon :: NonNull s -> Either (NonNull s) (a, NonNull s) + yon ns = case nuncons ns of + (_, Nothing) -> Left ns + (x, Just xs) -> Right (x, xs) + +instance forall a. Cons (NonEmpty a) (NonEmpty a) a a where + _Cons = prism hither yon + where + hither :: (a, NonEmpty a) -> NonEmpty a + hither (a, x :| xs) = a :| (x : xs) + + yon :: NonEmpty a -> Either (NonEmpty a) (a, NonEmpty a) + yon ns@(x :| xs) = case xs of + (y : ys) -> Right (x, y :| ys) + [] -> Left ns + + +instance Arbitrary PName where + arbitrary = PName . pack <$> listOf1 (elements ['a'..'z']) + +instance Arbitrary Key where + arbitrary = Key <$> listOf1 arbSafeText + where arbSafeText = pack <$> listOf1 (elements ['a'..'z']) + shrink (Key []) = error "unreachable" + shrink k@(Key [_]) = pure k + shrink (Key (p:ps)) = Key . (p :) <$> shrink ps + +instance Arbitrary Pos where + arbitrary = mkPos . succ . abs <$> arbitrary + shrink (unPos -> 1) = [] + shrink (unPos -> x) = mkPos <$> [x..1] + +instance Arbitrary Node where + arbitrary = scale (`div` 10) $ sized node + where + node n | n > 0 = oneof $ leaves ++ branches (n `div` 4) + node _ = oneof leaves + branches n = + [ Section <$> arbitrary <*> subnodes n + , InvertedSection <$> arbitrary <*> subnodes n + ] + subnodes = fmap concatTextBlocks . listOf . node + leaves = + [ TextBlock . pack <$> listOf1 (elements ['a'..'z']) + , EscapedVar <$> arbitrary + , UnescapedVar <$> arbitrary + -- TODO fix pretty-printing of mustache partials + -- , Partial <$> arbitrary <*> arbitrary + ] + shrink = genericShrink + +concatTextBlocks :: [Node] -> [Node] +concatTextBlocks [] = [] +concatTextBlocks [x] = [x] +concatTextBlocks (TextBlock txt₁ : TextBlock txt₂ : xs) + = concatTextBlocks $ TextBlock (txt₁ <> txt₂) : concatTextBlocks xs +concatTextBlocks (x : xs) = x : concatTextBlocks xs + +instance Arbitrary Template where + arbitrary = scale (`div` 8) $ do + template <- concatTextBlocks <$> arbitrary + -- templateName <- arbitrary + -- rest <- arbitrary + let templateName = "template" + rest = mempty + pure $ Template + { templateActual = templateName + , templateCache = rest & at templateName ?~ template + } + shrink (Template actual cache) = + let Just tpl = cache ^. at actual + in do + cache' <- shrink cache + tpl' <- shrink tpl + actual' <- shrink actual + pure $ Template + { templateActual = actual' + , templateCache = cache' & at actual' ?~ tpl' + } + +instance CoArbitrary Template where + coarbitrary = coarbitrary . ppTemplate + +instance Function Template where + function = functionMap ppTemplate parseTemplatePartial + where + parseTemplatePartial txt + = compileMustacheText "template" txt ^?! _Right + +ppNode :: Map PName [Node] -> Node -> Text +ppNode _ (TextBlock txt) = txt +ppNode _ (EscapedVar k) = "{{" <> showKey k <> "}}" +ppNode ctx (Section k body) = + let sk = showKey k + in "{{#" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}" +ppNode _ (UnescapedVar k) = "{{{" <> showKey k <> "}}}" +ppNode ctx (InvertedSection k body) = + let sk = showKey k + in "{{^" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}" +ppNode _ (Partial n _) = "{{> " <> unPName n <> "}}" + +ppTemplate :: Template -> Text +ppTemplate (Template actual cache) = + case cache ^. at actual of + Nothing -> error "Template not found?" + Just nodes -> foldMap (ppNode cache) nodes + +instance ToJSON Template where + toJSON = String . ppTemplate + +instance FromJSON Template where + parseJSON + = withText "Template" + $ either (fail . errorBundlePretty) pure + . compileMustacheText "template" + +deriving anyclass instance NFData Node +deriving anyclass instance NFData Template + +instance FromJSON Color where + parseJSON (String "black") = pure black + parseJSON (String "red") = pure red + parseJSON (String "green") = pure green + parseJSON (String "yellow") = pure yellow + parseJSON (String "blue") = pure blue + parseJSON (String "magenta") = pure magenta + parseJSON (String "cyan") = pure cyan + parseJSON (String "white") = pure white + parseJSON (String "brightBlack") = pure brightBlack + parseJSON (String "brightRed") = pure brightRed + parseJSON (String "brightGreen") = pure brightGreen + parseJSON (String "brightYellow") = pure brightYellow + parseJSON (String "brightBlue") = pure brightBlue + parseJSON (String "brightMagenta") = pure brightMagenta + parseJSON (String "brightCyan") = pure brightCyan + parseJSON (String "brightWhite") = pure brightWhite + parseJSON n@(Number _) = Color240 <$> parseJSON n + parseJSON x = typeMismatch "Color" x + +instance ToJSON Color where + toJSON color + | color == black = "black" + | color == red = "red" + | color == green = "green" + | color == yellow = "yellow" + | color == blue = "blue" + | color == magenta = "magenta" + | color == cyan = "cyan" + | color == white = "white" + | color == brightBlack = "brightBlack" + | color == brightRed = "brightRed" + | color == brightGreen = "brightGreen" + | color == brightYellow = "brightYellow" + | color == brightBlue = "brightBlue" + | color == brightMagenta = "brightMagenta" + | color == brightCyan = "brightCyan" + | color == brightWhite = "brightWhite" + | Color240 num <- color = toJSON num + | otherwise = error $ "unimplemented: " <> show color + +instance (Eq a, Show a, Read a, FromJSON a) => FromJSON (MaybeDefault a) where + parseJSON Null = pure Default + parseJSON (String "keepCurrent") = pure KeepCurrent + parseJSON x = SetTo <$> parseJSON x + +instance ToJSON a => ToJSON (MaybeDefault a) where + toJSON Default = Null + toJSON KeepCurrent = String "keepCurrent" + toJSON (SetTo x) = toJSON x + +-------------------------------------------------------------------------------- + +instance Arbitrary Color where + arbitrary = oneof [ Color240 <$> choose (0, 239) + , ISOColor <$> choose (0, 15) + ] + +deriving anyclass instance CoArbitrary Color +deriving anyclass instance Function Color + +instance (Eq a, Show a, Read a, Arbitrary a) => Arbitrary (MaybeDefault a) where + arbitrary = oneof [ pure Default + , pure KeepCurrent + , SetTo <$> arbitrary + ] + +instance CoArbitrary a => CoArbitrary (MaybeDefault a) where + coarbitrary Default = variant @Int 1 + coarbitrary KeepCurrent = variant @Int 2 + coarbitrary (SetTo x) = variant @Int 3 . coarbitrary x + +instance (Eq a, Show a, Read a, Function a) => Function (MaybeDefault a) where + function = functionShow + +deriving via (EqEqProp Attr) instance EqProp Attr + +instance Arbitrary Attr where + arbitrary = do + attrStyle <- arbitrary + attrForeColor <- arbitrary + attrBackColor <- arbitrary + attrURL <- arbitrary + pure Attr {..} + +deriving anyclass instance CoArbitrary Attr +deriving anyclass instance Function Attr + +instance ToJSON Attr where + toJSON Attr{..} = object + [ "style" .= maybeDefaultToJSONWith styleToJSON attrStyle + , "foreground" .= attrForeColor + , "background" .= attrBackColor + , "url" .= attrURL + ] + where + maybeDefaultToJSONWith _ Default = Null + maybeDefaultToJSONWith _ KeepCurrent = String "keepCurrent" + maybeDefaultToJSONWith tj (SetTo x) = tj x + styleToJSON style + | style == standout = "standout" + | style == underline = "underline" + | style == reverseVideo = "reverseVideo" + | style == blink = "blink" + | style == dim = "dim" + | style == bold = "bold" + | style == italic = "italic" + | otherwise = toJSON style + +instance FromJSON Attr where + parseJSON = withObject "Attr" $ \obj -> do + attrStyle <- parseStyle =<< obj .:? "style" .!= Default + attrForeColor <- obj .:? "foreground" .!= Default + attrBackColor <- obj .:? "background" .!= Default + attrURL <- obj .:? "url" .!= Default + pure Attr{..} + + where + parseStyle (SetTo (String "standout")) = pure (SetTo standout) + parseStyle (SetTo (String "underline")) = pure (SetTo underline) + parseStyle (SetTo (String "reverseVideo")) = pure (SetTo reverseVideo) + parseStyle (SetTo (String "blink")) = pure (SetTo blink) + parseStyle (SetTo (String "dim")) = pure (SetTo dim) + parseStyle (SetTo (String "bold")) = pure (SetTo bold) + parseStyle (SetTo (String "italic")) = pure (SetTo italic) + parseStyle (SetTo n@(Number _)) = SetTo <$> parseJSON n + parseStyle (SetTo v) = typeMismatch "Style" v + parseStyle Default = pure Default + parseStyle KeepCurrent = pure KeepCurrent + +deriving stock instance Ord Color +deriving stock instance Ord a => Ord (MaybeDefault a) +deriving stock instance Ord Attr + +-------------------------------------------------------------------------------- + +instance (SemiSequence a, Arbitrary (Element a), Arbitrary a) + => Arbitrary (NonNull a) where + arbitrary = ncons <$> arbitrary <*> arbitrary + +instance ToJSON a => ToJSON (NonNull a) where + toJSON = toJSON . toNullable + +instance (FromJSON a, MonoFoldable a) => FromJSON (NonNull a) where + parseJSON = maybe (fail "Found empty list") pure . fromNullable <=< parseJSON + +instance NFData a => NFData (NonNull a) where + rnf xs = xs `seq` toNullable xs `deepseq` () + +-------------------------------------------------------------------------------- + +instance forall t name. (NFData t, Monoid t, NFData name) + => NFData (Editor t name) where + rnf ed = getName @_ @name ed `deepseq` getEditContents ed `deepseq` () + +deriving via (ReadShowJSON SMGen) instance ToJSON SMGen +deriving via (ReadShowJSON SMGen) instance FromJSON SMGen + +instance ToJSON StdGen where + toJSON = toJSON . unStdGen + toEncoding = toEncoding . unStdGen + +instance FromJSON StdGen where + parseJSON = fmap StdGen . parseJSON + +-------------------------------------------------------------------------------- + +instance CoArbitrary a => CoArbitrary (NonNull a) where + coarbitrary = coarbitrary . toNullable + +instance (MonoFoldable a, Function a) => Function (NonNull a) where + function = functionMap toNullable $ fromMaybe (error "null") . fromNullable + +instance (Arbitrary t, Arbitrary n, GenericTextZipper t) + => Arbitrary (Editor t n) where + arbitrary = editor <$> arbitrary <*> arbitrary <*> arbitrary + +instance forall t n. (CoArbitrary t, CoArbitrary n, Monoid t) + => CoArbitrary (Editor t n) where + coarbitrary ed = coarbitrary (getName @_ @n ed, getEditContents ed) + +instance CoArbitrary StdGen where + coarbitrary = coarbitrary . show + +instance Function StdGen where + function = functionMap unStdGen StdGen + +instance Function SMGen where + function = functionShow + +-------------------------------------------------------------------------------- + +deriving newtype instance (Arbitrary s, CoArbitrary (m (a, s))) + => CoArbitrary (StateT s m a) + +-------------------------------------------------------------------------------- + +deriving via (GenericArbitrary (V2 a)) instance Arbitrary a => Arbitrary (V2 a) +instance CoArbitrary a => CoArbitrary (V2 a) +instance Function a => Function (V2 a) + +-------------------------------------------------------------------------------- + +instance CoArbitrary Boundary +instance Function Boundary + +instance Arbitrary a => Arbitrary (Extended a) where + arbitrary = oneof [ pure NegInf + , pure PosInf + , Finite <$> arbitrary + ] + +instance CoArbitrary a => CoArbitrary (Extended a) where + coarbitrary NegInf = variant 1 + coarbitrary PosInf = variant 2 + coarbitrary (Finite x) = variant 3 . coarbitrary x + +instance (Function a) => Function (Extended a) where + function = functionMap g h + where + g NegInf = Left True + g (Finite a) = Right a + g PosInf = Left False + h (Left False) = PosInf + h (Left True) = NegInf + h (Right a) = Finite a + +instance ToJSON a => ToJSON (Extended a) where + toJSON NegInf = String "NegInf" + toJSON PosInf = String "PosInf" + toJSON (Finite x) = toJSON x + +instance FromJSON a => FromJSON (Extended a) where + parseJSON (String "NegInf") = pure NegInf + parseJSON (String "PosInf") = pure PosInf + parseJSON val = Finite <$> parseJSON val + +instance (EqProp a, Show a) => EqProp (Extended a) where + NegInf =-= NegInf = property True + PosInf =-= PosInf = property True + (Finite x) =-= (Finite y) = x =-= y + x =-= y = counterexample (show x <> " /= " <> show y) False + +instance Arbitrary Interval.Boundary where + arbitrary = elements [ Interval.Open , Interval.Closed ] + +instance (Ord r, Arbitrary r) => Arbitrary (Interval r) where + arbitrary = do + lower <- arbitrary + upper <- arbitrary + pure $ (if upper < lower then flip else id) + Interval.interval + lower + upper + +instance CoArbitrary a => CoArbitrary (Interval a) where + coarbitrary int = coarbitrary (lowerBound' int) . coarbitrary (upperBound' int) + +instance (Function a, Ord a) => Function (Interval a) where + function = functionMap g h + where + g = lowerBound' &&& upperBound' + h = uncurry interval + +deriving via (EqEqProp (Interval a)) instance Eq a => (EqProp (Interval a)) + +instance ToJSON a => ToJSON (Interval a) where + toJSON x = Array . fromList $ + [ object [ lowerKey .= lowerVal ] + , object [ upperKey .= upperVal ] + ] + where + (lowerVal, lowerBoundary) = lowerBound' x + (upperVal, upperBoundary) = upperBound' x + upperKey = boundaryToKey upperBoundary + lowerKey = boundaryToKey lowerBoundary + boundaryToKey Open = "Excluded" + boundaryToKey Closed = "Included" + +instance forall a. (FromJSON a, Ord a) => FromJSON (Interval a) where + parseJSON x = + boundPairWithBoundary x + <|> boundPairWithoutBoundary x + <|> singleVal x + where + boundPairWithBoundary = withArray "Bound pair" $ \arr -> do + checkLength arr + lower <- parseBound $ arr ^?! ix 0 + upper <- parseBound $ arr ^?! ix 1 + pure $ interval lower upper + parseBound = withObject "Bound" $ \obj -> do + when (length obj /= 1) $ fail "Expected an object with a single key" + let [(k, v)] = obj ^@.. ifolded + boundary <- case k of + "Excluded" -> pure Open + "Open" -> pure Open + "Included" -> pure Closed + "Closed" -> pure Closed + _ -> fail "Invalid boundary specification" + val <- parseJSON v + pure (val, boundary) + boundPairWithoutBoundary = withArray "Bound pair" $ \arr -> do + checkLength arr + lower <- parseJSON $ arr ^?! ix 0 + upper <- parseJSON $ arr ^?! ix 1 + pure $ lower <=..< upper + singleVal v = do + val <- parseJSON v + pure $ val <=..<= val + checkLength arr = + when (length arr /= 2) $ fail "Expected array of length 2" diff --git a/users/grfn/xanthous/src/Xanthous/Physics.hs b/users/grfn/xanthous/src/Xanthous/Physics.hs new file mode 100644 index 000000000000..37530cbbc21b --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Physics.hs @@ -0,0 +1,71 @@ +-------------------------------------------------------------------------------- +module Xanthous.Physics + ( throwDistance + , bluntThrowDamage + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Xanthous.Data + ( Meters + , (:**:)(..) + , Square + , Grams + , (|*|) + , (|/|) + , Hitpoints + , Per (..) + , squared + , Uno(..), (|+|) + ) +-------------------------------------------------------------------------------- + +-- university shotputter can put a 16 lb shot about 14 meters +-- ≈ 7.25 kg 14 meters +-- 14m = x / (7.25kg × y + z)² +-- 14m = x / (7250g × y + z)² +-- +-- we don't want to scale down too much: +-- +-- 10 kg 10 meters +-- = 10000 g 10 meters +-- +-- 15 kg w meters +-- = 15000 g w meters +-- +-- 14m = x / (7250g × y + z)² +-- 10m = x / (10000g × y + z)² +-- wm = x / (15000g × y + z)² +-- +-- w≈0.527301 ∧ y≈0.000212178 sqrt(x) ∧ z≈1.80555 sqrt(x) ∧ 22824.1 sqrt(x)!=0 +-- +-- x = 101500 +-- y = 0.0675979 +-- z = 575.231 +-- + +-- TODO make this dynamic +strength :: Meters :**: Square Grams +strength = Times 10150000 + +yCoeff :: Uno Double +yCoeff = Uno 0.0675979 + +zCoeff :: Uno Double +zCoeff = Uno 575.231 + +-- | Calculate the maximum distance an object with the given weight can be +-- thrown +throwDistance + :: Grams -- ^ Weight of the object + -> Meters -- ^ Max distance thrown +throwDistance weight = strength |/| squared (weight |*| yCoeff |+| zCoeff) + +-- | Returns the damage dealt by a blunt object with the given weight when +-- thrown +bluntThrowDamage + :: Grams + -> Hitpoints +bluntThrowDamage weight = throwDamageRatio |*| weight + where + throwDamageRatio :: Hitpoints `Per` Grams + throwDamageRatio = Rate $ 1 / 5000 diff --git a/users/grfn/xanthous/src/Xanthous/Prelude.hs b/users/grfn/xanthous/src/Xanthous/Prelude.hs new file mode 100644 index 000000000000..2cb4299303ba --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Prelude.hs @@ -0,0 +1,48 @@ +-------------------------------------------------------------------------------- +module Xanthous.Prelude + ( module ClassyPrelude + , Type + , Constraint + , module GHC.TypeLits + , module Control.Lens + , module Data.Void + , module Control.Comonad + , module Witherable + , fail + + , (&!) + + -- * Classy-Prelude addons + , ninsertSet + , ndeleteSet + , toVector + ) where +-------------------------------------------------------------------------------- +import ClassyPrelude hiding + ( return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say + , catMaybes, filter, mapMaybe, hashNub, ordNub + , Memoized, runMemoized + ) +import Data.Kind +import GHC.TypeLits hiding (Text) +import Control.Lens hiding (levels, Level) +import Data.Void +import Control.Comonad +import Witherable +import Control.Monad.Fail (fail) +-------------------------------------------------------------------------------- + +ninsertSet + :: (IsSet set, MonoPointed set) + => Element set -> NonNull set -> NonNull set +ninsertSet x xs = impureNonNull $ opoint x `union` toNullable xs + +ndeleteSet :: IsSet b => Element b -> NonNull b -> b +ndeleteSet x = deleteSet x . toNullable + +toVector :: (MonoFoldable (f a), Element (f a) ~ a) => f a -> Vector a +toVector = fromList . toList + +infixl 1 &! +(&!) :: a -> (a -> b) -> b +(&!) = flip ($!) diff --git a/users/grfn/xanthous/src/Xanthous/Random.hs b/users/grfn/xanthous/src/Xanthous/Random.hs new file mode 100644 index 000000000000..329b321b8bda --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Random.hs @@ -0,0 +1,186 @@ +-------------------------------------------------------------------------------- +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- +module Xanthous.Random + ( Choose(..) + , ChooseElement(..) + , Weighted(..) + , evenlyWeighted + , weightedBy + , subRand + , chance + , chooseSubset + , chooseRange + , FiniteInterval(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.List.NonEmpty (NonEmpty(..)) +import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom)) +import Control.Monad.Random (Rand, evalRand, mkStdGen, StdGen) +import Data.Functor.Compose +import Data.Random.Shuffle.Weighted +import Data.Random.Distribution +import Data.Random.Distribution.Uniform +import Data.Random.Distribution.Uniform.Exclusive +import Data.Random.Sample +import qualified Data.Random.Source as DRS +import Data.Interval ( Interval, lowerBound', Extended (Finite) + , upperBound', Boundary (Closed), lowerBound, upperBound + ) +-------------------------------------------------------------------------------- + +instance {-# INCOHERENT #-} (Monad m, MonadRandom m) => DRS.MonadRandom m where + getRandomWord8 = getRandom + getRandomWord16 = getRandom + getRandomWord32 = getRandom + getRandomWord64 = getRandom + getRandomDouble = getRandom + getRandomNByteInteger n = getRandomR (0, 256 ^ n) + +class Choose a where + type RandomResult a + choose :: MonadRandom m => a -> m (RandomResult a) + +newtype ChooseElement a = ChooseElement a + +instance MonoFoldable a => Choose (ChooseElement a) where + type RandomResult (ChooseElement a) = Maybe (Element a) + choose (ChooseElement xs) = do + chosenIdx <- getRandomR (0, olength xs - 1) + let pick _ (Just x) = Just x + pick (x, i) Nothing + | i == chosenIdx = Just x + | otherwise = Nothing + pure $ ofoldr pick Nothing $ zip (toList xs) [0..] + +instance MonoFoldable a => Choose (NonNull a) where + type RandomResult (NonNull a) = Element a + choose + = fmap (fromMaybe (error "unreachable")) -- why not lol + . choose + . ChooseElement + . toNullable + +instance Choose (NonEmpty a) where + type RandomResult (NonEmpty a) = a + choose = choose . fromNonEmpty @[_] + +instance Choose (a, a) where + type RandomResult (a, a) = a + choose (x, y) = choose (x :| [y]) + +newtype Weighted w t a = Weighted (t (w, a)) + deriving (Functor, Foldable) via (t `Compose` (,) w) + +deriving newtype instance Eq (t (w, a)) => Eq (Weighted w t a) +deriving newtype instance Show (t (w, a)) => Show (Weighted w t a) +deriving newtype instance NFData (t (w, a)) => NFData (Weighted w t a) + +instance Traversable t => Traversable (Weighted w t) where + traverse f (Weighted twa) = Weighted <$> (traverse . traverse) f twa + +evenlyWeighted :: [a] -> Weighted Int [] a +evenlyWeighted = Weighted . itoList + +-- | Weight the elements of some functor by a function. Larger values of 'w' per +-- its 'Ord' instance will be more likely to be generated +weightedBy :: Functor t => (a -> w) -> t a -> Weighted w t a +weightedBy weighting xs = Weighted $ (weighting &&& id) <$> xs + +instance (Num w, Ord w, Distribution Uniform w, Excludable w) + => Choose (Weighted w [] a) where + type RandomResult (Weighted w [] a) = Maybe a + choose (Weighted ws) = sample $ headMay <$> weightedSample 1 ws + +instance (Num w, Ord w, Distribution Uniform w, Excludable w) + => Choose (Weighted w NonEmpty a) where + type RandomResult (Weighted w NonEmpty a) = a + choose (Weighted ws) = + sample + $ fromMaybe (error "unreachable") . headMay + <$> weightedSample 1 (toList ws) + +subRand :: MonadRandom m => Rand StdGen a -> m a +subRand sub = evalRand sub . mkStdGen <$> getRandom + +-- | Has a @n@ chance of returning 'True' +-- +-- eg, chance 0.5 will return 'True' half the time +chance + :: (Num w, Ord w, Distribution Uniform w, Excludable w, MonadRandom m) + => w + -> m Bool +chance n = choose $ weightedBy (bool 1 (n * 2)) bools + +-- | Choose a random subset of *about* @w@ of the elements of the given +-- 'Witherable' structure +chooseSubset :: ( Num w, Ord w, Distribution Uniform w, Excludable w + , Witherable t + , MonadRandom m + ) => w -> t a -> m (t a) +chooseSubset = filterA . const . chance + +-- | Choose a random @n@ in the given interval +chooseRange + :: ( MonadRandom m + , Distribution Uniform n + , Enum n + , Bounded n + , Ord n + ) + => Interval n + -> m (Maybe n) +chooseRange int = traverse sample distribution + where + (lower, lowerBoundary) = lowerBound' int + lowerR = case lower of + Finite x -> if lowerBoundary == Closed + then x + else succ x + _ -> minBound + (upper, upperBoundary) = upperBound' int + upperR = case upper of + Finite x -> if upperBoundary == Closed + then x + else pred x + _ -> maxBound + distribution + | lowerR <= upperR = Just $ Uniform lowerR upperR + | otherwise = Nothing + +instance ( Distribution Uniform n + , Enum n + , Bounded n + , Ord n + ) + => Choose (Interval n) where + type RandomResult (Interval n) = n + choose = fmap (fromMaybe $ error "Invalid interval") . chooseRange + +newtype FiniteInterval a + = FiniteInterval { unwrapFiniteInterval :: (Interval a) } + +instance ( Distribution Uniform n + , Ord n + ) + => Choose (FiniteInterval n) where + type RandomResult (FiniteInterval n) = n + -- TODO broken with open/closed right now + choose + = sample + . uncurry Uniform + . over both getFinite + . (lowerBound &&& upperBound) + . unwrapFiniteInterval + where + getFinite (Finite x) = x + getFinite _ = error "Infinite value" + +-------------------------------------------------------------------------------- + +bools :: NonEmpty Bool +bools = True :| [False] diff --git a/users/grfn/xanthous/src/Xanthous/Util.hs b/users/grfn/xanthous/src/Xanthous/Util.hs new file mode 100644 index 000000000000..f918340f055b --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util.hs @@ -0,0 +1,351 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE QuantifiedConstraints #-} +-------------------------------------------------------------------------------- +module Xanthous.Util + ( EqEqProp(..) + , EqProp(..) + , foldlMapM + , foldlMapM' + , between + + , appendVia + + -- * Foldable + -- ** Uniqueness + -- *** Predicates on uniqueness + , isUniqueOf + , isUnique + -- *** Removing all duplicate elements in n * log n time + , uniqueOf + , unique + -- *** Removing sequentially duplicate elements in linear time + , uniqOf + , uniq + -- ** Bag sequence algorithms + , takeWhileInclusive + , smallestNotIn + , removeVectorIndex + , removeFirst + , maximum1 + , minimum1 + + -- * Combinators + , times, times_, endoTimes + + -- * State utilities + , modifyK, modifyKL, useListOf + + -- * Type-level programming utils + , KnownBool(..) + + -- * + , AlphaChar(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (foldr) +-------------------------------------------------------------------------------- +import Test.QuickCheck.Checkers +import Data.Foldable (foldr) +import Data.Monoid +import Data.Proxy +import qualified Data.Vector as V +import Data.Semigroup (Max(..), Min(..)) +import Data.Semigroup.Foldable +import Control.Monad.State.Class +import Control.Monad.State (evalState) +-------------------------------------------------------------------------------- + +newtype EqEqProp a = EqEqProp a + deriving newtype Eq + +instance Eq a => EqProp (EqEqProp a) where + (=-=) = eq + +foldlMapM :: forall g b a m. (Foldable g, Monoid b, Applicative m) => (a -> m b) -> g a -> m b +foldlMapM f = foldr f' (pure mempty) + where + f' :: a -> m b -> m b + f' x = liftA2 mappend (f x) + +-- Strict in the monoidal accumulator. For monads strict +-- in the left argument of bind, this will run in constant +-- space. +foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b +foldlMapM' f xs = foldr f' pure xs mempty + where + f' :: a -> (b -> m b) -> b -> m b + f' x k bl = do + br <- f x + let !b = mappend bl br + k b + +-- | Returns whether the third argument is in the range given by the first two +-- arguments, inclusive +-- +-- >>> between (0 :: Int) 2 2 +-- True +-- +-- >>> between (0 :: Int) 2 3 +-- False +between + :: Ord a + => a -- ^ lower bound + -> a -- ^ upper bound + -> a -- ^ scrutinee + -> Bool +between lower upper x = x >= lower && x <= upper + +-- | +-- >>> appendVia Sum 1 2 +-- 3 +appendVia :: (Rewrapping s t, Semigroup s) => (Unwrapped s -> s) -> Unwrapped s -> Unwrapped s -> Unwrapped s +appendVia wrap x y = op wrap $ wrap x <> wrap y + +-------------------------------------------------------------------------------- + +-- | Returns True if the targets of the given 'Fold' are unique per the 'Ord' instance for @a@ +-- +-- >>> isUniqueOf (folded . _1) ([(1, 2), (2, 2), (3, 2)] :: [(Int, Int)]) +-- True +-- +-- >>> isUniqueOf (folded . _2) ([(1, 2), (2, 2), (3, 2)] :: [(Int, Int)]) +-- False +-- +-- @ +-- 'isUniqueOf' :: Ord a => 'Getter' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Fold' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Lens'' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Iso'' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Traversal'' s a -> s -> 'Bool' +-- 'isUniqueOf' :: Ord a => 'Prism'' s a -> s -> 'Bool' +-- @ +isUniqueOf :: Ord a => Getting (Endo (Set a, Bool)) s a -> s -> Bool +isUniqueOf aFold = orOf _2 . foldrOf aFold rejectUnique (mempty, True) + where + rejectUnique x (seen, acc) + | seen ^. contains x = (seen, False) + | otherwise = (seen & contains x .~ True, acc) + +-- | Returns true if the given 'Foldable' container contains only unique +-- elements, as determined by the 'Ord' instance for @a@ +-- +-- >>> isUnique ([3, 1, 2] :: [Int]) +-- True +-- +-- >>> isUnique ([1, 1, 2, 2, 3, 1] :: [Int]) +-- False +isUnique :: (Foldable f, Ord a) => f a -> Bool +isUnique = isUniqueOf folded + + +-- | O(n * log n). Returns a monoidal, 'Cons'able container (a list, a Set, +-- etc.) consisting of the unique (per the 'Ord' instance for @a@) targets of +-- the given 'Fold' +-- +-- >>> uniqueOf (folded . _2) ([(1, 2), (2, 2), (3, 2), (4, 3)] :: [(Int, Int)]) :: [Int] +-- [2,3] +-- +-- @ +-- 'uniqueOf' :: Ord a => 'Getter' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Fold' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Lens'' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Iso'' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Traversal'' s a -> s -> [a] +-- 'uniqueOf' :: Ord a => 'Prism'' s a -> s -> [a] +-- @ +uniqueOf + :: (Monoid c, Ord w, Cons c c w w) => Getting (Endo (Set w, c)) a w -> a -> c +uniqueOf aFold = snd . foldrOf aFold rejectUnique (mempty, mempty) + where + rejectUnique x (seen, acc) + | seen ^. contains x = (seen, acc) + | otherwise = (seen & contains x .~ True, cons x acc) + +-- | Returns a monoidal, 'Cons'able container (a list, a Set, etc.) consisting +-- of the unique (per the 'Ord' instance for @a@) contents of the given +-- 'Foldable' container +-- +-- >>> unique [1, 1, 2, 2, 3, 1] :: [Int] +-- [2,3,1] + +-- >>> unique [1, 1, 2, 2, 3, 1] :: Set Int +-- fromList [3,2,1] +unique :: (Foldable f, Cons c c a a, Ord a, Monoid c) => f a -> c +unique = uniqueOf folded + +-------------------------------------------------------------------------------- + +-- | O(n). Returns a monoidal, 'Cons'able container (a list, a Vector, etc.) +-- consisting of the targets of the given 'Fold' with sequential duplicate +-- elements removed +-- +-- This function (sorry for the confusing name) differs from 'uniqueOf' in that +-- it only compares /sequentially/ duplicate elements (and thus operates in +-- linear time). +-- cf 'Data.Vector.uniq' and POSIX @uniq@ for the name +-- +-- >>> uniqOf (folded . _2) ([(1, 2), (2, 2), (3, 1), (4, 2)] :: [(Int, Int)]) :: [Int] +-- [2,1,2] +-- +-- @ +-- 'uniqOf' :: Eq a => 'Getter' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Fold' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Lens'' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Iso'' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Traversal'' s a -> s -> [a] +-- 'uniqOf' :: Eq a => 'Prism'' s a -> s -> [a] +-- @ +uniqOf :: (Monoid c, Cons c c w w, Eq w) => Getting (Endo (Maybe w, c)) a w -> a -> c +uniqOf aFold = snd . foldrOf aFold rejectSeen (Nothing, mempty) + where + rejectSeen x (Nothing, acc) = (Just x, x <| acc) + rejectSeen x tup@(Just a, acc) + | x == a = tup + | otherwise = (Just x, x <| acc) + +-- | O(n). Returns a monoidal, 'Cons'able container (a list, a Vector, etc.) +-- consisting of the targets of the given 'Foldable' container with sequential +-- duplicate elements removed +-- +-- This function (sorry for the confusing name) differs from 'unique' in that +-- it only compares /sequentially/ unique elements (and thus operates in linear +-- time). +-- cf 'Data.Vector.uniq' and POSIX @uniq@ for the name +-- +-- >>> uniq [1, 1, 1, 2, 2, 2, 3, 3, 1] :: [Int] +-- [1,2,3,1] +-- +-- >>> uniq [1, 1, 1, 2, 2, 2, 3, 3, 1] :: Vector Int +-- [1,2,3,1] +-- +uniq :: (Foldable f, Eq a, Cons c c a a, Monoid c) => f a -> c +uniq = uniqOf folded + +-- | Like 'takeWhile', but inclusive +takeWhileInclusive :: (a -> Bool) -> [a] -> [a] +takeWhileInclusive _ [] = [] +takeWhileInclusive p (x:xs) = x : if p x then takeWhileInclusive p xs else [] + +-- | Returns the smallest value not in a list +smallestNotIn :: (Ord a, Bounded a, Enum a) => [a] -> a +smallestNotIn xs = case uniq $ sort xs of + [] -> minBound + xs'@(x : _) + | x > minBound -> minBound + | otherwise + -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..] + +-- | Remove the element at the given index, if any, from the given vector +removeVectorIndex :: Int -> Vector a -> Vector a +removeVectorIndex idx vect = + let (before, after) = V.splitAt idx vect + in before <> fromMaybe Empty (tailMay after) + +-- | Remove the first element in a sequence that matches a given predicate +removeFirst :: IsSequence seq => (Element seq -> Bool) -> seq -> seq +removeFirst p + = flip evalState False + . filterM (\x -> do + found <- get + let matches = p x + when matches $ put True + pure $ found || not matches) + +maximum1 :: (Ord a, Foldable1 f) => f a -> a +maximum1 = getMax . foldMap1 Max + +minimum1 :: (Ord a, Foldable1 f) => f a -> a +minimum1 = getMin . foldMap1 Min + +times :: (Applicative f, Num n, Enum n) => n -> (n -> f b) -> f [b] +times n f = traverse f [1..n] + +times_ :: (Applicative f, Num n, Enum n) => n -> f a -> f [a] +times_ n fa = times n (const fa) + +-- | Multiply an endomorphism by an integral +-- +-- >>> endoTimes (4 :: Int) succ (5 :: Int) +-- 9 +endoTimes :: Integral n => n -> (a -> a) -> a -> a +endoTimes n f = appEndo $ stimes n (Endo f) + +-------------------------------------------------------------------------------- + +-- | This class gives a boolean associated with a type-level bool, a'la +-- 'KnownSymbol', 'KnownNat' etc. +class KnownBool (bool :: Bool) where + boolVal' :: forall proxy. proxy bool -> Bool + boolVal' _ = boolVal @bool + + boolVal :: Bool + boolVal = boolVal' $ Proxy @bool + +instance KnownBool 'True where boolVal = True +instance KnownBool 'False where boolVal = False + +-------------------------------------------------------------------------------- + +-- | Modify some monadic state via the application of a kleisli endomorphism on +-- the state itself +-- +-- Note that any changes made to the state during execution of @k@ will be +-- overwritten +-- +-- @@ +-- modifyK pure === pure () +-- @@ +modifyK :: MonadState s m => (s -> m s) -> m () +modifyK k = get >>= k >>= put + +-- | Modify some monadic state via the application of a kleisli endomorphism on +-- the target of a lens +-- +-- Note that any changes made to the state during execution of @k@ will be +-- overwritten +-- +-- @@ +-- modifyKL id pure === pure () +-- @@ +modifyKL :: MonadState s m => LensLike m s s a b -> (a -> m b) -> m () +modifyKL l k = get >>= traverseOf l k >>= put + +-- | Use a list of all the targets of a 'Fold' in the current state +-- +-- @@ +-- evalState (useListOf folded) === toList +-- @@ +useListOf :: MonadState s m => Getting (Endo [a]) s a -> m [a] +useListOf = gets . toListOf + +-------------------------------------------------------------------------------- + +-- | A newtype wrapper around 'Char' whose 'Enum' and 'Bounded' instances only +-- include the characters @[a-zA-Z]@ +-- +-- >>> succ (AlphaChar 'z') +-- 'A' +newtype AlphaChar = AlphaChar { getAlphaChar :: Char } + deriving stock Show + deriving (Eq, Ord) via Char + +instance Enum AlphaChar where + toEnum n + | between 0 25 n + = AlphaChar . toEnum $ n + fromEnum 'a' + | between 26 51 n + = AlphaChar . toEnum $ n - 26 + fromEnum 'A' + | otherwise + = error $ "Tag " <> show n <> " out of range [0, 51] for enum AlphaChar" + fromEnum (AlphaChar chr) + | between 'a' 'z' chr + = fromEnum chr - fromEnum 'a' + | between 'A' 'Z' chr + = fromEnum chr - fromEnum 'A' + | otherwise + = error $ "Invalid value for alpha char: " <> show chr + +instance Bounded AlphaChar where + minBound = AlphaChar 'a' + maxBound = AlphaChar 'Z' diff --git a/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs b/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs new file mode 100644 index 000000000000..9e158cc8e2d4 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs @@ -0,0 +1,24 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.Comonad + ( -- * Store comonad utils + replace + , current + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Control.Comonad.Store.Class +-------------------------------------------------------------------------------- + +-- | Replace the current position of a store comonad with a new value by +-- comparing positions +replace :: (Eq i, ComonadStore i w) => w a -> a -> w a +replace w x = w =>> \w' -> if pos w' == pos w then x else extract w' +{-# INLINE replace #-} + +-- | Lens into the current position of a store comonad. +-- +-- current = lens extract replace +current :: (Eq i, ComonadStore i w) => Lens' (w a) a +current = lens extract replace +{-# INLINE current #-} diff --git a/users/grfn/xanthous/src/Xanthous/Util/Graph.hs b/users/grfn/xanthous/src/Xanthous/Util/Graph.hs new file mode 100644 index 000000000000..8e5c04f4bfa9 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util/Graph.hs @@ -0,0 +1,33 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.Graph where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Graph.Inductive.Query.MST (msTree) +import qualified Data.Graph.Inductive.Graph as Graph +import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.Basic (undir) +import Data.Set (isSubsetOf) +-------------------------------------------------------------------------------- + +mstSubGraph + :: forall gr node edge. (DynGraph gr, Real edge, Show edge) + => gr node edge -> gr node edge +mstSubGraph graph = insEdges mstEdges . insNodes (labNodes graph) $ Graph.empty + where + mstEdges = ordNub $ do + LP path <- msTree $ undir graph + case path of + [] -> [] + [_] -> [] + ((n₂, edgeWeight) : (n₁, _) : _) -> + pure (n₁, n₂, edgeWeight) + +isSubGraphOf + :: (Graph gr1, Graph gr2, Ord node, Ord edge) + => gr1 node edge + -> gr2 node edge + -> Bool +isSubGraphOf graph₁ graph₂ + = setFromList (labNodes graph₁) `isSubsetOf` setFromList (labNodes graph₂) + && setFromList (labEdges graph₁) `isSubsetOf` setFromList (labEdges graph₂) diff --git a/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs b/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs new file mode 100644 index 000000000000..0cb009f45ad0 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE TemplateHaskell #-} +-- | Graphics algorithms and utils for rendering things in 2D space +-------------------------------------------------------------------------------- +module Xanthous.Util.Graphics + ( circle + , filledCircle + , line + , straightLine + , delaunay + + -- * Debugging and testing tools + , renderBooleanGraphics + , showBooleanGraphics + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +-- https://github.com/noinia/hgeometry/issues/28 +-- import qualified Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer +-- as Geometry +import qualified Algorithms.Geometry.DelaunayTriangulation.Naive + as Geometry +import qualified Algorithms.Geometry.DelaunayTriangulation.Types as Geometry +import Control.Monad.State (execState, State) +import qualified Data.Geometry.Point as Geometry +import Data.Ext ((:+)(..)) +import Data.List (unfoldr) +import Data.List.NonEmpty (NonEmpty((:|))) +import qualified Data.List.NonEmpty as NE +import Data.Ix (Ix) +import Linear.V2 +-------------------------------------------------------------------------------- + + +-- | Generate a circle centered at the given point and with the given radius +-- using the <midpoint circle algorithm +-- https://en.wikipedia.org/wiki/Midpoint_circle_algorithm>. +-- +-- Code taken from <https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#Haskell> +circle :: (Num i, Ord i) + => V2 i -- ^ center + -> i -- ^ radius + -> [V2 i] +circle (V2 x₀ y₀) radius + -- Four initial points, plus the generated points + = V2 x₀ (y₀ + radius) + : V2 x₀ (y₀ - radius) + : V2 (x₀ + radius) y₀ + : V2 (x₀ - radius) y₀ + : points + where + -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets. + points = concatMap generatePoints $ unfoldr step initialValues + + generatePoints (V2 x y) + = [ V2 (x₀ `xop` x') (y₀ `yop` y') + | (x', y') <- [(x, y), (y, x)] + , xop <- [(+), (-)] + , yop <- [(+), (-)] + ] + + initialValues = (1 - radius, 1, (-2) * radius, 0, radius) + + step (f, ddf_x, ddf_y, x, y) + | x >= y = Nothing + | otherwise = Just (V2 x' y', (f', ddf_x', ddf_y', x', y')) + where + (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1) + | otherwise = (f + ddf_x, ddf_y, y) + ddf_x' = ddf_x + 2 + x' = x + 1 + + +data FillState i + = FillState + { _inCircle :: Bool + , _result :: NonEmpty (V2 i) + } +makeLenses ''FillState + +runFillState :: NonEmpty (V2 i) -> State (FillState i) a -> [V2 i] +runFillState circumference s + = toList + . view result + . execState s + $ FillState False circumference + +-- | Generate a *filled* circle centered at the given point and with the given +-- radius by filling a circle generated with 'circle' +filledCircle :: (Num i, Integral i, Ix i) + => V2 i -- ^ center + -> i -- ^ radius + -> [V2 i] +filledCircle center radius = + case NE.nonEmpty (circle center radius) of + Nothing -> [] + Just circumference -> runFillState circumference $ + -- the first and last lines of all circles are solid, so the whole "in the + -- circle, out of the circle" thing doesn't work... but that's fine since + -- we don't need to fill them. So just skip them + for_ [succ minX..pred maxX] $ \x -> + for_ [minY..maxY] $ \y -> do + let pt = V2 x y + next = V2 x $ succ y + whenM (use inCircle) $ result %= NE.cons pt + + when (pt `elem` circumference && next `notElem` circumference) + $ inCircle %= not + + where + (V2 minX minY, V2 maxX maxY) = minmaxes circumference + +-- | Draw a line between two points using Bresenham's line drawing algorithm +-- +-- Code taken from <https://wiki.haskell.org/Bresenham%27s_line_drawing_algorithm> +line :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i] +line pa@(V2 xa ya) pb@(V2 xb yb) + = (if maySwitch pa < maySwitch pb then id else reverse) points + where + points = map maySwitch . unfoldr go $ (x₁, y₁, 0) + steep = abs (yb - ya) > abs (xb - xa) + maySwitch = if steep then view _yx else id + [V2 x₁ y₁, V2 x₂ y₂] = sort [maySwitch pa, maySwitch pb] + δx = x₂ - x₁ + δy = abs (y₂ - y₁) + ystep = if y₁ < y₂ then 1 else -1 + go (xTemp, yTemp, err) + | xTemp > x₂ = Nothing + | otherwise = Just (V2 xTemp yTemp, (xTemp + 1, newY, newError)) + where + tempError = err + δy + (newY, newError) = if (2 * tempError) >= δx + then (yTemp + ystep, tempError - δx) + else (yTemp, tempError) +{-# SPECIALIZE line :: V2 Int -> V2 Int -> [V2 Int] #-} +{-# SPECIALIZE line :: V2 Word -> V2 Word -> [V2 Word] #-} + +straightLine :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i] +straightLine pa@(V2 xa _) pb@(V2 _ yb) = line pa midpoint ++ line midpoint pb + where midpoint = V2 xa yb + +delaunay + :: (Ord n, Fractional n) + => NonEmpty (V2 n, p) + -> [((V2 n, p), (V2 n, p))] +delaunay + = map (over both fromPoint) + . Geometry.edgesAsPoints + . Geometry.delaunayTriangulation + . map toPoint + where + toPoint (V2 px py, pid) = Geometry.Point2 px py :+ pid + fromPoint (Geometry.Point2 px py :+ pid) = (V2 px py, pid) + +-------------------------------------------------------------------------------- + +renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> String +renderBooleanGraphics [] = "" +renderBooleanGraphics (pt : pts') = intercalate "\n" rows + where + rows = row <$> [minX..maxX] + row x = [minY..maxY] <&> \y -> if V2 x y `member` ptSet then 'X' else ' ' + (V2 minX minY, V2 maxX maxY) = minmaxes pts + pts = pt :| pts' + ptSet :: Set (V2 i) + ptSet = setFromList $ toList pts + +showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> IO () +showBooleanGraphics = putStrLn . pack . renderBooleanGraphics + +minmaxes :: forall i. (Ord i) => NonEmpty (V2 i) -> (V2 i, V2 i) +minmaxes xs = + ( V2 (minimum1Of (traverse1 . _x) xs) + (minimum1Of (traverse1 . _y) xs) + , V2 (maximum1Of (traverse1 . _x) xs) + (maximum1Of (traverse1 . _y) xs) + ) diff --git a/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs b/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs new file mode 100644 index 000000000000..724f2339dd21 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs @@ -0,0 +1,14 @@ + +module Xanthous.Util.Inflection + ( toSentence + ) where + +import Xanthous.Prelude + +toSentence :: (MonoFoldable mono, Element mono ~ Text) => mono -> Text +toSentence xs = case reverse . toList $ xs of + [] -> "" + [x] -> x + [b, a] -> a <> " and " <> b + (final : butlast) -> + intercalate ", " (reverse butlast) <> ", and " <> final diff --git a/users/grfn/xanthous/src/Xanthous/Util/JSON.hs b/users/grfn/xanthous/src/Xanthous/Util/JSON.hs new file mode 100644 index 000000000000..91d1328e4a10 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util/JSON.hs @@ -0,0 +1,19 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.JSON + ( ReadShowJSON(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Data.Aeson +-------------------------------------------------------------------------------- + +newtype ReadShowJSON a = ReadShowJSON a + deriving newtype (Read, Show) + +instance Show a => ToJSON (ReadShowJSON a) where + toJSON = toJSON . show + +instance Read a => FromJSON (ReadShowJSON a) where + parseJSON = withText "readable" + $ maybe (fail "Could not read") pure . readMay diff --git a/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs b/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs new file mode 100644 index 000000000000..dfa65372351d --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs @@ -0,0 +1,21 @@ +-------------------------------------------------------------------------------- +module Xanthous.Util.Optparse + ( readWithGuard + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import qualified Options.Applicative as Opt +-------------------------------------------------------------------------------- + +readWithGuard + :: Read b + => (b -> Bool) + -> (b -> String) + -> Opt.ReadM b +readWithGuard predicate errmsg = do + res <- Opt.auto + unless (predicate res) + $ Opt.readerError + $ errmsg res + pure res diff --git a/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs b/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs new file mode 100644 index 000000000000..be12bc294513 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE UndecidableInstances #-} +module Xanthous.Util.QuickCheck + ( functionShow + , FunctionShow(..) + , functionJSON + , FunctionJSON(..) + , genericArbitrary + , GenericArbitrary(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Test.QuickCheck +import Test.QuickCheck.Function +import Test.QuickCheck.Instances.ByteString () +import Test.QuickCheck.Arbitrary.Generic +import Data.Aeson +import GHC.Generics (Rep) +-------------------------------------------------------------------------------- + +newtype FunctionShow a = FunctionShow a + deriving newtype (Show, Read) + +instance (Show a, Read a) => Function (FunctionShow a) where + function = functionShow + +functionJSON :: (ToJSON a, FromJSON a) => (a -> c) -> a :-> c +functionJSON = functionMap encode (headEx . decode) + +newtype FunctionJSON a = FunctionJSON a + deriving newtype (ToJSON, FromJSON) + +instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where + function = functionJSON + +-------------------------------------------------------------------------------- + +newtype GenericArbitrary a = GenericArbitrary a + deriving newtype Generic + +instance (Generic a, GArbitrary rep, Rep a ~ rep) + => Arbitrary (GenericArbitrary a) where + arbitrary = genericArbitrary diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml new file mode 100644 index 000000000000..27ee841dd9db --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/messages.yaml @@ -0,0 +1,161 @@ +welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? Use hjklybnu to move. +dead: + - You have died... + - You die... + - You perish... + - You have perished... + +generic: + continue: Press enter to continue... + +save: + disabled: "Sorry, saving is currently disabled" + location: "Enter filename to save to: " + overwrite: "A file named {{filename}} already exists. Would you like to overwrite it? " + +quit: + confirm: Really quit without saving? + +entities: + description: You see here {{entityDescriptions}} + say: + creature: + visible: The {{creature.creatureType.name}} {{creature.creatureType.sayVerb}} "{{message}}" + invisible: You hear something yell "{{message}}" in the distance + +pickUp: + menu: What would you like to pick up? + pickUp: You pick up the {{item.itemType.name}}. + nothingToPickUp: "There's nothing here to pick up" + +cant: + goUp: + - You can't go up here + - There's nothing here that would let you go up + goDown: + - You can't go down here + - There's nothing here that would let you go down + +open: + prompt: Direction to open (hjklybnu.)? + success: "You open the door." + locked: "That door is locked" + nothingToOpen: "There's nothing to open there." + alreadyOpen: "That door is already open." + +close: + prompt: Direction to close (hjklybnu.)? + success: + - You close the door. + - You shut the door. + nothingToClose: "There's nothing to close there." + alreadyClosed: "That door is already closed." + blocked: "The {{entityDescriptions}} {{blockOrBlocks}} the door!" + +look: + prompt: Select a position on the map to describe (use Enter to confirm) + nothing: There's nothing there + +character: + namePrompt: "What's your name? " + body: + knuckles: + calluses: + - You've started developing calluses on your knuckles from all the punching you've been doing. + - You've been fighting with your fists so much they're starting to develop calluses. + +combat: + nothingToAttack: There's nothing to attack there. + menu: Which creature would you like to attack? + fistSelfDamage: + - You hit so hard with your fists you hurt yourself! + - The punch leaves your knuckles bloody! + fistExtraSelfDamage: + - You hurt your already-bloody fists with the strike! + - Ouch! Your fists were already bleeding! + hit: + fists: + - You punch the {{creature.creatureType.name}} with your bare fists! It hurts. A lot. + - You strike the {{creature.creatureType.name}} with your bare fists! It leaves a bit of a bruise on your knuckles. + generic: + - You hit the {{creature.creatureType.name}}. + - You attack the {{creature.creatureType.name}}. + creatureAttack: + natural: The {{creature.creatureType.name}} {{attackDescription}}. + genericWeapon: The {{creature.creatureType.name}} attacks you with its {{item.itemType.name}}. + killed: + - You kill the {{creature.creatureType.name}}! + - You've killed the {{creature.creatureType.name}}! + +debug: + toggleRevealAll: revealAll now set to {{revealAll}} + +eat: + noFood: + - You have nothing edible. + - You don't have any food. + - You don't have anything to eat. + - You search your pockets for something edible, and come up short. + menuPrompt: What would you like to eat? + eat: You eat the {{item.itemType.name}}. + +read: + prompt: Direction to read (hjklybnu.)? + nothing: "There's nothing there to read" + result: "\"{{message}}\"" + +inventory: + describe: + select: Select an item in your inventory to describe + nothing: You aren't carrying anything + +wield: + nothing: + - You aren't carrying anything you can wield + - You can't wield anything in your backpack + - You can't wield anything currently in your backpack + menu: What would you like to wield? + # TODO: use actual hands + wielded : You wield the {{wieldedItem.itemType.name}} in your right hand. + +fire: + nothing: + - You don't currently have anything you can throw + - You don't have anything to throw + zeroRange: + - That item is too heavy to throw! + - That's too heavy to throw + - You're not strong enough to throw that any meaningful distance + menu: What would you like to throw? + target: Choose a target + atRange: + - It's too heavy for you to throw any further than this + fired: + noTarget: + - You throw the {{item.itemType.name}} at the ground + noDamage: + - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to care. + - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to do anything. + - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to hurt it. + someDamage: + - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It hits it on the head!. + +drop: + nothing: You aren't carrying anything + menu: What would you like to drop? + # TODO: use actual hands + dropped: + - You drop the {{item.itemType.name}}. + - You drop the {{item.itemType.name}} on the ground. + - You put the {{item.itemType.name}} on the ground. + - You take the {{item.itemType.name}} out of your backpack and put it on the ground. + - You take the {{item.itemType.name}} out of your backpack and drop it on the ground. + +autocommands: + enemyInSight: There's a {{firstEntity.creatureType.name}} nearby! + resting: Resting... + doneResting: Done resting +### + +tutorial: + message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance! You can pick items up with ,. diff --git a/users/grfn/xanthous/test/Spec.hs b/users/grfn/xanthous/test/Spec.hs new file mode 100644 index 000000000000..64c10cf21e20 --- /dev/null +++ b/users/grfn/xanthous/test/Spec.hs @@ -0,0 +1,59 @@ +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Xanthous.Data.EntitiesSpec +import qualified Xanthous.Data.EntityCharSpec +import qualified Xanthous.Data.EntityMap.GraphicsSpec +import qualified Xanthous.Data.EntityMapSpec +import qualified Xanthous.Data.LevelsSpec +import qualified Xanthous.Data.MemoSpec +import qualified Xanthous.Data.NestedMapSpec +import qualified Xanthous.DataSpec +import qualified Xanthous.Entities.CommonSpec +import qualified Xanthous.Entities.RawsSpec +import qualified Xanthous.Entities.RawTypesSpec +import qualified Xanthous.Entities.CharacterSpec +import qualified Xanthous.GameSpec +import qualified Xanthous.Game.StateSpec +import qualified Xanthous.Game.PromptSpec +import qualified Xanthous.Generators.Level.UtilSpec +import qualified Xanthous.MessageSpec +import qualified Xanthous.Messages.TemplateSpec +import qualified Xanthous.OrphansSpec +import qualified Xanthous.RandomSpec +import qualified Xanthous.Util.GraphSpec +import qualified Xanthous.Util.GraphicsSpec +import qualified Xanthous.Util.InflectionSpec +import qualified Xanthous.UtilSpec +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMainWithRerun test + +test :: TestTree +test = testGroup "Xanthous" + [ Xanthous.Data.EntitiesSpec.test + , Xanthous.Data.EntityMap.GraphicsSpec.test + , Xanthous.Data.EntityMapSpec.test + , Xanthous.Data.LevelsSpec.test + , Xanthous.Data.MemoSpec.test + , Xanthous.Data.NestedMapSpec.test + , Xanthous.DataSpec.test + , Xanthous.Entities.CommonSpec.test + , Xanthous.Entities.RawsSpec.test + , Xanthous.Entities.CharacterSpec.test + , Xanthous.Entities.RawTypesSpec.test + , Xanthous.GameSpec.test + , Xanthous.Game.StateSpec.test + , Xanthous.Game.PromptSpec.test + , Xanthous.Generators.Level.UtilSpec.test + , Xanthous.MessageSpec.test + , Xanthous.Messages.TemplateSpec.test + , Xanthous.OrphansSpec.test + , Xanthous.RandomSpec.test + , Xanthous.Util.GraphSpec.test + , Xanthous.Util.GraphicsSpec.test + , Xanthous.Util.InflectionSpec.test + , Xanthous.UtilSpec.test + , Xanthous.Data.EntityCharSpec.test + ] diff --git a/users/grfn/xanthous/test/Test/Prelude.hs b/users/grfn/xanthous/test/Test/Prelude.hs new file mode 100644 index 000000000000..75c1ebf5e76a --- /dev/null +++ b/users/grfn/xanthous/test/Test/Prelude.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- +module Test.Prelude + ( module Xanthous.Prelude + , module Test.Tasty + , module Test.Tasty.HUnit + , module Test.Tasty.QuickCheck + , module Test.Tasty.Ingredients.Rerun + , module Test.QuickCheck.Classes + , testBatch + , jsonRoundTrip + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (assert, elements) +-------------------------------------------------------------------------------- +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.Ingredients.Rerun +import Test.QuickCheck.Classes +import Test.QuickCheck.Checkers (TestBatch, EqProp ((=-=))) +import Test.QuickCheck.Instances.ByteString () +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +import Data.Aeson (ToJSON, FromJSON) +-------------------------------------------------------------------------------- + +testBatch :: TestBatch -> TestTree +testBatch (name, tests) = testGroup name $ uncurry testProperty <$> tests + +jsonRoundTrip + :: forall a. (ToJSON a, FromJSON a, EqProp a, Arbitrary a, Show a) => TestTree +jsonRoundTrip = testProperty "JSON round trip" $ \(x :: a) -> + JSON.decode (JSON.encode x) =-= Just x diff --git a/users/grfn/xanthous/test/Xanthous/Data/EntitiesSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntitiesSpec.hs new file mode 100644 index 000000000000..e403503743c0 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Data/EntitiesSpec.hs @@ -0,0 +1,28 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.EntitiesSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Data.Entities +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.Entities" + [ testGroup "Collision" + [ testProperty "JSON round-trip" $ \(c :: Collision) -> + JSON.decode (JSON.encode c) === Just c + , testGroup "JSON encoding examples" + [ testCase "Stop" $ JSON.encode Stop @?= "\"Stop\"" + , testCase "Combat" $ JSON.encode Combat @?= "\"Combat\"" + ] + ] + , testGroup "EntityAttributes" + [ testProperty "JSON round-trip" $ \(ea :: EntityAttributes) -> + JSON.decode (JSON.encode ea) === Just ea + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Data/EntityCharSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntityCharSpec.hs new file mode 100644 index 000000000000..9e8024c9d223 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Data/EntityCharSpec.hs @@ -0,0 +1,18 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityCharSpec where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Data.EntityChar +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.EntityChar" + [ testProperty "JSON round-trip" $ \(ec :: EntityChar) -> + JSON.decode (JSON.encode ec) === Just ec + ] diff --git a/users/grfn/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs new file mode 100644 index 000000000000..fd37548ce864 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs @@ -0,0 +1,57 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityMap.GraphicsSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Data +import Xanthous.Data.EntityMap +import Xanthous.Data.EntityMap.Graphics +import Xanthous.Entities.Environment (Wall(..)) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.EntityMap.Graphics" + [ testGroup "visiblePositions" + [ testProperty "one step in each cardinal direction is always visible" + $ \pos (Cardinal dir) (Positive r) (wallPositions :: Set Position)-> + pos `notMember` wallPositions ==> + let em = review _EntityMap . map (, Wall) . toList $ wallPositions + em' = em & atPosition (move dir pos) %~ (Wall <|) + poss = visiblePositions pos r em' + in counterexample ("visiblePositions: " <> show poss) + $ move dir pos `member` poss + , testGroup "bugs" + [ testCase "non-contiguous bug 1" + $ let charPos = Position 20 20 + gormlakPos = Position 17 19 + em = insertAt gormlakPos TestEntity + . insertAt charPos TestEntity + $ mempty + visPositions = visiblePositions charPos 12 em + in (gormlakPos `member` visPositions) @? + ( "not (" + <> show gormlakPos <> " `member` " + <> show visPositions + <> ")" + ) + ] + ] + ] + +-------------------------------------------------------------------------------- + +data TestEntity = TestEntity + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON, NFData) + +instance Brain TestEntity where + step _ = pure +instance Draw TestEntity +instance Entity TestEntity where + description _ = "" + entityChar _ = "e" diff --git a/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs new file mode 100644 index 000000000000..7c5cad019616 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE ApplicativeDo #-} +-------------------------------------------------------------------------------- +module Xanthous.Data.EntityMapSpec where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Data.EntityMap +import Xanthous.Data (Positioned(..)) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = localOption (QuickCheckTests 20) + $ testGroup "Xanthous.Data.EntityMap" + [ testBatch $ monoid @(EntityMap Int) mempty + , testGroup "Deduplicate" + [ testGroup "Semigroup laws" + [ testProperty "associative" $ \(a :: Deduplicate (EntityMap Int)) b c -> + a <> (b <> c) === (a <> b) <> c + ] + ] + , testGroup "Eq laws" + [ testProperty "reflexivity" $ \(em :: EntityMap Int) -> + em == em + , testProperty "symmetric" $ \(em₁ :: EntityMap Int) em₂ -> + (em₁ == em₂) == (em₂ == em₁) + , testProperty "transitive" $ \(em₁ :: EntityMap Int) em₂ em₃ -> + if (em₁ == em₂ && em₂ == em₃) + then (em₁ == em₃) + else True + ] + , testGroup "JSON encoding/decoding" + [ testProperty "round-trips" $ \(em :: EntityMap Int) -> + let em' = JSON.decode (JSON.encode em) + in counterexample (show (em' ^? _Just . lastID, em ^. lastID + , em' ^? _Just . byID == em ^. byID . re _Just + , em' ^? _Just . byPosition == em ^. byPosition . re _Just + , em' ^? _Just . _EntityMap == em ^. _EntityMap . re _Just + )) + $ em' === Just em + , testProperty "Preserves IDs" $ \(em :: EntityMap Int) -> + let Just em' = JSON.decode $ JSON.encode em + in toEIDsAndPositioned em' === toEIDsAndPositioned em + ] + + , localOption (QuickCheckTests 50) + $ testGroup "atPosition" + [ testProperty "setget" $ \pos (em :: EntityMap Int) es -> + view (atPosition pos) (set (atPosition pos) es em) === es + , testProperty "getset" $ \pos (em :: EntityMap Int) -> + set (atPosition pos) (view (atPosition pos) em) em === em + , testProperty "setset" $ \pos (em :: EntityMap Int) es -> + (set (atPosition pos) es . set (atPosition pos) es) em + === + set (atPosition pos) es em + -- testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos + , testProperty "preserves IDs" $ \(em :: EntityMap Int) e1 e2 p -> + let (eid, em') = insertAtReturningID p e1 em + em'' = em' & atPosition p %~ (e2 <|) + in + counterexample ("em': " <> show em') + . counterexample ("em'': " <> show em'') + $ em'' ^. at eid === Just (Positioned p e1) + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs new file mode 100644 index 000000000000..a7528331627d --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs @@ -0,0 +1,66 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.LevelsSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +-------------------------------------------------------------------------------- +import Xanthous.Util (between) +import Xanthous.Data.Levels +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.Levels" + [ testGroup "current" + [ testProperty "view is extract" $ \(levels :: Levels Int) -> + levels ^. current === extract levels + , testProperty "set replaces current" $ \(levels :: Levels Int) new -> + extract (set current new levels) === new + , testProperty "set extract is id" $ \(levels :: Levels Int) -> + set current (extract levels) levels === levels + , testProperty "set y ∘ set x ≡ set y" $ \(levels :: Levels Int) x y -> + set current y (set current x levels) === set current y levels + ] + , localOption (QuickCheckTests 20) + $ testBatch $ semigroup @(Levels Int) (error "unused", 1 :: Int) + , testGroup "next/prev" + [ testGroup "nextLevel" + [ testProperty "seeks forwards" $ \(levels :: Levels Int) genned -> + (pos . runIdentity . nextLevel (Identity genned) $ levels) + === pos levels + 1 + , testProperty "maintains the invariant" $ \(levels :: Levels Int) genned -> + let levels' = runIdentity . nextLevel (Identity genned) $ levels + in between 0 (toEnum $ length levels') $ pos levels' + , testProperty "extract is total" $ \(levels :: Levels Int) genned -> + let levels' = runIdentity . nextLevel (Identity genned) $ levels + in total $ extract levels' + , testProperty "uses the generated level as the next level" + $ \(levels :: Levels Int) genned -> + let levels' = seek (toEnum $ length levels - 1) levels + levels'' = runIdentity . nextLevel (Identity genned) $ levels' + in counterexample (show levels'') + $ extract levels'' === genned + ] + , testGroup "prevLevel" + [ testProperty "seeks backwards" $ \(levels :: Levels Int) -> + case prevLevel levels of + Nothing -> property Discard + Just levels' -> pos levels' === pos levels - 1 + , testProperty "maintains the invariant" $ \(levels :: Levels Int) -> + case prevLevel levels of + Nothing -> property Discard + Just levels' -> property $ between 0 (toEnum $ length levels') $ pos levels' + , testProperty "extract is total" $ \(levels :: Levels Int) -> + case prevLevel levels of + Nothing -> property Discard + Just levels' -> total $ extract levels' + ] + ] + , testGroup "JSON" + [ testProperty "toJSON/parseJSON round-trip" $ \(levels :: Levels Int) -> + JSON.decode (JSON.encode levels) === Just levels + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Data/MemoSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/MemoSpec.hs new file mode 100644 index 000000000000..ad81f1984d8f --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Data/MemoSpec.hs @@ -0,0 +1,19 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.MemoSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +import Test.QuickCheck.Instances.Text () +-------------------------------------------------------------------------------- +import Xanthous.Data.Memo +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.MemoSpec" + [ testGroup "getMemoized" + [ testProperty "when key matches" $ \k v -> + getMemoized @Int @Int k (memoizeWith k v) === Just v + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Data/NestedMapSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/NestedMapSpec.hs new file mode 100644 index 000000000000..acf7a67268f4 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Data/NestedMapSpec.hs @@ -0,0 +1,20 @@ +-------------------------------------------------------------------------------- +module Xanthous.Data.NestedMapSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck.Instances.Semigroup () +-------------------------------------------------------------------------------- +import qualified Xanthous.Data.NestedMap as NM +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data.NestedMap" + [ testProperty "insert/lookup" $ \nm ks v -> + let nm' = NM.insert ks v nm + in counterexample ("inserted: " <> show nm') + $ NM.lookup @Map @Int @Int ks nm' === Just (NM.Val v) + ] diff --git a/users/grfn/xanthous/test/Xanthous/DataSpec.hs b/users/grfn/xanthous/test/Xanthous/DataSpec.hs new file mode 100644 index 000000000000..9e67505ba928 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/DataSpec.hs @@ -0,0 +1,109 @@ +-------------------------------------------------------------------------------- +module Xanthous.DataSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude hiding (Right, Left, Down, toList, all) +import Data.Group +import Data.Foldable (toList, all) +-------------------------------------------------------------------------------- +import Xanthous.Data +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Data" + [ testGroup "Position" + [ testBatch $ monoid @Position mempty + , testProperty "group laws" $ \(pos :: Position) -> + pos <> invert pos == mempty && invert pos <> pos == mempty + , testGroup "stepTowards laws" + [ testProperty "takes only one step" $ \src tgt -> + src /= tgt ==> + isUnit (src `diffPositions` (src `stepTowards` tgt)) + -- , testProperty "moves in the right direction" $ \src tgt -> + -- stepTowards src tgt == move (directionOf src tgt) src + ] + , testProperty "directionOf laws" $ \pos dir -> + directionOf pos (move dir pos) == dir + , testProperty "diffPositions is add inverse" $ \(pos₁ :: Position) pos₂ -> + diffPositions pos₁ pos₂ == addPositions pos₁ (invert pos₂) + , testGroup "isUnit" + [ testProperty "double direction is never unit" $ \dir -> + not . isUnit $ move dir (asPosition dir) + , testCase "examples" $ do + isUnit (Position @Int 1 1) @? "not . isUnit $ Position 1 1" + isUnit (Position @Int 0 (-1)) @? "not . isUnit $ Position 0 (-1)" + (not . isUnit) (Position @Int 1 13) @? "isUnit $ Position 1 13" + ] + ] + + , testGroup "Direction" + [ testProperty "opposite is involutive" $ \(dir :: Direction) -> + opposite (opposite dir) == dir + , testProperty "opposite provides inverse" $ \dir -> + invert (asPosition dir) === asPosition (opposite dir) + , testProperty "asPosition isUnit" $ \dir -> + dir /= Here ==> isUnit (asPosition dir) + , testGroup "Move" + [ testCase "Up" $ move Up mempty @?= Position @Int 0 (-1) + , testCase "Down" $ move Down mempty @?= Position @Int 0 1 + , testCase "Left" $ move Left mempty @?= Position @Int (-1) 0 + , testCase "Right" $ move Right mempty @?= Position @Int 1 0 + , testCase "UpLeft" $ move UpLeft mempty @?= Position @Int (-1) (-1) + , testCase "UpRight" $ move UpRight mempty @?= Position @Int 1 (-1) + , testCase "DownLeft" $ move DownLeft mempty @?= Position @Int (-1) 1 + , testCase "DownRight" $ move DownRight mempty @?= Position @Int 1 1 + ] + ] + + , testGroup "Corner" + [ testGroup "instance Opposite" + [ testProperty "involutive" $ \(corner :: Corner) -> + opposite (opposite corner) === corner + ] + ] + + , testGroup "Edge" + [ testGroup "instance Opposite" + [ testProperty "involutive" $ \(edge :: Edge) -> + opposite (opposite edge) === edge + ] + ] + + , testGroup "Box" + [ testGroup "boxIntersects" + [ testProperty "True" $ \dims -> + boxIntersects (Box @Word (V2 1 1) (V2 2 2)) + (Box (V2 2 2) dims) + , testProperty "False" $ \dims -> + not $ boxIntersects (Box @Word (V2 1 1) (V2 2 2)) + (Box (V2 4 2) dims) + ] + ] + + , testGroup "Neighbors" + [ testGroup "rotations" + [ testProperty "always has the same members" + $ \(neighs :: Neighbors Int) -> + all (\ns -> sort (toList ns) == sort (toList neighs)) + $ rotations neighs + , testProperty "all rotations have the same rotations" + $ \(neighs :: Neighbors Int) -> + let rots = rotations neighs + in all (\ns -> sort (toList $ rotations ns) == sort (toList rots)) + rots + ] + ] + + , testGroup "units" + [ testGroup "unit suffixes" + [ testCase "density" + $ tshow (10000 :: Grams `Per` Cubic Meters) @?= "10000.0 g/m³" + , testCase "volume" + $ tshow (5 :: Cubic Meters) @?= "5.0 m³" + , testCase "area" + $ tshow (5 :: Square Meters) @?= "5.0 m²" + ] + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs new file mode 100644 index 000000000000..734cce1efbbe --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs @@ -0,0 +1,24 @@ +{-# OPTIONS_GHC -Wno-type-defaults #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.CharacterSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Entities.Character +import Xanthous.Util (endoTimes) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Entities.CharacterSpec" + [ testGroup "Knuckles" + [ testBatch $ monoid @Knuckles mempty + , testGroup "damageKnuckles" + [ testCase "caps at 5" $ + let knuckles' = endoTimes 6 damageKnuckles mempty + in _knuckleDamage knuckles' @?= 5 + ] + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs new file mode 100644 index 000000000000..ba27e3cbca4e --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs @@ -0,0 +1,32 @@ +-------------------------------------------------------------------------------- +module Xanthous.Entities.CommonSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +import Data.Vector.Lens (toVectorOf) +-------------------------------------------------------------------------------- +import Xanthous.Entities.Common +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Entities.CommonSpec" + [ testGroup "Inventory" + [ testProperty "items === itemsWithPosition . _2" $ \inv -> + inv ^.. items === inv ^.. itemsWithPosition . _2 + , testGroup "removeItemFromPosition" $ + let rewield w inv = + let (old, inv') = inv & wielded <<.~ w + in inv' & backpack <>~ toVectorOf (wieldedItems . wieldedItem) old + in [ (Backpack, \item -> backpack %~ (item ^. wieldedItem <|)) + , (LeftHand, rewield . inLeftHand) + , (RightHand, rewield . inRightHand) + , (BothHands, rewield . review doubleHanded) + ] <&> \(pos, addItem) -> + testProperty (show pos) $ \inv item -> + let inv' = addItem item inv + inv'' = removeItemFromPosition pos (item ^. wieldedItem) inv' + in inv'' ^.. items === inv ^.. items + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs new file mode 100644 index 000000000000..e23f7faba3a6 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.RawTypesSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Data.Interval (Extended(..), (<=..<=)) +-------------------------------------------------------------------------------- +import Xanthous.Entities.RawTypes +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Entities.RawTypesSpec" + [ testGroup "CreatureGenerateParams" + [ testGroup "Ord laws" + [ testProperty "comparability" $ \(a :: CreatureGenerateParams) b -> + a <= b || b <= a + , testProperty "transitivity" $ \(a :: CreatureGenerateParams) b c -> + a <= b && b <= c ==> a <= c + , testProperty "reflexivity" $ \(a :: CreatureGenerateParams) -> + a <= a + , testProperty "antisymmetry" $ \(a :: CreatureGenerateParams) b -> + (a <= b && b <= a) == (a == b) + ] + , testGroup "canGenerate" $ + let makeParams minB maxB = + let _levelRange = maybe NegInf Finite minB <=..<= maybe PosInf Finite maxB + _equippedItem = Nothing + in CreatureGenerateParams {..} + in + [ testProperty "no bounds" $ \level -> + let gps = makeParams Nothing Nothing + in canGenerate level gps + , testProperty "min bound" $ \level minB -> + let gps = makeParams (Just minB) Nothing + in canGenerate level gps === (level >= minB) + , testProperty "max bound" $ \level maxB -> + let gps = makeParams Nothing (Just maxB) + in canGenerate level gps === (level <= maxB) + ] + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs new file mode 100644 index 000000000000..b6c80be51be7 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs @@ -0,0 +1,30 @@ +-- | + +module Xanthous.Entities.RawsSpec (main, test) where + +import Test.Prelude +import Xanthous.Entities.Raws +import Xanthous.Entities.RawTypes + (_Creature, entityName, generateParams, HasEquippedItem (equippedItem)) + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Entities.Raws" + [ testGroup "raws" + [ testCase "are all valid" $ raws `deepseq` pure () + , testCase "all CreatureEquippedItems reference existent entity names" $ + let notFound + = raws + ^.. folded + . _Creature + . generateParams + . _Just + . equippedItem + . _Just + . entityName + . filtered (isNothing . raw) + in null notFound @? ("Some entities weren't found: " <> show notFound) + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Game/PromptSpec.hs b/users/grfn/xanthous/test/Xanthous/Game/PromptSpec.hs new file mode 100644 index 000000000000..d7a3df4acafa --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Game/PromptSpec.hs @@ -0,0 +1,19 @@ +-------------------------------------------------------------------------------- +module Xanthous.Game.PromptSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Game.Prompt +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Game.PromptSpec" + [ testGroup "mkMenuItems" + [ testCase "with duplicate items" + $ mkMenuItems @[_] [('a', MenuOption @Int "a" 1), ('a', MenuOption "a" 2)] + @?= mapFromList [('a', MenuOption "a" 1), ('b', MenuOption "a" 2)] + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Game/StateSpec.hs b/users/grfn/xanthous/test/Xanthous/Game/StateSpec.hs new file mode 100644 index 000000000000..34584f73b2ad --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Game/StateSpec.hs @@ -0,0 +1,30 @@ +-------------------------------------------------------------------------------- +module Xanthous.Game.StateSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Entities.Raws (raws) +import Xanthous.Generators.Level.LevelContents (entityFromRaw) +import Control.Monad.Random (evalRandT) +import System.Random (getStdGen) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Game.StateSpec" + [ testGroup "entityTypeName" + [ testCase "for a creature" $ do + let gormlakRaw = raws ^?! ix "gormlak" + creature <- runRand $ entityFromRaw gormlakRaw + entityTypeName creature @?= "Creature" + , testCase "for an item" $ do + let stickRaw = raws ^?! ix "stick" + item <- runRand $ entityFromRaw stickRaw + entityTypeName item @?= "Item" + ] + ] + where + runRand x = evalRandT x =<< getStdGen diff --git a/users/grfn/xanthous/test/Xanthous/GameSpec.hs b/users/grfn/xanthous/test/Xanthous/GameSpec.hs new file mode 100644 index 000000000000..2fa8527d0e59 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/GameSpec.hs @@ -0,0 +1,55 @@ +module Xanthous.GameSpec where + +import Test.Prelude hiding (Down) +import Xanthous.Game +import Xanthous.Game.State +import Control.Lens.Properties +import Xanthous.Data (move, Direction(Down)) +import Xanthous.Data.EntityMap (atPosition) + +main :: IO () +main = defaultMain test + +test :: TestTree +test + = localOption (QuickCheckTests 10) + . localOption (QuickCheckMaxSize 10) + $ testGroup "Xanthous.Game" + [ testGroup "positionedCharacter" + [ testProperty "lens laws" $ isLens positionedCharacter + , testCase "updates the position of the character" $ do + initialGame <- getInitialState + let initialPos = initialGame ^. characterPosition + updatedGame = initialGame & characterPosition %~ move Down + updatedPos = updatedGame ^. characterPosition + updatedPos @?= move Down initialPos + updatedGame ^. entities . atPosition initialPos @?= fromList [] + updatedGame ^. entities . atPosition updatedPos + @?= fromList [SomeEntity $ initialGame ^. character] + ] + , testGroup "characterPosition" + [ testProperty "lens laws" $ isLens characterPosition + ] + , testGroup "character" + [ testProperty "lens laws" $ isLens character + ] + , testGroup "MessageHistory" + [ testGroup "MonoComonad laws" + [ testProperty "oextend oextract ≡ id" + $ \(mh :: MessageHistory) -> oextend oextract mh === mh + , testProperty "oextract ∘ oextend f ≡ f" + $ \(mh :: MessageHistory) f -> (oextract . oextend f) mh === f mh + , testProperty "oextend f ∘ oextend g ≡ oextend (f . oextend g)" + $ \(mh :: MessageHistory) f g -> + (oextend f . oextend g) mh === oextend (f . oextend g) mh + ] + ] + , testGroup "Saving the game" + [ testProperty "forms a prism" $ isPrism saved + , testProperty "round-trips" $ \gs -> + loadGame (saveGame gs) === Just gs + , testProperty "preserves the character ID" $ \gs -> + let Just gs' = loadGame $ saveGame gs + in gs' ^. character === gs ^. character + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs b/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs new file mode 100644 index 000000000000..b53c657f7559 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE PackageImports #-} +-------------------------------------------------------------------------------- +module Xanthous.Generators.Level.UtilSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +import System.Random (mkStdGen) +import Control.Monad.Random (runRandT) +import Data.Array.ST (STUArray, runSTUArray, thaw) +import Data.Array.IArray (bounds, array) +import Data.Array.MArray (newArray, readArray, writeArray) +import Data.Array (Array, range, listArray, Ix) +import Control.Monad.ST (ST, runST) +import "checkers" Test.QuickCheck.Instances.Array () +import Linear.V2 +-------------------------------------------------------------------------------- +import Xanthous.Util +import Xanthous.Data (width, height) +-------------------------------------------------------------------------------- +import Xanthous.Generators.Level.Util +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +-------------------------------------------------------------------------------- + +newtype GenArray a b = GenArray (Array a b) + deriving stock (Show, Eq) + +instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) + => Arbitrary (GenArray a b) where + arbitrary = GenArray <$> do + (mkElem :: a -> b) <- arbitrary + minDims <- arbitrary + maxDims <- arbitrary + let bnds = (minDims, maxDims) + pure $ listArray bnds $ mkElem <$> range bnds + +test :: TestTree +test = testGroup "Xanthous.Generators.Util" + [ testGroup "randInitialize" + [ testProperty "returns an array of the correct dimensions" + $ \dims seed aliveChance -> + let gen = mkStdGen seed + res = runSTUArray + $ fmap fst + $ flip runRandT gen + $ randInitialize dims aliveChance + in bounds res === (0, V2 (dims ^. width) (dims ^. height)) + ] + , testGroup "numAliveNeighborsM" + [ testProperty "maxes out at 8" + $ \(GenArray (arr :: Array (V2 Word) Bool)) loc -> + let + act :: forall s. ST s Word + act = do + mArr <- thaw @_ @_ @_ @(STUArray s) arr + numAliveNeighborsM mArr loc + res = runST act + in counterexample (show res) $ between 0 8 res + , testCase "on the outer x edge" $ + let act :: forall s. ST s Word + act = do + cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word) + (V2 0 0, V2 2 2) + [ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True) + , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True) + , (V2 0 2, True), (V2 1 2, True), (V2 2 2, True) + ] + numAliveNeighborsM cells (V2 0 1) + res = runST act + in res @?= 7 + , testCase "on the outer y edge" $ + let act :: forall s. ST s Word + act = do + cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word) + (V2 0 0, V2 2 2) + [ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True) + , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True) + , (V2 0 2, True), (V2 1 2, True), (V2 2 2, True) + ] + numAliveNeighborsM cells (V2 1 0) + res = runST act + in res @?= 6 + ] + , testGroup "numAliveNeighbors" + [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $ + \(GenArray (arr :: Array (V2 Word) Bool)) loc -> + let + act :: forall s. ST s Word + act = do + mArr <- thaw @_ @_ @_ @(STUArray s) arr + numAliveNeighborsM mArr loc + res = runST act + in numAliveNeighbors arr loc === res + , testCase "on the outer x edge" $ + let cells = + array @Array @Bool @(V2 Word) + (V2 0 0, V2 2 2) + [ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True) + , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True) + , (V2 0 2, True), (V2 1 2, True), (V2 2 2, True) + ] + in numAliveNeighbors cells (V2 0 1) @?= 7 + , testCase "on the outer y edge" $ + let cells = + array @Array @Bool @(V2 Word) + (V2 0 0, V2 2 2) + [ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True) + , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True) + , (V2 0 2, True), (V2 1 2, True), (V2 2 2, True) + ] + in numAliveNeighbors cells (V2 1 0) @?= 6 + ] + , testGroup "cloneMArray" + [ testCase "clones the array" $ runST $ + let + go :: forall s. ST s Assertion + go = do + arr <- newArray @(STUArray s) (0 :: Int, 5) (1 :: Int) + arr' <- cloneMArray @_ @(STUArray s) arr + writeArray arr' 0 1234 + x <- readArray arr 0 + pure $ x @?= 1 + in go + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/MessageSpec.hs b/users/grfn/xanthous/test/Xanthous/MessageSpec.hs new file mode 100644 index 000000000000..2068e338bafe --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/MessageSpec.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedLists #-} +module Xanthous.MessageSpec ( main, test ) where + +import Test.Prelude +import Xanthous.Messages +import Data.Aeson +import Text.Mustache +import Control.Lens.Properties + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Messages" + [ testGroup "Message" + [ testGroup "JSON decoding" + [ testCase "Single" + $ decode "\"Test Single Template\"" + @?= Just (Single + $ compileMustacheText "template" "Test Single Template" + ^?! _Right) + , testCase "Choice" + $ decode "[\"Choice 1\", \"Choice 2\"]" + @?= Just + (Choice + [ compileMustacheText "template" "Choice 1" ^?! _Right + , compileMustacheText "template" "Choice 2" ^?! _Right + ]) + ] + ] + , localOption (QuickCheckTests 50) + . localOption (QuickCheckMaxSize 10) + $ testGroup "MessageMap" + [ testGroup "instance Ixed" + [ testProperty "traversal laws" $ \k -> + isTraversal $ ix @MessageMap k + , testCase "preview when exists" $ + let + Right tpl = compileMustacheText "foo" "bar" + msg = Single tpl + mm = Nested [("foo", Direct msg)] + in mm ^? ix ["foo"] @?= Just msg + ] + , testGroup "lookupMessage" + [ testProperty "is equivalent to preview ix" $ \msgMap path -> + lookupMessage path msgMap === msgMap ^? ix path + ] + ] + + , testGroup "Messages" + [ testCase "are all valid" $ messages `deepseq` pure () + ] + + , testGroup "Template" + [ testGroup "eq" + [ testProperty "reflexive" $ \(tpl :: Template) -> tpl == tpl + ] + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Messages/TemplateSpec.hs b/users/grfn/xanthous/test/Xanthous/Messages/TemplateSpec.hs new file mode 100644 index 000000000000..2a3873c3b016 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Messages/TemplateSpec.hs @@ -0,0 +1,80 @@ +-------------------------------------------------------------------------------- +module Xanthous.Messages.TemplateSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +import Test.QuickCheck.Instances.Text () +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Function (fix) +-------------------------------------------------------------------------------- +import Xanthous.Messages.Template +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Messages.Template" + [ testGroup "parsing" + [ testProperty "literals" $ forAll genLiteral $ \s -> + testParse template s === Right (Literal s) + , parseCase "escaped curlies" + "foo\\{" + $ Literal "foo{" + , parseCase "simple substitution" + "foo {{bar}}" + $ Literal "foo " `Concat` Subst (SubstPath $ "bar" :| []) + , parseCase "substitution with filters" + "foo {{bar | baz}}" + $ Literal "foo " + `Concat` Subst (SubstFilter (SubstPath $ "bar" :| []) + (FilterName "baz")) + , parseCase "substitution with multiple filters" + "foo {{bar | baz | qux}}" + $ Literal "foo " + `Concat` Subst (SubstFilter (SubstFilter (SubstPath $ "bar" :| []) + (FilterName "baz")) + (FilterName "qux")) + , parseCase "two substitutions and a literal" + "{{a}}{{b}}c" + $ Subst (SubstPath $ "a" :| []) + `Concat` Subst (SubstPath $ "b" :| []) + `Concat` Literal "c" + , localOption (QuickCheckTests 10) + $ testProperty "round-trips with ppTemplate" $ \tpl -> + testParse template (ppTemplate tpl) === Right tpl + ] + , testBatch $ monoid @Template mempty + , testGroup "rendering" + [ testProperty "rendering literals renders literally" + $ forAll genLiteral $ \s fs vs -> + render fs vs (Literal s) === Right s + , testProperty "rendering substitutions renders substitutions" + $ forAll genPath $ \ident val fs -> + let tpl = Subst (SubstPath ident) + tvs = varsWith ident val + in render fs tvs tpl === Right val + , testProperty "filters filter" $ forAll genPath + $ \ident filterName filterFn val -> + let tpl = Subst (SubstFilter (SubstPath ident) filterName) + fs = mapFromList [(filterName, filterFn)] + vs = varsWith ident val + in render fs vs tpl === Right (filterFn val) + ] + ] + where + genLiteral = pack . filter (`notElem` ['\\', '{']) <$> arbitrary + parseCase name input expected = + testCase name $ testParse template input @?= Right expected + testParse p = over _Left errorBundlePretty . runParser p "<test>" + genIdentifier = pack @Text <$> listOf1 (elements identifierChars) + identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_'] + + varsWith (p :| []) val = vars [(p, Val val)] + varsWith (phead :| ps) val = vars . pure . (phead ,) . flip fix ps $ + \next pth -> case pth of + [] -> Val val + p : ps' -> nested [(p, next ps')] + + genPath = (:|) <$> genIdentifier <*> listOf genIdentifier + +-- diff --git a/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs b/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs new file mode 100644 index 000000000000..0d800e8a91de --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedLists #-} +-------------------------------------------------------------------------------- +module Xanthous.OrphansSpec where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Text.Mustache +import Text.Megaparsec (errorBundlePretty) +import Graphics.Vty.Attributes +import qualified Data.Aeson as JSON +import Data.Interval (Interval, (<=..<=), (<=..<), (<..<=)) +import Data.Aeson ( ToJSON(toJSON), object, Value(Array) ) +import Data.Aeson.Types (fromJSON) +import Data.IntegerInterval (Extended(Finite)) +-------------------------------------------------------------------------------- +import Xanthous.Orphans +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Orphans" + [ localOption (QuickCheckTests 50) + . localOption (QuickCheckMaxSize 10) + $ testGroup "Template" + [ testProperty "ppTemplate / compileMustacheText " \tpl -> + let src = ppTemplate tpl + res :: Either String Template + res = over _Left errorBundlePretty + $ compileMustacheText (templateActual tpl) src + expected = templateCache tpl ^?! at (templateActual tpl) + in + counterexample (unpack src) + $ Right expected === do + (Template actual cache) <- res + maybe (Left "Template not found") Right $ cache ^? at actual + , testProperty "JSON round trip" $ \(tpl :: Template) -> + counterexample (unpack $ ppTemplate tpl) + $ JSON.decode (JSON.encode tpl) === Just tpl + ] + , testGroup "Attr" + [ jsonRoundTrip @Attr ] + , testGroup "Extended" + [ jsonRoundTrip @(Extended Int) ] + , testGroup "Interval" + [ testGroup "JSON" + [ jsonRoundTrip @(Interval Int) + , testCase "parses a single value as a length-1 interval" $ + getSuccess (fromJSON $ toJSON (1 :: Int)) + @?= Just (Finite (1 :: Int) <=..<= Finite 1) + , testCase "parses a pair of values as a single-ended interval" $ + getSuccess (fromJSON $ toJSON ([1, 2] :: [Int])) + @?= Just (Finite (1 :: Int) <=..< Finite (2 :: Int)) + , testCase "parses the full included/excluded syntax" $ + getSuccess (fromJSON $ Array [ object [ "Excluded" JSON..= (1 :: Int) ] + , object [ "Included" JSON..= (4 :: Int) ] + ]) + @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int)) + , testCase "parses open/closed as aliases" $ + getSuccess (fromJSON $ Array [ object [ "Open" JSON..= (1 :: Int) ] + , object [ "Closed" JSON..= (4 :: Int) ] + ]) + @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int)) + ] + ] + ] + where + getSuccess :: JSON.Result a -> Maybe a + getSuccess (JSON.Error _) = Nothing + getSuccess (JSON.Success r) = Just r diff --git a/users/grfn/xanthous/test/Xanthous/RandomSpec.hs b/users/grfn/xanthous/test/Xanthous/RandomSpec.hs new file mode 100644 index 000000000000..c88bd9562928 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/RandomSpec.hs @@ -0,0 +1,45 @@ +-------------------------------------------------------------------------------- +module Xanthous.RandomSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Control.Monad.Random +-------------------------------------------------------------------------------- +import Xanthous.Random +import Xanthous.Orphans () +import qualified Data.Interval as Interval +import Data.Interval (Interval, Extended (Finite), (<=..<=)) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Random" + [ testGroup "chooseSubset" + [ testProperty "chooses a subset" + $ \(l :: [Int]) (Positive (r :: Double)) -> randomTest $ do + ss <- chooseSubset r l + pure $ all (`elem` l) ss + ] + , testGroup "chooseRange" + [ testProperty "chooses in the range" + $ \(rng :: Interval Int) -> + not (Interval.null rng) + ==> randomTest ( do + chooseRange rng >>= \case + Just r -> pure + . counterexample (show r) + $ r `Interval.member` rng + Nothing -> pure $ property Discard + ) + , testProperty "nonEmpty range is never empty" + $ \ (lower :: Int) (NonZero diff) -> randomTest $ do + let upper = lower + diff + r <- chooseRange (Finite lower <=..<= Finite upper) + pure $ isJust r + + ] + ] + where + randomTest prop = evalRandT prop . mkStdGen =<< arbitrary diff --git a/users/grfn/xanthous/test/Xanthous/Util/GraphSpec.hs b/users/grfn/xanthous/test/Xanthous/Util/GraphSpec.hs new file mode 100644 index 000000000000..35ff090b28b9 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Util/GraphSpec.hs @@ -0,0 +1,39 @@ +module Xanthous.Util.GraphSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Util.Graph +import Data.Graph.Inductive.Basic +import Data.Graph.Inductive.Graph (labNodes, size, order) +import Data.Graph.Inductive.PatriciaTree +import Data.Graph.Inductive.Arbitrary +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graph" + [ testGroup "mstSubGraph" + [ testProperty "always produces a subgraph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph $ undir graph + in counterexample (show msg) + $ msg `isSubGraphOf` undir graph + , testProperty "returns a graph with the same nodes" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) + $ labNodes msg === labNodes graph + , testProperty "has nodes - 1 edges" + $ \(CG _ (graph :: Gr Int Int)) -> + order graph > 1 ==> + let msg = mstSubGraph graph + in counterexample (show msg) + $ size msg === order graph - 1 + , testProperty "always produces a simple graph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) $ isSimple msg + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/grfn/xanthous/test/Xanthous/Util/GraphicsSpec.hs new file mode 100644 index 000000000000..61e589280362 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Util/GraphicsSpec.hs @@ -0,0 +1,72 @@ +module Xanthous.Util.GraphicsSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude hiding (head) +-------------------------------------------------------------------------------- +import Data.List (nub, head) +import Data.Set (isSubsetOf) +import Linear.V2 +-------------------------------------------------------------------------------- +import Xanthous.Util.Graphics +import Xanthous.Util +import Xanthous.Orphans () +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graphics" + [ testGroup "circle" + [ testCase "radius 1, origin 2,2" + {- + | | 0 | 1 | 2 | 3 | + |---+---+---+---+---| + | 0 | | | | | + | 1 | | | x | | + | 2 | | x | | x | + | 3 | | | x | | + -} + $ (sort . unique @[] @[_]) (circle @Int (V2 2 2) 1) + @?= [ V2 1 2 + , V2 2 1, V2 2 3 + , V2 3 2 + ] + , testCase "radius 12, origin 0" + $ (sort . nub) (circle @Int 0 12) + @?= (sort . nub) + [ V2 (-12) (-4), V2 (-12) (-3), V2 (-12) (-2), V2 (-12) (-1) + , V2 (-12) 0, V2 (-12) 1, V2 (-12) 2, V2 (-12) 3, V2 (-12) 4 + , V2 (-11) (-6), V2 (-11) (-5), V2 (-11) 5, V2 (-11) 6, V2 (-10) (-7) + , V2 (-10) 7, V2 (-9) (-9), V2 (-9) (-8), V2 (-9) 8, V2 (-9) 9 + , V2 (-8) (-9), V2 (-8) 9, V2 (-7) (-10), V2 (-7) 10, V2 (-6) (-11) + , V2 (-6) 11, V2 (-5) (-11), V2 (-5) 11, V2 (-4) (-12), V2 (-4) 12 + , V2 (-3) (-12), V2 (-3) 12, V2 (-2) (-12), V2 (-2) 12, V2 (-1) (-12) + , V2 (-1) 12, V2 0 (-12), V2 0 12, V2 1 (-12), V2 1 12, V2 2 (-12) + , V2 2 12, V2 3 (-12), V2 3 12, V2 4 (-12), V2 4 12, V2 5 (-11) + , V2 5 11, V2 6 (-11), V2 6 11, V2 7 (-10), V2 7 10, V2 8 (-9), V2 8 9 + , V2 9 (-9), V2 9 (-8), V2 9 8, V2 9 9, V2 10 (-7), V2 10 7 + , V2 11 (-6), V2 11 (-5), V2 11 5, V2 11 6, V2 12 (-4), V2 12 (-3) + , V2 12 (-2), V2 12 (-1), V2 12 0, V2 12 1, V2 12 2, V2 12 3, V2 12 4 + ] + ] + , testGroup "filledCircle" + [ testProperty "is a superset of circle" $ \center radius -> + let circ = circle @Int center radius + filledCirc = filledCircle center radius + in counterexample ( "circle: " <> show circ + <> "\nfilledCircle: " <> show filledCirc) + $ setFromList circ `isSubsetOf` setFromList filledCirc + -- TODO later + -- , testProperty "is always contiguous" $ \center radius -> + -- let filledCirc = filledCircle center radius + -- in counterexample (renderBooleanGraphics filledCirc) $ + ] + , testGroup "line" + [ testProperty "starts and ends at the start and end points" $ \start end -> + let ℓ = line @Int start end + in counterexample ("line: " <> show ℓ) + $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end) + ] + ] + +-------------------------------------------------------------------------------- diff --git a/users/grfn/xanthous/test/Xanthous/Util/InflectionSpec.hs b/users/grfn/xanthous/test/Xanthous/Util/InflectionSpec.hs new file mode 100644 index 000000000000..fad841043152 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Util/InflectionSpec.hs @@ -0,0 +1,18 @@ +module Xanthous.Util.InflectionSpec (main, test) where + +import Test.Prelude +import Xanthous.Util.Inflection + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Inflection" + [ testGroup "toSentence" + [ testCase "empty" $ toSentence [] @?= "" + , testCase "single" $ toSentence ["x"] @?= "x" + , testCase "two" $ toSentence ["x", "y"] @?= "x and y" + , testCase "three" $ toSentence ["x", "y", "z"] @?= "x, y, and z" + , testCase "four" $ toSentence ["x", "y", "z", "w"] @?= "x, y, z, and w" + ] + ] diff --git a/users/grfn/xanthous/test/Xanthous/UtilSpec.hs b/users/grfn/xanthous/test/Xanthous/UtilSpec.hs new file mode 100644 index 000000000000..684a03b2c7a0 --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/UtilSpec.hs @@ -0,0 +1,46 @@ +module Xanthous.UtilSpec (main, test) where + +import Test.Prelude +import Xanthous.Util +import Control.Monad.State.Lazy (execState) + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util" + [ testGroup "smallestNotIn" + [ testCase "examples" $ do + smallestNotIn [7 :: Word, 3, 7] @?= 0 + smallestNotIn [7 :: Word, 0, 1, 3, 7] @?= 2 + , testProperty "returns an element not in the list" $ \(xs :: [Word]) -> + smallestNotIn xs `notElem` xs + , testProperty "pred return is in the list" $ \(xs :: [Word]) -> + let res = smallestNotIn xs + in res /= 0 ==> pred res `elem` xs + , testProperty "ignores order" $ \(xs :: [Word]) -> + forAll (shuffle xs) $ \shuffledXs -> + smallestNotIn xs === smallestNotIn shuffledXs + ] + , testGroup "takeWhileInclusive" + [ testProperty "takeWhileInclusive (const True) ≡ id" + $ \(xs :: [Int]) -> takeWhileInclusive (const True) xs === xs + ] + , testGroup "endoTimes" + [ testCase "endoTimes 4 succ 5" + $ endoTimes (4 :: Int) succ (5 :: Int) @?= 9 + ] + , testGroup "modifyKL" + [ testCase "_1 += 1" + $ execState (modifyKL _1 $ pure . succ) (1 :: Int, 2 :: Int) @?= (2, 2) + ] + , testGroup "removeFirst" + [ testCase "example" $ + removeFirst @[Int] (> 5) [1..10] @?= [1, 2, 3, 4, 5, 7, 8, 9, 10] + , testProperty "the result is the right length" $ \(xs :: [Int]) p -> + length (removeFirst p xs) `elem` [length xs, length xs - 1] + ] + , testGroup "AlphaChar" + [ testCase "succ 'z'" $ succ (AlphaChar 'z') @?= AlphaChar 'A' + ] + ] diff --git a/users/grfn/xanthous/xanthous.cabal b/users/grfn/xanthous/xanthous.cabal new file mode 100644 index 000000000000..987e1f48f693 --- /dev/null +++ b/users/grfn/xanthous/xanthous.cabal @@ -0,0 +1,528 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.5. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 8cae8550487b6092c18c82a0dc29bf22980d416771c66f6fca3e151875c66495 + +name: xanthous +version: 0.1.0.0 +synopsis: A WIP TUI RPG +description: Please see the README on GitHub at <https://github.com/glittershark/xanthous> +category: Game +homepage: https://github.com/glittershark/xanthous#readme +bug-reports: https://github.com/glittershark/xanthous/issues +author: Griffin Smith +maintainer: root@gws.fyi +copyright: 2019 Griffin Smith +license: GPL-3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.org + +source-repository head + type: git + location: https://github.com/glittershark/xanthous + +library + exposed-modules: + Data.Aeson.Generic.DerivingVia + Xanthous.AI.Gormlak + Xanthous.App + Xanthous.App.Autocommands + Xanthous.App.Common + Xanthous.App.Prompt + Xanthous.App.Time + Xanthous.Command + Xanthous.Data + Xanthous.Data.App + Xanthous.Data.Entities + Xanthous.Data.EntityChar + Xanthous.Data.EntityMap + Xanthous.Data.EntityMap.Graphics + Xanthous.Data.Levels + Xanthous.Data.Memo + Xanthous.Data.NestedMap + Xanthous.Data.VectorBag + Xanthous.Entities.Character + Xanthous.Entities.Common + Xanthous.Entities.Creature + Xanthous.Entities.Creature.Hippocampus + Xanthous.Entities.Draw.Util + Xanthous.Entities.Entities + Xanthous.Entities.Environment + Xanthous.Entities.Item + Xanthous.Entities.Marker + Xanthous.Entities.Raws + Xanthous.Entities.RawTypes + Xanthous.Game + Xanthous.Game.Arbitrary + Xanthous.Game.Draw + Xanthous.Game.Env + Xanthous.Game.Lenses + Xanthous.Game.Memo + Xanthous.Game.Prompt + Xanthous.Game.State + Xanthous.Generators.Level + Xanthous.Generators.Level.CaveAutomata + Xanthous.Generators.Level.Dungeon + Xanthous.Generators.Level.LevelContents + Xanthous.Generators.Level.Util + Xanthous.Generators.Level.Village + Xanthous.Generators.Speech + Xanthous.Messages + Xanthous.Messages.Template + Xanthous.Monad + Xanthous.Orphans + Xanthous.Physics + Xanthous.Prelude + Xanthous.Random + Xanthous.Util + Xanthous.Util.Comonad + Xanthous.Util.Graph + Xanthous.Util.Graphics + Xanthous.Util.Inflection + Xanthous.Util.JSON + Xanthous.Util.Optparse + Xanthous.Util.QuickCheck + other-modules: + Paths_xanthous + hs-source-dirs: + src + default-extensions: + BlockArguments + ConstraintKinds + DataKinds + DeriveAnyClass + DeriveGeneric + DerivingStrategies + DerivingVia + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTSyntax + GeneralizedNewtypeDeriving + KindSignatures + StandaloneKindSignatures + LambdaCase + MultiWayIf + NoImplicitPrelude + NoStarIsType + OverloadedStrings + PolyKinds + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns + ghc-options: -Wall + build-depends: + JuicyPixels + , MonadRandom + , QuickCheck + , Rasterific + , aeson + , array + , async + , base + , bifunctors + , brick + , checkers + , classy-prelude + , comonad + , comonad-extras + , constraints + , containers + , criterion + , data-default + , data-interval + , deepseq + , directory + , fgl + , fgl-arbitrary + , file-embed + , filepath + , generic-arbitrary + , generic-lens + , groups + , hgeometry + , hgeometry-combinatorial + , lens + , lifted-async + , linear + , megaparsec + , mmorph + , monad-control + , mtl + , optparse-applicative + , parallel + , parser-combinators + , pointed + , quickcheck-instances + , quickcheck-text + , random + , random-extras + , random-fu + , random-source + , raw-strings-qq + , reflection + , semigroupoids + , semigroups + , splitmix + , stache + , streams + , text + , text-zipper + , tomland + , transformers + , vector + , vty + , witherable + , yaml + , zlib + default-language: Haskell2010 + +executable xanthous + main-is: Main.hs + other-modules: + Paths_xanthous + hs-source-dirs: + app + default-extensions: + BlockArguments + ConstraintKinds + DataKinds + DeriveAnyClass + DeriveGeneric + DerivingStrategies + DerivingVia + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTSyntax + GeneralizedNewtypeDeriving + KindSignatures + StandaloneKindSignatures + LambdaCase + MultiWayIf + NoImplicitPrelude + NoStarIsType + OverloadedStrings + PolyKinds + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 + build-depends: + JuicyPixels + , MonadRandom + , QuickCheck + , Rasterific + , aeson + , array + , async + , base + , bifunctors + , brick + , checkers + , classy-prelude + , comonad + , comonad-extras + , constraints + , containers + , criterion + , data-default + , data-interval + , deepseq + , directory + , fgl + , fgl-arbitrary + , file-embed + , filepath + , generic-arbitrary + , generic-lens + , groups + , hgeometry + , hgeometry-combinatorial + , lens + , lifted-async + , linear + , megaparsec + , mmorph + , monad-control + , mtl + , optparse-applicative + , parallel + , parser-combinators + , pointed + , quickcheck-instances + , quickcheck-text + , random + , random-extras + , random-fu + , random-source + , raw-strings-qq + , reflection + , semigroupoids + , semigroups + , splitmix + , stache + , streams + , text + , text-zipper + , tomland + , transformers + , vector + , vty + , witherable + , xanthous + , yaml + , zlib + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Test.Prelude + Xanthous.Data.EntitiesSpec + Xanthous.Data.EntityCharSpec + Xanthous.Data.EntityMap.GraphicsSpec + Xanthous.Data.EntityMapSpec + Xanthous.Data.LevelsSpec + Xanthous.Data.MemoSpec + Xanthous.Data.NestedMapSpec + Xanthous.DataSpec + Xanthous.Entities.CharacterSpec + Xanthous.Entities.CommonSpec + Xanthous.Entities.RawsSpec + Xanthous.Entities.RawTypesSpec + Xanthous.Game.PromptSpec + Xanthous.Game.StateSpec + Xanthous.GameSpec + Xanthous.Generators.Level.UtilSpec + Xanthous.Messages.TemplateSpec + Xanthous.MessageSpec + Xanthous.OrphansSpec + Xanthous.RandomSpec + Xanthous.Util.GraphicsSpec + Xanthous.Util.GraphSpec + Xanthous.Util.InflectionSpec + Xanthous.UtilSpec + Paths_xanthous + hs-source-dirs: + test + default-extensions: + BlockArguments + ConstraintKinds + DataKinds + DeriveAnyClass + DeriveGeneric + DerivingStrategies + DerivingVia + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTSyntax + GeneralizedNewtypeDeriving + KindSignatures + StandaloneKindSignatures + LambdaCase + MultiWayIf + NoImplicitPrelude + NoStarIsType + OverloadedStrings + PolyKinds + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O0 + build-depends: + JuicyPixels + , MonadRandom + , QuickCheck + , Rasterific + , aeson + , array + , async + , base + , bifunctors + , brick + , checkers + , classy-prelude + , comonad + , comonad-extras + , constraints + , containers + , criterion + , data-default + , data-interval + , deepseq + , directory + , fgl + , fgl-arbitrary + , file-embed + , filepath + , generic-arbitrary + , generic-lens + , groups + , hgeometry + , hgeometry-combinatorial + , lens + , lens-properties + , lifted-async + , linear + , megaparsec + , mmorph + , monad-control + , mtl + , optparse-applicative + , parallel + , parser-combinators + , pointed + , quickcheck-instances + , quickcheck-text + , random + , random-extras + , random-fu + , random-source + , raw-strings-qq + , reflection + , semigroupoids + , semigroups + , splitmix + , stache + , streams + , tasty + , tasty-hunit + , tasty-quickcheck + , tasty-rerun + , text + , text-zipper + , tomland + , transformers + , vector + , vty + , witherable + , xanthous + , yaml + , zlib + default-language: Haskell2010 + +benchmark benchmark + type: exitcode-stdio-1.0 + main-is: Bench.hs + other-modules: + Bench.Prelude + Xanthous.Generators.UtilBench + Xanthous.RandomBench + Paths_xanthous + hs-source-dirs: + bench + default-extensions: + BlockArguments + ConstraintKinds + DataKinds + DeriveAnyClass + DeriveGeneric + DerivingStrategies + DerivingVia + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTSyntax + GeneralizedNewtypeDeriving + KindSignatures + StandaloneKindSignatures + LambdaCase + MultiWayIf + NoImplicitPrelude + NoStarIsType + OverloadedStrings + PolyKinds + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + JuicyPixels + , MonadRandom + , QuickCheck + , Rasterific + , aeson + , array + , async + , base + , bifunctors + , brick + , checkers + , classy-prelude + , comonad + , comonad-extras + , constraints + , containers + , criterion + , data-default + , data-interval + , deepseq + , directory + , fgl + , fgl-arbitrary + , file-embed + , filepath + , generic-arbitrary + , generic-lens + , groups + , hgeometry + , hgeometry-combinatorial + , lens + , lifted-async + , linear + , megaparsec + , mmorph + , monad-control + , mtl + , optparse-applicative + , parallel + , parser-combinators + , pointed + , quickcheck-instances + , quickcheck-text + , random + , random-extras + , random-fu + , random-source + , raw-strings-qq + , reflection + , semigroupoids + , semigroups + , splitmix + , stache + , streams + , text + , text-zipper + , tomland + , transformers + , vector + , vty + , witherable + , xanthous + , yaml + , zlib + default-language: Haskell2010 |
