Files
kiss-vscode/projects/nat-archive-tool/src/nat/Archive.kiss

108 lines
3.9 KiB
Plaintext

(defNew [&prop :String archiveDir]
[:Array<System> systems
[]
:Option<String> gitDir
(let [gitDir (joinPath archiveDir ".git")]
(if (FileSystem.exists gitDir)
(Some gitDir)
None))
// Parse all entries into a dictionary of id => entry
:Map<String,Entry> entries
(let [entryDir (joinPath archiveDir "entries")
filesDir (joinPath archiveDir "files")]
(assert (FileSystem.exists archiveDir) "Archive directory $archiveDir does not exist")
(assert (FileSystem.isDirectory archiveDir) "$archiveDir is not a directory")
(FileSystem.createDirectory entryDir)
(FileSystem.createDirectory filesDir)
// Sync with git if the archive is a repository:
(whenLet [(Some gitDir) gitDir]
(assertProcess "git" ["pull"] [] true archiveDir))
(let [entryFiles (FileSystem.readDirectory entryDir)]
(for file entryFiles
=>(file.withoutExtension)
(the Entry (tink.Json.parse (File.getContent (joinPath archiveDir "entries" file)))))))
:DynamicAccess<Dynamic> playgrounds
(let [playgroundsFile (joinPath archiveDir "playgrounds.json")]
(unless (FileSystem.exists playgroundsFile)
(File.saveContent playgroundsFile
#"{
"default": "Playground-MAIN",
"Playground-MAIN": {
"catsMatch": "true"
}
}
"#))
(haxe.Json.parse (File.getContent playgroundsFile)))])
(method changePlaygrounds [:Dynamic->Void change]
(change playgrounds)
(File.saveContent (joinPath archiveDir "playgrounds.json") (haxe.Json.stringify playgrounds "\t")))
(method :String currentPlayground []
(dictGet playgrounds "default"))
(method addSystem [:System system]
(systems.push system)
system)
(method addAndProcessSystem [:System system &opt :ArchiveUI ui]
(addSystem system)
(refreshSystem system)
(system.process this ui)
system)
(method refreshSystem [:System system]
(doFor =>id e entries
(system.checkEntryInOrOut this e)))
(method forceProcessAll [&opt :ArchiveUI ui]
(doFor system systems (refreshSystem system))
(processSystems))
(method processSystems [&opt :ArchiveUI ui]
(doFor system systems
(system.process this ui)))
(prop &mut :Entry->Dynamic defaultInitializer null)
(method :Entry createEntry [:Entry->Dynamic initializer] // initializer returns Dynamic so ->:Void isn't required
(let [e (new Entry)]
(when defaultInitializer
(defaultInitializer e))
(initializer e)
(dictSet entries e.id e)
(refreshEntry e)
e))
// After modifying an entry, this must be called. If you are writing in a createEntry
// initializer or a system's processEntry function, this will happen automatically.
// Also most functions that only affect the Entry, not its components' contents,
// will call this automatically though (withWritableEntry).
// When changing components, use the (withWritableComponents) macro in Lib.kiss
(method refreshEntry [:Entry e]
(_saveEntry e)
(doFor system systems
(system.checkEntryInOrOut this e)))
(method _saveEntry [:Entry e]
(File.saveContent
(joinPath archiveDir "entries" (e.id.withExtension "json"))
(tink.Json.stringify e))
// Sync with git if the archive is a repository:
(whenLet [(Some gitDir) gitDir
gitDo ->gitArgs (assertProcess "git" gitArgs [] true archiveDir)]
(gitDo ["add" "playgrounds.json"])
(gitDo ["add" "entries"])
(gitDo ["add" "files"])
(gitDo ["commit" "-m" "$(Date.now)"])
(gitDo ["push"])))
(method fullString [:Entry e]
(haxe.Json.stringify e null "\t"))
(method :String filePath [file]
(joinPath archiveDir "files" file))