some non-reflective frp deployment working

diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor
index 9a3e605c7fc4926f5b5f90fd1fd4af6259208529..a859c36f2e22661c7c8b2dee311d7de787e43c00 100644 (file)
--- a/extra/monads/monads.factor
+++ b/extra/monads/monads.factor
@@ -8,6 +8,7 @@ IN: monads
 ! Functors
 GENERIC# fmap 1 ( functor quot -- functor' )
 GENERIC# <$ 1 ( functor quot -- functor' )
 ! Functors
 GENERIC# fmap 1 ( functor quot -- functor' )
 GENERIC# <$ 1 ( functor quot -- functor' )

+GENERIC# $> 1 ( functor quot -- functor' )

 
 ! Monads
 
 
 ! Monads
 

diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index 479d39a2b7b4a2b7be5093df54cd34955b9ce41e..8100bce353d3d7940dcab3aa2e88b7eeae097cb6 100644 (file)
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -1,7 +1,6 @@
 USING: accessors arrays byte-arrays calendar classes classes.tuple
 classes.tuple.parser combinators db db.tuples db.types kernel
 USING: accessors arrays byte-arrays calendar classes classes.tuple
 classes.tuple.parser combinators db db.tuples db.types kernel

-math prettyprint sequences strings unicode.case urls words
-tools.continuations ;
+math sequences strings unicode.case urls words ;

 IN: persistency
 
 TUPLE: persistent id ;
 IN: persistency
 
 TUPLE: persistent id ;


@@ -13,7 +12,7 @@ TUPLE: persistent id ;
 : remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
 
 SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types 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 ;
+   [ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ;

 
 : define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
 
 
 : define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
 

diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index db693e350c4f091f4fa923bc3d371f5f0ecfc0df..a1287c736346d9a5a0a90f8071d86a7e31ab90ba 100644 (file)
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,6 +1,6 @@
-USING: accessors arrays kernel models monads sequences
+USING: accessors assocs arrays kernel models monads sequences

 ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons
 ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons

-ui.gadgets.buttons.private ui.gadgets.editors
+ui.gadgets.buttons.private ui.gadgets.editors words images.loader

 ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer ;
 IN: ui.frp.gadgets
 
 ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer ;
 IN: ui.frp.gadgets
 


@@ -52,10 +52,11 @@ M: frp-field model-changed 2dup frp-model>> =
 : <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
     f <model> >>model ;
 
 : <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
     f <model> >>model ;
 

-: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> ;
-SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
+: image-prep ( -- quot ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround [ <image-name> ] [ load-image ] [ ] tri
+    [ \ cached-image "memoize" word-prop set-at ] 3curry ;
+SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] append over push-all ;

 
 

-SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] append over push-all ;

 
 GENERIC: output-model ( gadget -- model )
 M: gadget output-model model>> ;
 
 GENERIC: output-model ( gadget -- model )
 M: gadget output-model model>> ;


@@ -75,4 +76,6 @@ INSTANCE: gadget-monad monad
 INSTANCE: gadget monad
 M: gadget monad-of drop gadget-monad ;
 M: gadget-monad return drop <gadget> swap >>model ;
 INSTANCE: gadget monad
 M: gadget monad-of drop gadget-monad ;
 M: gadget-monad return drop <gadget> swap >>model ;

-M: gadget >>= output-model [ swap call( x -- y ) ] curry ; 
\ No newline at end of file
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ; 
+
+! Make sure prop removal really destroys normal db code
\ No newline at end of file

diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 88443dc4795f53fe1874ffa49b37d70c2c3a6ea5..c3c32cd76f420ba9390a6775f3d8c6410a5cce1a 100644 (file)
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -21,8 +21,8 @@ TUPLE: placeholder < gadget members ;
 ! Just take the previous mentioned placeholder and use it
 ! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
 DEFER: with-interface
 ! Just take the previous mentioned placeholder and use it
 ! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
 DEFER: with-interface

-: insertion-quot ( quot -- quot' ) make:building get [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
-    swap '[ [ _ , @ ] with-interface ] ;
+: insertion-quot ( quot -- quot' ) make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
+    swap '[ [ _ , @ ] with-interface ] ] when* ;

 
 SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
 SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
 
 SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
 SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;


@@ -71,4 +71,7 @@ M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
 
 : with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
 
 
 : with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
 

-M: model >>= [ swap insertion-quot <action> ] curry ;
\ No newline at end of file
+M: model >>= [ swap insertion-quot <action> ] curry ;
+M: model fmap insertion-quot <mapped> ;
+M: model $> insertion-quot side-effect-model new-mapped-model ;
+M: model <$ insertion-quot quot-model new-mapped-model ;
\ No newline at end of file

diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 9ba2fc6cd2d655f8e812053daa9f3f4fd72e9edb..681ffafeae715cd75af27b9a6d85305f36f3d13b 100644 (file)
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -71,11 +71,8 @@ M: mapped-model (model-changed)
 TUPLE: side-effect-model < mapped-model ;
 M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
 
 TUPLE: side-effect-model < mapped-model ;
 M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
 

-: $> ( model quot -- signal ) side-effect-model new-mapped-model ;
-

 TUPLE: quot-model < mapped-model ;
 M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
 TUPLE: quot-model < mapped-model ;
 M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;

-M: model <$ quot-model new-mapped-model ;

 
 TUPLE: action-value < basic-model parent ;
 : <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
 
 TUPLE: action-value < basic-model parent ;
 : <action-value> ( parent value -- model ) action-value new-model swap >>parent ;


@@ -105,5 +102,4 @@ M: (frp-when) (model-changed) [ quot>> ] 2keep
 : with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
 
 USE: ui.frp.signals.templates
 : with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
 
 USE: ui.frp.signals.templates

-M: model fmap <mapped> ;

 << { "$>" "<$" "fmap" } [ fmaps ] each >>
\ No newline at end of file
 << { "$>" "<$" "fmap" } [ fmaps ] each >>
\ No newline at end of file

diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 427c423ea5b43a1115939b87da8f4f754311dab9..dc81aff15e56c5df5aab2f15ff206a9f18e03238 100644 (file)
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,4 +1,4 @@
-USING: accessors models macros generalizations kernel
+USING: accessors models monads macros generalizations kernel

 ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
 ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
 ui.gadgets.packs locals sequences fonts io.styles
 ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
 ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
 ui.gadgets.packs locals sequences fonts io.styles