keyan · June 10, 2021 02:14 · Jun 10, 2021
diff --git a/news.6sep06.arc b/news.6sep06.arc
@@ -0,0 +1,228 @@
+; This is the earliest version of HN I can find.  It's 166 LOC, and
+; the write date is 6 Sep 2006, meaning it's 4 days old.  There are 
+; only two pages, news and submit, and there are no comments yet.
+; -------------------------------------------------------------------
+
+
+; News.  2 Sep 06.
+
+; todo: add newacct to login, 
+;  clean up defop2, inbox, admin ability to edit, del stories, log files
+;  only count 1 vote per low-karma acct per ip addr
+; generate the non-logged-in frontpage every half min as a string in
+;  memory and just dump it when requested
+; don't keep old stories in memory, fetch story titles, notice dups,
+; different user classes
+; have internal and external names for users, and store stuff under
+;  internal names, so if a name is reused, the new user doesn't get
+;  the old one's votes.  internal should be external+count
+
+; idea: a var that is always written to disk when modified, and whose
+; val is read off disk when unknown (initially).  lazy loading.
+
+(deftem profile
+  karma 1)
+
+(deftem story
+  id    (new-storyid)
+  url   nil
+  title nil
+  score 0
+  by    nil
+  time  (seconds))
+
+(= newsdir*  "/arc/news/"
+   storydir* "/arc/news/story/"
+   votedir*  "/arc/news/vote/"
+   profdir*  "/arc/news/profile/")
+
+(= sid* nil stories* nil)
+
+(def load-storyid ()
+  (= sid* (readfile1 "/arc/news/storyid")))
+
+(def save-storyid (n)
+  (writefile1 n "/arc/news/storyid"))
+
+(def new-storyid ()
+  (save-storyid (++ sid*)))
+
+
+(def load-stories ()
+  (= stories* (sort (fn (x y) (> (x 'id) (y 'id)))
+                    (map (fn (filename)
+                           (w/infile i (+ storydir* filename)
+                             (temread 'story i)))
+                         (dir storydir*)))))
+
+(def save-story (s)
+  (save-table s (string storydir* (s 'id))))
+
+(def load-news ()
+  (load-storyid)
+  (load-stories))
+
+
+(def frontpage-rank (s (o gravity 1))
+  (/ (s 'score) 
+     (expt (* (/ (max .5 (story-age s)) 60) gravity) 2)))
+
+(def story-age (s)
+  (/ (- (seconds) (s 'time)) 60.0))
+
+; later memoize scorefn if faster
+
+(def topstories (n (o scorefn frontpage-rank))
+  (bestn n 
+         (fn (x y) (> (scorefn x) (scorefn y)))
+         stories*))
+
+
+(= votes* (table) profs* (table))
+
+(def user-known (u)
+  (file-exists (+ votedir* u)))
+
+(def init-user (u)
+  (= (votes* u) (table) (profs* u) (instance 'profile))
+  (save-votes u)
+  (save-prof u)
+  u)
+
+(def load-user (u)
+  (= (votes* u) (load-table (+ votedir* u)))
+  (= (profs* u) (w/infile i (+ profdir* u) 
+                  (temread 'profile i)))
+  u)
+
+(def save-votes (u)
+  (save-table (votes* u) (+ votedir* u)))
+
+(def save-prof (u)
+  (w/outfile o (+ profdir* u)
+    (write (tablist (profs* u)) o)))
+
+; (save-table (profs* u) (+ profdir* u))
+
+(def ensure-news-user (u)
+  (when (and u (no (votes* u)))
+    (if (user-known u)
+        (load-user u)
+        (init-user u)))
+  u)
+
+
+(defop news (str args cooks)
+  (if (no stories*) (load-news))
+  (w/stdout str (newspage (get-user cooks))))
+
+; anonform2 within login2 is displaying the set-cookie header line
+; because fns defined with defop now automatically add the blank
+; line.
+
+; should be able to just define y as a regular op like x, but with
+;  defoph, and not have a special case for it in handle
+
+(def newspage (user)
+  (ensure-news-user user)
+  (whitepage
+    (intag b (pr "Top Stories"))
+    (hspace 30)
+    (if user (pr user " (" ((profs* user) 'karma) ") | "))
+    (if user
+        (newwith-ref (submit-page user)
+          (pr "submit"))
+        (newwith-ref (login2 "You have to be logged in to submit links."
+                          (fn (u)
+                            (submit-page u)))
+                  (pr "submit")))
+    (pr " | ")
+    (if user
+        (newwith-ref (do (logout-user user)
+                      (newspage nil))
+          (pr "logout"))
+        ; when have with-ref2 add a login option
+        )
+    ; *** remove before flight
+          (hspace 30)
+          (intag (a href "kapow") (pr "kill server"))
+    (brs 2)
+    (intag (table border 0)
+      (let i 0
+        (foreach s (topstories 50) 
+          (display-story (++ i) s user))))))
+
+(def display-story (i story user)
+  (tr
+    (intag (td align 'right) (pr i "."))
+    (td (if (or (no user)
+                (no ((votes* user) (story 'id))))
+            (newwith-ref (if user
+                          (do (vote-for user story)
+                              (newspage user))
+                          (login2 "You have to be logged in to vote."
+                                  (fn (u)
+                                    (ensure-news-user u)
+                                    (unless ((votes* u) (story 'id))
+                                      (vote-for u story))
+                                    (newspage u))))
+               (pr "^"))))
+    (td (intag (a href (story 'url))
+          (pr (story 'title)))))
+  (tr (intag (td colspan 2))
+      (td (intag (font size 1 color (gray 130))
+            (prs (story 'score) "points" 
+                 "by" (story 'by) 
+                 (into-string 
+                   (let a (story-age story)
+                     (if (> a 120)
+                         (prs (round (/ a 60)) "hours ago")
+                         (prs (round a)        "minutes ago")))))))))
+
+(def vote-for (user story)
+  (++ (story 'score))
+  (save-story story)
+  (= ((votes* user) (story 'id)) (story 'score))
+  (save-votes user)
+  (let submitter (story 'by)
+    (unless (is user submitter)
+      (ensure-news-user submitter)
+      (++ ((profs* submitter) 'karma))
+      (save-prof submitter))))
+
+(defop submit (str args cooks)
+  (aif (get-user cooks)
+       (w/stdout str (submit-page it))
+       (page str (invite-login))))
+
+(def submit-page (user)
+  (ensure-news-user user)
+  (whitepage
+    (intag b (pr "Submit Story"))
+    (newanonform (fn (args)
+                   (with (url (alref args "u") title (alref args "t"))
+                     (let s (obj id    (new-storyid) 
+                                 url   url 
+                                 title title
+                                 score 0
+                                 by    user
+                                 time  (seconds))
+                       (vote-for user s)
+                       (push s stories*)))
+                   (newspage user))
+      (inputs u url   50 nil
+              t title 50 nil)
+      (submit "submit"))))
+
+
+; junk
+
+(defop t1 (str args cooks)
+  (w/stdout str
+    (whitepage 
+      (newanonform (fn (args)
+                     (whitepage
+                       (pr (alref args "n") " is " (alref args "a") ".")))
+        (inputs n name 20 nil
+                a age  3  nil)
+        (submit "submit")))))