{-|
  PriLabels are labels with a priority.

  PriLabels are usefull when widgets can have their label set multiple
  times. This happens with genericcally created widgets. For example in:

  data Foo = Foo { someName :: Bar }
  data Bar = Bar Int

  widgets created from Bar instances can have labels set due it's
  constructor name and the fieldName in Foo (someName). A GUI
  application programmer may also set the widgets label.

  When a widget has set it's label multiple times, the priority can be
  used to decide which label should be chosen.
-}
module Graphics.UI.SybWidget.PriLabel
    ( PriLabel(..)
    , Priority(..)
    , badConstrLabel, goodConstrLabel, fieldNameLabel, userDefinedLabel
    , bestLabel, humanizeLabel
    , defaultLabel, labelless
    )
where

import Data.Char

-- |Prioritized label. If two 'PriLabel' can be used for some
--  component, then the one with highest priority is used.
data PriLabel = PriLabel { priority :: Priority, labelString :: String } deriving (Show, Eq)
-- |The label priority.
data Priority = BadConstr | GoodConstr | FieldName | UserDefined deriving (Show, Ord, Eq, Bounded, Enum)

badConstrLabel, goodConstrLabel, fieldNameLabel, userDefinedLabel :: String -> PriLabel
badConstrLabel   label = PriLabel BadConstr   label
goodConstrLabel  label = PriLabel GoodConstr  label
fieldNameLabel   label = PriLabel FieldName   label
userDefinedLabel label = PriLabel UserDefined label

-- |Creates a default (lowest priority) PriLabel
defaultLabel :: String -> PriLabel
defaultLabel label = PriLabel BadConstr label

labelless :: PriLabel
labelless = defaultLabel ""

-- |Choose label with highest priority. If equal then choose the left
-- |(first parameter) label.
bestLabel :: PriLabel -> PriLabel -> PriLabel
bestLabel left@(PriLabel priL _) right@(PriLabel priR _)
    | priL >= priR  = left
    | otherwise     = right

-- |Humanized label strings, by turning labels like "someLabelName"
-- into "Some label name".
humanizeLabel :: PriLabel -> PriLabel
humanizeLabel (PriLabel pri label) = PriLabel pri label'
    where
    label' | pri == UserDefined || not (and (map isLegitChar label))
               -- safegaurd against accidentally calling humanizeLabel twice 
               -- and against parsing special labels like "()"
                                = label
           | elem '_' label     = (first toUpper . nonCamel) label
           | otherwise          = camelCase label
    -- humanizing non-camel case identifiers
    isLegitChar x = isAlphaNum x || elem x ['_', '\'']
    nonCamel []             = []
    nonCamel ('_':[])       = []
    nonCamel (x:[])         = x:[]
    nonCamel ('_':x:[])     = ' ':toUpper x:[]
    nonCamel (x:y:[])       = x:nonCamel [y]
    nonCamel ('_':x:y:xs)
        | isUpper y         = ' ':toUpper x:nonCamel (y:xs)
        | otherwise         = ' ':toLower x:nonCamel (y:xs)
    nonCamel (x:xs)         = x:nonCamel xs
    --
    camelCase []            = []
    camelCase (x:xs)        = toUpper x : (seperateWords [] xs)
    seperateWords cs []           = cs
    seperateWords [] (x:xs)
        | isUpper x               = ' ':seperateWords [x] xs
        | otherwise               =   x:seperateWords [] xs
    seperateWords (c:[]) (x:xs)
        | isUpper x               = seperateWords (c:x:[]) xs
        | otherwise               = toLower c:x:seperateWords [] (xs)
    seperateWords (cs) (x:xs)
        | isUpper x               = seperateWords (cs ++ [x]) xs
        | otherwise               = (init cs) ++ ' ':(toLower $ last cs):x:seperateWords [] xs
    first _ []     = []
    first f (x:xs) = (f x):xs