module SimpleCss.Tricks.Shortcuts.Css(
Dir(..),
top, bottom, left, right, hor, ver, sides,
lfloat, rfloat, rclear, lclear, bclear,
BorderStyle, BorderWidth, BorderColor,
border, borderNone, borderRadius,
margin,
padding,
width, height,
bkgColor, brick, pict,
color,
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
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
lfloat :: [Decl]
lfloat = [fl]
rfloat :: [Decl]
rfloat = [fr]
bclear :: [Decl]
bclear = [cb]
rclear :: [Decl]
rclear = [cr]
lclear :: [Decl]
lclear = [cl]
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 :: [Dir]
sides = [DAll]
hor :: [Dir]
hor = [left, right]
ver :: [Dir]
ver = [top, bottom]
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]
borderNone :: [Dir] -> [Decl]
borderNone dirs = map fromDir dirs
where fromDir x = (ident $ "border" ++ show x) <:> int 0
borderRadius :: [Expr] -> [Decl]
borderRadius rs = map ((<:> spaces rs) . ident)
["border-radius", "-webkit-border-radius", "-moz-border-radius"]
margin :: [Dir] -> Expr -> [Decl]
margin dirs e = map fromDirs dirs
where fromDirs x = (ident "margin" ++ show x) <:> e
padding :: [Dir] -> Expr -> [Decl]
padding dirs e = map fromDirs dirs
where fromDirs x = (ident "padding" ++ show x) <:> e
width :: Expr -> [Decl]
width e = [C.width <:> e]
height :: Expr -> [Decl]
height e = [C.height <:> e]
bkgColor :: Expr -> [Decl]
bkgColor e = [C.backgroundColor <:> e]
brick :: Expr -> Expr -> [Decl]
brick col bkg = [C.color <:> col, C.backgroundColor <:> bkg, C.textDecoration <:> C.none]
pict :: String -> [Decl]
pict file = [C.backgroundImage <:> url file]
color :: Expr -> [Decl]
color x = [C.color <:> x]
data Box = InlineBlock [Decl] | Block [Decl]
box :: [Decl] -> Box
box = Block
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]
static :: Box -> Css a -> Css a
static ds = div' . (dot $ decls ds)
rollOver :: Box -> Box -> Css a -> Css a
rollOver staticBox hoverBox = div' . pseudo [(ident "hover", h)] . dot s
where s = decls staticBox
h = decls hoverBox
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)]