Css.hs

-- | styling shortcuts 

module SimpleCss.Tricks.Shortcuts.Css(
        -- * directions
        --
        -- Directions. 
        --
        -- >hor = [left, right]
        -- >ver = [top, right]
        -- >sides = [DAll]
        Dir(..), 
        
        -- ** direction constructors
        top, bottom, left, right, hor, ver, sides,
        {-
        -- * position
        --
        -- sets position property to relative, fixed or absolute given
        -- x and y coordinates. 
        --
        relPos, fixPos, absPos,
        -}
        -- * floating
        lfloat, rfloat, rclear, lclear, bclear,

        -- * Box model
        
        -- ** border
        BorderStyle, BorderWidth, BorderColor,
        border, borderNone, borderRadius,

        -- ** margin
        margin,

        -- ** padding
        padding,

        -- ** content
        width, height,

        -- * background
        bkgColor, brick, pict,

        -- * Text
        color,

        -- * mouse interaction
        Box, box, ibox, static, rollOver, onMouse
) 
where

import Language.Css.Syntax
import Language.Css.Build
import qualified Language.Css.Build.Idents as C

import SimpleCss 

---------------------------------------------------------
-- style short-cuts

cl = C.clear <:> C.right
cr = C.clear <:> C.left

cb = C.clear <:> C.both
fl = C.float <:> C.left
fr = C.float <:> C.right

pr  = C.position <:> C.relative
l n = C.left  <:> n
r n = C.right <:> n
w n = C.width <:> n
h n = C.height <:> n

mt n = C.marginTop <:> n
mb n = C.marginBottom <:> n

ml n = C.marginLeft <:> n
mr n = C.marginRight <:> n

padt n = C.paddingTop <:> n
padb n = C.paddingBottom <:> n

padl n = C.paddingLeft <:> n
padr n = C.paddingRight <:> n

----------------------------------------------------

-- position
{-
setPos :: (Num t, Ord t) => Expr -> (t -> Expr) -> t -> t -> [Decl]
setPos st leng x y = (C.position <:> st) : uncurry setDirs (getDirs x y)
    where setDirs a b = [a <:> leng (abs x), b <:> leng (abs y)]
          getDirs x y 
            | x < 0 && y < 0 = (C.right, C.bottom)
            | x < 0 && y > 0 = (C.right, C.top)
            | x > 0 && y < 0 = (C.left,  C.bottom)
            | otherwise      = (C.left,  C.top)

relPos :: (Num t, Ord t) => (t -> Expr) -> t -> t -> [Decl]
relPos = setPos C.relative

fixPos :: (Num t, Ord t) => (t -> Expr) -> t -> t -> [Decl]
fixPos = setPos C.fixed

absPos :: (Num t, Ord t) => (t -> Expr) -> t -> t -> [Decl]
absPos = setPos C.absolute
--}
-- floats
--

-- | sets @float@ property to @left@
lfloat :: [Decl]
lfloat = [fl]

-- | sets @float@ property to @right@
rfloat :: [Decl]
rfloat = [fr]

-- | sets @clear@ property to @both@
bclear :: [Decl]
bclear = [cb]

-- | sets @clear@ property to @right@
rclear :: [Decl]
rclear = [cr]

-- | sets @clear@ property to @left@
lclear :: [Decl]
lclear = [cl]





-- border

type BorderColor = Expr
type BorderWidth = Expr
type BorderStyle = Expr

data Dir = DAll | DLeft | DRight | DBottom | DTop

instance Show Dir where
    show a = case a of
                DAll    -> ""
                DLeft   -> "-left"
                DRight  -> "-right"
                DBottom -> "-bottom"
                DTop    -> "-top"


top = DTop
left = DLeft
right = DRight
bottom = DBottom

-- | >sides = [left, top, right, bottom]
sides :: [Dir]
sides = [DAll]

-- | >hor = [left, right]
hor :: [Dir]
hor = [left, right]

-- | >ver = [top, bottom]
ver :: [Dir]
ver = [top, bottom]

-- | sets @border@ properties
border :: [Dir] -> BorderStyle -> BorderWidth -> BorderColor -> [Decl]
border dirs st wid col = map fromDir dirs
    where fromDir x = (ident $ "border" ++ show x) <:> spaces [wid, st, col]

-- | sets @border@ property to none and assigns @border-width@ to zero
borderNone :: [Dir] -> [Decl]
borderNone dirs = map fromDir dirs
    where fromDir x = (ident $ "border" ++ show x) <:> int 0

-- | sets @border-radius@ property
borderRadius :: [Expr] -> [Decl]
borderRadius rs = map ((<:> spaces rs) . ident)
    ["border-radius", "-webkit-border-radius", "-moz-border-radius"]

-- | sets @margin@ width
margin :: [Dir] -> Expr -> [Decl]
margin dirs e = map fromDirs dirs
    where fromDirs x = (ident "margin" ++ show x) <:> e

-- | sets @padding@ width
padding :: [Dir] -> Expr -> [Decl]
padding dirs e = map fromDirs dirs
    where fromDirs x = (ident "padding" ++ show x) <:> e

-- | sets @wdth@
width :: Expr -> [Decl]
width e = [C.width <:> e]

-- | sets @height@
height :: Expr -> [Decl]
height e = [C.height <:> e]


-- background

-- | sets @background-color@ property
bkgColor :: Expr -> [Decl]
bkgColor e = [C.backgroundColor <:> e]

-- | sets color and background-color properties
brick :: Expr -> Expr -> [Decl]
brick col bkg = [C.color <:> col, C.backgroundColor <:> bkg, C.textDecoration <:> C.none]

-- | loads picture to background
pict :: String -> [Decl]
pict file = [C.backgroundImage <:> url file]


-- text

-- | sets @color@ property to specified color
color :: Expr -> [Decl]
color x = [C.color <:> x] 

-- mouse - interaction

-- | Box model
--
-- elements groupped in box can be displayed as @block@ or as @inline-block@
data Box = InlineBlock [Decl] | Block [Decl]

-- | block box
box :: [Decl] -> Box
box = Block

-- | inline-block box
ibox :: [Decl] -> Box
ibox = InlineBlock

decls :: Box -> [Decl]
decls x = 
    case x of
        InlineBlock ds -> ds ++ [C.display <:> C.inlineBlock]
        Block       ds -> ds ++ [C.display <:> C.block]
    

---------------------------------------------------
-- translators

-- | static box
static :: Box -> Css a -> Css a
static ds = div' . (dot $ decls ds)

-- | rollover box
--
-- arguments :
--
-- * static box
--
-- * on hover box
rollOver :: Box -> Box -> Css a -> Css a
rollOver staticBox hoverBox = div' . pseudo [(ident "hover", h)] . dot s
    where s = decls staticBox
          h = decls hoverBox


-- | mouse-interaction box
-- arguments :
--
-- * link
--
-- * visited
--
-- * hover
--
-- * active
--
-- box

onMouse :: Box -> Box -> Box -> Box -> (Css a -> Css a)
onMouse l v h a = 
    div' . 
    pseudo [(ident "link",    decls l),
            (ident "visited", decls v),
            (ident "hover",   decls h),
            (ident "active",  decls a)]