kiss-lang/kiss-vscode
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

logic for top-priority habit entries

Browse Source
This commit is contained in:
Nat Quayle Nelson
2022-09-11 00:05:08 +00:00
parent 2a34c29dcb
commit f774c1aa0d
3 changed files with 113 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
projects/flixel-desktop-habit-puzzle-game/source/Entry.kiss
View File

@@ -1,8 +1,9 @@
(defNew [&prop &mut :EntryType type (defNew [&prop &mut :EntryType type
&prop &mut :Array<EntryLabel> labels]) &prop &mut :Array<EntryLabel> labels
&prop &mut :Bool topPriority])
(method toString [] (method toString []
"$(case type "$?(when topPriority "! ")$(case type
((Daily days lastDayDone) ((Daily days lastDayDone)
(+ (+
(.join (for day days (.join (for day days

190
projects/flixel-desktop-habit-puzzle-game/source/HabitModel.kiss
View File

@@ -41,75 +41,78 @@
path (parts.join " ")] path (parts.join " ")]
(objectWith path startingPoints puzzleWidth puzzleHeight piecesPerPoint skipped)))) (objectWith path startingPoints puzzleWidth puzzleHeight piecesPerPoint skipped))))
((Some line) ((Some line)
(.push (let [topPriority (line.startsWith "! ")]
(case lastHeader (when topPriority (set line (line.substr 2)))
("DAILY" dailyEntries) (.push
("MONTHLY" monthlyEntries)
("INTERVAL" intervalEntries)
("BONUS" bonusEntries)
("TODO" todoEntries)
(otherwise (throw "bad header")))
(new Entry
(case lastHeader (case lastHeader
("BONUS" Bonus) ("DAILY" dailyEntries)
("TODO" Todo) ("MONTHLY" monthlyEntries)
("DAILY" ("INTERVAL" intervalEntries)
(case (line.split ":") ("BONUS" bonusEntries)
([noColon] ("TODO" todoEntries)
(Daily (otherwise (throw "bad header")))
// all days of week (new Entry
(collect (range 1 8)) (case lastHeader
// never done before ("BONUS" Bonus)
"")) ("TODO" Todo)
([::&mut preColon ...afterColon] ("DAILY"
(set line (afterColon.join ":")) (case (line.split ":")
(Daily ([noColon]
// Days of week specified by abbreviation: (Daily
(sort (filter // all days of week
[ (collect (range 1 8))
// disambiguate Th from T and Su from S: // never done before
(when (contains preColon "Th") {(set preColon (StringTools.replace preColon "Th" "")) 4}) ""))
(when (contains preColon "Su") {(set preColon (StringTools.replace preColon "Su" "")) 7}) ([::&mut preColon ...afterColon]
(when (contains preColon "M") 1) (set line (afterColon.join ":"))
(when (contains preColon "T") 2) (Daily
(when (contains preColon "W") 3) // Days of week specified by abbreviation:
(when (contains preColon "F") 5) (sort (filter
(when (contains preColon "S") 6) [
// disambiguate Th from T and Su from S:
])) (when (contains preColon "Th") {(set preColon (StringTools.replace preColon "Th" "")) 4})
// Last date completed after that: (when (contains preColon "Su") {(set preColon (StringTools.replace preColon "Su" "")) 7})
(ifLet [[days date] (preColon.split " ")] (when (contains preColon "M") 1)
date (when (contains preColon "T") 2)
""))) (when (contains preColon "W") 3)
(otherwise (throw "bad line")))) (when (contains preColon "F") 5)
("MONTHLY" (when (contains preColon "S") 6)
(case (line.split ": ")
([::&mut preColon ...afterColon] ]))
(set line (afterColon.join ": ")) // Last date completed after that:
(Monthly (ifLet [[days date] (preColon.split " ")]
// Days of month can be positive (1-31) or negative (-1 to -31) date
(map (.split (first (preColon.split " ")) ",") Std.parseInt) "")))
// Last date completed after that: (otherwise (throw "bad line"))))
(ifLet [[::days ...date] (preColon.split " ")] ("MONTHLY"
(date.join " ") (case (line.split ": ")
""))) ([::&mut preColon ...afterColon]
(otherwise (throw "bad line")))) (set line (afterColon.join ": "))
("INTERVAL" (Monthly
(case (line.split ": ") // Days of month can be positive (1-31) or negative (-1 to -31)
([::&mut preColon ...afterColon] (map (.split (first (preColon.split " ")) ",") Std.parseInt)
(set line (afterColon.join ": ")) // Last date completed after that:
(case (preColon.split " ") (ifLet [[::days ...date] (preColon.split " ")]
([days] (date.join " ")
(Interval (Std.parseInt days) "")) "")))
([::days ...lastDayDone] (otherwise (throw "bad line"))))
(Interval (Std.parseInt days) (lastDayDone.join " "))) ("INTERVAL"
(otherwise (throw "bad interval habit: $line")))) (case (line.split ": ")
(otherwise (throw "bad interval habit: $line")))) ([::&mut preColon ...afterColon]
(otherwise (throw "bad header: $lastHeader"))) (set line (afterColon.join ": "))
(for l (line.split "/") (case (preColon.split " ")
(object ([days]
label (StringTools.trim (StringTools.replace l "|" "")) (Interval (Std.parseInt days) ""))
points (count (l.split "") ->c (= c "|"))))))) ([::days ...lastDayDone]
(Interval (Std.parseInt days) (lastDayDone.join " ")))
(otherwise (throw "bad interval habit: $line"))))
(otherwise (throw "bad interval habit: $line"))))
(otherwise (throw "bad header: $lastHeader")))
(for l (line.split "/")
(object
label (StringTools.trim (StringTools.replace l "|" ""))
points (count (l.split "") ->c (= c "|"))))
topPriority))))
(otherwise (break)))))) (otherwise (break))))))
(method :Array<Entry> allEntries [] (method :Array<Entry> allEntries []
@@ -166,7 +169,7 @@
(function isNotDeleted [:Entry e] (function isNotDeleted [:Entry e]
!(isDeleted e)) !(isDeleted e))
(function isActive [:Entry e] (function _isActive [:Entry e]
(when (isDeleted e) (when (isDeleted e)
(return false)) (return false))
(case e.type (case e.type
@@ -196,22 +199,47 @@
(Todo (= 0 .points (activeLabel e))) (Todo (= 0 .points (activeLabel e)))
(otherwise true))) (otherwise true)))
(method :Array<Entry> activeDailyEntries [] // Check if an entry is active PRE-top priority filtering
(filter dailyEntries isActive)) (method :Array<Entry> _activeDailyEntries []
(filter dailyEntries _isActive))
(method :Array<Entry> activeMonthlyEntries [] (method :Array<Entry> _activeMonthlyEntries []
(filter monthlyEntries isActive)) (filter monthlyEntries _isActive))
(method :Array<Entry> activeIntervalEntries [] (method :Array<Entry> _activeIntervalEntries []
(filter intervalEntries isActive)) (filter intervalEntries _isActive))
(method :Array<Entry> activeBonusEntries [] (method :Array<Entry> _activeBonusEntries []
(filter bonusEntries isActive)) (filter bonusEntries _isActive))
(method :Array<Entry> activeTodoEntries [] (method :Array<Entry> _activeTodoEntries []
(filter todoEntries isActive)) (filter todoEntries _isActive))
(method addEntry [:EntryType type :Array<String> labels] (method :Array<Entry> _allActiveEntries []
(cast (concat
(_activeDailyEntries)
(_activeMonthlyEntries)
(_activeIntervalEntries)
(_activeBonusEntries)
(_activeTodoEntries))))
(method :Bool topPriorityIsActive []
(apply or (for e (_allActiveEntries) e.topPriority)))
(defMacro topPriority [name]
`(method :Array<Entry> ,name []
(let [_active (,(ReaderExp.Symbol (+ "_" (symbolNameValue name))))]
(if (topPriorityIsActive)
(filter _active ->e e.topPriority)
_active))))
(topPriority activeDailyEntries)
(topPriority activeMonthlyEntries)
(topPriority activeIntervalEntries)
(topPriority activeBonusEntries)
(topPriority activeTodoEntries)
(method addEntry [:EntryType type :Array<String> labels :Bool topPriority]
(.push (case type (.push (case type
(Todo todoEntries) (Todo todoEntries)
(Bonus bonusEntries) (Bonus bonusEntries)
@@ -219,7 +247,7 @@
((Daily _ _) dailyEntries) ((Daily _ _) dailyEntries)
((Monthly _ _) monthlyEntries) ((Monthly _ _) monthlyEntries)
(otherwise (throw ""))) (otherwise (throw "")))
(new Entry type (for label labels (objectWith [points 0] label)))) (new Entry type (for label labels (objectWith [points 0] label)) topPriority))
(save)) (save))
(method deleteEntry [:Entry e] (method deleteEntry [:Entry e]

2
projects/flixel-desktop-habit-puzzle-game/source/HabitState.kiss
View File

@@ -837,7 +837,7 @@
(labelsAdding.push entryNameText.text)) (labelsAdding.push entryNameText.text))
(unless labelsAdding (unless labelsAdding
(return)) (return))
(model.addEntry typeAdding labelsAdding) (model.addEntry typeAdding labelsAdding false) // TODO allow choosing priority!
(refreshModel) (refreshModel)
(entryNameText.kill) (entryNameText.kill)
(set entryNameText null) (set entryNameText null)