Layouts.hs

module SimpleCss.Tricks.Layouts (
    -- * width/height    
    (^-), (^|),

    -- * Types
    ColumnWidth(..), totalWidth, colw, toColumnWidth,
   
    -- * Margin layouts
    --
    -- | This layouts are based on setting margins and floating menus 
    leftContent, rightContent, leftRightContent,
   
    -- * Liquid layouts
    --
    -- | Tricky floating and nesting. 
    --
    -- Requires color and background-color to be set for all columns
    columns        
) 

where

import Data.List

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

oh  = C.overflow <:> C.hidden

-- width

-- | setting width in procents
(^-) :: Double -> Css a -> Css a
a ^- b = dot [w $ pct a] b

-- | setting height in procents
(^|) :: Double -> Css a -> Css a
a ^| b = dot [h $ pct a] b


-------------------------------------------------------------
-- Column Width type

-- | construct list of columnWidth values from list of triplets
toColumnWidth :: [(a, a, a)] -> [ColumnWidth a]
toColumnWidth xs = [ColumnWidth a b c | (a, b, c) <- xs]

-- | short-cut for 'ColumnWidth' constructor
colw :: Num a => a -> a -> a -> ColumnWidth a
colw = ColumnWidth

-- | represents column layout
data ColumnWidth a = ColumnWidth 
                    { leftPad  :: a    -- ^ left padding width
                    , midWidth :: a    -- ^ content width 
                    , rightPad :: a    -- ^ right padding width
                    } deriving (Show)


-- | @leftPad + midWidth + rightPad@
totalWidth :: Num a => ColumnWidth a -> a
totalWidth x = midWidth x + leftPad x + rightPad x


--------------------------------------------------------
-- Margin techniques


-- | left menu + content + right menu
--
-- arguments are : 
--
-- * length constructor
--
-- * left menu column width
--
-- * right menu column width
--
-- * left menu
--
-- * right menu
--
-- * content
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]


-- | left menu + content
--
-- arguments are : 
--
-- * length constructor
--
-- * left menu column width 
--
-- * left menu
--
-- * content
leftContent :: Num t => (t -> Expr) -> t -> Css a -> Css a -> Css a
leftContent = menuContent fl ml

-- | content + right menu
--
-- arguments are : 
--
-- * length constructor
--
-- * right menu column width
--
-- * right menu 
--
-- * content
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]

-----------------------------------------------------------------------------------------
-- Liquid layout

-- | liquid layouts
--
-- Places n-columns, implementation of Matthew James Taylor's liquid layout technique.
--
-- See <http://matthewjamestaylor.com/blog/equal-height-columns-cross-browser-css-no-hacks>
--
-- every columns is wrapped in two divs (inner an outer) and floated, styling is applied
-- to both divs, it makes possible to construct columns of equal height, they look like.
--
-- All inherited properties should be assigned for each column. 
--
-- For example if you want to make two columns one is black background and white text and
-- another mirrors colors, you should define colors for BOTH columns. Otherwise one column will
-- spread all over the screen
--
-- >elems = [p text1, p text2]
-- >
-- >decl1 = dot [C.color <:> white, C.backgroundColor <:> black]
-- >decl2 = dot [C.color <:> black, C.backgroundColor <:> white]
-- >ds = [decl1, decl2]
-- > 
-- >ws = toColumnWidth [(10, 40, 10), (10, 40, 10)]
-- >
-- >res = columns pct (zip (zip ws ds) elems) 
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