{-# 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)
#include "defaults.h"

type Customiser a = a ->  a
cust :: (a->a) -> Customiser a -- to obtain better type signatures
cust :: (a -> a) -> a -> a
cust = (a -> a) -> a -> a
forall a. a -> a
id

type PF p a b = F (Either (Customiser p) a) b
type PK p a b = K (Either (Customiser p) a) b

getpar :: (t -> Maybe c) -> [t] -> c
getpar t -> Maybe c
pp = c -> Maybe c -> c
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> c
forall a. HasCallStack => [Char] -> a
error [Char]
"getpar:: missing default") (Maybe c -> c) -> ([t] -> Maybe c) -> [t] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Maybe c) -> [t] -> Maybe c
forall t a. (t -> Maybe a) -> [t] -> Maybe a
getparMaybe t -> Maybe c
pp

getparMaybe :: (t -> Maybe a) -> [t] -> Maybe a
getparMaybe t -> Maybe a
pp [] = Maybe a
forall a. Maybe a
Nothing
getparMaybe t -> Maybe a
pp (t
p:[t]
ps) =
     case t -> Maybe a
pp t
p of
       Just a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
       Maybe a
Nothing -> (t -> Maybe a) -> [t] -> Maybe a
getparMaybe t -> Maybe a
pp [t]
ps

noPF :: PF p a b -> F a b
noPF :: PF p a b -> F a b
noPF PF p a b
f = PF p a b
f PF p a b -> (a -> Either (Customiser p) a) -> F a b
forall c d e. F c d -> (e -> c) -> F e d
>=^< a -> Either (Customiser p) a
forall a b. b -> Either a b
Right

standard :: Customiser a
standard :: Customiser a
standard = Customiser a
forall a. a -> a
id

parameter_class(FontSpec,FontSpec)
setFont :: a -> Customiser xxx
setFont a
f = FontSpec -> Customiser xxx
forall xxx. HasFontSpec xxx => FontSpec -> Customiser xxx
setFontSpec (a -> FontSpec
forall a. (Show a, FontGen a) => a -> FontSpec
fontSpec a
f)

--parameter_class(Title,String)
parameter_class(Keys,[(ModState,KeySym)])
parameter_class(WinAttr,[WindowAttributes])
parameter_class(BorderWidth,Int)

parameter_class(BgColorSpec,ColorSpec)
parameter_class(FgColorSpec,ColorSpec)
-- eta expanded because of the stupid monomorphism restriction
setBgColor :: a -> Customiser xxx
setBgColor a
c = ColorSpec -> Customiser xxx
forall xxx. HasBgColorSpec xxx => ColorSpec -> Customiser xxx
setBgColorSpec (ColorSpec -> Customiser xxx)
-> (a -> ColorSpec) -> a -> Customiser xxx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (a -> Customiser xxx) -> a -> Customiser xxx
forall a b. (a -> b) -> a -> b
$ a
c
setFgColor :: a -> Customiser xxx
setFgColor a
c = ColorSpec -> Customiser xxx
forall xxx. HasFgColorSpec xxx => ColorSpec -> Customiser xxx
setFgColorSpec (ColorSpec -> Customiser xxx)
-> (a -> ColorSpec) -> a -> Customiser xxx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (a -> Customiser xxx) -> a -> Customiser xxx
forall a b. (a -> b) -> a -> b
$ a
c
--getBgColor c = getBgColorSpec $ c
--getFgColor c = getFgColorSpec $ c

parameter_class(Margin,Int)
parameter_class(Align,Alignment)
parameter_class1(InitSize)
parameter_class1(InitDisp)
parameter_class(Stretchable,(Bool,Bool))
parameter_class(InitText,[String])
parameter_class(Sizing,Sizing)