Style.lhs

> {-# LANGUAGE GeneralizedNewtypeDeriving #-}

> module Barrie.Style (Style, Styled(..), addStyle, emptyStyle,
>                      caption, getCaption,
>                      hideDisabled, getHideDisabled,
>                      homogenous, getHomogenous,
>                      textValue, textItems) where

> import Data.Monoid

> newtype Style = Style [(String, StyleValue)]
>            deriving (Read, Show, Monoid)

> type StyleValue = String

> mkStyle :: String -> StyleValue -> Style
> mkStyle name value = Style [(name, value)]

> class Styled a where
>    setStyle :: Style -> a -> a
>    getStyle :: a -> Style

> instance Styled Style where
>    setStyle = const
>    getStyle = id

> addStyle :: (Styled a) => Style -> a -> a
> addStyle style item = setStyle (style `mappend` getStyle item) item

> emptyStyle :: Style
> emptyStyle = Style []

> styleValue :: (Styled a) => String -> a -> Maybe StyleValue
> styleValue name ss = lookup name styleList
>    where (Style styleList) = getStyle ss

> caption :: (Styled a) => String -> a -> a
> caption text = addStyle $ mkStyle "caption" text

> getCaption :: (Styled a) => a -> Maybe StyleValue
> getCaption = styleValue "caption"

> textValue :: (Styled a) => String -> a -> a
> textValue text = addStyle $ mkStyle "textValue" text

> textItems :: (Styled a) => [String] -> a -> a
> textItems items = addStyle $ mkStyle "textItems" (unlines items)

> hideDisabled :: (Styled a) => Bool -> a -> a
> hideDisabled hide = addStyle $ mkStyle "hideDisabled" (show hide)

> getHideDisabled :: (Styled a) => a -> Bool
> getHideDisabled style = case styleValue "hideDisabled" style of
>                           Nothing -> False
>                           Just text -> read text


> homogenous :: (Styled a) => Bool -> a -> a
> homogenous set = addStyle $ mkStyle "homogenous" (show set)

> getHomogenous :: (Styled a) => a -> Bool
> getHomogenous style = case styleValue "homogenous" style of
>                           Nothing -> False
>                           Just text -> read text