{-# LANGUAGE CPP #-} module FDefaults(module FDefaults,module Alignment,fromMaybe) where import Fudget import CompOps import Xtypes import Alignment(Alignment(..)) --import Geometry(pmax) import Data.Maybe(fromMaybe) import Sizing(Sizing) import GCAttrs --(ColorSpec,colorSpec) {- HBC uses "cpp -C -traditional" which causes all the to be left behind when the macro definitions are processed. That is why the definitions are inside a comment. -} type Customiser a = a -> a cust :: (a->a) -> Customiser a -- to obtain better type signatures cust = id type PF p a b = F (Either (Customiser p) a) b type PK p a b = K (Either (Customiser p) a) b getpar pp = fromMaybe (error "getpar:: missing default") . getparMaybe pp getparMaybe pp [] = Nothing getparMaybe pp (p:ps) = case pp p of Just a -> Just a Nothing -> getparMaybe pp ps noPF :: PF p a b -> F a b noPF f = f >=^< Right standard :: Customiser a standard = id class HasFontSpec xxx where { setFontSpec :: (FontSpec) -> Customiser xxx; getFontSpec :: xxx -> (FontSpec); getFontSpecMaybe :: xxx -> Maybe (FontSpec); getFontSpec = fromMaybe (error "get FontSpec: missing default") . getFontSpecMaybe } setFont f = setFontSpec (fontSpec f) --class HasTitle xxx where { setTitle :: (String) -> Customiser xxx; getTitle :: xxx -> (String); getTitleMaybe :: xxx -> Maybe (String); getTitle = fromMaybe (error "get Title: missing default") . getTitleMaybe } class HasKeys xxx where { setKeys :: ([(ModState,KeySym)]) -> Customiser xxx; getKeys :: xxx -> ([(ModState,KeySym)]); getKeysMaybe :: xxx -> Maybe ([(ModState,KeySym)]); getKeys = fromMaybe (error "get Keys: missing default") . getKeysMaybe } class HasWinAttr xxx where { setWinAttr :: ([WindowAttributes]) -> Customiser xxx; getWinAttr :: xxx -> ([WindowAttributes]); getWinAttrMaybe :: xxx -> Maybe ([WindowAttributes]); getWinAttr = fromMaybe (error "get WinAttr: missing default") . getWinAttrMaybe } class HasBorderWidth xxx where { setBorderWidth :: (Int) -> Customiser xxx; getBorderWidth :: xxx -> (Int); getBorderWidthMaybe :: xxx -> Maybe (Int); getBorderWidth = fromMaybe (error "get BorderWidth: missing default") . getBorderWidthMaybe } class HasBgColorSpec xxx where { setBgColorSpec :: (ColorSpec) -> Customiser xxx; getBgColorSpec :: xxx -> (ColorSpec); getBgColorSpecMaybe :: xxx -> Maybe (ColorSpec); getBgColorSpec = fromMaybe (error "get BgColorSpec: missing default") . getBgColorSpecMaybe } class HasFgColorSpec xxx where { setFgColorSpec :: (ColorSpec) -> Customiser xxx; getFgColorSpec :: xxx -> (ColorSpec); getFgColorSpecMaybe :: xxx -> Maybe (ColorSpec); getFgColorSpec = fromMaybe (error "get FgColorSpec: missing default") . getFgColorSpecMaybe } -- eta expanded because of the stupid monomorphism restriction setBgColor c = setBgColorSpec . colorSpec $ c setFgColor c = setFgColorSpec . colorSpec $ c --getBgColor c = getBgColorSpec $ c --getFgColor c = getFgColorSpec $ c class HasMargin xxx where { setMargin :: (Int) -> Customiser xxx; getMargin :: xxx -> (Int); getMarginMaybe :: xxx -> Maybe (Int); getMargin = fromMaybe (error "get Margin: missing default") . getMarginMaybe } class HasAlign xxx where { setAlign :: (Alignment) -> Customiser xxx; getAlign :: xxx -> (Alignment); getAlignMaybe :: xxx -> Maybe (Alignment); getAlign = fromMaybe (error "get Align: missing default") . getAlignMaybe } class HasInitSize xxx where { setInitSize :: a -> Customiser (xxx a); getInitSizeMaybe :: xxx a -> Maybe a; getInitSize :: xxx a -> a; getInitSize = fromMaybe (error "get InitSize: missing default") . getInitSizeMaybe } class HasInitDisp xxx where { setInitDisp :: a -> Customiser (xxx a); getInitDispMaybe :: xxx a -> Maybe a; getInitDisp :: xxx a -> a; getInitDisp = fromMaybe (error "get InitDisp: missing default") . getInitDispMaybe } class HasStretchable xxx where { setStretchable :: ((Bool,Bool)) -> Customiser xxx; getStretchable :: xxx -> ((Bool,Bool)); getStretchableMaybe :: xxx -> Maybe ((Bool,Bool)); getStretchable = fromMaybe (error "get Stretchable: missing default") . getStretchableMaybe } class HasInitText xxx where { setInitText :: ([String]) -> Customiser xxx; getInitText :: xxx -> ([String]); getInitTextMaybe :: xxx -> Maybe ([String]); getInitText = fromMaybe (error "get InitText: missing default") . getInitTextMaybe } class HasSizing xxx where { setSizing :: (Sizing) -> Customiser xxx; getSizing :: xxx -> (Sizing); getSizingMaybe :: xxx -> Maybe (Sizing); getSizing = fromMaybe (error "get Sizing: missing default") . getSizingMaybe }