module SimpleCss.Tricks.Layouts (
(^-), (^|),
ColumnWidth(..), totalWidth, colw, toColumnWidth,
leftContent, rightContent, leftRightContent,
columns
)
where
import Data.List
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
oh = C.overflow <:> C.hidden
(^-) :: Double -> Css a -> Css a
a ^- b = dot [w $ pct a] b
(^|) :: Double -> Css a -> Css a
a ^| b = dot [h $ pct a] b
toColumnWidth :: [(a, a, a)] -> [ColumnWidth a]
toColumnWidth xs = [ColumnWidth a b c | (a, b, c) <- xs]
colw :: Num a => a -> a -> a -> ColumnWidth a
colw = ColumnWidth
data ColumnWidth a = ColumnWidth
{ leftPad :: a
, midWidth :: a
, rightPad :: a
} deriving (Show)
totalWidth :: Num a => ColumnWidth a -> a
totalWidth x = midWidth x + leftPad x + rightPad x
leftRightContent :: Num t
=> (t -> Expr) -> t -> t
-> Css a -> Css a -> Css a -> Css a
leftRightContent leng wLeft wRight left right cont =
vcat [leftStyle $ div' left, rightStyle $ div' right, contStyle $ div' cont]
where leftStyle = sideStyle fl wLeft leng
rightStyle = sideStyle fr wRight leng
contStyle = vcat . return . dot [
ml $ leng wLeft,
mr $ leng wRight]
leftContent :: Num t => (t -> Expr) -> t -> Css a -> Css a -> Css a
leftContent = menuContent fl ml
rightContent :: Num t => (t -> Expr) -> t -> Css a -> Css a -> Css a
rightContent = menuContent fr mr
menuContent :: Num t => Decl -> (Expr -> Decl)
-> (t -> Expr) -> t -> Css a -> Css a -> Css a
menuContent float margin leng wMenu left cont = vcat [leftStyle $ div' left, contStyle $ div' cont]
where leftStyle = sideStyle float wMenu leng
contStyle = vcat . return . dot [ margin $ leng wMenu]
sideStyle float width leng =
vcat . return . dot [float, w $ leng width]
columns :: Num t => (t -> Expr) -> [((ColumnWidth t, Css a -> Css a), Css a)] -> Css a
columns leng a' = vcat $ return $ (foldl1 (.) $ reverse conts) $ vcat $ zipWith ($) cols xs
where (cws, xs) = unzip a
cols = zipWith4 (toCol leng) [0 ..] (colShifts cws) (map midWidth cws) st'
conts = zipWith4 (toCont leng s) [0 ..] (tail ds ++ [0]) (zip xs st') adds
adds = replicate (length a 1) [] ++ [[oh]]
ds = map totalWidth cws
s = sum ds
(a, st') = unzip [((w, x), st) | ((w, st), x) <- a']
toCol :: Num t => (t -> Expr) -> Int -> t -> t -> (Css a -> Css a) -> (Css a -> Css a)
toCol leng n shift d outerStyle =
dot [fl, w $ leng d, pr, l $ leng shift, oh] . vcat . return . outerStyle
toCont :: Num t => (t -> Expr) -> t -> Int -> t -> (Css a, Css a -> Css a) -> [Decl] -> (Css a -> Css a)
toCont leng totalWidth n shift (x, outerStyle) adds = outerStyle . dot (
[w $ leng totalWidth, fl, pr, r $ leng shift] ++ adds) . vcat . return
colShifts :: Num a => [ColumnWidth a] -> [a]
colShifts xs = map (globalShift + ) $ zipWith (+) leftShifts rightShifts'
where globalShift = sum ds head ds
leftShifts = map leftPad xs
rightShifts' = fst $ foldl f ([], 0) $ zipWith (+) leftShifts rightShifts
rightShifts = map rightPad xs
f (res, i) x = (res ++ [i], i + x)
ds = map totalWidth xs