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