From c3e756e63469979f5e4cba5be2805671bee8149a Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Sat, 2 Jul 2022 00:36:36 +0000 Subject: [PATCH] DLSystem check for youtube-dl --- src/nat/ArchiveController.kiss | 1 + src/nat/Lib.kiss | 13 +++++++++---- src/nat/SelectionCommands.kiss | 6 +++++- src/nat/components/DLURL.hx | 3 +++ src/nat/systems/DLSystem.hx | 8 ++++++++ src/nat/systems/DLSystem.kiss | 16 ++++++++++++++++ src/nat/systems/TagSystem.kiss | 2 +- src/nat/systems/WikipediaImageSystem.kiss | 2 +- src/test/TestMain.kiss | 8 ++++---- 9 files changed, 48 insertions(+), 11 deletions(-) create mode 100644 src/nat/components/DLURL.hx create mode 100644 src/nat/systems/DLSystem.hx create mode 100644 src/nat/systems/DLSystem.kiss diff --git a/src/nat/ArchiveController.kiss b/src/nat/ArchiveController.kiss index 87d5ae3..c41043a 100644 --- a/src/nat/ArchiveController.kiss +++ b/src/nat/ArchiveController.kiss @@ -161,6 +161,7 @@ (archive.addSystem (new WikipediaImageSystem)) (archive.addSystem (new ImageAttachmentSystem)) (archive.addSystem (new KeyShortcutSystem this)) + (archive.addSystem (new DLSystem)) // Just for testing: // (archive.addSystem (new AttachmentSystem ["jpg" "jpeg" "png"] ->[archive e files] ~files)) diff --git a/src/nat/Lib.kiss b/src/nat/Lib.kiss index eaa7d4f..88ac372 100644 --- a/src/nat/Lib.kiss +++ b/src/nat/Lib.kiss @@ -70,23 +70,28 @@ (= ,value (readComponent e ,componentType)))) ,process)) -(function :Array tagList [archive :nat.Entry e] +(function :Array tagList [:nat.Entry e] (if (hasComponent e Tags) (let [t (readComponent e Tags)] (collect (t.keys))) [])) -(function tagsMatch [archive e tagsBoolExp] - (BoolExpInterp.eval tagsBoolExp (tagList archive e))) +(function tagsMatch [e tagsBoolExp] + (BoolExpInterp.eval tagsBoolExp (tagList e))) (function componentsMatch [:nat.Entry e componentsBoolExp] (BoolExpInterp.eval componentsBoolExp (for =>cType cId e.components cType))) +(function componentsAndTagsMatch [:nat.Entry e componentsAndTagsBoolExp] + (BoolExpInterp.eval componentsAndTagsBoolExp (cast (concat (tagList e) (for =>cType cId e.components cType))))) + +(defAlias &call catsMatch componentsAndTagsMatch) + (function addFiles [:nat.Archive archive :nat.Entry e :Array files &opt leaveOriginalCopy] (withWritableEntry archive e (doFor file files (let [pathWithoutDir (haxe.io.Path.withoutDirectory file)] - (unless !(= -1 (e.files.indexOf pathWithoutDir)) + (unless (contains e.files pathWithoutDir) (let [pathInArchive (joinPath archive.archiveDir "files" pathWithoutDir)] (unless (sys.FileSystem.exists pathInArchive) ((if leaveOriginalCopy sys.io.File.copy sys.FileSystem.rename) diff --git a/src/nat/SelectionCommands.kiss b/src/nat/SelectionCommands.kiss index 480d2c6..bd7b493 100644 --- a/src/nat/SelectionCommands.kiss +++ b/src/nat/SelectionCommands.kiss @@ -62,10 +62,14 @@ lastChangeSet) (defSelectCommand SelectByTags [tagsBoolExp (Text null)] - (filter archive.entries ->e (tagsMatch archive e tagsBoolExp))) + (filter archive.entries ->e (tagsMatch e tagsBoolExp))) (defSelectCommand SelectByComponents [componentsBoolExp (Text null)] (filter archive.entries ->e (componentsMatch e componentsBoolExp))) +// TODO selectByCats +// there is currently no easy way to defAlias for every variation of a selection command, +// so Cats may be the canonical name + (defSelectCommand SelectByName [name (Text null)] (nameSystem.getEntries name)) \ No newline at end of file diff --git a/src/nat/components/DLURL.hx b/src/nat/components/DLURL.hx new file mode 100644 index 0000000..a951dba --- /dev/null +++ b/src/nat/components/DLURL.hx @@ -0,0 +1,3 @@ +package nat.components; + +typedef DLURL = String; \ No newline at end of file diff --git a/src/nat/systems/DLSystem.hx b/src/nat/systems/DLSystem.hx new file mode 100644 index 0000000..26f02c2 --- /dev/null +++ b/src/nat/systems/DLSystem.hx @@ -0,0 +1,8 @@ +package nat.systems; + +import kiss.Prelude; +import kiss.List; +import nat.System; + +@:build(kiss.Kiss.build()) +class DLSystem extends System {} diff --git a/src/nat/systems/DLSystem.kiss b/src/nat/systems/DLSystem.kiss new file mode 100644 index 0000000..57ffe87 --- /dev/null +++ b/src/nat/systems/DLSystem.kiss @@ -0,0 +1,16 @@ +(load "../Lib.kiss") + +(defNew [] + // Check if youtube-dl is installed before doing anything + (let [&mut hasYTDL false] + (tryProcess "youtube-dl" [] ->error (when (contains error "You must provide at least one URL") (set hasYTDL true))) + + (super + ->[archive e] + (and ~hasYTDL (catsMatch e "(unless dlProcessed DLURL)")) + ->[archive e &opt ui] + { + + // (addFiles ) + // (addTags archive e ["dlProcessed"]) + }))) \ No newline at end of file diff --git a/src/nat/systems/TagSystem.kiss b/src/nat/systems/TagSystem.kiss index e422f3c..e7e0e7c 100644 --- a/src/nat/systems/TagSystem.kiss +++ b/src/nat/systems/TagSystem.kiss @@ -5,5 +5,5 @@ :EntryProcessor processor] [] (super - (lambda [:Archive archive :Entry e] (tagsMatch archive e tagFilterString)) + (lambda [:Archive archive :Entry e] (tagsMatch e tagFilterString)) processor)) \ No newline at end of file diff --git a/src/nat/systems/WikipediaImageSystem.kiss b/src/nat/systems/WikipediaImageSystem.kiss index 9e17c2c..4e5777b 100644 --- a/src/nat/systems/WikipediaImageSystem.kiss +++ b/src/nat/systems/WikipediaImageSystem.kiss @@ -3,7 +3,7 @@ (defNew [] (super "https://en.wikipedia.org/w/api.php" - ->[archive e] (tagsMatch archive e "(and media !wikipediaProcessed)") + ->[archive e] (tagsMatch e "(and media !wikipediaProcessed)") scrapeForImages 1)) diff --git a/src/test/TestMain.kiss b/src/test/TestMain.kiss index 9eef7cd..bbd3ec8 100644 --- a/src/test/TestMain.kiss +++ b/src/test/TestMain.kiss @@ -19,10 +19,10 @@ (assert (hasComponent song2 Tags)) (assert (componentsMatch song1 "(and Name Author)")) (assert (componentsMatch song2 "(and Name Author)")) - (assert (tagsMatch archive song1 "(and song western)")) - (assert !(tagsMatch archive song1 "(and song religious)")) - (assert (tagsMatch archive song2 "(and song religious)")) - (assert !(tagsMatch archive song2 "(and song western)")) + (assert (tagsMatch song1 "(and song western)")) + (assert !(tagsMatch song1 "(and song religious)")) + (assert (tagsMatch song2 "(and song religious)")) + (assert !(tagsMatch song2 "(and song western)")) (withWritableComponents archive song1 [author Author