1 {-| 2 PriLabels are labels with a priority. 3 4 PriLabels are usefull when widgets can have their label set multiple 5 times. This happens with genericcally created widgets. For example in: 6 7 data Foo = Foo { someName :: Bar } 8 data Bar = Bar Int 9 10 widgets created from Bar instances can have labels set due it's 11 constructor name and the fieldName in Foo (someName). A GUI 12 application programmer may also set the widgets label. 13 14 When a widget has set it's label multiple times, the priority can be 15 used to decide which label should be chosen. 16 -} 17 module Graphics.UI.SybWidget.PriLabel 18 ( PriLabel(..) 19 , Priority(..) 20 , badConstrLabel, goodConstrLabel, fieldNameLabel, userDefinedLabel 21 , bestLabel, humanizeLabel 22 , defaultLabel, labelless 23 ) 24 where 25 26 import Char 27 28 -- |Prioritized label. If two 'PriLabel' can be used for some 29 -- component, then the one with highest priority is used. 30 data PriLabel = PriLabel { priority :: Priority, labelString :: String } deriving (Show, Eq) 31 -- |The label priority. 32 data Priority = BadConstr | GoodConstr | FieldName | UserDefined deriving (Show, Ord, Eq, Bounded, Enum) 33 34 badConstrLabel, goodConstrLabel, fieldNameLabel, userDefinedLabel :: String -> PriLabel 35 badConstrLabel label = PriLabel BadConstr label 36 goodConstrLabel label = PriLabel GoodConstr label 37 fieldNameLabel label = PriLabel FieldName label 38 userDefinedLabel label = PriLabel UserDefined label 39 40 -- |Creates a default (lowest priority) PriLabel 41 defaultLabel :: String -> PriLabel 42 defaultLabel label = PriLabel BadConstr label 43 44 labelless :: PriLabel 45 labelless = defaultLabel "" 46 47 -- |Choose label with highest priority. If equal then choose the left 48 -- |(first parameter) label. 49 bestLabel :: PriLabel -> PriLabel -> PriLabel 50 bestLabel left@(PriLabel priL _) right@(PriLabel priR _) 51 | priL >= priR = left 52 | otherwise = right 53 54 -- |Humanized label strings, by turning labels like "someLabelName" 55 -- into "Some label name". 56 humanizeLabel :: PriLabel -> PriLabel 57 humanizeLabel (PriLabel pri label) = PriLabel pri label' 58 where 59 label' | pri == UserDefined || not (and (map isLegitChar label)) 60 -- safegaurd against accidentally calling humanizeLabel twice 61 -- and against parsing special labels like "()" 62 = label 63 | elem '_' label = (first toUpper . nonCamel) label 64 | otherwise = camelCase label 65 -- humanizing non-camel case identifiers 66 isLegitChar x = isAlphaNum x || elem x ['_', '\''] 67 nonCamel [] = [] 68 nonCamel ('_':[]) = [] 69 nonCamel (x:[]) = x:[] 70 nonCamel ('_':x:[]) = ' ':toUpper x:[] 71 nonCamel (x:y:[]) = x:nonCamel [y] 72 nonCamel ('_':x:y:xs) 73 | isUpper y = ' ':toUpper x:nonCamel (y:xs) 74 | otherwise = ' ':toLower x:nonCamel (y:xs) 75 nonCamel (x:xs) = x:nonCamel xs 76 -- 77 camelCase [] = [] 78 camelCase (x:xs) = toUpper x : (seperateWords [] xs) 79 seperateWords cs [] = cs 80 seperateWords [] (x:xs) 81 | isUpper x = ' ':seperateWords [x] xs 82 | otherwise = x:seperateWords [] xs 83 seperateWords (c:[]) (x:xs) 84 | isUpper x = seperateWords (c:x:[]) xs 85 | otherwise = toLower c:x:seperateWords [] (xs) 86 seperateWords (cs) (x:xs) 87 | isUpper x = seperateWords (cs ++ [x]) xs 88 | otherwise = (init cs) ++ ' ':(toLower $ last cs):x:seperateWords [] xs 89 first _ [] = [] 90 first f (x:xs) = (f x):xs