import argv
import child_process as p
import directories
import filepath
import gleam/bit_array
import gleam/bool
import gleam/crypto
import gleam/dynamic/decode
import gleam/http
import gleam/http/request
import gleam/httpc
import gleam/int
import gleam/io
import gleam/list
import gleam/option.{type Option, None, Some}
import gleam/order
import gleam/result.{try}
import gleam/string
import kludge/internal/manifest
import kludge/internal/patch
import platform
import simplifile
import snag
import star
import temporary
import tom
fn patch_plural(count: Int) {
case count {
1 -> "patch"
_ -> "patches"
}
}
fn print_help() {
io.println(
"Kludge - patch a package in a pinch 🩹
gleam run -m kludge # Patches everything in ./patches
gleam run -m kludge [package] # Writes your changes in ./patches for that package",
)
}
pub fn main() -> Nil {
case argv.load().arguments {
[] ->
case apply_patches() {
Ok(#([], [], _ignored)) -> {
io.println("No patches left to apply")
}
Ok(#(success, failure, ignored)) -> {
let success_count = success |> list.length
let success_msg = case success_count {
0 -> ""
_ -> {
let applied =
success
|> list.map(fn(path) { "* " <> path })
|> string.join("\n")
"Successfully applied "
<> success_count |> int.to_string
<> " "
<> patch_plural(success_count)
<> "\n"
<> applied
}
}
let failure_count = failure |> list.length
let failure_msg = case failure_count {
0 -> ""
_ -> {
let failures =
failure
|> list.map(fn(path) {
"* " <> path.0 <> " - " <> snag.line_print(path.1)
})
|> string.join("\n")
"Failed to apply "
<> failure_count |> int.to_string
<> " "
<> patch_plural(failure_count)
<> "\n"
<> failures
}
}
let ignored_count = ignored |> list.length
let ignored_msg = case ignored_count {
0 -> ""
1 -> "There is 1 patch that was already applied"
_ ->
"There are "
<> ignored_count |> int.to_string
<> " "
<> patch_plural(ignored_count)
<> " that were already applied"
}
[success_msg, failure_msg, ignored_msg]
|> list.filter(fn(it) { it |> string.is_empty |> bool.negate })
|> string.join("\n")
|> io.println()
}
Error(err) -> io.println(snag.pretty_print(err))
}
["--help"] | ["-h"] | ["help"] -> print_help()
[package] ->
case find_patches(package) {
Ok(diff) -> io.println("Wrote patch to " <> diff)
Error(err) -> io.println(snag.pretty_print(err))
}
_ -> print_help()
}
Nil
}
fn get_manifest() -> Result(manifest.Manifest, snag.Snag) {
use toml_text <- try(
simplifile.read("manifest.toml")
|> snag.map_error(simplifile.describe_error)
|> snag.context("Unable to read manifest file"),
)
use toml <- try(
tom.parse_to_dynamic(toml_text)
|> snag.map_error(string.inspect)
|> snag.context("Cannot parse manifest file's toml"),
)
use manifest <- try(
decode.run(toml, manifest.manifest_decoder())
|> snag.map_error(string.inspect)
|> snag.context("Cannot decode manfiest file structure"),
)
Ok(manifest)
}
fn apply_patches() -> Result(
#(List(String), List(#(String, snag.Snag)), List(String)),
snag.Snag,
) {
use manifest <- try(get_manifest())
use patches <- try(
simplifile.read_directory("./patches")
|> snag.map_error(simplifile.describe_error)
|> snag.context("Cannot read patches directory"),
)
let sorted_patches =
list.map(patches, fn(name) {
patch.parse_patch_name("./patches/" <> name) |> result.replace_error(name)
})
|> list.sort(fn(lhs, rhs) {
case lhs {
Ok(lhs) ->
case rhs {
Ok(rhs) -> patch.compare_patch(lhs, rhs)
Error(_) -> order.Gt
}
Error(_) -> order.Lt
}
})
list.fold(sorted_patches, #([], [], []), fn(acc, patch) {
let name = case patch {
Ok(patch) -> patch.path
Error(name) -> name
}
let #(successes, errors, ignored) = acc
let result = {
use patch <- try(patch |> result.replace_error(InvalidFileName))
let version = case
list.find(manifest.packages, fn(it) { it.name == patch.package_name })
{
Ok(manifest_package) ->
case manifest_package {
manifest.GitPackage(..)
| manifest.PathPackage(..)
| manifest.HexPackage(..) -> manifest_package.version |> Ok
}
Error(Nil) -> Error(DependencyDoesNotExist)
}
use version <- try(version)
let actual_version = case version == patch.package_version {
True -> None
False -> Some(version)
}
use p.Output(code, _text) <- try(
p.new_with_path("git")
|> p.cwd(".")
|> p.args([
"apply",
"--directory=build/packages/" <> patch.package_name,
patch.path,
])
|> p.run
|> result.map_error(fn(err) {
string.inspect(err)
|> snag.new()
|> snag.layer("Cannot start git")
|> GitApplyError(actual_version)
}),
)
case code {
0 -> {
Ok(Nil)
}
_ -> {
use p.Output(code, text) <- try(
p.new_with_path("git")
|> p.cwd(".")
|> p.args([
"apply",
"--check",
"--reverse",
"--directory=build/packages/" <> patch.package_name,
patch.path,
])
|> p.run
|> result.map_error(fn(err) {
string.inspect(err)
|> snag.new()
|> snag.layer("Cannot start git")
|> GitApplyError(actual_version)
}),
)
use <- bool.guard(
code != 0,
Error(GitApplyError(
snag.new("git error: " <> text)
|> snag.layer("Cannot apply patch"),
actual_version,
)),
)
Error(PatchAlreadyApplied)
}
}
}
case result {
Ok(Nil) -> #([name, ..successes], errors, ignored)
Error(err) ->
case err {
InvalidFileName -> #(
successes,
[#(name, snag.new("Cannot parse file name")), ..errors],
ignored,
)
GitApplyError(snag, expected_version) -> {
let snag = case expected_version {
Some(version) ->
snag.layer(
snag,
"Package version mismatch, actual version is " <> version,
)
None -> snag
}
#(successes, [#(name, snag), ..errors], ignored)
}
DependencyDoesNotExist -> #(
successes,
[
#(name, snag.new("Dependency does not exist in manifest.toml")),
..errors
],
ignored,
)
PatchAlreadyApplied -> #(successes, errors, [name, ..ignored])
}
}
})
|> Ok
}
/// Version of the package according to manifest.toml
type ApplyPatchError {
InvalidFileName
DependencyDoesNotExist
GitApplyError(msg: snag.Snag, expected_version: Option(String))
PatchAlreadyApplied
}
fn git(args: List(String), cwd: String) {
use p.Output(code, text) as out <- try(
p.new_with_path("git")
|> p.cwd(cwd)
|> p.args(args)
|> p.run
|> snag.map_error(string.inspect),
)
case code {
0 -> Ok(out)
_ ->
snag.error(
"Git returned an unexpected error with code "
<> int.to_string(code)
<> " and body "
<> text,
)
}
}
fn find_patches(package_name: String) {
use manifest <- try(get_manifest())
use package <- try(
list.find(manifest.packages, fn(it) { it.name == package_name })
|> snag.replace_error("Cannot find package " <> package_name),
)
let patch_file_path =
"./patches/" <> package.name <> "+" <> package.version <> ".patch"
use <- bool.guard(
{ simplifile.is_file(patch_file_path) |> result.unwrap(False) },
snag.error(
"Patch "
<> patch_file_path
<> " already exists, move or remove to make a new patch",
),
)
let diff =
{
use temp_dir <- temporary.create(temporary.directory())
let git = git(_, temp_dir)
use version <- try(
git(["--version"])
|> snag.context("Cannot check version"),
)
use <- bool.guard(
!string.starts_with(version.output, "git version "),
snag.error(
"git does not appear to be git, the version control software",
)
|> snag.context("Cannot check version"),
)
use Nil <- try(
clone_original_into(package, temp_dir)
|> snag.context("Cannot getting original version of the package"),
)
use _ <- try(
p.new_with_path("git")
|> p.cwd(temp_dir)
|> p.args(["init"])
|> p.run
|> snag.map_error(string.inspect)
|> snag.context("Error initializing repository"),
)
use _ <- try(
git(["config", "--local", "user.name", "gleam-kludge"])
|> snag.context("Error setting git username"),
)
use _ <- try(
git(["config", "--local", "user.email", "gleam@kludge.run"])
|> snag.context("Error setting git email"),
)
use _ <- try(
git(["add", "-f", "."])
|> snag.context("Error adding original files to be tracked"),
)
use _ <- try(
git(["commit", "--allow-empty", "-m", "original"])
|> snag.context("Error commiting original files"),
)
use entries <- try(
simplifile.read_directory(temp_dir)
|> snag.map_error(simplifile.describe_error)
|> snag.context("Cannot list temp dir"),
)
use _ <- try(
list.try_each(list.filter(entries, fn(e) { e != ".git" }), fn(entry) {
simplifile.delete(filepath.join(temp_dir, entry))
|> snag.map_error(simplifile.describe_error)
})
|> snag.context("Cannot clear temp dir"),
)
let original = "build/packages/" <> package.name
use Nil <- try(
simplifile.copy_directory(original, temp_dir)
|> snag.map_error(simplifile.describe_error)
|> snag.context(
"Cannot copy modified files to git temp dir (" <> temp_dir <> ")",
),
)
use _ <- try(
git(["add", "-f", "."])
|> snag.context("Cannot stage modified files to repo"),
)
use _ <- try(
git(["reset", "--", "build", "manifest.toml"])
|> snag.context("Cannot reset modified in repo"),
)
use p.Output(code, text) <- try(
git([
"diff",
"--cached",
"--no-color",
"--ignore-space-at-eol",
"--no-ext-diff",
"--src-prefix=a/",
"--dst-prefix=b/",
]),
)
case code {
0 -> Ok(text)
_ ->
case string.contains(text, "Unexpected file mode string: 120000") {
True ->
Error(snag.new(
"These changes involve creating symlinks, kludge does not support symlinks.",
))
False -> Error(snag.new("Cannot create diff" <> text))
}
}
}
|> snag.map_error(simplifile.describe_error)
|> result.flatten()
|> snag.context("Cannot determine diff")
use diff <- try(diff)
use <- bool.guard(
string.is_empty(diff),
snag.error("No changes have been made"),
)
use Nil <- try(
simplifile.create_directory_all("./patches")
|> snag.map_error(simplifile.describe_error)
|> snag.context("Cannot make patches directory"),
)
use Nil <- try(
simplifile.write(patch_file_path, diff)
|> snag.map_error(simplifile.describe_error)
|> snag.context("Cannot write patch file"),
)
Ok(patch_file_path)
}
fn clone_original_into(
package: manifest.ManifestPackage,
destination: String,
) -> snag.Result(Nil) {
case package {
manifest.HexPackage(..) -> {
use cache <- try(
get_gleam_cache()
|> snag.context("Cannot find gleam hexpm cache directory"),
)
let hexpkgs = filepath.join(cache, "hex/hexpm/packages/")
let cached_package_path =
filepath.join(hexpkgs, package.outer_checksum <> ".tar")
let can_use_cached =
result.unwrap(simplifile.is_file(cached_package_path), False)
let outer_archive_find_result = case can_use_cached {
True -> {
use bits <- try(
simplifile.read_bits(cached_package_path)
|> snag.map_error(simplifile.describe_error),
)
let checksum =
bit_array.base16_encode(crypto.hash(crypto.Sha256, bits))
use <- bool.guard(
checksum != package.outer_checksum,
snag.error(
"Hash validation error! Expected (manifest): "
<> package.outer_checksum
<> " Got (in cache): "
<> checksum,
),
)
Ok(star.FromData(bits))
}
False -> {
use response <- try(
request.new()
|> request.set_method(http.Get)
|> request.set_scheme(http.Https)
|> request.set_host("repo.hex.pm")
|> request.set_path(
"tarballs/" <> package.name <> "-" <> package.version <> ".tar",
)
|> request.set_body(<<>>)
|> httpc.send_bits()
|> snag.map_error(string.inspect)
|> snag.context("Cannot fetch package " <> package.name),
)
use <- bool.guard(
response.status != 200,
snag.error(
"Non 200 response ("
<> int.to_string(response.status)
<> ") was sent by hexpm",
),
)
let checksum =
bit_array.base16_encode(crypto.hash(crypto.Sha256, response.body))
use <- bool.guard(
checksum != package.outer_checksum,
snag.error(
"Hash validation error! Expected (manifest): "
<> package.outer_checksum
<> " Got (downloaded): "
<> checksum,
),
)
Ok(star.FromData(response.body))
}
}
use outer_archive <- try(
outer_archive_find_result
|> snag.context("Cannot find outer archive source"),
)
use outer_files <- try(
outer_archive
|> star.extract_memory(star.Uncompressed, star.AllEntries)
|> snag.map_error(string.inspect)
|> snag.context("Error when decompressing decompressing outer"),
)
use contents <- try(
list.find(outer_files, fn(file) {
file.header.name == "contents.tar.gz"
})
|> snag.replace_error("Cannot find contents.tar.gz in hex archive"),
)
use Nil <- try(
star.extract(
star.FromData(contents.contents),
destination,
star.Gzip,
star.AllEntries,
star.Overwrite,
)
|> snag.map_error(string.inspect)
|> snag.context("Failed to extract hexpm contents.tar.gz"),
)
Ok(Nil)
}
manifest.GitPackage(..) -> {
let git = git(_, destination)
use _ <- try(
git(["init"]) |> snag.context("Failed to initialize git repository"),
)
use _ <- try(
git(["remote", "add", "origin", package.repo])
|> snag.context("Cannot add repo origin of " <> package.repo),
)
use _ <- try(
git(["fetch", "--depth=1", "origin", package.commit])
|> snag.context(
"Error fetching git commit hash"
<> package.commit
<> ". Warning: server may not support shallow SHA fetches (uploadpack.allowReachableSHA1InWant)",
),
)
use _ <- try(
git(["checkout", "FETCH_HEAD"])
|> snag.context("Cannot check out FETCH_HEAD"),
)
Ok(Nil)
}
manifest.PathPackage(..) -> {
Error(snag.new("Path packages are not supported in kludge."))
}
}
}
fn get_gleam_cache() -> Result(String, snag.Snag) {
case platform.os() {
platform.Darwin ->
case directories.home_dir() {
Ok(home) -> Ok(filepath.join(home, "Library/Caches/gleam"))
Error(Nil) -> snag.error("Cannot find home directory")
}
platform.Win32 ->
case directories.data_local_dir() {
Ok(dir) -> Ok(filepath.join(dir, "gleam"))
Error(Nil) -> snag.error("Cannot find local app data")
}
// everything is xdg here
platform.Linux
| platform.FreeBsd
| platform.OpenBsd
| platform.SunOs
| platform.Aix
| platform.OtherOs(_) ->
case directories.cache_dir() {
Ok(cache) -> filepath.join(cache, "gleam") |> Ok
Error(Nil) -> snag.error("Cannot find cache directory")
}
}
}