From 63f3c5dedd01569366e5209a79d79ec6c940d020 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 16 Jun 2009 14:36:01 -0500
Subject: [PATCH] persistency allows sql types for slots

---
 basis/db/queries/queries.factor      |  6 +++-
 extra/persistency/persistency.factor |  9 ++++--
 extra/recipes/recipes.factor         | 41 ++++++++++++++++++----------
 3 files changed, 37 insertions(+), 19 deletions(-)

diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index c4aa47d383..d2674205b1 100755
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -4,7 +4,7 @@ USING: accessors kernel math namespaces make sequences random
 strings math.parser math.intervals combinators math.bitwise
 nmake db db.tuples db.types classes words shuffle arrays
 destructors continuations db.tuples.private prettyprint
-db.private byte-arrays ;
+db.private byte-arrays strings.parser parser ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -130,6 +130,10 @@ M: integer where ( spec obj -- ) object-where ;
 
 M: string where ( spec obj -- ) object-where ;
 
+TUPLE: pattern value ; C: <pattern> pattern
+SYNTAX: %" parse-string <pattern> parsed ;
+M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ;
+
 : filter-slots ( tuple specs -- specs' )
     [
         slot-name>> swap get-slot-named
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index e56a81fd7c..479d39a2b7 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -6,10 +6,13 @@ IN: persistency
 
 TUPLE: persistent id ;
 
-: add-types ( table -- table' ) [ dup array? [ first ] when dup >upper FACTOR-BLOB 3array ] map
-    { "id" "ID" +db-assigned-id+ } prefix ;
+: add-types ( table -- table' ) [ dup array? [ [ first dup >upper ] [ second ] bi 3array ]
+        [ dup >upper FACTOR-BLOB 3array ] if
+    ] map { "id" "ID" +db-assigned-id+ } prefix ;
 
-SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ define-tuple-class ]
+: remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
+
+SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ]
    [ nip [ dup unparse >upper ] [ add-types ] bi* define-persistent ] 3bi ;
 
 : define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 788dfb1a51..f9663403f5 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,18 +1,23 @@
-USING: accessors arrays db.tuples db.sqlite persistency
+USING: accessors arrays db.tuples db.sqlite persistency db.queries
 io.files.temp kernel monads sequences ui ui.frp.gadgets
 ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
-colors.constants ui.pens.solid combinators math locals strings
-ui.tools.inspector ;
+colors.constants ui.pens.solid combinators math locals strings fries
+ui.images db.types ;
 FROM: sets => prune ;
 IN: recipes
-STORED-TUPLE: recipe title votes txt genre ;
-: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title ;
+STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
+: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
 "recipes.db" temp-file <sqlite-db> recipe define-db
-: top-recipes ( -- recipes ) <query> T{ recipe } >>tuple "votes" >>order get-tuples ;
-: top-genres ( -- genres ) top-recipes [ genre>> ] map prune 5 (head-slice) ;
+: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
+    "votes" >>order 30 >>limit swap >>offset get-tuples ;
+: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
+: <image-button> ( str -- button ) i" vocab:recipes/icons/_.tiff" <image-name> <frp-button> ;
+
 : interface ( -- book ) [ 
      [
-        [ $ TOOLBAR $ <spacer> $ GENRES $ ] <hbox> { 5 0 } >>gap COLOR: gray <solid> >>interior ,
+        [ $ TOOLBAR $ <spacer> $ SEARCH $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
+        [ "Genres:" <label> , <spacer> $ GENRES $ ] <hbox>
+            { 5 0 } >>gap COLOR: gray <solid> >>interior ,
         $ RECIPES $
      ] <vbox> ,
      [
@@ -21,19 +26,27 @@ STORED-TUPLE: recipe title votes txt genre ;
         $ BUTTON $
      ] <vbox> ,
   ] <frp-book*> { 350 245 } >>pref-dim ;
+  
 :: recipe-browser ( -- ) [
     interface
       <frp-table*> :> tbl
       "okay" <frp-border-button> BUTTON -> :> ok
-      "Submit Recipe" <frp-button> [ store-tuple ] >>value TOOLBAR -> :> submit
+      "submit" <image-button> [ store-tuple ] >>value TOOLBAR -> :> submit
+      "love" <image-button> TOOLBAR -> [ 1 ] <$
+      "hate" <image-button> -> [ -1 ] <$ 2array <merge> :> votes
+      "back" <image-button> -> [ -30 ] <$
+      "more" <image-button> -> [ 30 ] <$ 2array <merge> :> viewed
+      <frp-field*> SEARCH ->% 1 :> search
       submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
-      ok t <basic> "all" <frp-button> GENRES -> 3array <merge> [ top-recipes ] <$ :> updates
+      viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> GENRES -> 3array <merge>
+        [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
       updates [ top-genres UI[ <frp-button> GENRES ->? ] map <merge> ] bind*
         [ text>> T{ recipe } swap >>genre get-tuples ] fmap
       tbl swap updates 2array <merge> >>model
         [ [ title>> ] [ genre>> ] bi 2array ] >>quot
-        { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1
-        actions>> submit [ "" dup dup <recipe> ] <$ 2array <merge>
+        { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>> :> val
+      val votes [ [ + ] curry change-votes store-tuple ] 2$>-| ,
+      val submit [ "" dup dup <recipe> ] <$ 2array <merge>
         { [ [ title>> ] fmap <frp-field> TITLE ->% .5 ]
           [ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
           [ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
@@ -44,6 +57,4 @@ STORED-TUPLE: recipe title votes txt genre ;
       2array <merge> 0 <basic> <switch> >>model
    ] with-interface "recipes" open-window ;
 
-MAIN: recipe-browser
-
-! should clear out old values on submission
\ No newline at end of file
+MAIN: recipe-browser
\ No newline at end of file