314 lines
15 KiB
Plaintext
314 lines
15 KiB
Plaintext
(prop :Array<Entry> dailyEntries [])
|
|
(prop :Array<Entry> monthlyEntries [])
|
|
(prop :Array<Entry> intervalEntries [])
|
|
(prop :Array<Entry> bonusEntries [])
|
|
(prop :Array<Entry> todoEntries [])
|
|
(prop :kiss.List<RewardFile> rewardFiles [])
|
|
(prop &mut :Int pomodoroPoints 0)
|
|
|
|
(defNew [&prop :String textFile]
|
|
(let [s (Stream.fromFile textFile)
|
|
&mut lastHeader ""]
|
|
// TODO could be whileLet
|
|
(loop
|
|
(case (s.takeLine)
|
|
((Some "DAILY")
|
|
(set lastHeader "DAILY"))
|
|
((Some "MONTHLY")
|
|
(set lastHeader "MONTHLY"))
|
|
((Some "INTERVAL")
|
|
(set lastHeader "INTERVAL"))
|
|
((Some "BONUS")
|
|
(set lastHeader "BONUS"))
|
|
((Some "TODO")
|
|
(set lastHeader "TODO"))
|
|
((Some "FILES")
|
|
(set lastHeader "FILES"))
|
|
((Some "POMODORO")
|
|
(set lastHeader "POMODORO"))
|
|
((when (apply = (concat ["-"] (line.split ""))) (Some line))
|
|
(continue))
|
|
((Some "") (continue))
|
|
// Types won't unify with the next case, so this is its own:
|
|
((when (= lastHeader "FILES") (Some line))
|
|
(rewardFiles.push
|
|
(let [parts (line.split " ")
|
|
skipped (case (parts.pop)
|
|
("true" true)
|
|
("false" false)
|
|
(otherwise (throw "bad bool")))
|
|
piecesPerPoint (Std.parseInt (parts.pop))
|
|
puzzleHeight (Std.parseInt (parts.pop))
|
|
puzzleWidth (Std.parseInt (parts.pop))
|
|
startingPoints (Std.parseInt (parts.pop))
|
|
path (parts.join " ")]
|
|
(objectWith path startingPoints puzzleWidth puzzleHeight piecesPerPoint skipped))))
|
|
((when (= lastHeader "POMODORO") (Some line)) (set pomodoroPoints (Std.parseInt line)))
|
|
((Some line)
|
|
(let [topPriority (line.startsWith "! ")]
|
|
(when topPriority (set line (line.substr 2)))
|
|
(.push
|
|
(case lastHeader
|
|
("DAILY" dailyEntries)
|
|
("MONTHLY" monthlyEntries)
|
|
("INTERVAL" intervalEntries)
|
|
("BONUS" bonusEntries)
|
|
("TODO" todoEntries)
|
|
(otherwise (throw "bad header")))
|
|
(new Entry
|
|
(case lastHeader
|
|
("BONUS" Bonus)
|
|
("TODO" Todo)
|
|
("DAILY"
|
|
(case (line.split ":")
|
|
([noColon]
|
|
(Daily
|
|
// all days of week
|
|
(collect (range 1 8))
|
|
// never done before
|
|
""))
|
|
([::&mut preColon ...afterColon]
|
|
(set line (afterColon.join ":"))
|
|
(Daily
|
|
// Days of week specified by abbreviation:
|
|
(sort (filter
|
|
[
|
|
// disambiguate Th from T and Su from S:
|
|
(when (contains preColon "Th") {(set preColon (StringTools.replace preColon "Th" "")) 4})
|
|
(when (contains preColon "Su") {(set preColon (StringTools.replace preColon "Su" "")) 7})
|
|
(when (contains preColon "M") 1)
|
|
(when (contains preColon "T") 2)
|
|
(when (contains preColon "W") 3)
|
|
(when (contains preColon "F") 5)
|
|
(when (contains preColon "S") 6)
|
|
|
|
]))
|
|
// Last date completed after that:
|
|
(ifLet [[days date] (preColon.split " ")]
|
|
date
|
|
"")))
|
|
(otherwise (throw "bad line"))))
|
|
("MONTHLY"
|
|
(case (line.split ": ")
|
|
([::&mut preColon ...afterColon]
|
|
(set line (afterColon.join ": "))
|
|
(Monthly
|
|
// Days of month can be positive (1-31) or negative (-1 to -31)
|
|
(map (.split (first (preColon.split " ")) ",") Std.parseInt)
|
|
// Last date completed after that:
|
|
(ifLet [[::days ...date] (preColon.split " ")]
|
|
(date.join " ")
|
|
"")))
|
|
(otherwise (throw "bad line"))))
|
|
("INTERVAL"
|
|
(case (line.split ": ")
|
|
([::&mut preColon ...afterColon]
|
|
(set line (afterColon.join ": "))
|
|
(case (preColon.split " ")
|
|
([days]
|
|
(Interval (Std.parseInt days) ""))
|
|
([::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 (withoutPointsStr l))
|
|
points (countPoints l)))
|
|
topPriority))))
|
|
(otherwise (break))))))
|
|
|
|
(method :Array<Entry> allEntries []
|
|
(cast (concat
|
|
dailyEntries
|
|
monthlyEntries
|
|
intervalEntries
|
|
bonusEntries
|
|
todoEntries)))
|
|
|
|
(method :Array<Entry> allUndeletedEntries []
|
|
(filter (allEntries) isNotDeleted))
|
|
|
|
(method :Int totalPoints []
|
|
(+ pomodoroPoints (apply + (for l (flatten (for e (allEntries) e.labels)) l.points))))
|
|
|
|
(function stringify [:Entry e]
|
|
(e.toString))
|
|
|
|
(function :String stringifyRewardFile [:RewardFile rewardFile]
|
|
"${rewardFile.path} ${rewardFile.startingPoints} ${rewardFile.puzzleWidth} ${rewardFile.puzzleHeight} ${rewardFile.piecesPerPoint} ${rewardFile.skipped}")
|
|
|
|
(method :Void save []
|
|
(localVar &mut content "DAILY\n-----\n")
|
|
(+= content (.join (map dailyEntries stringify) "\n") "\n")
|
|
(+= content "\nMONTHLY\n--------\n")
|
|
(+= content (.join (map monthlyEntries stringify) "\n") "\n")
|
|
(+= content "\nINTERVAL\n--------\n")
|
|
(+= content (.join (map intervalEntries stringify) "\n") "\n")
|
|
(+= content "\nBONUS\n-----\n")
|
|
(+= content (.join (map bonusEntries stringify) "\n") "\n")
|
|
(+= content "\nTODO\n----\n")
|
|
(+= content (.join (map todoEntries stringify) "\n") "\n")
|
|
(+= content "\nPOMODORO\n--------\n${pomodoroPoints}\n")
|
|
(+= content "\nFILES\n-----\n")
|
|
(+= content (.join (map rewardFiles stringifyRewardFile) "\n") "\n")
|
|
(File.saveContent textFile
|
|
content))
|
|
|
|
// With rotating entries, the active one is the first one with the lowest score:
|
|
(function :EntryLabel activeLabel [:Entry e]
|
|
(let [lowScore (apply min (for label e.labels label.points))]
|
|
(doFor label e.labels (when (= lowScore label.points) (return label)))
|
|
(throw "no active?!")))
|
|
|
|
(function todayString []
|
|
(let [d (Date.now)] "$(d.getDate)-$(+ 1 (d.getMonth))-$(d.getFullYear)"))
|
|
|
|
(function isDeleted [:Entry e]
|
|
(or (.startsWith .label (first e.labels) "~")
|
|
(case e.type
|
|
(Todo !(= 0 .points (activeLabel e)))
|
|
(otherwise false))))
|
|
|
|
(function isNotDeleted [:Entry e]
|
|
!(isDeleted e))
|
|
|
|
(function _isActive [:Entry e]
|
|
(when (isDeleted e)
|
|
(return false))
|
|
(case e.type
|
|
((Daily days lastDayDone)
|
|
(let [&mut today (.getDay (Date.now))]
|
|
(when (= today 0) (set today 7))
|
|
(and !(= lastDayDone (todayString)) (contains days today))))
|
|
((Monthly days lastDayDone)
|
|
// TODO logic
|
|
(let [&mut nextDay
|
|
(DateTime.fromDate (Date.now))
|
|
oneDayInterval (DateTimeInterval.create (DateTime.make 1970 1 1) (DateTime.make 1970 1 2))
|
|
dayToEndSearch
|
|
(if lastDayDone
|
|
(DateTime.fromString lastDayDone)
|
|
(let [&mut now (DateTime.fromDate (Date.now))]
|
|
(until (= 1 (now.getDay)) #{now -= oneDayInterval;}#)
|
|
now))]
|
|
(until (and (= (nextDay.getDay) (dayToEndSearch.getDay)) (= (nextDay.getMonth) (dayToEndSearch.getMonth)) (= (nextDay.getYear) (dayToEndSearch.getYear)))
|
|
(let [daysInMonth (DateTime.daysInMonth (nextDay.getMonth) (nextDay.isLeapYear))
|
|
adjustedDays (for day days (% (+ daysInMonth day) daysInMonth))]
|
|
(when (contains adjustedDays (nextDay.getDay)) (return true)))
|
|
#{nextDay -= oneDayInterval;}#)
|
|
(return false)))
|
|
((Interval days lastDayDone)
|
|
(or !lastDayDone (<= days #{(DateTime.fromDate(Date.now()) - DateTime.fromString(lastDayDone)).getTotalDays();}#)))
|
|
(Todo (= 0 .points (activeLabel e)))
|
|
(otherwise true)))
|
|
|
|
// Check if an entry is active PRE-top priority filtering
|
|
(method :Array<Entry> _activeDailyEntries []
|
|
(filter dailyEntries _isActive))
|
|
|
|
(method :Array<Entry> _activeMonthlyEntries []
|
|
(filter monthlyEntries _isActive))
|
|
|
|
(method :Array<Entry> _activeIntervalEntries []
|
|
(filter intervalEntries _isActive))
|
|
|
|
(method :Array<Entry> _activeBonusEntries []
|
|
(filter bonusEntries _isActive))
|
|
|
|
(method :Array<Entry> _activeTodoEntries []
|
|
(filter todoEntries _isActive))
|
|
|
|
(method :Array<Entry> _allActiveEntries []
|
|
(cast (concat
|
|
(_activeDailyEntries)
|
|
(_activeMonthlyEntries)
|
|
(_activeIntervalEntries)
|
|
(_activeBonusEntries)
|
|
(_activeTodoEntries))))
|
|
|
|
(prop &mut :Bool showLowerPriority false)
|
|
|
|
(method :Bool topPriorityIsActive []
|
|
?(unless showLowerPriority (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
|
|
(Todo todoEntries)
|
|
(Bonus bonusEntries)
|
|
((Interval _ _) intervalEntries)
|
|
((Daily _ _) dailyEntries)
|
|
((Monthly _ _) monthlyEntries)
|
|
(otherwise (throw "")))
|
|
(new Entry type (for label labels (objectWith [points 0] label)) topPriority))
|
|
(save))
|
|
|
|
(method deleteEntry [:Entry e]
|
|
(set e.labels (for label e.labels (object points label.points label "~")))
|
|
(save))
|
|
|
|
(method toggleEntryPriority [:Entry e]
|
|
(set e.topPriority !e.topPriority)
|
|
(save))
|
|
|
|
(method addRewardFile [path startingPoints puzzleWidth puzzleHeight piecesPerPoint]
|
|
(rewardFiles.push (objectWith [skipped false] path startingPoints puzzleWidth puzzleHeight piecesPerPoint))
|
|
(save))
|
|
|
|
(method skipRewardFile []
|
|
(set .skipped (last rewardFiles) true)
|
|
(save))
|
|
|
|
(method addPoint [:Entry e]
|
|
(let [label (activeLabel e)]
|
|
(+= label.points 1)
|
|
// For task-list types, set lastDayDone when the final label is done
|
|
(when (apply = (for label e.labels label.points))
|
|
(whenLet [(Daily days lastDayDone) e.type]
|
|
(set e.type (Daily days (HabitModel.todayString))))
|
|
(whenLet [(Monthly days lastDayDone) e.type]
|
|
(set e.type (Monthly days (.toString (DateTime.now)))))
|
|
(whenLet [(Interval days lastDayDone) e.type]
|
|
(set e.type (Interval days (.toString (DateTime.now)))))))
|
|
(save))
|
|
|
|
(method addPomPoint []
|
|
(+= pomodoroPoints 1)
|
|
(save))
|
|
|
|
(var tallyUnit 5)
|
|
(function pointsStr [points]
|
|
(let [&mut str "" symbols ["+" "*" "\$"]]
|
|
(doFor i (reverse (collect (range symbols.length)))
|
|
(let [scaledTallyUnit (^ tallyUnit i)
|
|
tallies (Math.floor (/ points scaledTallyUnit))]
|
|
(+= str (* (nth symbols i) tallies))
|
|
(-= points (* tallies scaledTallyUnit))))
|
|
str))
|
|
|
|
(function withoutPointsStr [:String label]
|
|
(doFor c (.split "|+*\$" "") (set label (label.replace c "")))
|
|
label)
|
|
|
|
(function countPoints [:String pointStr]
|
|
(apply + (for char (pointStr.split "")
|
|
(case char
|
|
("|" 1)
|
|
("+" 1)
|
|
("*" tallyUnit)
|
|
("\$" (^ tallyUnit 2))
|
|
(otherwise 0))))) |