Layout.hs

-- |
-- Module:     Data.CSS.Properties.Layout
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

module Data.CSS.Properties.Layout
    ( -- * Borders
      border,
      borderColor,
      borderStyle,
      borderWidth,

      -- * Inline layout
      lineHeight,
      verticalAlign,

      -- * Margin and padding
      margin,
      padding,
      -- ** Paged media
      pageMargins,
      pageBreakBefore,
      pageBreakAfter,
      pageBreakInside,

      -- * Position
      edgePos,
      position,
      zIndex,
      -- ** Float
      clear,
      float,

      -- * Size
      -- ** Height
      height,
      minHeight,
      maxHeight,
      -- ** Width
      width,
      minWidth,
      maxWidth,

      -- * Tables
      borderCollapse,
      borderSpacing,
      captionSide,
      emptyCells,
      tableLayout,

      -- * Visibility
      clip,
      display,
      overflow,
      visibility
    )
    where

import qualified Data.ByteString as B
import Control.Monad.Reader
import Control.Monad.Writer.Class
import Data.Colour
import Data.CSS.Build
import Data.CSS.Properties.Types
import Data.CSS.Properties.Utils
import Data.CSS.Types
import Data.List
import Data.Set (Set)


-- | Set all @border@ properties for all edges.

border ::
    (ColourOps f, Real a, ToPropValue (f b))
    => BorderWidth a  -- ^ Border width.
    -> BorderStyle    -- ^ Border style.
    -> f b            -- ^ Border color.
    -> SetProp
border w s c = "border" $= (w, s, c)


-- | Collapse borders for tables (@border-collapse@)?

borderCollapse :: Bool -> SetProp
borderCollapse c =
    "border-collapse" $= PropValue (if c then "collapse" else "separate")


-- | Set the border color for the given edges (@border*-color@).

borderColor :: (ColourOps f, ToPropValue (f a)) => Edge (f a) -> SetProp
borderColor = byEdge "border" "-color"


-- | Set the table's @border-spacing@ (up to two values).

borderSpacing :: (Real a) => [Length a] -> SetProp
borderSpacing = setProp "border-spacing"


-- | Set the border style for the given edges (@border*-style@).

borderStyle :: Edge BorderStyle -> SetProp
borderStyle = byEdge "border" "-style"


-- | Set the border width for the given edges (@border*-width@).

borderWidth :: (Real a) => Edge (BorderWidth a) -> SetProp
borderWidth = byEdge "border" "-width"


-- | Set the given property by edge.

byEdge ::
    (ToPropValue a)
    => PropName          -- ^ Common prefix.
    -> PropName          -- ^ Common suffix.
    -> Edge a            -- ^ Edge-oriented specification.
    -> SetProp
byEdge (PropName pfx) (PropName sfx) edge =
    case edge of
      BottomEdge p -> PropName (B.append (B.append pfx "-bottom") sfx) $= p
      Edges ps     -> PropName (B.append pfx sfx) $= ps
      LeftEdge p   -> PropName (B.append (B.append pfx "-left") sfx) $= p
      RightEdge p  -> PropName (B.append (B.append pfx "-right") sfx) $= p
      TopEdge p    -> PropName (B.append (B.append pfx "-top") sfx) $= p


-- | Set the @caption-side@.

captionSide :: CaptionSide -> SetProp
captionSide = setProp "caption-side"


-- | Set the sides to @clear@.

clear :: [FloatEdge] -> SetProp
clear es
    | l && r     = "clear" $= PropValue "both"
    | l         = "clear" $= PropValue "left"
    | r         = "clear" $= PropValue "right"
    | otherwise = "clear" $= PropValue "none"
    where
    (l, r) = foldl' f (False, False) es

    f (_, r') LeftFloat  = (True, r')
    f (l', _) RightFloat = (l', True)


-- | Set the @clip@ mode to the given shape or @auto@.

clip :: (Real a) => Maybe (ClipMode a) -> SetProp
clip = setProp "clip" . maybeProp "auto"


-- | Set the @display@ mode.

display :: DisplayMode -> SetProp
display = setProp "display"


-- | Set edge positions (@top@, @right@, @bottom@, @left@).

edgePos :: (Real a) => Edge (AutoLen (FactorLen Length) a) -> SetProp
edgePos (Edges ls) =
    let edges l1 l2 l3 l4 = "top" $= l1 >> "right" $= l2 >> "bottom" $= l3 >> "left" $= l4 in
    case ls of
      l1:l2:l3:l4:_ -> edges l1 l2 l3 l4
      l1:l2:l3:_    -> edges l1 l2 l3 l2
      l1:l2:_       -> edges l1 l2 l1 l2
      l1:_          -> edges l1 l1 l1 l1
      []            -> return ()
edgePos (BottomEdge l) = "bottom" $= l
edgePos (LeftEdge l)   = "left" $= l
edgePos (RightEdge l)  = "right" $= l
edgePos (TopEdge l)    = "top" $= l


-- | Show @empty-cells@?

emptyCells :: Bool -> SetProp
emptyCells s =
    "empty-cells" $= PropValue (if s then "show" else "hide")


-- | Set @float@ side.

float :: Maybe FloatEdge -> SetProp
float = setProp "float" . maybeProp "none"


-- | Set the @height@.

height :: (Real a) => AutoLen (FactorLen Length) a -> SetProp
height = setProp "height"


-- | Set the @line-height@ to the given length or @normal@.

lineHeight :: (Real a) => Maybe (FactorLen Length a) -> SetProp
lineHeight = setProp "line-height" . maybeProp "normal"


-- | Set the margin for the given edges (@margin*@).

margin :: (Real a) => Edge (AutoLen (FactorLen Length) a) -> SetProp
margin = byEdge "margin" ""


-- | Set the @max-height@.

maxHeight :: (Real a) => Maybe (FactorLen Length a) -> SetProp
maxHeight = setProp "max-height" . maybeProp "none"


-- | Set the @max-width@.

maxWidth :: (Real a) => Maybe (FactorLen Length a) -> SetProp
maxWidth = setProp "max-width" . maybeProp "none"


-- | Set the @min-height@.

minHeight :: (Real a) => FactorLen Length a -> SetProp
minHeight = setProp "min-height"


-- | Set the @min-width@.

minWidth :: (Real a) => FactorLen Length a -> SetProp
minWidth = setProp "min-width"


-- | Set the @overflow@ handling mode.

overflow :: OverflowMode -> SetProp
overflow = setProp "overflow"


-- | Set the padding for the given edges (@padding*@).

padding :: (Real a) => Edge (FactorLen Length a) -> SetProp
padding = byEdge "padding" ""


-- | Specify the page margins for paged media.

pageMargins ::
    (MonadWriter CSS m, Real a)
    => PageSelector  -- ^ Optional selector below @\@page@.
    -> Edge (AutoLen (FactorLen Length) a)  -- ^ Margins.
    -> ReaderT (Set MediaType) m ()
pageMargins pageSel = select (sel pageSel) . margin
    where
    sel AllPages   = [Selector "@page"]
    sel FirstPage  = [Selector "@page :first"]
    sel LeftPages  = [Selector "@page :left"]
    sel RightPages = [Selector "@page :right"]


-- | Set page breaking behaviour after the element (@page-break-after@)
-- to the given value or @auto@.

pageBreakAfter :: Maybe (PageBreak a) -> SetProp
pageBreakAfter = setProp "page-break-after" . maybeProp "auto"


-- | Set page breaking behaviour before the element
-- (@page-break-before@) to the given value or @auto@.

pageBreakBefore :: Maybe (PageBreak a) -> SetProp
pageBreakBefore = setProp "page-break-before" . maybeProp "auto"


-- | Set page breaking behaviour inside the element
-- (@page-break-inside@) to the given value or @auto@.

pageBreakInside :: Maybe (PageBreak InsideBreak) -> SetProp
pageBreakInside = setProp "page-break-inside" . maybeProp "auto"


-- | Set the @position@ mode.

position :: PositionMode -> SetProp
position = setProp "position"


-- | Set the @table-layout@.

tableLayout :: TableLayout -> SetProp
tableLayout = setProp "table-layout"


-- | Set the @vertical-align@ mode.

verticalAlign :: (Real a) => VerticalAlign a -> SetProp
verticalAlign = setProp "vertical-align"


-- | Set the @visibility@ mode.

visibility :: VisibilityMode -> SetProp
visibility = setProp "visibility"


-- | Set the @width@.

width :: (Real a) => AutoLen (FactorLen Length) a -> SetProp
width = setProp "width"


-- | Set the @z-index@ to the given integer or @auto@.

zIndex :: (Integral a) => Maybe a -> SetProp
zIndex = setProp "z-index" . maybeProp "auto" . fmap toInteger