cascading (empty) → 0.1.0
raw patch · 18 files changed
+3023/−0 lines, 18 filesdep +basedep +blaze-builderdep +bytestringsetup-changed
Dependencies added: base, blaze-builder, bytestring, colour, containers, lens, mtl, text, utf8-string, web-routes
Files
- Data/CSS.hs +379/−0
- Data/CSS/Build.hs +131/−0
- Data/CSS/Properties.hs +25/−0
- Data/CSS/Properties/Classes.hs +79/−0
- Data/CSS/Properties/Compat.hs +43/−0
- Data/CSS/Properties/Font.hs +124/−0
- Data/CSS/Properties/Layout.hs +317/−0
- Data/CSS/Properties/Text.hs +210/−0
- Data/CSS/Properties/Types.hs +886/−0
- Data/CSS/Properties/UI.hs +69/−0
- Data/CSS/Properties/Utils.hs +30/−0
- Data/CSS/Render.hs +81/−0
- Data/CSS/Types.hs +245/−0
- Data/CSS/Utils.hs +95/−0
- LICENSE +32/−0
- README.md +165/−0
- Setup.lhs +12/−0
- cascading.cabal +100/−0
+ Data/CSS.hs view
@@ -0,0 +1,379 @@+-- |+-- Module: Data.CSS+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- This library implements a domain-specific language for cascading+-- style sheets as used in web pages. It allows you to specify your+-- style sheets in regular Haskell syntax and gives you all the+-- additional power of server-side document generation.++{-# OPTIONS_GHC -fno-warn-unused-imports #-}++module Data.CSS+ ( -- * Tutorial+ -- $tut++ -- ** Selectors and media+ -- $tut_selectors++ -- ** Rendering+ -- $tut_rendering++ -- ** Lengths+ -- $tut_lengths++ -- ** Colors+ -- $tut_colors++ -- ** Edge-oriented properties+ -- $tut_edges++ -- ** Imports+ -- $tut_imports++ -- ** Miscellaneous+ -- *** Important properties+ -- $tut_misc_important++ -- *** Inheriting+ -- $tut_misc_inherit++ -- ** Optimizations+ -- $tut_optimize++ -- * Reexports+ module Data.CSS.Build,+ module Data.CSS.Render,+ module Data.CSS.Types+ )+ where++import Blaze.ByteString.Builder+import Control.Monad.Writer+import Data.ByteString (ByteString)+import Data.Colour+import Data.CSS.Build+import Data.CSS.Properties+import Data.CSS.Render+import Data.CSS.Types+import Web.Routes.RouteT+++{- $tut++Style sheets are values of type 'CSS'. This type denotes style sheets,+including for different media and is itself a monoid, so that you can+build your style sheets either in a chunk-by-chunk fashion or using a+writer monad. The latter is the recommended way, because it gives you+access to a large library of predefined properties with additional type+safety. It is recommended to enable the @OverloadedStrings@ extension+for this library and is assumed for the rest of this tutorial.++Style properties are usually specified by using the predefined property+writers:++> display InlineDisplay+> direction LeftToRight+> float LeftFloat++If a property is not pre-defined you can set it by using 'setProp' or+its infix variant '$='.++> setProp "font-family" ("times" :: PropValue)+> "text-decoration" $= ("underline" :: PropValue)++The type signatures are necessary because the property value is actually+polymorphic and needs to be an instance of 'ToPropValue'. There are many+predefined instances:++> "z-index" $= 15+> "margin" $= ["1em", "2px"]++These values will render as @15@ and @1em 2px@ respectively.++-}+++{- $tut_selectors++In order to specify properties you first need to establish media types+and selectors. The simplest way to do this is to use 'onAll', 'onMedia'+and 'select':++> stylesheet :: Writer CSS ()+> stylesheet =+> onAll . select ["p"] $ do+> lineHeight . Just $ _Cm # 1+> zIndex Nothing+> borderStyle . LeftEdge $ SolidBorder++This will render as the following stylesheet:++> p {+> line-height: 10mm;+> z-index: auto;+> border-left-style: solid;+> }++To restrict the media to which the stylesheet applies just use 'onMedia'+instead of 'onAll':++> onMedia ["print"] . select ["p"] $ ...++This will render as:++> @media print {+> p { /* ... */ }+> }++Often it is convenient to specify properties for elements below the+current selection. You can use the 'below' combinator to do this:++> onAll . select ["p"] $ do+> lineHeight . Just $ _Cm # 1+> zIndex Nothing+>+> below ["em"] $ do+> margin . Edges $ [_Em # 0.2, _Ex # 1]+> padding . Edges $ [_Em # 0.1, _Ex # 0.5]++The inner block specifies properties for @p em@, so the above will+render as the following stylesheet:++> p {+> line-height: 10mm;+> z-index: auto;+> }+>+> p em {+> margin: 0.2em 1ex;+> padding: 0.1em 0.5ex;+> }++You can also specify properties for multiple selectors simultaneously:++> onAll . select ["html", "body"] $ do+> margin . Edges $ [zeroLen]+> padding . Edges $ [_Em # 1, _Ex # 2]+>+> below ["a", "p"] $ do+> backgroundColor black+> color limegreen++This renders as the following stylesheet:++> html, body {+> margin: 0;+> padding: 1em 2ex;+> }+>+> html a, body a, html p, body p {+> background-color: #000;+> color: #32cd32;+> }++-}+++{- $tut_rendering++To render a stylesheet you can use 'fromCSS', 'renderCSS' or+'renderCSST'. All of these will give you a 'Builder'. You can then use+combinators like 'toByteString' or 'toByteStringIO' to turn it into a+'ByteString', send it to a client or write it to a file.++The lowest level function is 'fromCSS', which will take a 'CSS' value+and give you a 'Builder':++> fromCSS :: CSS -> Builder++The most convenient way to write your stylesheets is to use a writer+monad, in which case you would use one of these functions instead,+depending on the shape of your monad:++> renderCSS :: Writer CSS a -> Builder+> renderCSST :: (Monad m) => WriterT CSS m a -> m Builder++The following example prints the stylesheet to stdout, assuming+@stylesheet@ is of type @'Writer' CSS ()@:++> import qualified Data.ByteString as B+>+> toByteStringIO B.putStr . renderCSS $ stylesheet++-}+++{- $tut_lengths++For convenience lengths can and should be specified by using predefined+prisms like '_Cm' (see 'HasLength'):++> lineHeight $ Just (_Cm # 1)++This will render as @line-height: 10mm@. All compatible lengths are+saved and rendered in a canonical unit. For example centimeters,+millimeters, inches, picas and points are all rendered as their+correspondingly scaled millimeter lengths, i.e. @'_In' \# 1@ will render+as @25.4mm@.++For convenience there are also two ways to specify percental lengths.+The lengths @'_Percent' \# 150@ and @'_Factor' \# 1.5@ are equivalent+and both render as @150%@.++There are also two special lengths, 'zeroLen' and 'autoLen', which+render as @0@ and @auto@ respectively.++-}+++{- $tut_colors++Colors are specified by using the 'Colour' and 'AlphaColour' types from+the colour library. They are rendered as either @\#rgb@, @\#rrggbb@ or+@rgba(r,g,b,a)@ depending on what color you specify and whether it is+fully opaque. The following renders as @border-left-color: \#0f0@:++> import Data.Colour.Names+>+> borderColor (LeftEdge lime)++The colour library gives you both correct color space handling, sensible+operators for mixing colors and a large library of predefined colors in+the "Data.Colour.Names" module. To mix two colors you can use 'blend'+for mixing or 'over' for alpha blending:++> blend 0.5 lime red+> (lime `withOpacity` 0.5) `over` black++Colors are all rendered in the (non-linear) sRGB color space, as this is+the assumed color space by most user agents and screens.++-}+++{- $tut_edges++Many CSS properties are edge-oriented, for example 'margin', 'padding'+and 'borderColor'. This library provides a unified interface to these+properties through the 'Edge' type. Examples:++> margin . BottomEdge $ _Mm # 1 -- margin-bottom: 1mm+> margin . LeftEdge $ _Mm # 1 -- margin-left: 1mm+> margin . RightEdge $ _Mm # 1 -- margin-right: 1mm+> margin . TopEdge $ _Mm # 1 -- margin-top: 1mm++To set all edges through the 'margin' property just use the 'Edges'+constructor:++> margin . Edges $ [_Mm # 2, _Mm # 1] -- margin: 2mm 1mm+> margin . Edges $ [_Mm # 5] -- margin: 5mm++You can also use the usual monadic combinators:++> mapM_ margin [LeftEdge (_Mm # 3),+> RightEdge (_Mm # 4)]++-}+++{- $tut_imports++To import an external stylesheet you can use 'importFrom' or+'importUrl'. The former allows you to specify raw URLs:++> importFrom "screen" "/style/screen.css"++In web frameworks like Happstack you would usually work on top of a+'MonadRoute'-based monad (like 'RouteT') as defined in the web-routes+library. In this case the 'importUrl' function allows you to use your+type-safe URLs conveniently:++> importUrl "all" (Style "screen")++To import a stylesheet for multiple media types, just use the import+functions multiple times for the same URL:++> mapM_ (`importFrom` "/style/screen.css") ["screen", "print"]++This will render as:++> @import url("/style/screen.css") print, screen;++-}+++{- $tut_misc_important++To set the @!important@ tag on a property you can use the 'important'+function:++> important (display InlineDisplay)++This renders as:++> display: inline !important;++-}+++{- $tut_misc_inherit++To inherit a property value use 'inherit'. You have to spell out the+property name in this case:++> inherit "display"++This renders as:++> display: inherit;++-}+++{- $tut_optimize++The underlying representation is a straightforward list of selectors and+properties. There may be closer or more efficient representations, but+all of them need to make some compromises along the way. Consider the+following stylesheet:++> p {+> border-color: #0f0;+> border-color: rgba(0, 255, 0, 1);+> }++You can optimize this to a single property, but which one? It depends+on whether the user agent supports CSS level 3, so we would need to make+assumptions. We also can't use a map of properties to a list of values.+Consider the following stylesheet:++> p {+> border-bottom-color: #0f0;+> border-color: #f00;+> }++The order of the properties does matter here, so we need to preserve it.+This rules out a map from properties to lists of values. The final+question is: Can we use a map from selectors to property lists? As it+turns out no, because CSS specificity does not always apply:++> a:link { /* ... */ }+> a:blah { /* ... */ }++These two selectors have the same specificity. CSS allows unsupported+pseudo-classes and user agents must ignore them, so in edge cases the+order can matter.++Other than media types CSS does not seem to exhibit any commutativity,+so we use regular lists. Also since most authors use mostly+hand-written stylesheets with little property overlap the list+representation is usually faster anyway, so this choice seems to be+sensible.++The only optimization performed by this library is the minified output+it produces. Pretty-printing is currently not supported.++-}
+ Data/CSS/Build.hs view
@@ -0,0 +1,131 @@+-- |+-- Module: Data.CSS.Build+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Build+ ( -- * Media types+ onAll,+ onMedia,++ -- * Selectors+ select,+ -- ** Selector modifiers+ below,+ local,++ -- * Setting properties+ ($=),+ important,+ inherit,+ setProp,++ -- * Auxiliary+ importFrom,+ importUrl+ )+ where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as Bc+import qualified Data.Map as M+import qualified Data.Set as S+import Control.Applicative+import Control.Lens+import Control.Monad.Reader+import Control.Monad.Writer.Class+import Data.CSS.Types+import Data.Set (Set)+import Data.Text (Text)+import Web.Routes.RouteT+++-- | Set the given property to the given value. (infix 2)+--+-- Infix version of 'setProp'.++($=) ::+ (ToPropValue a)+ => PropName -- ^ Property to set.+ -> a -- ^ Value to set the property to.+ -> SetProp+prop $= val = do+ BuildCfg mt sel <- ask+ tell (CSS M.empty (M.singleton mt [Property sel prop (toPropValue val) False]))++infix 2 $=+++-- | Given children of the current selector.++below :: (MonadWriter CSS m) => [Selector] -> m a -> m a+below sels =+ censoring (cssProps . mapped . mapped . propSelector)+ (liftA2 (\(Selector sel) (Selector sel') ->+ Selector $ B.append (Bc.snoc sel' ' ') sel)+ sels)+++-- | Mark all property values important.++important :: (MonadWriter CSS m) => m a -> m a+important =+ censoring (cssProps . mapped . mapped . propImportant)+ (const True)+++-- | Import the given style sheet for the given media type.++importFrom :: (MonadWriter CSS m) => MediaType -> Text -> m ()+importFrom mt url = tell (CSS (M.singleton url (S.singleton mt)) M.empty)+++-- | Import the given style sheet for the given media type.++importUrl ::+ (MonadRoute m, MonadWriter CSS m)+ => MediaType+ -> URL m+ -> m ()+importUrl mt = showURL >=> importFrom mt+++-- | Set the given property to be inherited.++inherit :: (MonadReader BuildCfg m, MonadWriter CSS m) => PropName -> m ()+inherit = ($= PropValue "inherit")+++-- | Specify stylesheets for all media,++onAll :: (Monad m) => ReaderT (Set MediaType) m a -> m a+onAll = onMedia [MediaType "all"]+++-- | Specify stylesheets for the given media.++onMedia :: (Monad m) => [MediaType] -> ReaderT (Set MediaType) m a -> m a+onMedia = flip runReaderT . S.fromList+++-- | Specify the selector.++select ::+ (Monad m)+ => [Selector]+ -> ReaderT BuildCfg m a+ -> ReaderT (Set MediaType) m a+select sel (ReaderT c) = ReaderT $ \mt -> c (BuildCfg mt sel)+++-- | Set the given property to the given value.+--+-- Non-infix version of '$='.++setProp ::+ (ToPropValue a)+ => PropName -- ^ Property to set.+ -> a -- ^ Value to set the property to.+ -> SetProp+setProp = ($=)
+ Data/CSS/Properties.hs view
@@ -0,0 +1,25 @@+-- |+-- Module: Data.CSS.Properties+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties+ ( -- * Reexports+ module Data.CSS.Properties.Classes,+ module Data.CSS.Properties.Compat,+ module Data.CSS.Properties.Font,+ module Data.CSS.Properties.Layout,+ module Data.CSS.Properties.Text,+ module Data.CSS.Properties.Types,+ module Data.CSS.Properties.UI+ )+ where++import Data.CSS.Properties.Classes+import Data.CSS.Properties.Compat+import Data.CSS.Properties.Font+import Data.CSS.Properties.Layout+import Data.CSS.Properties.Text+import Data.CSS.Properties.Types+import Data.CSS.Properties.UI
+ Data/CSS/Properties/Classes.hs view
@@ -0,0 +1,79 @@+-- |+-- Module: Data.CSS.Properties.Classes+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties.Classes+ ( -- * Length prisms+ HasLength(..),+ HasAutoLength(..),+ HasPercent(..)+ )+ where++import Control.Lens+++-- | Class for length types with a notion of automatic length.++class HasAutoLength len where+ -- | Automatic length.+ autoLen :: len a+++-- | Class of types, which feature CSS lengths.+--+-- Minimal complete definition: '_Em', '_Ex', '_Mm', '_Px', 'zeroLen'.++class HasLength len where+ -- | 'Length' in centimeters (@cm@). Compatible with '_In', '_Mm',+ -- '_Pc' and '_Pt'.+ _Cm :: (Fractional a, Real a) => Prism' (len a) a+ _Cm = _Mm . iso (/ 10) (* 10)++ -- | 'Length' in units of the font size (@em@).+ _Em :: (Fractional a, Real a) => Prism' (len a) a++ -- | 'Length' in units of the height of the @x@ character in the+ -- current font (@ex@).+ _Ex :: (Fractional a, Real a) => Prism' (len a) a++ -- | 'Length' in inches (@in@). Compatible with '_Cm', '_Mm', '_Pc'+ -- and '_Pt'.+ _In :: (Fractional a, Real a) => Prism' (len a) a+ _In = _Mm . iso (/ 25.4) (* 25.4)++ -- | 'Length' in millimeters (@mm@). Compatible with '_Cm', '_In',+ -- '_Pc' and '_Pt'.+ _Mm :: (Fractional a, Real a) => Prism' (len a) a++ -- | 'Length' in picas (@pc@). Compatible with '_Cm', '_In', '_Mm'+ -- and '_Pt'.+ _Pc :: (Fractional a, Real a) => Prism' (len a) a+ _Pc = _Mm . iso (/ (127/30)) (* (127/30))++ -- | 'Length' in points (@pt@). Compatible with '_Cm', '_In', '_Mm'+ -- and '_Pc'.+ _Pt :: (Fractional a, Real a) => Prism' (len a) a+ _Pt = _Mm . iso (/ (127/360)) (* (127/360))++ -- | 'Length' in pixels (@px@).+ _Px :: (Fractional a, Real a) => Prism' (len a) a++ -- | Zero length.+ zeroLen :: len a+++-- | Class for length types with percentages.+--+-- Minimal complete definition: '_Factor'.++class HasPercent len where+ -- | Relative 'Length' by factor where 1 means 100% (@%@).+ -- Compatible with '_Percent'.+ _Factor :: (Fractional a, Real a) => Prism' (len a) a++ -- | Relative 'Length' in percent (@%@). Compatible with '_Factor'.+ _Percent :: (Fractional a, Real a) => Prism' (len a) a+ _Percent = _Factor . iso (* 100) (/ 100)
+ Data/CSS/Properties/Compat.hs view
@@ -0,0 +1,43 @@+-- |+-- Module: Data.CSS.Properties.Compat+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties.Compat+ ( -- * Vendor prefixes+ vendors+ )+ where++import qualified Data.ByteString as B+import Control.Lens+import Control.Monad.Writer.Class+import Data.CSS.Types+++-- | Adds vendor-prefixed properties for all properties in the given+-- style sheet. The following vendors are currently added:+--+-- * Microsoft (@-ms-@),+--+-- * Mozilla (@-moz-@),+--+-- * Opera (@-o-@),+--+-- * WebKit (@-webkit-@).+--+-- This combinator keeps the original (non-prefixed) property and does+-- not prefix properties that already have a vendor prefix.++vendors ::+ (MonadWriter CSS m)+ => m a+ -> m a+vendors =+ censoring (cssProps . mapped) . concatMap $ \(Property sel (PropName name) val imp) ->+ let prefix pfx = Property sel (PropName $ B.append pfx name) val imp+ prefixes+ | B.isPrefixOf "-" name = [""]+ | otherwise = ["", "-moz-", "-ms-", "-o-", "-webkit-"]+ in map prefix prefixes
+ Data/CSS/Properties/Font.hs view
@@ -0,0 +1,124 @@+-- |+-- Module: Data.CSS.Properties.Font+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties.Font+ ( -- * Colors and background+ backgroundAttachment,+ backgroundColor,+ backgroundImage,+ backgroundImageUrl,+ backgroundPosition,+ backgroundRepeat,+ color,++ -- * Fonts+ fontFamily,+ fontSize,+ fontStyle,+ fontVariant,+ fontWeight,++ -- * Text decoration+ textDecoration+ )+ where++import qualified Data.ByteString.Char8 as Bc+import Data.Colour+import Data.CSS.Properties.Types+import Data.CSS.Properties.Utils+import Data.CSS.Build+import Data.CSS.Types+import Data.Text (Text)+import Web.Routes.RouteT+++-- | Set the @background-attachment@.++backgroundAttachment :: BackgroundAttachment -> SetProp+backgroundAttachment = setProp "background-attachment"+++-- | Set the @background-color@.++backgroundColor :: (ColourOps f, ToPropValue (f a)) => f a -> SetProp+backgroundColor = setProp "background-color"+++-- | Set the @background-image@.++backgroundImage :: Maybe (CssUrl Text) -> SetProp+backgroundImage = setProp "background-image" . maybeProp "none"+++-- | Set the @background-image@.++backgroundImageUrl :: (MonadRoute m) => Maybe (URL m) -> SetPropM m+backgroundImageUrl img = do+ renderUrl <- askRouteFn+ backgroundImage . fmap (CssUrl . flip renderUrl []) $ img+++-- | Set the @background-position@.++backgroundPosition ::+ (Real a, Real b)+ => FactorLen Length a+ -> FactorLen Length b+ -> SetProp+backgroundPosition = curry (setProp "background-position")+++-- | Set @background-repeat@.++backgroundRepeat :: BackgroundRepeat -> SetProp+backgroundRepeat = setProp "background-repeat"+++-- | Set the foreground @color@.++color :: (ColourOps f, ToPropValue (f a)) => f a -> SetProp+color = setProp "color"+++-- | Set the @font-family@ choices.++fontFamily :: [FontFamily] -> SetProp+fontFamily =+ setProp "font-family" .+ PropValue .+ Bc.intercalate "," .+ map (_propValueStr . toPropValue)+++-- | Set the @font-size@.++fontSize :: (Real a) => FontSize a -> SetProp+fontSize = setProp "font-size"+++-- | Set the @font-style@.++fontStyle :: FontStyle -> SetProp+fontStyle = setProp "font-style"+++-- | Set the @font-variant@.++fontVariant :: FontVariant -> SetProp+fontVariant = setProp "font-variant"+++-- | Set the @font-weight@.++fontWeight :: FontWeight -> SetProp+fontWeight = setProp "font-weight"+++-- | Set the @text-decoration@.++textDecoration :: Maybe TextDecoration -> SetProp+textDecoration = setProp "text-decoration" . maybeProp "none"
+ Data/CSS/Properties/Layout.hs view
@@ -0,0 +1,317 @@+-- |+-- 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
+ Data/CSS/Properties/Text.hs view
@@ -0,0 +1,210 @@+-- |+-- Module: Data.CSS.Properties.Text+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties.Text+ ( -- * Alignment and spacing+ letterSpacing,+ textAlign,+ textIndent,+ whiteSpace,+ wordSpacing,++ -- * Direction+ direction,+ unicodeBidi,++ -- * Generated content+ content,+ contentUrl,+ counterIncrement,+ counterReset,+ quotes,++ -- * List formatting+ listStyle,+ listStyleImage,+ listStyleImageUrl,+ listStylePosition,+ listStyleType,+ listStyleUrl,++ -- * Paged media+ orphans,+ widows,++ -- * Transformation+ textTransform+ )+ where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+import Data.ByteString (ByteString)+import Data.CSS.Build+import Data.CSS.Properties.Types+import Data.CSS.Properties.Utils+import Data.CSS.Types+import Data.CSS.Utils+import Data.Monoid+import Data.Text (Text)+import Web.Routes.RouteT+++-- | Set the generated @content@ to the given list of parts or @normal@.++content :: Maybe [ContentPart (CssUrl Text)] -> SetProp+content = setProp "content" . maybeProp "normal"+++-- | Set the generated @content@ to the given list of parts or @normal@.++contentUrl :: (MonadRoute m) => Maybe [ContentPart (URL m)] -> SetPropM m+contentUrl parts = do+ renderUrl <- askRouteFn+ content . fmap (map (fmap $ CssUrl . flip renderUrl [])) $ parts+++-- | Increment the given counters by the given value+-- (@counter-increment@).++counterIncrement :: (Integral a) => [(ByteString, a)] -> SetProp+counterIncrement [] = setProp "counter-increment" (PropValue "none")+counterIncrement cs = setProp "counter-increment" (map (formatCounter 1) cs)+++-- | Reset the given counters to the given value (@counter-reset@).++counterReset :: (Integral a) => [(ByteString, a)] -> SetProp+counterReset [] = setProp "counter-reset" (PropValue "none")+counterReset cs = setProp "counter-reset" (map (formatCounter 0) cs)+++-- | Set the text @direction@.++direction :: TextDirection -> SetProp+direction = setProp "direction"+++-- | Format the given identifier/counter pair for 'counterIncrement' and+-- 'counterReset' with the given default value.++formatCounter :: (Integral a) => a -> (ByteString, a) -> ByteString+formatCounter def (ctr, n)+ | n == def = ctr+ | otherwise =+ toByteString $+ fromByteString ctr <>+ fromChar ' ' <>+ showReal n+++-- | Set the @letter-spacing@ to the specified value or @normal@.++letterSpacing :: (Real a) => Maybe (Length a) -> SetProp+letterSpacing = setProp "letter-spacing" . maybeProp "normal"+++-- | Set all @list-style@ properties.++listStyle :: ListStyle -> ListPosition -> Maybe (CssUrl Text) -> SetProp+listStyle style pos url = setProp "list-style" (style, pos, maybeProp "none" url)+++-- | Set the @list-style-image@.++listStyleImage :: Maybe (CssUrl Text) -> SetProp+listStyleImage = setProp "list-style-image" . maybeProp "none"+++-- | Set the @list-style-image@.++listStyleImageUrl :: (MonadRoute m) => Maybe (URL m) -> SetPropM m+listStyleImageUrl url = do+ renderUrl <- askRouteFn+ listStyleImage . fmap (CssUrl . flip renderUrl []) $ url+++-- | Set the @list-style-position@.++listStylePosition :: ListPosition -> SetProp+listStylePosition = setProp "list-style-position"+++-- | Set the @list-style-type@.++listStyleType :: ListStyle -> SetProp+listStyleType = setProp "list-style-type"+++-- | Set all @list-style@ properties.++listStyleUrl ::+ (MonadRoute m)+ => ListStyle+ -> ListPosition+ -> Maybe (URL m)+ -> SetPropM m+listStyleUrl style pos url = do+ renderUrl <- askRouteFn+ listStyle style pos (fmap (CssUrl . flip renderUrl []) url)+++-- | Set the @orphans@ threshold (minimum number of lines at the bottom+-- of a page).++orphans :: (Integral a) => a -> SetProp+orphans = setProp "orphans" . toInteger+++-- | Set the @quotes@ pairs (@none@ if empty).++quotes :: [(CssString Text, CssString Text)] -> SetProp+quotes [] = setProp "quotes" (PropValue "none")+quotes qs = setProp "quotes" qs+++-- | Set @text-align@.++textAlign :: TextAlign -> SetProp+textAlign = setProp "text-align"+++-- | Set the @text-indent@.++textIndent :: (Real a) => FactorLen Length a -> SetProp+textIndent = setProp "text-indent"+++-- | Set the @text-transform@.++textTransform :: Maybe TextTransform -> SetProp+textTransform = setProp "text-transform" . maybeProp "none"+++-- | Set the @unicode-bidi@ mode.++unicodeBidi :: UnicodeBidiMode -> SetProp+unicodeBidi = setProp "unicode-bidi"+++-- | Set the white space collapse and text wrapping modes+-- (@white-space@).++whiteSpace :: TextWrapMode -> SetProp+whiteSpace = setProp "white-space"+++-- | Set the @widows@ threshold (minimum number of lines at the top of a+-- page).++widows :: (Integral a) => a -> SetProp+widows = setProp "widows" . toInteger+++-- | Set the @word-spacing@ to the specified value or @normal@.++wordSpacing :: (Real a) => Maybe (Length a) -> SetProp+wordSpacing = setProp "word-spacing" . maybeProp "normal"
+ Data/CSS/Properties/Types.hs view
@@ -0,0 +1,886 @@+-- |+-- Module: Data.CSS.Properties.Types+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties.Types+ ( -- * Lengths+ Length,+ AutoLen,+ FactorLen,++ -- * Generic CSS types+ CssString(..),+ CssUrl(..),++ -- * Edge-oriented+ Edge(..),++ -- * Specific properties+ -- ** Backgrounds+ BackgroundAttachment(..),+ BackgroundRepeat(..),+ -- ** Borders+ BorderStyle(..),+ BorderWidth(..),+ -- ** Fonts+ FontFamily(..),+ FontSize(..),+ FontStyle(..),+ FontVariant(..),+ FontWeight(..),+ -- ** Generated content+ ContentPart(..),+ -- ** Layout+ ClipMode(..),+ DisplayMode(..),+ FloatEdge(..),+ OverflowMode(..),+ PositionMode(..),+ VisibilityMode(..),+ -- ** Lists+ ListPosition(..),+ ListStyle(..),+ -- ** Paged media+ PageBreak(..), AnyBreak, InsideBreak,+ PageSelector(..),+ -- ** Tables+ CaptionSide(..),+ TableLayout(..),+ -- ** Text+ TextAlign(..),+ TextDecoration(..),+ TextDirection(..),+ TextTransform(..),+ TextWrapMode(..),+ UnicodeBidiMode(..),+ VerticalAlign(..),+ -- ** User interface+ Cursor(..)+ )+ where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8 hiding (fromString)+import Control.Lens+import Data.ByteString (ByteString)+import Data.CSS.Properties.Classes+import Data.CSS.Properties.Utils+import Data.CSS.Types+import Data.CSS.Utils+import Data.Data+import Data.Foldable (Foldable(fold))+import Data.List+import Data.Monoid+import Data.String+import Data.Text (Text)+++-- | Length transformer to add automatic lengths.++data AutoLen len a = AutoLen | NoAutoLen (len a)+ deriving (Eq, Ord, Show)++instance HasAutoLength (AutoLen len) where+ autoLen = AutoLen++instance (HasLength len) => HasLength (AutoLen len) where+ _Cm = _NoAutoLen . _Cm+ _Em = _NoAutoLen . _Em+ _Ex = _NoAutoLen . _Ex+ _Mm = _NoAutoLen . _Mm+ _Px = _NoAutoLen . _Px+ zeroLen = NoAutoLen zeroLen++instance (HasPercent len) => HasPercent (AutoLen len) where+ _Factor = _NoAutoLen . _Factor++instance (ToPropValue (len a)) => ToPropValue (AutoLen len a) where+ toPropBuilder AutoLen = fromByteString "auto"+ toPropBuilder (NoAutoLen l) = toPropBuilder l+++-- | Background attachment.++data BackgroundAttachment+ = FixedBgr -- ^ @fixed@ background.+ | ScrollBgr -- ^ @scroll@ background.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue BackgroundAttachment where+ toPropBuilder FixedBgr = fromByteString "fixed"+ toPropBuilder ScrollBgr = fromByteString "scroll"+++-- | Background repeating.++data BackgroundRepeat+ = NoRepeat -- ^ @no-repeat@.+ | Repeat -- ^ @repeat@ both axes.+ | RepeatX -- ^ @repeat-x@ axis.+ | RepeatY -- ^ @repeat-y@ axis.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue BackgroundRepeat where+ toPropBuilder NoRepeat = fromByteString "no-repeat"+ toPropBuilder Repeat = fromByteString "repeat"+ toPropBuilder RepeatX = fromByteString "repeat-x"+ toPropBuilder RepeatY = fromByteString "repeat-y"+++-- | Border style.++data BorderStyle+ = NoBorder+ | HiddenBorder+ | DottedBorder+ | DashedBorder+ | SolidBorder+ | DoubleBorder+ | GrooveBorder+ | RidgeBorder+ | InsetBorder+ | OutsetBorder+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue BorderStyle where+ toPropBuilder NoBorder = fromByteString "none"+ toPropBuilder HiddenBorder = fromByteString "hidden"+ toPropBuilder DottedBorder = fromByteString "dotted"+ toPropBuilder DashedBorder = fromByteString "dashed"+ toPropBuilder SolidBorder = fromByteString "solid"+ toPropBuilder DoubleBorder = fromByteString "double"+ toPropBuilder GrooveBorder = fromByteString "groove"+ toPropBuilder RidgeBorder = fromByteString "ridge"+ toPropBuilder InsetBorder = fromByteString "inset"+ toPropBuilder OutsetBorder = fromByteString "outset"+++-- | Border widths.++data BorderWidth a+ = BorderWidth (Length a) -- ^ Custom border width.+ | MediumWidth -- ^ Medium border width.+ | ThickWidth -- ^ Thick border width.+ | ThinWidth -- ^ Thin border width.+ deriving (Eq, Ord, Show, Typeable)++instance HasLength BorderWidth where+ _Em = _BorderWidth . _Em+ _Ex = _BorderWidth . _Ex+ _Mm = _BorderWidth . _Mm+ _Px = _BorderWidth . _Px+ zeroLen = BorderWidth zeroLen++instance (Real a) => ToPropValue (BorderWidth a) where+ toPropBuilder (BorderWidth l) = toPropBuilder l+ toPropBuilder MediumWidth = fromByteString "medium"+ toPropBuilder ThickWidth = fromByteString "thick"+ toPropBuilder ThinWidth = fromByteString "thin"+++-- | Table caption sides.++data CaptionSide+ = BottomSide -- ^ Table's @bottom@ side.+ | TopSide -- ^ Table's @top@ side.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue CaptionSide where+ toPropBuilder BottomSide = fromByteString "bottom"+ toPropBuilder TopSide = fromByteString "top"+++-- | Clipping modes.++data ClipMode a+ -- | Rectangular clipping region.+ = ClipRect (AutoLen Length a)+ (AutoLen Length a)+ (AutoLen Length a)+ (AutoLen Length a)+ deriving (Eq, Ord, Show, Typeable)++instance (Real a) => ToPropValue (ClipMode a) where+ toPropBuilder (ClipRect t r b l) =+ fromByteString "rect(" <>+ toPropBuilder t <> fromChar ',' <>+ toPropBuilder r <> fromChar ',' <>+ toPropBuilder b <> fromChar ',' <>+ toPropBuilder l <> fromChar ')'+++-- | Parts for the @content@ property.++data ContentPart url+ = AttrPart ByteString -- ^ @attr(x)@ part.+ | CloseQuotePart -- ^ @close-quote@ part.+ | CounterPart ByteString (Maybe ListStyle) -- ^ @counter(x, y)@ part.+ | CountersPart ByteString Text (Maybe ListStyle) -- ^ @counters(x, y)@ part.+ | NoCloseQuotePart -- ^ @no-close-quote@ part.+ | NoOpenQuotePart -- ^ @no-open-quote@ part.+ | OpenQuotePart -- ^ @open-quote@ part.+ | TextPart (CssString Text) -- ^ Text part.+ | UriPart url -- ^ @url(x)@ part.+ deriving (Data, Eq, Functor, Ord, Read, Show, Typeable)++instance IsString (ContentPart url) where+ fromString = TextPart . fromString++instance (ToPropValue url) => ToPropValue (ContentPart url) where+ toPropBuilder part =+ case part of+ AttrPart attr -> bs "attr(" <> bs attr <> ch ')'+ CloseQuotePart -> bs "close-quote"+ NoCloseQuotePart -> bs "no-close-quote"+ NoOpenQuotePart -> bs "no-open-quote"+ OpenQuotePart -> bs "open-quote"+ UriPart url -> toPropBuilder url+ CounterPart name (Just DecimalList) ->+ bs "counter(" <> bs name <> ch ')'+ CounterPart name style ->+ bs "counter(" <>+ bs name <> ch ',' <>+ maybeBuilder "none" style <>+ ch ')'+ CountersPart name sep (Just DecimalList) ->+ bs "counters(" <>+ bs name <> ch ',' <>+ cssString sep <>+ ch ')'+ CountersPart name sep style ->+ bs "counters(" <>+ bs name <> ch ',' <>+ cssString sep <> ch ',' <>+ maybeBuilder "none" style <>+ ch ')'+ TextPart text -> toPropBuilder text++ where+ bs = fromByteString+ ch = fromChar+++-- | CSS strings.++newtype CssString a = CssString { getCssString :: a }+ deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable)++instance (IsString a) => IsString (CssString a) where+ fromString = CssString . fromString++instance ToPropValue (CssString Text) where+ toPropBuilder = cssString . getCssString+++-- | CSS URLs.++newtype CssUrl a = CssUrl { getCssUrl :: a }+ deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable)++instance (IsString a) => IsString (CssUrl a) where+ fromString = CssUrl . fromString++instance ToPropValue (CssUrl Text) where+ toPropBuilder (CssUrl url) =+ fromByteString "url(" <>+ cssString url <>+ fromChar ')'+++-- | Cursors.++data Cursor url+ = CrosshairCursor -- ^ @crosshair@ cursor.+ | CursorFrom [url] -- ^ Cursor from one of the given URLs.+ | DefaultCursor -- ^ @default@ cursor.+ | EResizeCursor -- ^ @e-resize@ cursor.+ | HelpCursor -- ^ @help@ cursor.+ | MoveCursor -- ^ @move@ cursor.+ | NResizeCursor -- ^ @n-resize@ cursor.+ | NeResizeCursor -- ^ @ne-resize@ cursor.+ | NwResizeCursor -- ^ @nw-resize@ cursor.+ | PointerCursor -- ^ @pointer@ cursor.+ | ProgressCursor -- ^ @progress@ cursor.+ | SResizeCursor -- ^ @s-resize@ cursor.+ | SeResizeCursor -- ^ @se-resize@ cursor.+ | SwResizeCursor -- ^ @sw-resize@ cursor.+ | TextCursor -- ^ @text@ cursor.+ | WResizeCursor -- ^ @w-resize@ cursor.+ | WaitCursor -- ^ @wait@ cursor.+ deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Typeable, Traversable)++instance (ToPropValue url) => ToPropValue (Cursor url) where+ toPropBuilder CrosshairCursor = fromByteString "crosshair"+ toPropBuilder DefaultCursor = fromByteString "default"+ toPropBuilder EResizeCursor = fromByteString "e-resize"+ toPropBuilder HelpCursor = fromByteString "help"+ toPropBuilder MoveCursor = fromByteString "move"+ toPropBuilder NResizeCursor = fromByteString "n-resize"+ toPropBuilder NeResizeCursor = fromByteString "ne-resize"+ toPropBuilder NwResizeCursor = fromByteString "nw-resize"+ toPropBuilder PointerCursor = fromByteString "pointer"+ toPropBuilder ProgressCursor = fromByteString "progress"+ toPropBuilder SResizeCursor = fromByteString "s-resize"+ toPropBuilder SeResizeCursor = fromByteString "se-resize"+ toPropBuilder SwResizeCursor = fromByteString "sw-resize"+ toPropBuilder TextCursor = fromByteString "text"+ toPropBuilder WResizeCursor = fromByteString "w-resize"+ toPropBuilder WaitCursor = fromByteString "wait"+ toPropBuilder (CursorFrom us) =+ fold .+ intersperse (fromChar ',') .+ map toPropBuilder $ us+++-- | Display modes.++data DisplayMode+ = BlockDisplay -- ^ @block@ display.+ | InlineBlockDisplay -- ^ @inline-block@ display.+ | InlineDisplay -- ^ @inline@ display.+ | ListItemDisplay -- ^ @list-item@ display+ | NoneDisplay -- ^ @none@ display.++ | TableDisplay -- ^ @table@ display.+ | InlineTableDisplay -- ^ @inline-table@ display.+ | TableRowGroupDisplay -- ^ @table-row-group@ display.+ | TableColumnDisplay -- ^ @table-column@ display.+ | TableColumnGroupDisplay -- ^ @table-column-group@ display.+ | TableHeaderGroupDisplay -- ^ @table-header-group@ display.+ | TableFooterGroupDisplay -- ^ @table-footer-group@ display.+ | TableRowDisplay -- ^ @table-row@ display.+ | TableCellDisplay -- ^ @table-cell@ display.+ | TableCaptionDisplay -- ^ @table-caption@ display.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue DisplayMode where+ toPropBuilder BlockDisplay = fromByteString "block"+ toPropBuilder InlineBlockDisplay = fromByteString "inline-block"+ toPropBuilder InlineDisplay = fromByteString "inline"+ toPropBuilder InlineTableDisplay = fromByteString "inline-table"+ toPropBuilder ListItemDisplay = fromByteString "list-item"+ toPropBuilder NoneDisplay = fromByteString "none"+ toPropBuilder TableCaptionDisplay = fromByteString "table-caption"+ toPropBuilder TableCellDisplay = fromByteString "table-cell"+ toPropBuilder TableColumnDisplay = fromByteString "table-column"+ toPropBuilder TableColumnGroupDisplay = fromByteString "table-column-group"+ toPropBuilder TableDisplay = fromByteString "table"+ toPropBuilder TableFooterGroupDisplay = fromByteString "table-footer-group"+ toPropBuilder TableHeaderGroupDisplay = fromByteString "table-header-group"+ toPropBuilder TableRowDisplay = fromByteString "table-row"+ toPropBuilder TableRowGroupDisplay = fromByteString "table-row-group"+++-- | Edge-oriented specifications.++data Edge a+ = Edges [a] -- ^ All edges.+ | BottomEdge a -- ^ Bottom edge.+ | LeftEdge a -- ^ Left edge.+ | RightEdge a -- ^ Right edge.+ | TopEdge a -- ^ Top edge.+ deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable)+++-- | Length transformer to add percental lengths.++data FactorLen len a = FactorLen a | NoFactorLen (len a)+ deriving (Eq, Ord, Show)++instance (HasAutoLength len) => HasAutoLength (FactorLen len) where+ autoLen = NoFactorLen autoLen++instance (HasLength len) => HasLength (FactorLen len) where+ _Cm = _NoFactorLen . _Cm+ _Em = _NoFactorLen . _Em+ _Ex = _NoFactorLen . _Ex+ _Mm = _NoFactorLen . _Mm+ _Px = _NoFactorLen . _Px+ zeroLen = NoFactorLen zeroLen++instance HasPercent (FactorLen len) where+ _Factor = prism FactorLen ex+ where+ ex (FactorLen x) = Right x+ ex len = Left len++instance (Real a, ToPropValue (len a)) => ToPropValue (FactorLen len a) where+ toPropBuilder (FactorLen x) = showReal (100*x) <> fromChar '%'+ toPropBuilder (NoFactorLen l) = toPropBuilder l+++-- | Floating edge.++data FloatEdge = LeftFloat | RightFloat+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue FloatEdge where+ toPropBuilder LeftFloat = fromByteString "left"+ toPropBuilder RightFloat = fromByteString "right"+++-- | Font families.++data FontFamily+ = CursiveFont -- ^ Generic @cursive@ font.+ | FantasyFont -- ^ Generic @fantasy@ font.+ | MonospaceFont -- ^ Generic @monospace@ font.+ | SansSerifFont -- ^ Generic @sans-serif@ font.+ | SerifFont -- ^ Generic @serif@ font.+ | NamedFont (CssString Text) -- ^ Specific named font.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance IsString FontFamily where+ fromString = NamedFont . fromString++instance ToPropValue FontFamily where+ toPropBuilder CursiveFont = fromByteString "cursive"+ toPropBuilder FantasyFont = fromByteString "fantasy"+ toPropBuilder MonospaceFont = fromByteString "monospace"+ toPropBuilder SansSerifFont = fromByteString "sans-serif"+ toPropBuilder SerifFont = fromByteString "serif"+ toPropBuilder (NamedFont ff) = toPropBuilder ff+++-- | Font sizes.++data FontSize a+ = XXSmallSize -- ^ Absolutely @xx-small@ size.+ | XSmallSize -- ^ Absolutely @x-small@ size.+ | SmallSize -- ^ Absolutely @small@ size.+ | MediumSize -- ^ Absolutely @medium@ size.+ | LargeSize -- ^ Absolutely @large@ size.+ | XLargeSize -- ^ Absolutely @x-large@ size.+ | XXLargeSize -- ^ Absolutely @xx-large@ size.++ | LargerSize -- ^ Relatively @larger@ size.+ | SmallerSize -- ^ Relatively @smaller@ size.++ | LengthSize (FactorLen Length a) -- ^ Specific font size.+ deriving (Eq, Ord, Show, Typeable)++instance HasLength FontSize where+ _Em = _LengthSize . _Em+ _Ex = _LengthSize . _Ex+ _Mm = _LengthSize . _Mm+ _Px = _LengthSize . _Px+ zeroLen = LengthSize zeroLen++instance HasPercent FontSize where+ _Factor = _LengthSize . _Factor++instance (Real a) => ToPropValue (FontSize a) where+ toPropBuilder LargeSize = fromByteString "large"+ toPropBuilder LargerSize = fromByteString "larger"+ toPropBuilder MediumSize = fromByteString "medium"+ toPropBuilder SmallSize = fromByteString "small"+ toPropBuilder SmallerSize = fromByteString "smaller"+ toPropBuilder XLargeSize = fromByteString "x-large"+ toPropBuilder XSmallSize = fromByteString "x-small"+ toPropBuilder XXLargeSize = fromByteString "xx-large"+ toPropBuilder XXSmallSize = fromByteString "xx-small"+ toPropBuilder (LengthSize l) = toPropBuilder l+++-- | Font styles.++data FontStyle+ = ItalicStyle -- ^ Select @italic@ style.+ | ObliqueStyle -- ^ Select @oblique@ style.+ | NormalStyle -- ^ Select @normal@ style.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue FontStyle where+ toPropBuilder ItalicStyle = fromByteString "italic"+ toPropBuilder ObliqueStyle = fromByteString "oblique"+ toPropBuilder NormalStyle = fromByteString "normal"+++-- | Font variants.++data FontVariant+ = NormalVariant -- ^ Select @normal@ font.+ | SmallCapsVariant -- ^ Select @small-caps@ font.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue FontVariant where+ toPropBuilder NormalVariant = fromByteString "normal"+ toPropBuilder SmallCapsVariant = fromByteString "small-caps"+++-- | Font weight.++data FontWeight+ = BolderWeight -- ^ Relatively @bolder@ font weight.+ | LighterWeight -- ^ Relatively @lighter@ font weight.+ | FontWeight Int -- ^ Specific font weight (1-9), 4 = @normal@, 7 = @bold@.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue FontWeight where+ toPropBuilder BolderWeight = fromByteString "bolder"+ toPropBuilder LighterWeight = fromByteString "lighter"+ toPropBuilder (FontWeight 4) = fromByteString "normal"+ toPropBuilder (FontWeight 7) = fromByteString "bold"+ toPropBuilder (FontWeight w) = showReal (100*w)+++-- | Length transformer to add lengths in various CSS units.++data Length a+ = EmLen a -- ^ Font sizes.+ | ExLen a -- ^ Vertical sizes of the letter @x@.+ | MmLen a -- ^ Millimeters.+ | PxLen a -- ^ Pixels.+ | ZeroLen -- ^ Zero.+ deriving (Eq, Ord, Show, Typeable)++instance HasLength Length where+ _Em = prism (orZeroLen EmLen) ex+ where+ ex (EmLen x) = Right x+ ex ZeroLen = Right 0+ ex len = Left len++ _Ex = prism (orZeroLen ExLen) ex+ where+ ex (ExLen x) = Right x+ ex ZeroLen = Right 0+ ex len = Left len++ _Mm = prism (orZeroLen MmLen) ex+ where+ ex (MmLen x) = Right x+ ex ZeroLen = Right 0+ ex len = Left len++ _Px = prism (orZeroLen PxLen) ex+ where+ ex (PxLen x) = Right x+ ex ZeroLen = Right 0+ ex len = Left len++ zeroLen = ZeroLen++instance (Real a) => ToPropValue (Length a) where+ toPropBuilder (EmLen x) = showReal x <> fromByteString "em"+ toPropBuilder (ExLen x) = showReal x <> fromByteString "ex"+ toPropBuilder (MmLen x) = showReal x <> fromByteString "mm"+ toPropBuilder (PxLen x) = showReal x <> fromByteString "px"+ toPropBuilder ZeroLen = fromChar '0'+++-- | List number/bullet position.++data ListPosition+ = InsideList -- ^ @inside@ the box.+ | OutsideList -- ^ @outside@ of the box.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue ListPosition where+ toPropBuilder InsideList = fromByteString "inside"+ toPropBuilder OutsideList = fromByteString "outside"+++-- | List number/bullet styles.++data ListStyle+ = ArmenianList -- ^ @armenian@ numbering.+ | CircleList -- ^ @circle@ bullets.+ | DecimalLeadingZeroList -- ^ @decimal-leading-zero@ numbering.+ | DecimalList -- ^ @decimal@ numbering.+ | DiscList -- ^ @disc@ bullets.+ | GeorgianList -- ^ @georgian@ numbering.+ | LowerAlphaList -- ^ @lower-alpha@ numbering.+ | LowerGreekList -- ^ @lower-greek@ numbering.+ | LowerLatinList -- ^ @lower-latin@ numbering.+ | LowerRomanList -- ^ @lower-roman@ numbering.+ | SquareList -- ^ @square@ bullets.+ | UpperAlphaList -- ^ @upper-alpha@ numbering.+ | UpperLatinList -- ^ @upper-latin@ numbering.+ | UpperRomanList -- ^ @upper-roman@ numbering.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue ListStyle where+ toPropBuilder ArmenianList = fromByteString "armenian"+ toPropBuilder CircleList = fromByteString "circle"+ toPropBuilder DecimalLeadingZeroList = fromByteString "decimal-leading-zero"+ toPropBuilder DecimalList = fromByteString "decimal"+ toPropBuilder DiscList = fromByteString "disc"+ toPropBuilder GeorgianList = fromByteString "georgian"+ toPropBuilder LowerAlphaList = fromByteString "lower-alpha"+ toPropBuilder LowerGreekList = fromByteString "lower-greek"+ toPropBuilder LowerLatinList = fromByteString "lower-latin"+ toPropBuilder LowerRomanList = fromByteString "lower-roman"+ toPropBuilder SquareList = fromByteString "square"+ toPropBuilder UpperAlphaList = fromByteString "upper-alpha"+ toPropBuilder UpperLatinList = fromByteString "upper-latin"+ toPropBuilder UpperRomanList = fromByteString "upper-roman"+++-- | Overflow handling mode.++data OverflowMode+ = AutoOverflow -- ^ @auto@ overflow handling.+ | HiddenOverflow -- ^ @hidden@ overflow handling.+ | ScrollOverflow -- ^ @scroll@ overflow handling.+ | VisibleOverflow -- ^ @visible@ overflow handling.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue OverflowMode where+ toPropBuilder AutoOverflow = fromByteString "auto"+ toPropBuilder HiddenOverflow = fromByteString "hidden"+ toPropBuilder ScrollOverflow = fromByteString "scroll"+ toPropBuilder VisibleOverflow = fromByteString "visible"+++-- | Page break rules.++data PageBreak :: * -> * where+ AlwaysBreak :: PageBreak AnyBreak+ AvoidBreak :: PageBreak InsideBreak+ LeftBreak :: PageBreak AnyBreak+ RightBreak :: PageBreak AnyBreak++instance ToPropValue (PageBreak a) where+ toPropBuilder AlwaysBreak = fromByteString "always"+ toPropBuilder AvoidBreak = fromByteString "avoid"+ toPropBuilder LeftBreak = fromByteString "left"+ toPropBuilder RightBreak = fromByteString "right"++-- | Page break context: any.+data AnyBreak++-- | Page break context: @page-break-inside@.+data InsideBreak+++-- | Page selectors for paged media.++data PageSelector+ = AllPages -- ^ Select all pages (@\@page@).+ | FirstPage -- ^ Select first page (@\@page :first@).+ | LeftPages -- ^ Select all left pages (@\@page :left@).+ | RightPages -- ^ Select all right pages (@\@page :right@).+ deriving (Data, Eq, Ord, Read, Show, Typeable)+++-- | Position modes.++data PositionMode+ = AbsolutePos -- ^ @absolute@ positioning.+ | FixedPos -- ^ @fixed@ positioning.+ | RelativePos -- ^ @relative@ positioning.+ | StaticPos -- ^ @static@ positioning.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue PositionMode where+ toPropBuilder AbsolutePos = fromByteString "absolute"+ toPropBuilder FixedPos = fromByteString "fixed"+ toPropBuilder RelativePos = fromByteString "relative"+ toPropBuilder StaticPos = fromByteString "static"+++-- | Table layout.++data TableLayout+ = AutoLayout -- ^ @auto@ layout.+ | FixedLayout -- ^ @fixed@ layout.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue TableLayout where+ toPropBuilder AutoLayout = fromByteString "auto"+ toPropBuilder FixedLayout = fromByteString "fixed"+++-- | Text alignment.++data TextAlign+ = CenterAlign -- ^ @center@ alignment.+ | JustifyAlign -- ^ @justify@ alignment.+ | LeftAlign -- ^ @left@ alignment.+ | RightAlign -- ^ @right@ alignment.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue TextAlign where+ toPropBuilder CenterAlign = fromByteString "center"+ toPropBuilder JustifyAlign = fromByteString "justify"+ toPropBuilder LeftAlign = fromByteString "left"+ toPropBuilder RightAlign = fromByteString "right"+++-- | Text decoration.++data TextDecoration+ = BlinkText -- ^ @blink@ text.+ | LineThroughText -- ^ @line-through@ text.+ | OverlineText -- ^ @overline@ text.+ | UnderlineText -- ^ @underline@ text.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue TextDecoration where+ toPropBuilder BlinkText = fromByteString "blink"+ toPropBuilder LineThroughText = fromByteString "line-through"+ toPropBuilder OverlineText = fromByteString "overline"+ toPropBuilder UnderlineText = fromByteString "underline"+++-- | Text direction.++data TextDirection+ = LeftToRight+ | RightToLeft+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue TextDirection where+ toPropBuilder LeftToRight = fromByteString "ltr"+ toPropBuilder RightToLeft = fromByteString "rtl"+++-- | Text transformation modes.++data TextTransform+ = CapitalizeText -- ^ @capitalize@ transform.+ | LowercaseText -- ^ @lowercase@ transform.+ | UppercaseText -- ^ @uppercase@ transform.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue TextTransform where+ toPropBuilder CapitalizeText = fromByteString "capitalize"+ toPropBuilder LowercaseText = fromByteString "lowercase"+ toPropBuilder UppercaseText = fromByteString "uppercase"+++-- | Text wrapping modes.++data TextWrapMode+ = NormalWrapping -- ^ @normal@ wrapping.+ | NowrapWrapping -- ^ @nowrap@ wrapping.+ | PreLineWrapping -- ^ @pre-line@ wrapping.+ | PreWrapWrapping -- ^ @pre-wrap@ wrapping.+ | PreWrapping -- ^ @pre@ wrapping.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue TextWrapMode where+ toPropBuilder NormalWrapping = fromByteString "normal"+ toPropBuilder NowrapWrapping = fromByteString "nowrap"+ toPropBuilder PreLineWrapping = fromByteString "pre-line"+ toPropBuilder PreWrapWrapping = fromByteString "pre-wrap"+ toPropBuilder PreWrapping = fromByteString "pre"+++-- | Unicode bidi embedding mode.++data UnicodeBidiMode+ = EmbedBidi -- ^ @embed@ mode.+ | NormalBidi -- ^ @normal@ mode.+ | OverrideBidi -- ^ @bidi-override@ mode.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue UnicodeBidiMode where+ toPropBuilder EmbedBidi = fromByteString "embed"+ toPropBuilder NormalBidi = fromByteString "normal"+ toPropBuilder OverrideBidi = fromByteString "bidi-override"+++-- | Vertical text/box alignment.++data VerticalAlign a+ = BaselineAlign+ | BottomAlign+ | LengthAlign (FactorLen Length a)+ | MiddleAlign+ | SubAlign+ | SuperAlign+ | TextBottomAlign+ | TextTopAlign+ | TopAlign+ deriving (Eq, Ord, Show, Typeable)++instance HasLength VerticalAlign where+ _Em = _LengthAlign . _Em+ _Ex = _LengthAlign . _Ex+ _Mm = _LengthAlign . _Mm+ _Px = _LengthAlign . _Px+ zeroLen = LengthAlign zeroLen++instance HasPercent VerticalAlign where+ _Factor = _LengthAlign . _Factor++instance (Real a) => ToPropValue (VerticalAlign a) where+ toPropBuilder BaselineAlign = fromByteString "baseline"+ toPropBuilder BottomAlign = fromByteString "bottom"+ toPropBuilder MiddleAlign = fromByteString "middle"+ toPropBuilder SubAlign = fromByteString "sub"+ toPropBuilder SuperAlign = fromByteString "super"+ toPropBuilder TextBottomAlign = fromByteString "text-bottom"+ toPropBuilder TextTopAlign = fromByteString "text-top"+ toPropBuilder TopAlign = fromByteString "top"+ toPropBuilder (LengthAlign x) = toPropBuilder x+++-- | Visibility modes.++data VisibilityMode+ = CollapseVisibility -- ^ @collapse@ visibility.+ | HiddenVisibility -- ^ @hidden@ visibility.+ | VisibleVisibility -- ^ @visible@ visibility.+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance ToPropValue VisibilityMode where+ toPropBuilder CollapseVisibility = fromByteString "collapse"+ toPropBuilder HiddenVisibility = fromByteString "hidden"+ toPropBuilder VisibleVisibility = fromByteString "visible"+++-- | Helper prism for border widths.++_BorderWidth :: Prism' (BorderWidth a) (Length a)+_BorderWidth = prism BorderWidth ex+ where+ ex (BorderWidth l) = Right l+ ex w = Left w+++-- | Helper prism for 'VerticalAlign'.++_LengthAlign :: Prism' (VerticalAlign a) (FactorLen Length a)+_LengthAlign = prism LengthAlign ex+ where+ ex (LengthAlign x) = Right x+ ex va = Left va+++-- | Helper prism for 'FontSize'.++_LengthSize :: Prism' (FontSize a) (FactorLen Length a)+_LengthSize = prism LengthSize ex+ where+ ex (LengthSize x) = Right x+ ex fs = Left fs+++-- | Helper prism for non-automatic lengths.++_NoAutoLen :: Prism' (AutoLen len a) (len a)+_NoAutoLen = prism NoAutoLen ex+ where+ ex (NoAutoLen l) = Right l+ ex len = Left len+++-- | Helper prism for non-automatic lengths.++_NoFactorLen :: Prism' (FactorLen len a) (len a)+_NoFactorLen = prism NoFactorLen ex+ where+ ex (NoFactorLen l) = Right l+ ex len = Left len+++-- | Helper function to convert a length to 'zeroLen' if it's zero.++orZeroLen :: (Eq a, HasLength len, Num a) => (a -> len a) -> (a -> len a)+orZeroLen _ 0 = zeroLen+orZeroLen f x = f x
+ Data/CSS/Properties/UI.hs view
@@ -0,0 +1,69 @@+-- |+-- Module: Data.CSS.Properties.UI+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties.UI+ ( -- * Cursor+ cursor,+ cursorUrl,++ -- * Outlines+ outline,+ outlineColor,+ outlineStyle,+ outlineWidth+ )+ where++import Data.Colour+import Data.CSS.Build+import Data.CSS.Properties.Types+import Data.CSS.Properties.Utils+import Data.CSS.Types+import Data.Text (Text)+import Web.Routes.RouteT+++-- | Set the @cursor@ to the specified value or @auto@.++cursor :: Maybe (Cursor (CssUrl Text)) -> SetProp+cursor = setProp "cursor" . maybeProp "auto"+++-- | Set the @cursor@ to the specified value or @auto@.++cursorUrl :: (MonadRoute m) => Maybe (Cursor (URL m)) -> SetPropM m+cursorUrl c = do+ renderUrl <- askRouteFn+ cursor . fmap (fmap (CssUrl . flip renderUrl [])) $ c+++-- | Set the @outline@ properties.++outline ::+ (ColourOps f, Real b, ToPropValue (f a))+ => Maybe (f a) -- ^ Color or @invert@.+ -> BorderStyle -- ^ Outline style.+ -> BorderWidth b -- ^ Outline width.+ -> SetProp+outline col style w = setProp "outline" (maybeProp "invert" col, style, w)+++-- | Set the @outline-color@ to the given color or @invert@.++outlineColor :: (ColourOps f, ToPropValue (f a)) => Maybe (f a) -> SetProp+outlineColor = setProp "outline-color" . maybeProp "invert"+++-- | Set the @outline-style@.++outlineStyle :: BorderStyle -> SetProp+outlineStyle = setProp "outline-style"+++-- | Set the @outline-width@.++outlineWidth :: (Real a) => BorderWidth a -> SetProp+outlineWidth = setProp "outline-width"
+ Data/CSS/Properties/Utils.hs view
@@ -0,0 +1,30 @@+-- |+-- Module: Data.CSS.Properties.Utils+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Properties.Utils+ ( -- * Maybe builders+ maybeBuilder,+ maybeProp+ )+ where++import Blaze.ByteString.Builder+import Data.ByteString (ByteString)+import Data.CSS.Types+++-- | Convenience wrapper around 'maybe' for properties. Renders as the+-- given bytestring if 'Nothing'.++maybeBuilder :: (ToPropValue a) => ByteString -> Maybe a -> Builder+maybeBuilder str = maybe (fromByteString str) toPropBuilder+++-- | Convenience wrapper around 'maybe' for properties. Renders as the+-- given bytestring if 'Nothing'.++maybeProp :: (ToPropValue a) => ByteString -> Maybe a -> PropValue+maybeProp str = maybe (PropValue str) toPropValue
+ Data/CSS/Render.hs view
@@ -0,0 +1,81 @@+-- |+-- Module: Data.CSS.Render+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Render+ ( -- * Rendering+ renderCSS,+ renderCSST,+ -- ** Helpers+ fromCSS+ )+ where++import qualified Data.Map as M+import qualified Data.Set as S+import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char.Utf8+import Control.Monad.Writer+import Data.CSS.Types+import Data.CSS.Utils+import Data.Foldable (fold, foldMap)+import Data.List+++-- | Render the given raw stylesheet to a 'Builder'.++fromCSS :: CSS -> Builder+fromCSS (CSS imports medias) =+ foldMap (uncurry fromImport) (M.toAscList imports) <>+ foldMap (uncurry media) (M.toAscList medias)++ where+ bs = fromByteString++ fromImport uri mts+ | S.member "all" mts = bs "@import url(" <> cssString uri <> bs ");"+ | otherwise =+ bs "@import url(" <> cssString uri <> fromChar ')' <>+ (fold . intersperse (fromChar ',') . map (bs . _mediaTypeStr) . S.toAscList) mts <>+ fromChar ';'++ media mts props+ | null props = mempty+ | S.null mts = mempty+ | S.member "all" mts = properties0 props+ | otherwise =+ bs "@media " <>+ (commasBS . map _mediaTypeStr . S.toList) mts <>+ fromChar '{' <>+ properties0 props <>+ fromChar '}'++ properties0 [] = mempty+ properties0 (Property sels (PropName name) (PropValue val) imp : props) =+ (commasBS . map _selectorStr) sels <> fromChar '{' <>+ bs name <> fromChar ':' <> bs val <>+ (if imp then fromByteString " !important" else mempty) <>+ properties sels props++ properties _ [] = fromChar '}'+ properties sels' props0@(Property sels (PropName name) (PropValue val) imp : props)+ | sels' == sels =+ fromChar ';' <>+ bs name <> fromChar ':' <> bs val <>+ (if imp then fromByteString " !important" else mempty) <>+ properties sels props+ | otherwise = fromChar '}' <> properties0 props0+++-- | Render the given stylesheet.++renderCSS :: Writer CSS a -> Builder+renderCSS = fromCSS . execWriter+++-- | Render the given stylesheet.++renderCSST :: (Monad m) => WriterT CSS m a -> m Builder+renderCSST = liftM fromCSS . execWriterT
+ Data/CSS/Types.hs view
@@ -0,0 +1,245 @@+-- |+-- Module: Data.CSS.Types+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++{-# LANGUAGE IncoherentInstances #-}++module Data.CSS.Types+ ( -- * Style sheets+ CSS(..), cssImports, cssProps,+ Property(..), propName, propSelector, propValue, propImportant,+ -- ** CSS building+ BuildCfg(..), bcMedia, bcSelector,+ SetProp,+ SetPropM,+ -- ** Auxiliary types+ MediaType(..), mediaTypeStr,+ PropName(..), propNameStr,+ PropValue(..), propValueStr,+ Selector(..), selectorStr,++ -- * Type classes+ ToPropValue(..)+ )+ where++import qualified Data.ByteString.Char8 as Bc+import qualified Data.ByteString.Lazy as Bl+import qualified Data.ByteString.UTF8 as Bu+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as Tl+import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8 as Blaze+import Control.Lens.TH+import Control.Monad.Reader.Class+import Control.Monad.Writer.Class+import Data.Bits+import Data.ByteString (ByteString)+import Data.Char+import Data.Colour+import Data.Colour.SRGB+import Data.Colour.SRGB.Linear+import Data.CSS.Utils+import Data.Data+import Data.Int+import Data.Map (Map)+import Data.Monoid+import Data.Ratio+import Data.Set (Set)+import Data.String+import Data.Text (Text)+import Data.Word+++-- | Types that feature a conversion function to 'PropValue'.++class ToPropValue a where+ toPropBuilder :: a -> Builder+ toPropBuilder = fromByteString . _propValueStr . toPropValue++ toPropValue :: a -> PropValue+ toPropValue = PropValue . toByteString . toPropBuilder++instance ToPropValue Double where toPropBuilder = showReal+instance ToPropValue Float where toPropBuilder = showReal+instance ToPropValue Int where toPropBuilder = showReal+instance ToPropValue Int8 where toPropBuilder = showReal+instance ToPropValue Int16 where toPropBuilder = showReal+instance ToPropValue Int32 where toPropBuilder = showReal+instance ToPropValue Int64 where toPropBuilder = showReal+instance ToPropValue Integer where toPropBuilder = showReal+instance ToPropValue Word where toPropBuilder = showReal+instance ToPropValue Word8 where toPropBuilder = showReal+instance ToPropValue Word16 where toPropBuilder = showReal+instance ToPropValue Word32 where toPropBuilder = showReal+instance ToPropValue Word64 where toPropBuilder = showReal+instance (Integral a) => ToPropValue (Ratio a) where toPropBuilder = showReal++instance ToPropValue ByteString where toPropValue = PropValue+instance ToPropValue Bl.ByteString where toPropValue = PropValue . Bl.toStrict+instance ToPropValue Char where toPropValue = PropValue . Bu.fromString . return+instance ToPropValue [Char] where toPropValue = PropValue . Bu.fromString+instance ToPropValue Text where toPropValue = PropValue . T.encodeUtf8+instance ToPropValue Tl.Text where toPropValue = PropValue . T.encodeUtf8 . Tl.toStrict++instance (Floating a, RealFrac a) => ToPropValue (AlphaColour a) where+ toPropBuilder col+ | t >= 1 = toPropBuilder col'+ | t <= 0 = fromByteString "rgba(0,0,0,0)"+ | otherwise =+ fromByteString "rgba(" <>+ Blaze.fromString (show r) <> fromChar ',' <>+ Blaze.fromString (show g) <> fromChar ',' <>+ Blaze.fromString (show b) <> fromChar ',' <>+ showReal t <> fromChar ')'++ where+ t = alphaChannel col+ RGB r' g' b' = fmap (/ t) . toRGB $ col `over` black+ col' = rgb r' g' b'+ RGB r g b = toSRGB24 col'++instance (Floating a, RealFrac a) => ToPropValue (Colour a) where+ toPropBuilder col =+ fromChar '#' <>+ maybe (colorHex r <> colorHex g <> colorHex b) id+ (fmap mconcat $ mapM colorShortHex [r, g, b])++ where+ RGB r g b = toSRGB24 col++instance (ToPropValue a) => ToPropValue [a] where+ toPropValue =+ PropValue .+ Bc.intercalate " " .+ map (_propValueStr . toPropValue)++instance (ToPropValue a, ToPropValue b) => ToPropValue (a, b) where+ toPropBuilder (a, b) =+ toPropBuilder a <> fromChar ' ' <> toPropBuilder b++instance (ToPropValue a, ToPropValue b, ToPropValue c) => ToPropValue (a, b, c) where+ toPropBuilder (a, b, c) =+ toPropBuilder a <> fromChar ' ' <>+ toPropBuilder b <> fromChar ' ' <>+ toPropBuilder c+++-- | CSS builder configuration.++data BuildCfg =+ BuildCfg {+ _bcMedia :: Set MediaType, -- ^ Current media type.+ _bcSelector :: [Selector] -- ^ Current selector.+ }+ deriving (Data, Eq, Ord, Read, Show, Typeable)+++-- | Cascading style sheets.++data CSS =+ CSS {+ _cssImports :: Map Text (Set MediaType), -- ^ External stylesheets (url, media-type).+ _cssProps :: Map (Set MediaType) [Property] -- ^ Properties.+ }+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance Monoid CSS where+ mempty = CSS M.empty M.empty++ mappend (CSS is1 ps1) (CSS is2 ps2) =+ CSS (M.unionWith S.union is1 is2) (M.unionWith (++) ps1 ps2)+++-- | Media types, e.g. @all@ or @print@.++newtype MediaType = MediaType { _mediaTypeStr :: ByteString }+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance IsString MediaType where+ fromString = MediaType . Bu.fromString+++-- | Style properties.++data Property =+ Property {+ _propSelector :: [Selector], -- ^ Selector for this property.+ _propName :: PropName, -- ^ Property name.+ _propValue :: PropValue, -- ^ Property value.+ _propImportant :: Bool -- ^ @!important@ property?+ }+ deriving (Data, Eq, Ord, Read, Show, Typeable)+++-- | Property names, e.g. @font-family@.++newtype PropName = PropName { _propNameStr :: ByteString }+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance IsString PropName where+ fromString = PropName . Bu.fromString+++-- | Property values, e.g. @sans-serif@.++newtype PropValue = PropValue { _propValueStr :: ByteString }+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance IsString PropValue where+ fromString = PropValue . Bu.fromString++instance ToPropValue PropValue where+ toPropValue = id+++-- | Selectors, e.g. @*@ or @#content p@.++newtype Selector = Selector { _selectorStr :: ByteString }+ deriving (Data, Eq, Ord, Read, Show, Typeable)++instance IsString Selector where+ fromString = Selector . Bu.fromString+++-- | Property setter.++type SetProp = forall m. SetPropM m+++-- | Parametric property setter.++type SetPropM m = (MonadReader BuildCfg m, MonadWriter CSS m) => m ()+++-- | Convert the given color byte to its hex representation.++colorHex :: Word8 -> Builder+colorHex x =+ fromChar (intToDigit (fromIntegral $ shiftR x 4)) <>+ fromChar (intToDigit (fromIntegral $ x .&. 0x0F))+++-- | Convert the given color byte to its short hex representation if+-- available.++colorShortHex :: Word8 -> Maybe Builder+colorShortHex x+ | hi == lo = Just (fromChar (intToDigit (fromIntegral lo)))+ | otherwise = Nothing+ where+ hi = shiftR x 4+ lo = x .&. 0x0F+++makeLenses ''BuildCfg+makeLenses ''CSS+makeLenses ''MediaType+makeLenses ''Property+makeLenses ''PropName+makeLenses ''PropValue+makeLenses ''Selector
+ Data/CSS/Utils.hs view
@@ -0,0 +1,95 @@+-- |+-- Module: Data.CSS.Utils+-- Copyright: (c) 2013 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Data.CSS.Utils+ ( -- * Builder utilities+ commas,+ commasBS,+ cssString,+ showHexInt,+ showReal+ )+ where++import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char.Utf8+import Data.ByteString (ByteString)+import Data.Char+import Data.Foldable (fold)+import Data.List+import Data.Monoid+import Data.Text (Text)+++-- | Render the given list of builders separated by commas.++commas :: [Builder] -> Builder+commas = fold . intersperse (fromChar ',')+++-- | Render the given list of builders separated by commas.++commasBS :: [ByteString] -> Builder+commasBS = commas . map fromByteString+++-- | Renders the given CSS string in double-quotes, escaped as+-- necessary.++cssString :: Text -> Builder+cssString s0 = fromChar '"' <> str s0 <> fromChar '"'+ where+ str s' =+ case T.uncons s' of+ Nothing -> mempty+ Just ('"', s) -> fromByteString "\\\"" <> str s+ Just ('\\', s) -> fromByteString "\\\\" <> str s+ Just (c, s)+ | isControl c -> fromChar '\\' <> showHexInt 6 (ord c) <> str s+ | otherwise -> fromChar c <> str s+++-- | @showHexInt p n@ builds the hexadecimal representation of @n@ with+-- at least @p@ digits. Prepends zeroes to fill.++showHexInt :: (Integral a) => Int -> a -> Builder+showHexInt p n | n < 0 = fromChar '-' <> showHexInt p (negate n)+showHexInt p 0 = fromByteString (B.replicate (max 0 p) '0')+showHexInt p' n' =+ p `seq` showHexInt p n <>+ fromChar (intToDigit $ fromIntegral r)++ where+ (n, r) = quotRem n' 16+ p = max 0 (pred p')+++-- | Lossily convert the given 'Real' number into a decimal+-- representation suitable for CSS.++showReal :: (Real a) => a -> Builder+showReal = showRat . toRational+ where+ showRat x | x < 0 = fromChar '-' <> showRat (negate x)+ showRat x =+ let (n, f) = properFraction x in+ (if n == 0 then fromChar '0' else intP n) <>+ (if f == 0 then mempty else fromChar '.' <> fromString (fracP 6 f))++ intP :: Integer -> Builder+ intP 0 = mempty+ intP n = let (q, r) = quotRem n 10 in intP q <> fromChar (intToDigit $ fromInteger r)++ fracP _ 0 = ""+ fracP 0 _ = ""+ fracP i f'+ | all (== '0') res = ""+ | otherwise = res+ where+ (n, f) = properFraction (10*f')+ res = intToDigit n : fracP (pred i) f
+ LICENSE view
@@ -0,0 +1,32 @@+cascading license+Copyright (c) 2013, Ertugrul Soeylemez++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in+ the documentation and/or other materials provided with the+ distribution.++ * Neither the name of the author nor the names of any contributors+ may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,165 @@+Cascading+=========++This library implements a domain-specific language for cascading style+sheets as used in web pages. It allows you to specify your style sheets+in regular Haskell syntax and gives you all the additional power of+server-side document generation. You can find examples below. To see a+full tutorial, have a look at the Haddock documentation of the+`Data.CSS` module.+++Current status+--------------++Right now most of the CSS 2.1 specification is implemented. In+particular all non-appendix properties now have type-safe Haskell+counterparts in `Data.CSS.Properties`.++The type safety goes very far to ensure conformance with the+specification, but some of it has been sacrificed for convenience and+API simplicity.++### To do++ * Write automated unit tests.+ * Write a pretty printer for debugging.+++Performance+-----------++The performance is based on and bound by blaze-builder, so is good+enough for most web applications. For a high-profile web site you may+want to cache the generated stylesheets. The easiest way to do this is+to use regular Haskell sharing. This gets you very close to the best+possible performance:++ stylesheet :: ByteString+ stylesheet =+ toByteString . renderCSS $+ {- actual stylesheet -}++If your stylesheet is highly parametric, sharing will not work and you+can use memoization instead. See the [memoize], [MemoTrie] or+[monad-memo].++[memoize]: http://hackage.haskell.org/package/memoize+[MemoTrie]: http://hackage.haskell.org/package/MemoTrie+[monad-memo]: http://hackage.haskell.org/package/monad-memo+++Rendering+---------++To render a stylesheet you can use `fromCSS`, `renderCSS` or+`renderCSST`. All of these will give you a `Builder`. You can then use+[blaze-builder] combinators like `toByteString` or `toByteStringIO` to+turn it into a `ByteString`, send it to a client or write it to a file.++The following example, assuming that `stylesheet` is of type `Writer CSS+()`, prints the stylesheet to stdout:++ import qualified Data.ByteString as B+ import Blaze.ByteString.Builder+ import Data.CSS++ toByteStringIO B.putStr . renderCSS $ stylesheet++[blaze-builder]: http://hackage.haskell.org/package/blaze-builder+++Examples+--------++The recommended way to create your stylesheets is to use a writer monad+(transformer). This gives you a large library of predefined properties+covering most of CSS level 2.1.++### Basic stylesheets++The following is a basic stylesheet. The imports are listed here for+your convenience, but will be implied in further examples:++ import Control.Lens+ import Control.Monad.Writer+ import Data.Colour+ import Data.CSS+ import Data.CSS.Properties++ stylesheet :: Writer CSS ()+ stylesheet =+ onAll $ do+ select ["p"] $ do+ margin . Edges $ [zeroLen]+ padding . Edges $ [_Em # 1, _Ex # 2]++ select ["em"] $ do+ fontWeight BolderWeight++The type signature of `stylesheet` is very specialized. The actual type+is more general and makes it easier to interleave your stylesheets with+web framework operations if necessary:++ stylesheet :: (MonadWriter CSS m) => m ()++The style sheet will render as:++ p {+ margin: 0;+ padding: 1em 2ex;+ }++ em {+ font-weight: bolder;+ }+++### Media types++ stylesheet = do+ onMedia ["print", "projection"] . select ["p"] $ do+ margin . Edges $ [_Em # 0.4, _Ex # 0.1]+ padding . Edges $ [zeroLen]++ onMedia ["screen"] . select ["p"] $ do+ margin . Edges $ [_Em # 0.8, _Ex # 0.4]+ padding . Edges $ [zeroLen]++Renders as:++ @media print, projection {+ p {+ margin: 0.4em 0.1ex;+ padding: 0;+ }+ }++ @media screen {+ p {+ margin: 0.8em 0.4ex;+ padding: 0;+ }+ }+++### Multiple selectors++ stylesheet = do+ onAll . select ["p", "li"] $ do+ margin . Edges $ [_Em # 0.4, _Ex # 0.1]+ padding . Edges $ [zeroLen]++ below ["em", "strong"] $+ fontWeight BolderWeight++Renders as:++ p, li {+ margin: 0.4em 0.1ex;+ padding: 0+ }++ p em, li em, p strong, li strong {+ font-weight: bolder;+ }
+ Setup.lhs view
@@ -0,0 +1,12 @@+cascading setup script+Copyright (C) 2013, Ertugrul Soeylemez++Please see the LICENSE file for terms and conditions of use,+modification and distribution of this package, including this file.++> module Main where+>+> import Distribution.Simple+>+> main :: IO ()+> main = defaultMain
+ cascading.cabal view
@@ -0,0 +1,100 @@+name: cascading+version: 0.1.0+category: Web+synopsis: DSL for HTML CSS (Cascading Style Sheets)+maintainer: Ertugrul Söylemez <es@ertes.de>+author: Ertugrul Söylemez <es@ertes.de>+copyright: (c) 2013 Ertugrul Söylemez+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files: README.md+description:+ This library implements an HTML-specific domain-specific language+ for cascading style sheets (CSS) in the spirit of blaze-html. See+ the documentation of the Data.CSS module for a tutorial.++Source-repository head+ type: darcs+ location: http://hub.darcs.net/ertes/cascading++library+ build-depends:+ base >= 4.5 && < 5,+ blaze-builder >= 0.3 && < 1,+ bytestring >= 0.10 && < 1,+ colour >= 2.3 && < 3,+ containers >= 0.5 && < 1,+ lens >= 3.9 && < 4,+ mtl >= 2.0 && < 3,+ text >= 0.11 && < 1,+ utf8-string >= 0.3 && < 1,+ web-routes >= 0.27 && < 1+ default-language: Haskell2010+ default-extensions:+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveTraversable+ FlexibleContexts+ FlexibleInstances+ GADTs+ KindSignatures+ OverloadedStrings+ RankNTypes+ TemplateHaskell+ other-extensions:+ IncoherentInstances+ ghc-options: -W+ exposed-modules:+ Data.CSS+ Data.CSS.Build+ Data.CSS.Properties+ Data.CSS.Properties.Classes+ Data.CSS.Properties.Compat+ Data.CSS.Properties.Font+ Data.CSS.Properties.Layout+ Data.CSS.Properties.Text+ Data.CSS.Properties.Types+ Data.CSS.Properties.UI+ Data.CSS.Properties.Utils+ Data.CSS.Render+ Data.CSS.Types+ Data.CSS.Utils++-- test-suite tests+-- type: exitcode-stdio-1.0+-- build-depends:+-- base >= 4.5 && < 5,+-- cascading,+-- QuickCheck,+-- test-framework,+-- test-framework-quickcheck2,+-- test-framework-th+-- default-language: Haskell2010+-- default-extensions:+-- TemplateHaskell+-- ghc-options: -W -threaded -rtsopts -with-rtsopts=-N+-- hs-source-dirs: test+-- main-is: Props.hs++-- test-suite cascading-test+-- type: exitcode-stdio-1.0+-- build-depends:+-- base >= 4.5 && < 5,+-- blaze-builder,+-- blaze-html,+-- bytestring,+-- cascading,+-- colour,+-- containers,+-- happstack-server,+-- lens,+-- mtl+-- default-language: Haskell2010+-- default-extensions:+-- OverloadedStrings+-- ghc-options: -threaded -rtsopts+-- hs-source-dirs: test+-- main-is: Test.hs