1 files changed, 94 insertions, 0 deletions
diff --git a/irc/storage.rkt b/irc/storage.rkt
new file mode 100644
index 0000000..d1425de
--- /dev/null
+++ b/irc/storage.rkt
@@ -0,0 +1,94 @@
+#lang racket/base
+(require irc/core irc/bot irc/db irc/users
+         racket/list racket/function
+         racket/format racket/serialize
+         db sql)
+(provide (all-defined-out))
+
+(define (current-storage) (connection-storage (current-connection)))
+
+(struct storage
+  (user volatile-user
+   channel volatile-channel
+   network volatile-network))
+
+(define (storage-init)
+  (set-connection-storage!
+    (current-connection)
+    (storage (load-storage (select name data #:from users)) (make-hash)
+             (load-storage (select name data #:from channels)) (make-hash)
+             (load-storage (select name data #:from network)) (make-hash))))
+
+; TODO !!! IRC downcasing of nicks
+
+(define (user-storage user #:volatile? [volatile #f])
+  (hash-ref! ((if volatile storage-volatile-user storage-user)
+              (current-storage))
+             user (thunk (make-hash))))
+
+(define (channel-storage channel #:volatile? [volatile #f])
+  (hash-ref! ((if volatile storage-volatile-channel storage-channel)
+              (current-storage)))
+             channel (thunk (make-hash)))
+
+(define (network-storage name #:volatile? [volatile #f])
+  (hash-ref! ((if volatile storage-volatile-network storage-network)
+              (current-storage))
+             name (thunk (make-hash))))
+
+(define (load-storage query)
+  (define storage (make-hash))
+  (for ([(name data) (in-query (current-database) query)])
+    (hash-set! storage name (deserialize (safe-read-string data))))
+  storage)
+
+(define empty-serialized-hash
+  (~s (serialize (make-hash))))
+
+(define (persist-user user)
+  (query-exec (current-database)
+    (insert #:into users
+            #:set [name ,user]
+                  [power 0]
+                  [data ,empty-serialized-hash]
+            #:or-ignore))
+
+  (query-exec (current-database)
+    (update users
+      #:set [data ,(~s (serialize (user-storage user)))]
+      #:where (= name ,user))))
+
+(define (persist-channel channel)
+  (query-exec (current-database)
+    (insert #:into channels
+            #:set [name ,channel]
+                  [autojoin 0]                  
+                  [data ,empty-serialized-hash]
+            #:or-ignore))
+
+  (query-exec (current-database)
+    (update channels
+      #:set [data ,(~s (serialize (channel-storage channel)))]
+      #:where (= name ,channel))))
+
+(define (persist-network name)
+  (query-exec (current-database)
+    (insert #:into network
+            #:set [name ,name]
+                  [data ,empty-serialized-hash]
+            #:or-ignore))
+
+  (query-exec (current-database)
+    (update network
+      #:set [data ,(~s (serialize (network-storage name)))]
+      #:where (= name ,name))))
+
+(define (ref h . path)
+  (foldl (λ (p h) (hash-ref h p)) h path))
+
+(define (ref-set! h value . path)
+  (if (pair? (cdr path))
+    (apply ref-set!
+           (hash-ref! h (car path) (thunk (make-hash)))
+           value (cdr path))
+    (hash-set! h (car path) value)))