{-# OPTIONS -fglasgow-exts #-}--------------------------------------------------------------------------------{-| Module : Attributes
Copyright : (c) Daan Leijen 2003
License : wxWindows
Maintainer : daan@cs.uu.nl
Stability : provisional
Portability : portable
Widgets @w@ can have attributes of type @a@ represented by the type 'Attr' @w a@.
An example of an attribute is 'Graphics.UI.WX.Classes.text' with type:
> text :: Attr (Window a) String
This means that any object derived from 'Window' has a 'Graphics.UI.WX.Classes.text' attribute of type 'String'.
An attribute can be read with the 'get' function:
> get w title :: IO String
When an attribute is associated with a value, we call it a /property/ of type 'Prop' @w@.
Properties are constructed by assigning a value to an attribute with the (':=') constructor:
> text := "hello world" :: Prop (Window a)
A list of properties can be set with the 'set' function:
> set w [text := "Hi"] :: IO ()
The (':~') constructor is used to transform an attribute value with an update function.
For example, the 'interval' on a timer can be doubled with the following expression.
> set timer [interval :~ (*2)]
The functions 'get', 'set', (':='), and (':~') are polymorphic and work for all widgets, but
the @text@ attribute just works for windows. Many attributes work for different kind
of objects and are organised into type classes. Actually, the real type of the
'Graphics.UI.WX.Classes.text' attribute is:
> Textual w => Attr w String
and 'Window' derived objects are part of this class:
> instance Textual (Window a)
But also menus and status fields:
> instance Textual (Menu a)
> instance Textual (StatusField)
Sometimes, it is convenient to also get a reference to the object itself when setting
a property. The operators ('::=') and ('::~') provide this reference.
-}--------------------------------------------------------------------------------moduleGraphics.UI.WX.Attributes(-- * AttributesAttr,Prop((:=),(:~),(::=),(::~)),ReadAttr,WriteAttr,CreateAttr,get,set,swap,mapAttr,mapAttrW-- * Internal-- ** Attributes,newAttr,readAttr,writeAttr,nullAttr,constAttr,makeAttr-- ** Reflection,attrName,propName,containsProperty-- ** Reflective attributes,reflectiveAttr,createAttr,withProperty,findProperty,withStyleProperty,withStylePropertyNot-- *** Filter,PropValue(..),filterProperty-- ** Cast,castAttr,castProp,castProps)whereimportGraphics.UI.WX.TypesimportData.Dynamicinfixr0:=,:~,::=,::~-- | A property of a widget @w@ is an attribute that-- is already associated with a value. .dataPropw=foralla.Attrwa:=a-- ^ Assign a value to an attribute.|foralla.Attrwa:~(a->a)-- ^ Apply an update function to an attribute.|foralla.Attrwa::=(w->a)-- ^ Assign a value to an attribute with the widget as argument.|foralla.Attrwa::~(w->a->a)-- ^ Apply an update function to an attribute with the widget as an argument.-- | An attribute that should be specified at creation time. Just for documentation purposes.typeCreateAttrwa=Attrwa-- | A read-only attribute. Just for documentation purposes.typeReadAttrwa=Attrwa-- | A write-only attribute. Just for documentation purposes.typeWriteAttrwa=Attrwa-- | Widgets @w@ can have attributes of type @a@.dataAttrwa=AttrString(Maybe(a->Dynamic,Dynamic->Maybea))-- name, dynamic conversion(w->IOa)(w->a->IO())-- getter setter (w->(a->a)->IOa)-- updater -- | Cast attributes.castAttr::(v->w)->Attrwa->AttrvacastAttrcoerce(Attrnamembdyngettersetterupd)=Attrnamembdyn(\v->getter(coercev))(\vx->(setter(coercev)x))(\vf->upd(coercev)f)-- | Cast propertiescastProp::(v->w)->Propw->PropvcastPropcoerceprop=casepropof(attr:=x)->(castAttrcoerceattr):=x(attr:~f)->(castAttrcoerceattr):~f(attr::=f)->(castAttrcoerceattr)::=(\v->f(coercev))(attr::~f)->(castAttrcoerceattr)::~(\vx->f(coercev)x)-- | Cast a list of properties.castProps::(v->w)->[Propw]->[Propv]castPropscoerceprops=map(castPropcoerce)props-- | Create a /reflective/ attribute with a specified name: value can possibly-- retrieved using 'getPropValue'. Note: the use of this function is discouraged-- as it leads to non-compositional code.reflectiveAttr::Typeablea=>String->(w->IOa)->(w->a->IO())->AttrwareflectiveAttrnamegettersetter=Attrname(Just(toDyn,fromDynamic))gettersetterupdaterwhereupdaterwf=dox<-getterw;setterw(fx);returnx-- | Create a /reflective/ attribute with a specified name: value can possibly-- retrieved using 'getPropValue'. Note: the use of this function is discouraged-- as it leads to non-compositional code.createAttr::Typeablea=>String->(w->IOa)->(w->a->IO())->CreateAttrwacreateAttrnamegettersetter=reflectiveAttrnamegettersetter-- | Create a new attribute with a specified name, getter, setter, and updater function.makeAttr::String->(w->IOa)->(w->a->IO())->(w->(a->a)->IOa)->AttrwamakeAttrnamegettersetterupdater=AttrnameNothinggettersetterupdater-- | Create a new attribute with a specified name, getter and setter function.newAttr::String->(w->IOa)->(w->a->IO())->AttrwanewAttrnamegettersetter=makeAttrnamegettersetterupdaterwhereupdaterwf=dox<-getterw;setterw(fx);returnx-- | Define a read-only attribute.readAttr::String->(w->IOa)->ReadAttrwareadAttrnamegetter=newAttrnamegetter(\wx->ioError(userError("attribute '"++name++"' is read-only.")))-- | Define a write-only attribute.writeAttr::String->(w->a->IO())->WriteAttrwawriteAttrnamesetter=newAttrname(\w->ioError(userError("attribute '"++name++"' is write-only.")))setter-- | A dummy attribute.nullAttr::String->WriteAttrwanullAttrname=writeAttrname(\wx->return())-- | A constant attribute.constAttr::Typeablea=>String->a->AttrwaconstAttrnamex=newAttrname(\w->returnx)(\wx->return())-- | (@mapAttr get set attr@) maps an attribute of @Attr w a@ to-- @Attr w b@ where (@get :: a -> b@) is used when the attribute is-- requested and (@set :: a -> b -> a@) is applied to current-- value when the attribute is set.mapAttr::(a->b)->(a->b->a)->Attrwa->AttrwbmapAttrgetset(Attrnamereflectgettersetterupdater)=AttrnameNothing(\w->doa<-getterw;return(geta))(\wb->doa<-getterw;setterw(setab))(\wf->doa<-updaterw(\a->seta(f(geta)));return(geta))-- | (@mapAttrW conv attr@) maps an attribute of @Attr w a@ to-- @Attr v a@ where (@conv :: v -> w@) is used to convert a widget-- @v@ into a widget of type @w@.mapAttrW::(v->w)->Attrwa->AttrvamapAttrWfattr=castAttrfattr-- | Get the value of an attribute---- > t <- get w text--get::w->Attrwa->IOagetw(Attrnamereflectgettersetterupdater)=getterw-- | Set a list of properties.---- > set w [text := "Hi"]--set::w->[Propw]->IO()setwprops=mapM_setproppropswheresetprop((Attrnamereflectgettersetterupdater):=x)=setterwxsetprop((Attrnamereflectgettersetterupdater):~f)=doupdaterwf;return()setprop((Attrnamereflectgettersetterupdater)::=f)=setterw(fw)setprop((Attrnamereflectgettersetterupdater)::~f)=doupdaterw(fw);return()-- | Set the value of an attribute and return the old value.swap::w->Attrwa->a->IOaswapw(Attrnamereflectgettersetterupdater)x=updaterw(constx)-- | Retrieve the name of an attributeattrName::Attrwa->StringattrName(Attrname____)=name-- | Retrieve the name of a property.propName::Propw->StringpropName(attr:=x)=attrNameattrpropName(attr:~f)=attrNameattrpropName(attr::=f)=attrNameattrpropName(attr::~f)=attrNameattr-- | Is a certain property in a list of properties?containsProperty::Attrwa->[Propw]->BoolcontainsPropertyattrprops=containsPropName(attrNameattr)props-- | Is a certain property in a list of properties?containsPropName::String->[Propw]->BoolcontainsPropNamenameprops=any(\p->propNamep==name)props-- | Property value: used when retrieving a property from a list.dataPropValuea=PropValuea|PropModify(a->a)|PropNoneinstanceShowa=>Show(PropValuea)whereshow(PropValuex)="PropValue "++showxshow(PropModifyf)="PropModify"show(PropNone)="PropNone"-- | Retrieve the value of a property and the list with the property removed.filterProperty::Typeablea=>Attrwa->[Propw]->(PropValuea,[Propw])filterProperty(Attrname____)props=walk[]PropNonepropswhere-- Daan: oh, how a simple thing like properties can result into this... ;-)walk::Typeablea=>[Propw]->PropValuea->[Propw]->(PropValuea,[Propw])walkaccresprops=casepropsof-- Property setter found.(((Attrattr(Just(todyn,fromdyn))___):=x):rest)|name==attr->casefromDynamic(todynx)ofJustx->walkacc(PropValuex)restNothing->walkaccresprops-- Property modifier found.(((Attrattr(Just(todyn,fromdyn))___):~f):rest)|name==attr->letdynfx=casefromdyn(toDynx)ofJustxx->casefromDynamic(todyn(fxx))ofJusty->yNothing->x-- identityNothing->x-- identityincaseresofPropValuex->walkacc(PropValue(dynfx))restPropModifyg->walkacc(PropModify(dynf.g))restPropNone->walkacc(PropModifydynf)rest-- Property found, but with the wrong arguments(((Attrattr____):=_):rest)|name==attr->stop(((Attrattr____):~_):rest)|name==attr->stop(((Attrattr____)::=_):rest)|name==attr->stop(((Attrattr____)::~_):rest)|name==attr->stop-- Defaults(prop:rest)->walk(prop:acc)resrest[]->stopwherestop=(res,reverseacc++props)-- | Try to find a property value and call the contination function with that value-- and the property list witht the searched property removed. If the property is not-- found, use the default value and the unchanged property list.withProperty::Typeablea=>Attrwa->a->(a->[Propw]->b)->[Propw]->bwithPropertyattrdefcontprops=casefilterPropertyattrpropsof(PropValuex,ps)->contxps(PropModifyf,ps)->cont(fdef)ps(PropNone,ps)->contdefps-- | Try to find a property value. Return |Nothing| if not found at all.findProperty::Typeablea=>Attrwa->a->[Propw]->Maybe(a,[Propw])findPropertyattrdefprops=casefilterPropertyattrpropsof(PropValuex,ps)->Just(x,ps)(PropModifyf,ps)->Just(fdef,ps)(PropNone,ps)->Nothing-- | Transform the properties based on a style property.withStyleProperty::AttrwBool->Style->([Propw]->Style->a)->[Propw]->Style->awithStylePropertypropflag=withStylePropertyExprop(bitsSetflag)(\isSetstyle->ifisSetthen(style.+.flag)else(style.-.flag))-- | Transform the properties based on a style property. The flag is interpreted negatively, i.e. |True|-- removes the bit instead of setting it.withStylePropertyNot::AttrwBool->Style->([Propw]->Style->a)->[Propw]->Style->awithStylePropertyNotpropflag=withStylePropertyExprop(not.bitsSetflag)(\isSetstyle->ifisSetthen(style.-.flag)else(style.+.flag))-- | Transform the properties based on a style property.withStylePropertyEx::AttrwBool->(Style->Bool)->(Bool->Style->Style)->([Propw]->Style->a)->[Propw]->Style->awithStylePropertyExpropdeftransformcontpropsstyle=casefilterPropertyproppropsof(PropValuex,ps)->contps(transformxstyle)(PropModifyf,ps)->contps(transform(f(defstyle))style)(PropNone,ps)->contpsstyle