clay (empty) → 0.0.1
raw patch · 26 files changed
+3289/−0 lines, 26 filesdep +basedep +mtldep +textsetup-changed
Dependencies added: base, mtl, text
Files
- LICENSE +28/−0
- Setup.lhs +4/−0
- clay.cabal +66/−0
- src/Clay.hs +127/−0
- src/Clay/Attributes.hs +132/−0
- src/Clay/Background.hs +285/−0
- src/Clay/Border.hs +84/−0
- src/Clay/Box.hs +38/−0
- src/Clay/Color.hs +296/−0
- src/Clay/Common.hs +50/−0
- src/Clay/Display.hs +198/−0
- src/Clay/Elements.hs +136/−0
- src/Clay/Font.hs +211/−0
- src/Clay/Geometry.hs +66/−0
- src/Clay/Gradient.hs +125/−0
- src/Clay/Media.hs +135/−0
- src/Clay/Property.hs +97/−0
- src/Clay/Pseudo.hs +40/−0
- src/Clay/Render.hs +197/−0
- src/Clay/Selector.hs +177/−0
- src/Clay/Size.hs +154/−0
- src/Clay/Stylesheet.hs +115/−0
- src/Clay/Text.hs +247/−0
- src/Clay/Time.hs +45/−0
- src/Clay/Transform.hs +134/−0
- src/Clay/Transition.hs +102/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) Sebastiaan Visser 2012++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.+
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ clay.cabal view
@@ -0,0 +1,66 @@+Name: clay+Version: 0.0.1+Synopsis: CSS preprocessor as embedded Haskell.+Description:+ Clay is a CSS preprocessor like LESS and Sass, but implemented as an embedded+ domain specific language (EDSL) in Haskell. This means that all CSS selectors+ and style rules are first class Haskell functions, which makes reuse and+ composability easy.++ .++ The project is described on <http://sebastiaanvisser.github.com/clay>.++ .++ The API documentation can be found in the top level module "Clay".++Author: Sebastiaan Visser+Maintainer: Sebastiaan Visser <code@fvisser.nl>+Homepage: http://sebastiaanvisser.github.com/clay+Bug-Reports: http://github.com/sebastiaanvisser/clay/issues++License: BSD3+License-File: LICENSE+Category: Web, Graphics+Cabal-Version: >= 1.6+Build-Type: Simple++Source-Repository head+ Type: git+ Location: git://github.com/sebastiaanvisser/clay.git++Library+ HS-Source-Dirs: src++ Exposed-Modules:+ Clay+ Clay.Attributes+ Clay.Background+ Clay.Border+ Clay.Box+ Clay.Color+ Clay.Common+ Clay.Display+ Clay.Elements+ Clay.Font+ Clay.Geometry+ Clay.Gradient+ Clay.Media+ Clay.Property+ Clay.Pseudo+ Clay.Render+ Clay.Selector+ Clay.Size+ Clay.Stylesheet+ Clay.Text+ Clay.Time+ Clay.Transform+ Clay.Transition++ GHC-Options: -Wall+ Build-Depends:+ base >= 4 && < 5,+ mtl >= 1 && < 2.2,+ text >= 0.11 && < 0.12+
+ src/Clay.hs view
@@ -0,0 +1,127 @@+module Clay+(+-- * Rendering stylesheets to CSS.+ render+, renderWith+, putCss++, pretty+, compact++-- * The @Css@ monad for collecting style rules.++, Css++, (?)+, (<?)+, (&)+, root+, pop++, (-:)++-- * The selector language.++, Selector+, Refinement++-- ** Elements selectors.++, star+, element+, (**)+, (|>)+, (#)+, (|+)++-- ** Refining selectors.++, byId+, byClass+, pseudo+, func++-- ** Attribute based refining.++, attr+, (@=)+, ($=)+, (~=)+, (|=)++-- * Apply media queries.+-- $media++, query+, queryNot+, queryOnly++-- * Pseudo elements and classes.++, module Clay.Pseudo++-- * HTML5 attribute and element names.++, module Clay.Attributes+, module Clay.Elements++-- * Commonly used value types.++, module Clay.Size+, module Clay.Color+, module Clay.Time++-- * Values shared between multiple properties.++, module Clay.Common++-- * Embedded style properties.++, module Clay.Background+, module Clay.Border+, module Clay.Box+, module Clay.Display+, module Clay.Font+, module Clay.Geometry+, module Clay.Gradient+, module Clay.Text+, module Clay.Transform+, module Clay.Transition+)+where++import Prelude hiding ((**))++import Clay.Render+import Clay.Stylesheet+import Clay.Selector++import Clay.Pseudo+import Clay.Elements hiding (link, em)+import Clay.Attributes hiding+ ( content, class_, target, checked, disabled+ , value, width, height, size, translate+ , hidden, start+ )++import Clay.Background+import Clay.Border+import Clay.Box+import Clay.Color+import Clay.Time+import Clay.Common+import Clay.Display hiding (table)+import Clay.Font hiding (menu, caption, small, icon)+import Clay.Geometry+import Clay.Gradient+import Clay.Size+import Clay.Text hiding (pre)+import Clay.Transform+import Clay.Transition++-- $media+--+-- Because a large part of the names export by "Clay.Media" clash with names+-- export by other modules we don't re-export it here and recommend you to+-- import the module qualified.+
+ src/Clay/Attributes.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE OverloadedStrings #-}+module Clay.Attributes where++import Clay.Selector++-- From: http://www.whatwg.org/specs/web-apps/current-work/multipage/section-index.html#index++accept, acceptCharset, accesskey, action, alt, async, autocomplete, autofocus,+ autoplay, challenge, charset, checked, class_, cols, colspan, content,+ contenteditable, contextmenu, controls, coords, crossorigin, datetime,+ default_, defer, dir, dirname, disabled, download, draggable, dropzone,+ enctype, for, formaction, formenctype, formmethod, formnovalidate,+ formtarget, headers, height, hidden, high, href, hreflang, httpEquiv, icon,+ id, inert, inputmode, ismap, itemid, itemprop, itemref, itemscope, itemtype,+ keytype, kind, lang, list, loop, low, manifest, max, maxlength, media,+ mediagroup, method, min, multiple, muted, name, novalidate, open, optimum,+ pattern, ping, placeholder, poster, preload, radiogroup, readonly, rel,+ required, reversed, rows, rowspan, sandbox, scope, scoped, seamless,+ selected, shape, size, sizes, spellcheck, src, srcdoc, srclang, srcset,+ start, step, tabindex, target, translate, type_, typemustmatch, usemap,+ value, width, wrap :: Refinement++accept = "accept"+acceptCharset = "accept-charset"+accesskey = "accesskey"+action = "action"+alt = "alt"+async = "async"+autocomplete = "autocomplete"+autofocus = "autofocus"+autoplay = "autoplay"+challenge = "challenge"+charset = "charset"+checked = "checked"+class_ = "class"+cols = "cols"+colspan = "colspan"+content = "content"+contenteditable = "contenteditable"+contextmenu = "contextmenu"+controls = "controls"+coords = "coords"+crossorigin = "crossorigin"+datetime = "datetime"+default_ = "default"+defer = "defer"+dir = "dir"+dirname = "dirname"+disabled = "disabled"+download = "download"+draggable = "draggable"+dropzone = "dropzone"+enctype = "enctype"+for = "for"+formaction = "formaction"+formenctype = "formenctype"+formmethod = "formmethod"+formnovalidate = "formnovalidate"+formtarget = "formtarget"+headers = "headers"+height = "height"+hidden = "hidden"+high = "high"+href = "href"+hreflang = "hreflang"+httpEquiv = "http-equiv"+icon = "icon"+id = "id"+inert = "inert"+inputmode = "inputmode"+ismap = "ismap"+itemid = "itemid"+itemprop = "itemprop"+itemref = "itemref"+itemscope = "itemscope"+itemtype = "itemtype"+keytype = "keytype"+kind = "kind"+lang = "lang"+list = "list"+loop = "loop"+low = "low"+manifest = "manifest"+max = "max"+maxlength = "maxlength"+media = "media"+mediagroup = "mediagroup"+method = "method"+min = "min"+multiple = "multiple"+muted = "muted"+name = "name"+novalidate = "novalidate"+open = "open"+optimum = "optimum"+pattern = "pattern"+ping = "ping"+placeholder = "placeholder"+poster = "poster"+preload = "preload"+radiogroup = "radiogroup"+readonly = "readonly"+rel = "rel"+required = "required"+reversed = "reversed"+rows = "rows"+rowspan = "rowspan"+sandbox = "sandbox"+scope = "scope"+scoped = "scoped"+seamless = "seamless"+selected = "selected"+shape = "shape"+size = "size"+sizes = "sizes"+spellcheck = "spellcheck"+src = "src"+srcdoc = "srcdoc"+srclang = "srclang"+srcset = "srcset"+start = "start"+step = "step"+tabindex = "tabindex"+target = "target"+translate = "translate"+type_ = "type"+typemustmatch = "typemustmatch"+usemap = "usemap"+value = "value"+width = "width"+wrap = "wrap"+
+ src/Clay/Background.hs view
@@ -0,0 +1,285 @@+{-# LANGUAGE+ OverloadedStrings+ , FlexibleInstances+ , GeneralizedNewtypeDeriving+ #-}+module Clay.Background+(+-- * Generic background property.++ Background (background)++-- * The background-color.++, backgroundColor++-- * The background-position.++, BackgroundPosition+, backgroundPosition+, backgroundPositions+, placed+, positioned++-- * The background-size.++, BackgroundSize+, backgroundSize+, backgroundSizes+, contain, cover+, by++-- * The background-repeat.++, BackgroundRepeat+, backgroundRepeat+, backgroundRepeats+, repeat, space, round, noRepeat+, xyRepeat+, repeatX, repeatY++-- * The background-origin.++, BackgroundOrigin+, backgroundOrigin+, backgroundOrigins+, origin++-- * The background-clip.++, BackgroundClip+, backgroundClip+, backgroundClips+, boxClip++-- * The background-attachment.++, BackgroundAttachment+, backgroundAttachment+, backgroundAttachments+, attachFixed, attachScroll++-- * The background-image.++, BackgroundImage+, backgroundImage+, backgroundImages+, url++-- * Specifying sides.++, Side+, sideTop+, sideLeft+, sideRight+, sideBottom+, sideCenter+, sideMiddle++-- * Specifying directions and location.++, Direction+, straight+, angular++, Location+, Loc+)+where++import Data.Text (Text)+import Data.Monoid+import Prelude hiding (repeat, round)++import Clay.Box+import Clay.Color+import Clay.Common+import Clay.Property+import Clay.Stylesheet+import Clay.Size++-- | We implement the generic background property as a type class that accepts+-- multiple value types. This allows us to combine different background aspects+-- into a shorthand syntax.++class Val a => Background a where+ background :: a -> Css+ background = key "background"++instance Background a => Background [a]+instance (Background a, Background b) => Background (a, b)++instance Background Color+instance Background BackgroundPosition+instance Background BackgroundSize+instance Background BackgroundRepeat+instance Background BackgroundOrigin+instance Background BackgroundClip+instance Background BackgroundAttachment+instance Background BackgroundImage++-------------------------------------------------------------------------------++backgroundColor :: Color -> Css+backgroundColor = key "background-color"++-------------------------------------------------------------------------------++newtype BackgroundPosition = BackgroundPosition Value+ deriving (Val, Other, Inherit)++placed :: Side -> Side -> BackgroundPosition+placed a b = BackgroundPosition (value (a, b))++positioned :: Size a -> Size a -> BackgroundPosition+positioned a b = BackgroundPosition (value (a, b))++backgroundPosition :: BackgroundPosition -> Css+backgroundPosition = key "background-position"++backgroundPositions :: [BackgroundPosition] -> Css+backgroundPositions = key "background-position"++-------------------------------------------------------------------------------++newtype BackgroundSize = BackgroundSize Value+ deriving (Val, Other, Inherit)++instance Auto BackgroundSize where auto = auto `by` auto++contain, cover :: BackgroundSize++contain = BackgroundSize "contain"+cover = BackgroundSize "cover"++by :: Size a -> Size b -> BackgroundSize+by a b = BackgroundSize (value (a, b))++backgroundSize :: BackgroundSize -> Css+backgroundSize = key "background-size"++backgroundSizes :: [BackgroundSize] -> Css+backgroundSizes = key "background-size"++-------------------------------------------------------------------------------++newtype BackgroundRepeat = BackgroundRepeat Value+ deriving (Val, Other, Inherit, None)++repeat, space, round, noRepeat :: BackgroundRepeat++repeat = BackgroundRepeat "repeat"+space = BackgroundRepeat "space"+round = BackgroundRepeat "round"+noRepeat = BackgroundRepeat "no-repeat"++xyRepeat :: BackgroundRepeat -> BackgroundRepeat -> BackgroundRepeat+xyRepeat a b = BackgroundRepeat (value (a, b))++repeatX, repeatY :: BackgroundRepeat++repeatX = xyRepeat repeat noRepeat+repeatY = xyRepeat noRepeat repeat++backgroundRepeat :: BackgroundRepeat -> Css+backgroundRepeat = key "background-repeat"++backgroundRepeats :: [BackgroundRepeat] -> Css+backgroundRepeats = key "background-repeat"++-------------------------------------------------------------------------------++newtype BackgroundImage = BackgroundImage Value+ deriving (Val, Other, Inherit, None)++url :: Text -> BackgroundImage+url u = BackgroundImage (value ("url(\"" <> u <> "\")"))++backgroundImage :: BackgroundImage -> Css+backgroundImage = key "background-image"++backgroundImages :: [BackgroundImage] -> Css+backgroundImages = key "background-image"++-------------------------------------------------------------------------------++newtype BackgroundOrigin = BackgroundOrigin Value+ deriving (Val, Other, Inherit)++origin :: BoxType -> BackgroundOrigin+origin b = BackgroundOrigin (value b)++backgroundOrigin :: BackgroundOrigin -> Css+backgroundOrigin = key "background-origin"++backgroundOrigins :: [BackgroundOrigin] -> Css+backgroundOrigins = key "background-origin"++-------------------------------------------------------------------------------++newtype BackgroundClip = BackgroundClip Value+ deriving (Val, Other, Inherit)++boxClip :: BoxType -> BackgroundClip+boxClip b = BackgroundClip (value b)++backgroundClip :: BackgroundClip -> Css+backgroundClip = key "background-clip"++backgroundClips :: [BackgroundClip] -> Css+backgroundClips = key "background-clip"++-------------------------------------------------------------------------------++newtype BackgroundAttachment = BackgroundAttachment Value+ deriving (Other, Val, Inherit)++attachFixed, attachScroll :: BackgroundAttachment+attachFixed = BackgroundAttachment "fixed"+attachScroll = BackgroundAttachment "scroll"++backgroundAttachment :: BackgroundAttachment -> Css+backgroundAttachment = key "background-attachment"++backgroundAttachments :: [BackgroundAttachment] -> Css+backgroundAttachments = key "background-attachment"++-------------------------------------------------------------------------------++newtype Side = Side Value+ deriving (Val, Other, Inherit)++-- | We have to prefix these values to avoid conflict with existing property+-- names.++sideTop, sideLeft, sideRight, sideBottom, sideCenter, sideMiddle :: Side++sideTop = Side "top"+sideLeft = Side "left"+sideRight = Side "right"+sideBottom = Side "bottom"+sideCenter = Side "center"+sideMiddle = Side "middle"++-------------------------------------------------------------------------------++newtype Direction = Direction Value+ deriving (Val, Other)++straight :: Side -> Direction+straight a = Direction (value a)++angular :: Angle a -> Direction+angular a = Direction (value a)++newtype Location = Location Value+ deriving (Val, Other)++class Val a => Loc a where+ location :: a -> Location+ location = Location . value++instance Loc Side+instance Loc (Size a)+instance (Loc a, Loc b) => Loc (a, b)+
+ src/Clay/Border.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.Border+(+-- * Stroke type.+ Stroke+, solid, dotted, dashed, double, wavy++-- * Border properties.++, border, borderTop, borderLeft, borderBottom, borderRight+, borderColor, borderLeftColor, borderRightColor, borderTopColor, borderBottomColor+, borderStyle, borderLeftStyle, borderRightStyle, borderTopStyle, borderBottomStyle+, borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth++-- * Border radius.++, borderRadius+, borderTopLeftRadius, borderTopRightRadius+, borderBottomLeftRadius, borderBottomRightRadius+)+where++import Clay.Property+import Clay.Stylesheet+import Clay.Color+import Clay.Common+import Clay.Size++newtype Stroke = Stroke Value+ deriving (Val, Other, Inherit, Auto, None)++solid, dotted, dashed, double, wavy :: Stroke++solid = Stroke "solid"+dotted = Stroke "dotted"+dashed = Stroke "dashed"+double = Stroke "double"+wavy = Stroke "Wavu"++border, borderTop, borderLeft, borderBottom, borderRight :: Stroke -> Size Abs -> Color -> Css++border a b c = key "border" (a ! b ! c)+borderTop a b c = key "border-top" (a ! b ! c)+borderLeft a b c = key "border-left" (a ! b ! c)+borderBottom a b c = key "border-bottom" (a ! b ! c)+borderRight a b c = key "border-right" (a ! b ! c)++borderColor, borderLeftColor, borderRightColor, borderTopColor, borderBottomColor :: Color -> Css++borderColor = key "border-color"+borderLeftColor = key "border-left-color"+borderRightColor = key "border-right-color"+borderTopColor = key "border-top-color"+borderBottomColor = key "border-bottom-color"++borderStyle, borderLeftStyle, borderRightStyle, borderTopStyle, borderBottomStyle :: Stroke -> Css++borderStyle = key "border-style"+borderLeftStyle = key "border-left-style"+borderRightStyle = key "border-right-style"+borderTopStyle = key "border-top-style"+borderBottomStyle = key "border-bottom-style"++borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth :: Size Abs -> Css++borderWidth = key "border-width"+borderLeftWidth = key "border-left-width"+borderRightWidth = key "border-right-width"+borderTopWidth = key "border-top-width"+borderBottomWidth = key "border-bottom-width"++-------------------------------------------------------------------------------++borderRadius :: Size a -> Css+borderRadius = key "border-radius"++borderTopLeftRadius, borderTopRightRadius,+ borderBottomLeftRadius, borderBottomRightRadius :: Size a -> Size a -> Css++borderTopLeftRadius a b = key "border-top-left-radius" (a ! b)+borderTopRightRadius a b = key "border-top-right-radius" (a ! b)+borderBottomLeftRadius a b = key "border-bottom-left-radius" (a ! b)+borderBottomRightRadius a b = key "border-bottom-right-radius" (a ! b)+
+ src/Clay/Box.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.Box+( BoxType+, paddingBox, borderBox, contentBox+, boxSizing+, boxShadow+)+where++import Data.Monoid++import Clay.Color+import Clay.Common+import Clay.Property+import Clay.Stylesheet+import Clay.Size++-------------------------------------------------------------------------------++newtype BoxType = BoxType Value+ deriving (Val, Inherit)++paddingBox, borderBox, contentBox :: BoxType++paddingBox = BoxType "padding-box"+borderBox = BoxType "border-box"+contentBox = BoxType "content-box"++-------------------------------------------------------------------------------++boxSizing :: BoxType -> Css+boxSizing = prefixed (browsers <> "box-sizing")++-------------------------------------------------------------------------------++boxShadow :: Size a -> Size a -> Size a -> Color -> Css+boxShadow x y w c = prefixed (browsers <> "box-shadow") (x ! y ! w ! c)+
+ src/Clay/Color.hs view
@@ -0,0 +1,296 @@+{-# LANGUAGE OverloadedStrings #-}+module Clay.Color where++import Data.Monoid+import Data.String+import Data.Text (Text)+import Text.Printf++import qualified Data.Text as Text+import Data.Text.Read as Text++import Clay.Property+import Clay.Common++-- * Color datatype.++data Color+ = Rgba Integer Integer Integer Integer+ | Hsla Integer Integer Integer Integer+ | Other Value+ deriving Show++-- * Color constructors.++rgba, hsla :: Integer -> Integer -> Integer -> Integer -> Color++rgba = Rgba+hsla = Hsla++rgb, hsl :: Integer -> Integer -> Integer -> Color++rgb r g b = rgba r g b 255+hsl r g b = hsla r g b 255++grayish :: Integer -> Color+grayish g = rgb g g g++transparent :: Color+transparent = rgba 0 0 0 0++-- * Setting individual color components.++setR :: Integer -> Color -> Color+setR r (Rgba _ g b a) = Rgba r g b a+setR r (Hsla _ g b a) = Hsla r g b a+setR _ (Other o) = Other o++setG :: Integer -> Color -> Color+setG g (Rgba r _ b a) = Rgba r g b a+setG g (Hsla r _ b a) = Hsla r g b a+setG _ (Other o) = Other o++setB :: Integer -> Color -> Color+setB b (Rgba r g _ a) = Rgba r g b a+setB b (Hsla r g _ a) = Hsla r g b a+setB _ (Other o) = Other o++setA :: Integer -> Color -> Color+setA a (Rgba r g b _) = Rgba r g b a+setA a (Hsla r g b _) = Hsla r g b a+setA _ (Other o) = Other o++-- * Computing with colors.++(*.) :: Color -> Integer -> Color+(*.) (Rgba r g b a) i = Rgba (clamp (r * i)) (clamp (g * i)) (clamp (b * i)) a+(*.) (Hsla r g b a) i = Hsla (clamp (r * i)) (clamp (g * i)) (clamp (b * i)) a+(*.) (Other o) _ = Other o++(+.) :: Color -> Integer -> Color+(+.) (Rgba r g b a) i = Rgba (clamp (r + i)) (clamp (g + i)) (clamp (b + i)) a+(+.) (Hsla r g b a) i = Hsla (clamp (r + i)) (clamp (g + i)) (clamp (b + i)) a+(+.) (Other o) _ = Other o++(-.) :: Color -> Integer -> Color+(-.) (Rgba r g b a) i = Rgba (clamp (r - i)) (clamp (g - i)) (clamp (b - i)) a+(-.) (Hsla r g b a) i = Hsla (clamp (r - i)) (clamp (g - i)) (clamp (b - i)) a+(-.) (Other o) _ = Other o++clamp :: Integer -> Integer+clamp i = max (min i 255) 0++-------------------------------------------------------------------------------++instance Val Color where+ value clr =+ case clr of+ Rgba r g b 255 -> Value $mconcat ["rgb(", p r, ",", p g, ",", p b, ")"]+ Rgba r g b a -> Value $mconcat ["rgba(", p r, ",", p g, ",", p b, ",", ah a, ")"]+ Hsla h s l 255 -> Value $mconcat ["hsl(", p h, ",", p s, ",", p l, ")"]+ Hsla h s l a -> Value $mconcat ["hsla(", p h, ",", p s, ",", p l, ",", ah a, ")"]+ Other o -> o+ where p = fromString . show+ ah = fromString . printf "%.4f" . (/ (256 :: Double)) . fromIntegral++instance None Color where none = Other "none"+instance Auto Color where auto = Other "auto"+instance Inherit Color where inherit = Other "inherit"+instance Other Color where other = Other++instance IsString Color where+ fromString = parse . fromString++parse :: Text -> Color+parse t =+ case Text.uncons t of+ Just ('#', cs) | Text.all isHex cs ->+ case Text.unpack cs of+ [a, b, c, d, e, f, g, h] -> rgba (hex a b) (hex c d) (hex e f) (hex g h)+ [a, b, c, d, e, f ] -> rgb (hex a b) (hex c d) (hex e f)+ [a, b, c, d ] -> rgba (hex a a) (hex b b) (hex c c) (hex d d)+ [a, b, c ] -> rgb (hex a a) (hex b b) (hex c c)+ _ -> err+ _ -> err++ where+ hex a b = either err fst (Text.hexadecimal (Text.singleton a <> Text.singleton b))+ isHex a = (a >= 'a' && a <= 'f') || (a >= 'A' && a <= 'F') || (a >= '0' && a <= '9')+ err = error "Invalid color string"++-------------------------------------------------------------------------------++-- * List of color values by name.++aliceblue, antiquewhite, aqua, aquamarine, azure, beige, bisque, black,+ blanchedalmond, blue, blueviolet, brown, burlywood, cadetblue, chartreuse,+ chocolate, coral, cornflowerblue, cornsilk, crimson, cyan, darkblue,+ darkcyan, darkgoldenrod, darkgray, darkgreen, darkgrey, darkkhaki,+ darkmagenta, darkolivegreen, darkorange, darkorchid, darkred, darksalmon,+ darkseagreen, darkslateblue, darkslategray, darkslategrey, darkturquoise,+ darkviolet, deeppink, deepskyblue, dimgray, dimgrey, dodgerblue, firebrick,+ floralwhite, forestgreen, fuchsia, gainsboro, ghostwhite, gold, goldenrod,+ gray, green, greenyellow, grey, honeydew, hotpink, indianred, indigo, ivory,+ khaki, lavender, lavenderblush, lawngreen, lemonchiffon, lightblue,+ lightcoral, lightcyan, lightgoldenrodyellow, lightgray, lightgreen,+ lightgrey, lightpink, lightsalmon, lightseagreen, lightskyblue,+ lightslategray, lightslategrey, lightsteelblue, lightyellow, lime, limegreen,+ linen, magenta, maroon, mediumaquamarine, mediumblue, mediumorchid,+ mediumpurple, mediumseagreen, mediumslateblue, mediumspringgreen,+ mediumturquoise, mediumvioletred, midnightblue, mintcream, mistyrose,+ moccasin, navajowhite, navy, oldlace, olive, olivedrab, orange, orangered,+ orchid, palegoldenrod, palegreen, paleturquoise, palevioletred, papayawhip,+ peachpuff, peru, pink, plum, powderblue, purple, red, rosybrown, royalblue,+ saddlebrown, salmon, sandybrown, seagreen, seashell, sienna, silver, skyblue,+ slateblue, slategray, slategrey, snow, springgreen, steelblue, tan, teal,+ thistle, tomato, turquoise, violet, wheat, white, whitesmoke, yellow,+ yellowgreen :: Color++aliceblue = rgb 240 248 255+antiquewhite = rgb 250 235 215+aqua = rgb 0 255 255+aquamarine = rgb 127 255 212+azure = rgb 240 255 255+beige = rgb 245 245 220+bisque = rgb 255 228 196+black = rgb 0 0 0+blanchedalmond = rgb 255 235 205+blue = rgb 0 0 255+blueviolet = rgb 138 43 226+brown = rgb 165 42 42+burlywood = rgb 222 184 135+cadetblue = rgb 95 158 160+chartreuse = rgb 127 255 0+chocolate = rgb 210 105 30+coral = rgb 255 127 80+cornflowerblue = rgb 100 149 237+cornsilk = rgb 255 248 220+crimson = rgb 220 20 60+cyan = rgb 0 255 255+darkblue = rgb 0 0 139+darkcyan = rgb 0 139 139+darkgoldenrod = rgb 184 134 11+darkgray = rgb 169 169 169+darkgreen = rgb 0 100 0+darkgrey = rgb 169 169 169+darkkhaki = rgb 189 183 107+darkmagenta = rgb 139 0 139+darkolivegreen = rgb 85 107 47+darkorange = rgb 255 140 0+darkorchid = rgb 153 50 204+darkred = rgb 139 0 0+darksalmon = rgb 233 150 122+darkseagreen = rgb 143 188 143+darkslateblue = rgb 72 61 139+darkslategray = rgb 47 79 79+darkslategrey = rgb 47 79 79+darkturquoise = rgb 0 206 209+darkviolet = rgb 148 0 211+deeppink = rgb 255 20 147+deepskyblue = rgb 0 191 255+dimgray = rgb 105 105 105+dimgrey = rgb 105 105 105+dodgerblue = rgb 30 144 255+firebrick = rgb 178 34 34+floralwhite = rgb 255 250 240+forestgreen = rgb 34 139 34+fuchsia = rgb 255 0 255+gainsboro = rgb 220 220 220+ghostwhite = rgb 248 248 255+gold = rgb 255 215 0+goldenrod = rgb 218 165 32+gray = rgb 128 128 128+green = rgb 0 128 0+greenyellow = rgb 173 255 47+grey = rgb 128 128 128+honeydew = rgb 240 255 240+hotpink = rgb 255 105 180+indianred = rgb 205 92 92+indigo = rgb 75 0 130+ivory = rgb 255 255 240+khaki = rgb 240 230 140+lavender = rgb 230 230 250+lavenderblush = rgb 255 240 245+lawngreen = rgb 124 252 0+lemonchiffon = rgb 255 250 205+lightblue = rgb 173 216 230+lightcoral = rgb 240 128 128+lightcyan = rgb 224 255 255+lightgoldenrodyellow = rgb 250 250 210+lightgray = rgb 211 211 211+lightgreen = rgb 144 238 144+lightgrey = rgb 211 211 211+lightpink = rgb 255 182 193+lightsalmon = rgb 255 160 122+lightseagreen = rgb 32 178 170+lightskyblue = rgb 135 206 250+lightslategray = rgb 119 136 153+lightslategrey = rgb 119 136 153+lightsteelblue = rgb 176 196 222+lightyellow = rgb 255 255 224+lime = rgb 0 255 0+limegreen = rgb 50 205 50+linen = rgb 250 240 230+magenta = rgb 255 0 255+maroon = rgb 128 0 0+mediumaquamarine = rgb 102 205 170+mediumblue = rgb 0 0 205+mediumorchid = rgb 186 85 211+mediumpurple = rgb 147 112 219+mediumseagreen = rgb 60 179 113+mediumslateblue = rgb 123 104 238+mediumspringgreen = rgb 0 250 154+mediumturquoise = rgb 72 209 204+mediumvioletred = rgb 199 21 133+midnightblue = rgb 25 25 112+mintcream = rgb 245 255 250+mistyrose = rgb 255 228 225+moccasin = rgb 255 228 181+navajowhite = rgb 255 222 173+navy = rgb 0 0 128+oldlace = rgb 253 245 230+olive = rgb 128 128 0+olivedrab = rgb 107 142 35+orange = rgb 255 165 0+orangered = rgb 255 69 0+orchid = rgb 218 112 214+palegoldenrod = rgb 238 232 170+palegreen = rgb 152 251 152+paleturquoise = rgb 175 238 238+palevioletred = rgb 219 112 147+papayawhip = rgb 255 239 213+peachpuff = rgb 255 218 185+peru = rgb 205 133 63+pink = rgb 255 192 203+plum = rgb 221 160 221+powderblue = rgb 176 224 230+purple = rgb 128 0 128+red = rgb 255 0 0+rosybrown = rgb 188 143 143+royalblue = rgb 65 105 225+saddlebrown = rgb 139 69 19+salmon = rgb 250 128 114+sandybrown = rgb 244 164 96+seagreen = rgb 46 139 87+seashell = rgb 255 245 238+sienna = rgb 160 82 45+silver = rgb 192 192 192+skyblue = rgb 135 206 235+slateblue = rgb 106 90 205+slategray = rgb 112 128 144+slategrey = rgb 112 128 144+snow = rgb 255 250 250+springgreen = rgb 0 255 127+steelblue = rgb 70 130 180+tan = rgb 210 180 140+teal = rgb 0 128 128+thistle = rgb 216 191 216+tomato = rgb 255 99 71+turquoise = rgb 64 224 208+violet = rgb 238 130 238+wheat = rgb 245 222 179+white = rgb 255 255 255+whitesmoke = rgb 245 245 245+yellow = rgb 255 255 0+yellowgreen = rgb 154 205 50+
+ src/Clay/Common.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A bunch of type classes representing common values shared between multiple+-- CSS properties, like `Auto`, `Inherit`, `None`, `Normal` and several more.+--+-- All the common value type classes have an instance for the Value type,+-- making them easily derivable for custom value types.+++module Clay.Common where++import Clay.Property++-------------------------------------------------------------------------------++class Auto a where auto :: a+class Inherit a where inherit :: a+class None a where none :: a+class Normal a where normal :: a+class Visible a where visible :: a+class Hidden a where hidden :: a++-- | The other type class is used to escape from the type safety introduced by+-- embedding CSS properties into the typed world of Clay. `Other` allows you to+-- cast any `Value` to a specific value type.++class Other a where other :: Value -> a++instance Auto Value where auto = "auto"+instance Inherit Value where inherit = "inherit"+instance Normal Value where normal = "normal"+instance None Value where none = "none"+instance Visible Value where visible = "visible"+instance Hidden Value where hidden = "hidden"+instance Other Value where other = id++-------------------------------------------------------------------------------++-- | Common list browser prefixes to make experimental properties work in+-- different browsers.++browsers :: Prefixed+browsers = Prefixed+ [ ( "-webkit-", "" )+ , ( "-moz-", "" )+ , ( "-ms-", "" )+ , ( "-o-", "" )+ , ( "", "" )+ ]+
+ src/Clay/Display.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.Display+(+-- * Float.++ float+, clear+, Clear+, both+, clearLeft+, clearRight++-- * Position.++, Position+, position+, static, absolute, fixed, relative++-- * Display++, Display+, display+, inline, block, listItem, runIn, inlineBlock, table, inlineTable, tableRowGroup+, tableHeaderGroup, tableFooterGroup, tableRow, tableColumnGroup, tableColumn+, tableCell, tableCaption, displayNone, displayInherit, flex+, inlineFlex, grid, inlineGrid++-- * Overlow++, Overflow+, scroll+, overflow, overflowX, overflowY++-- * Visibility.++, Visibility+, collapse+, visibility++-- Clipping.++, Clip+, clip+, rect++-- * Z-index.++, zIndex++-- * Pointer-events.++, PointerEvents+, pointerEvents+, visiblePainted, visibleFill, visibleStroke, painted+, fillEvents, strokeEvents, allEvents++)+where++import Data.Monoid+import Data.String++import Clay.Background+import Clay.Size+import Clay.Property+import Clay.Stylesheet+import Clay.Common++-------------------------------------------------------------------------------++float :: Side -> Css+float = key "float"++newtype Clear = Clear Value+ deriving (Val, Other, None, Inherit)++both :: Clear+both = Clear "both"++clearLeft :: Clear+clearLeft = Clear "left"++clearRight :: Clear+clearRight = Clear "right"++clear :: Clear -> Css+clear = key "clear"++-------------------------------------------------------------------------------++newtype Position = Position Value+ deriving (Val, Other, Inherit)++static, absolute, fixed, relative :: Position++static = Position "static"+absolute = Position "absolute"+fixed = Position "fixed"+relative = Position "relative"++position :: Position -> Css+position = key "position"++-------------------------------------------------------------------------------++newtype Display = Display Value+ deriving (Val, Other, None, Inherit)++inline, block, listItem, runIn, inlineBlock, table, inlineTable, tableRowGroup,+ tableHeaderGroup, tableFooterGroup, tableRow, tableColumnGroup, tableColumn,+ tableCell, tableCaption, displayNone, displayInherit, flex, inlineFlex, grid,+ inlineGrid :: Display++inline = Display "inline"+block = Display "block"+listItem = Display "list-item"+runIn = Display "runIn"+inlineBlock = Display "inline-block"+table = Display "table"+inlineTable = Display "inline-table"+tableRowGroup = Display "table-row-Group"+tableHeaderGroup = Display "table-header-group"+tableFooterGroup = Display "table-footer-group"+tableRow = Display "table-row"+tableColumnGroup = Display "table-column-group"+tableColumn = Display "table-column"+tableCell = Display "table-cell"+tableCaption = Display "table-caption"+displayNone = Display "none"+displayInherit = Display "inherit"+flex = Display "flex"+inlineFlex = Display "inline-flex"+grid = Display "grid"+inlineGrid = Display "inline-grid"++display :: Display -> Css+display = key "display"++-------------------------------------------------------------------------------++newtype Overflow = Overflow Value+ deriving (Val, Other, Auto, Inherit, Hidden, Visible)++scroll :: Overflow+scroll = Overflow "scroll"++overflow, overflowX, overflowY :: Overflow -> Css++overflow = key "overflow"+overflowX = key "overflow-y"+overflowY = key "overflow-x"++-------------------------------------------------------------------------------++newtype Visibility = Visibility Value+ deriving (Val, Other, Auto, Inherit, Hidden, Visible)++collapse :: Visibility+collapse = Visibility "collapse"++visibility :: Visibility -> Css+visibility = key "overflow"++-------------------------------------------------------------------------------++newtype Clip = Clip Value+ deriving (Val, Other, Auto, Inherit)++clip :: Clip -> Css+clip = key "clip"++rect :: Size a -> Size a -> Size a -> Size a -> Clip+rect t r b l = Clip (mconcat ["rect(", value t, ",", value r, ",", value b, ",", value l, ")"])++-------------------------------------------------------------------------------++zIndex :: Integer -> Css+zIndex i = key "z-index" (fromString (show i) :: Value)++-------------------------------------------------------------------------------++newtype PointerEvents = PointerEvents Value+ deriving (Val, Other, Auto, Visible, None, Inherit)++visiblePainted, visibleFill, visibleStroke, painted,+ fillEvents, strokeEvents, allEvents :: PointerEvents++visiblePainted = PointerEvents "visiblePainted"+visibleFill = PointerEvents "visibleFill"+visibleStroke = PointerEvents "visibleStroke"+painted = PointerEvents "painted"+fillEvents = PointerEvents "fill"+strokeEvents = PointerEvents "stroke"+allEvents = PointerEvents "all"++pointerEvents :: PointerEvents -> Css+pointerEvents = key "pointer-events"+
+ src/Clay/Elements.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE OverloadedStrings #-}+module Clay.Elements where++import Data.String++import Clay.Selector++-- From: http://www.whatwg.org/specs/web-apps/current-work/multipage/section-index.html#index++-- | Special cases, these items occur both as an HTML tag and an HTML+-- attribute. We keep them polymorph.++abbr, cite, command, data_, form, label, span, style, title :: IsString a => a++abbr = "abbr"+cite = "cite"+command = "command"+data_ = "data"+form = "form"+label = "label"+span = "span"+style = "style"+title = "title"++a, address, area, article, aside, audio, b, base, bdi, bdo, blockquote,+ body, br, button, canvas, caption, code, col, colgroup, datalist, dd, del,+ details, dfn, dialog, div, dl, dt, em, embed, fieldset, figcaption, figure,+ footer, h1, h2, h3, h4, h5, h6, head, header, hgroup, hr, html, i, iframe,+ img, input, ins, kbd, keygen, legend, li, link, map, mark, menu, meta, meter,+ nav, noscript, object, ol, optgroup, option, output, p, param, pre, progress,+ q, rp, rt, ruby, s, samp, script, section, select, small, source, strong,+ sub, summary, sup, table, tbody, td, textarea, tfoot, th, thead, time, tr,+ track, u, ul, var, video, wbr :: Selector++a = "a"+address = "address"+area = "area"+article = "article"+aside = "aside"+audio = "audio"+b = "b"+base = "base"+bdi = "bdi"+bdo = "bdo"+blockquote = "blockquote"+body = "body"+br = "br"+button = "button"+canvas = "canvas"+caption = "caption"+code = "code"+col = "col"+colgroup = "colgroup"+datalist = "datalist"+dd = "dd"+del = "del"+details = "details"+dfn = "dfn"+dialog = "dialog"+div = "div"+dl = "dl"+dt = "dt"+em = "em"+embed = "embed"+fieldset = "fieldset"+figcaption = "figcaption"+figure = "figure"+footer = "footer"+h1 = "h1"+h2 = "h2"+h3 = "h3"+h4 = "h4"+h5 = "h5"+h6 = "h6"+head = "head"+header = "header"+hgroup = "hgroup"+hr = "hr"+html = "html"+i = "i"+iframe = "iframe"+img = "img"+input = "input"+ins = "ins"+kbd = "kbd"+keygen = "keygen"+legend = "legend"+li = "li"+link = "link"+map = "map"+mark = "mark"+menu = "menu"+meta = "meta"+meter = "meter"+nav = "nav"+noscript = "noscript"+object = "object"+ol = "ol"+optgroup = "optgroup"+option = "option"+output = "output"+p = "p"+param = "param"+pre = "pre"+progress = "progress"+q = "q"+rp = "rp"+rt = "rt"+ruby = "ruby"+s = "s"+samp = "samp"+script = "script"+section = "section"+select = "select"+small = "small"+source = "source"+strong = "strong"+sub = "sub"+summary = "summary"+sup = "sup"+table = "table"+tbody = "tbody"+td = "td"+textarea = "textarea"+tfoot = "tfoot"+th = "th"+thead = "thead"+time = "time"+tr = "tr"+track = "track"+u = "u"+ul = "ul"+var = "var"+video = "video"+wbr = "wbr"+
+ src/Clay/Font.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE+ OverloadedStrings+ , GeneralizedNewtypeDeriving+ , FlexibleInstances+ #-}+module Clay.Font+(++-- * Generic font property.++ Font (font)+, Optional (..)+, Required (..)++-- * Color.++, fontColor+, color++-- * Font-family.++, fontFamily+, sansSerif+, serif+, monospace++-- * Font-size.++, FontSize+, fontSize+, fontSizeCustom+, xxSmall, xSmall, small, medium, large, xLarge, xxLarge, smaller, larger++-- * Font-style++, FontStyle+, fontStyle+, italic, oblique++-- * Font-variant.++, FontVariant+, fontVariant+, smallCaps++-- * Font-weight++, FontWeight+, fontWeight+, bold, bolder, lighter+, weight++-- * Named fonts.++, NamedFont+, caption, icon, menu, messageBox, smallCaption, statusBar++-- * Line-height.++, lineHeight+)+where++import Data.Text (pack)+import Data.Monoid+import Prelude hiding (Left, Right)++import Clay.Color+import Clay.Common+import Clay.Property+import Clay.Stylesheet+import Clay.Size++-- | We implement the generic font property as a type class that accepts+-- multiple value types. This allows us to combine different font aspects into+-- a shorthand syntax. Fonts require a mandatory part and have a optional a+-- part.++class Val a => Font a where+ font :: a -> Css+ font = key "font"++data Optional =+ Optional+ (Maybe FontWeight)+ (Maybe FontVariant)+ (Maybe FontStyle)++instance Val Optional where+ value (Optional a b c) = value (a ! b ! c)++data Required a =+ Required+ (Size a)+ (Maybe (Size a))+ [Literal]++instance Val (Required a) where+ value (Required a Nothing c) = value (a ! c)+ value (Required a (Just b) c) = value ((value a <> "/" <> value b) ! c)++instance Font ( Required a)+instance Font (Optional, Required a)++-------------------------------------------------------------------------------++-- | An alias for color.++fontColor :: Color -> Css+fontColor = key "color"++color :: Color -> Css+color = key "color"++-------------------------------------------------------------------------------++fontFamily :: [Literal] -> Css+fontFamily = key "font-family"++sansSerif :: Literal+sansSerif = "sans-serif"++serif :: Literal+serif = "serif"++monospace :: Literal+monospace = "fixed"++-------------------------------------------------------------------------------++newtype FontSize = FontSize Value+ deriving (Val, Inherit, Auto)++xxSmall, xSmall, small, medium, large, xLarge, xxLarge, smaller, larger :: FontSize++xxSmall = FontSize "xx-small"+xSmall = FontSize "x-small"+small = FontSize "small"+medium = FontSize "medium"+large = FontSize "large"+xLarge = FontSize "x-large"+xxLarge = FontSize "xx-large"+smaller = FontSize "smaller"+larger = FontSize "larger"++fontSize :: Size a -> Css+fontSize = key "font-size"++fontSizeCustom :: FontSize -> Css+fontSizeCustom = key "font-size"++-------------------------------------------------------------------------------++newtype FontStyle = FontStyle Value+ deriving (Val, Inherit, Normal)++italic, oblique :: FontStyle++italic = FontStyle "italic"+oblique = FontStyle "oblique"++fontStyle :: FontStyle -> Css+fontStyle = key "font-style"++-------------------------------------------------------------------------------++newtype FontVariant = FontVariant Value+ deriving (Val, Inherit, Normal)++smallCaps :: FontVariant+smallCaps = FontVariant "small-caps"++fontVariant :: FontVariant -> Css+fontVariant = key "font-variant"++-------------------------------------------------------------------------------++newtype FontWeight = FontWeight Value+ deriving (Val, Inherit, Normal)++bold, bolder, lighter :: FontWeight++bold = FontWeight "bold"+bolder = FontWeight "bolder"+lighter = FontWeight "lighter"++weight :: Integer -> FontWeight+weight i = FontWeight (value (pack (show i)))++fontWeight :: FontWeight -> Css+fontWeight = key "font-weight"++-------------------------------------------------------------------------------++newtype NamedFont = NamedFont Value+ deriving Val++caption, icon, menu, messageBox, smallCaption, statusBar :: NamedFont++caption = NamedFont "caption"+icon = NamedFont "icon"+menu = NamedFont "menu"+messageBox = NamedFont "message-box"+smallCaption = NamedFont "small-caption"+statusBar = NamedFont "status-bar"++-------------------------------------------------------------------------------++lineHeight :: Size a -> Css+lineHeight = key "line-height"+
+ src/Clay/Geometry.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+module Clay.Geometry+(+-- * Positioning.+ size, top, left, bottom, right++-- * Sizing.+, width, height, minWidth, minHeight++-- * Padding.+, padding+, paddingTop, paddingLeft, paddingRight, paddingBottom++-- * Margin.+, margin+, marginTop, marginLeft, marginRight, marginBottom+)+where++import Prelude hiding (Left, Right)++import Clay.Property+import Clay.Stylesheet+import Clay.Size++-------------------------------------------------------------------------------++size, top, left, bottom, right :: Size Abs -> Css++size = key "size"+top = key "top"+left = key "left"+bottom = key "bottom"+right = key "right"++width, height, minWidth, minHeight :: Size a -> Css++width = key "width"+height = key "height"+minWidth = key "min-width"+minHeight = key "min-height"++-------------------------------------------------------------------------------++padding :: Size Abs -> Size Abs -> Size Abs -> Size Abs -> Css+padding a b c d = key "padding" (a ! b ! c ! d)++paddingTop, paddingLeft, paddingRight, paddingBottom :: Size Abs -> Css++paddingTop = key "padding-top"+paddingLeft = key "padding-left"+paddingRight = key "padding-right"+paddingBottom = key "padding-bottom"++-------------------------------------------------------------------------------++margin :: Size Abs -> Size Abs -> Size Abs -> Size Abs -> Css+margin a b c d = key "margin" (a ! b ! c ! d)++marginTop, marginLeft, marginRight, marginBottom :: Size Abs -> Css++marginTop = key "margin-top"+marginLeft = key "margin-left"+marginRight = key "margin-right"+marginBottom = key "margin-bottom"+
+ src/Clay/Gradient.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE+ OverloadedStrings+ , FlexibleInstances+ , GeneralizedNewtypeDeriving+ #-}+module Clay.Gradient+(+-- * Color ramp type.++ Ramp++-- * Linear gradients.++, linearGradient+, hGradient+, vGradient++-- * Radial gradients.++, Radial+, circle, ellipse+, circular, elliptical++-- , Extend+-- , closestSide, closestCorner, farthestSide, farthestCorner++, radialGradient++-- * Repeating gradients.++, repeatingLinearGradient+, hRepeatingGradient+, vRepeatingGradient+, repeatingRadialGradient++)+where++import Data.Monoid++import Clay.Color+import Clay.Common+import Clay.Property+import Clay.Size+import Clay.Background++type Ramp = [(Color, Size Rel)]++-------------------------------------------------------------------------------++linearGradient :: Direction -> Ramp -> BackgroundImage+linearGradient d xs = other $ Value $+ let Value v = "linear-gradient(" <> value d <> "," <> ramp xs <> ")"+ in browsers <> v++hGradient, vGradient :: Color -> Color -> BackgroundImage++hGradient = shortcut (linearGradient (straight sideLeft))+vGradient = shortcut (linearGradient (straight sideTop ))++-------------------------------------------------------------------------------++repeatingLinearGradient :: Direction -> Ramp -> BackgroundImage+repeatingLinearGradient d xs = other $ Value $+ let Value v = "repeating-linear-gradient(" <> value d <> "," <> ramp xs <> ")"+ in browsers <> v++hRepeatingGradient, vRepeatingGradient :: Color -> Color -> BackgroundImage++hRepeatingGradient = shortcut (repeatingLinearGradient (straight sideLeft))+vRepeatingGradient = shortcut (repeatingLinearGradient (straight sideTop ))++-------------------------------------------------------------------------------++newtype Radial = Radial Value+ deriving (Val, Other)++circle :: Radial+circle = Radial "circle"++ellipse :: Radial+ellipse = Radial "ellipse"++circular :: Size Abs -> Radial+circular radius = Radial ("circle " <> value radius)++elliptical :: Size a -> Size a -> Radial+elliptical radx rady = Radial (value ("ellipse " <> value (radx, rady)))++{-++newtype Extend = Extend Value+ deriving (Val, Other)++closestSide, closestCorner, farthestSide, farthestCorner :: Extend++closestSide = Extend "closest-side"+closestCorner = Extend "closest-corner"+farthestSide = Extend "farthest-side"+farthestCorner = Extend "farthest-corner"++-}++-------------------------------------------------------------------------------++radialGradient :: Loc l => l -> Radial -> Ramp -> BackgroundImage+radialGradient d r xs = other $ Value $+ let Value v = "radial-gradient("+ <> value [value d, value r, ramp xs] <> ")"+ in browsers <> v++repeatingRadialGradient :: Loc l => l -> Radial -> Ramp -> BackgroundImage+repeatingRadialGradient d r xs = other $ Value $+ let Value v = "repeating-radial-gradient("+ <> value [value d, value r, ramp xs] <> ")"+ in browsers <> v++-------------------------------------------------------------------------------++ramp :: Ramp -> Value+ramp xs = value (map (\(a, b) -> value (value a, value b)) xs)++shortcut :: (Ramp -> BackgroundImage) -> Color -> Color -> BackgroundImage+shortcut g f t = g [(f, 0), (t, 100)]+
+ src/Clay/Media.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}+module Clay.Media+(++-- * Media types.++ all, aural, braille, handheld, print, projection+, screen, tty, tv, embossed++-- * Geometrical features.++, width, minWidth, maxWidth, height, minHeight, maxHeight, deviceWidth+, minDeviceWidth, maxDeviceWidth, deviceHeight, minDeviceHeight+, maxDeviceHeight++-- * Aspect ration features.++, aspectRatio, minAspectRatio, maxAspectRatio, deviceAspectRatio+, minDeviceAspectRatio, maxDeviceAspectRatio++-- * Color related features.++, color, monochrome, scan, grid+, minColor, maxColor, colorIndex, minColorIndex, maxColorIndex, minMonochrome+, maxMonochrome++-- * Resolution related features.++, resolution, minResolution, maxResolution++-- * Resolution value type.++, Resolution+, dpi+, dppx+)++where++import Data.Text (Text, pack)+import Data.Monoid++import Clay.Common+import Clay.Size+import Clay.Property+import Clay.Stylesheet++import Prelude hiding (all, print)++-------------------------------------------------------------------------------++all, aural, braille, handheld, print, projection+ , screen, tty, tv, embossed :: MediaType++all = MediaType "all"+aural = MediaType "aural"+braille = MediaType "braille"+handheld = MediaType "handheld"+print = MediaType "print"+projection = MediaType "projection"+screen = MediaType "screen"+tty = MediaType "tty"+tv = MediaType "tv"+embossed = MediaType "embossed"++-------------------------------------------------------------------------------++with :: Val a => Text -> a -> Feature+with f v = Feature f (Just (value v))++without :: Text -> Feature+without f = Feature f Nothing++width, minWidth, maxWidth, height, minHeight, maxHeight, deviceWidth+ , minDeviceWidth, maxDeviceWidth, deviceHeight, minDeviceHeight+ , maxDeviceHeight :: Size Abs -> Feature++width = with "width"+minWidth = with "min-width"+maxWidth = with "max-width"+height = with "height"+minHeight = with "min-height"+maxHeight = with "max-height"+deviceWidth = with "device-width"+minDeviceWidth = with "min-device-width"+maxDeviceWidth = with "max-device-width"+deviceHeight = with "device-height"+minDeviceHeight = with "min-device-height"+maxDeviceHeight = with "max-device-height"++aspectRatio, minAspectRatio, maxAspectRatio, deviceAspectRatio+ , minDeviceAspectRatio, maxDeviceAspectRatio :: (Integer, Integer) -> Feature++aspectRatio (x, y) = with "aspect-ratio" (value x <> "/" <> value y)+minAspectRatio (x, y) = with "min-aspect-ratio" (value x <> "/" <> value y)+maxAspectRatio (x, y) = with "max-aspect-ratio" (value x <> "/" <> value y)+deviceAspectRatio (x, y) = with "device-aspect-ratio" (value x <> "/" <> value y)+minDeviceAspectRatio (x, y) = with "min-device-aspect-ratio" (value x <> "/" <> value y)+maxDeviceAspectRatio (x, y) = with "max-device-aspect-ratio" (value x <> "/" <> value y)++color, monochrome, scan, grid :: Feature++color = without "color"+monochrome = without "monochrome"+scan = without "scan"+grid = without "grid"++minColor, maxColor, colorIndex, minColorIndex, maxColorIndex, minMonochrome+ , maxMonochrome :: Integer -> Feature++minColor = with "min-color"+maxColor = with "max-color"+colorIndex = with "color-index"+minColorIndex = with "min-color-index"+maxColorIndex = with "max-color-index"+minMonochrome = with "min-monochrome"+maxMonochrome = with "max-monochrome"++resolution, minResolution, maxResolution :: Val a => a -> Feature++resolution = with "resolution"+minResolution = with "min-resolution"+maxResolution = with "max-resolution"++-------------------------------------------------------------------------------++newtype Resolution = Resolution Value+ deriving (Val, Other)++dpi :: Integer -> Resolution+dpi i = Resolution (value (pack (show i) <> "dpi"))++dppx :: Integer -> Resolution+dppx i = Resolution (value (pack (show i) <> "dppx"))+
+ src/Clay/Property.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.Property where++import Control.Arrow (second)+import Control.Monad.Writer+import Data.List (partition, sort)+import Data.Maybe+import Data.String+import Data.Text (Text, replace)++data Prefixed = Prefixed [(Text, Text)] | Plain Text+ deriving Show++instance IsString Prefixed where+ fromString s = Plain (fromString s)++instance Monoid Prefixed where+ mempty = ""+ mappend = merge++merge :: Prefixed -> Prefixed -> Prefixed+merge (Plain x ) (Plain y ) = Plain (x <> y)+merge (Plain x ) (Prefixed ys) = Prefixed (map (second (x <>)) ys)+merge (Prefixed xs) (Plain y ) = Prefixed (map (second (<> y)) xs)+merge (Prefixed xs) (Prefixed ys) =+ let kys = map fst ys+ kxs = map fst xs+ in Prefixed $ zipWith (\(p, a) (_, b) -> (p, a <> b))+ (sort (fst (partition ((`elem` kys) . fst) xs)))+ (sort (fst (partition ((`elem` kxs) . fst) ys)))++plain :: Prefixed -> Text+plain (Prefixed xs) = "" `fromMaybe` lookup "" xs+plain (Plain p ) = p++-------------------------------------------------------------------------------++newtype Key a = Key { unKeys :: Prefixed }+ deriving (Show, Monoid, IsString)++cast :: Key a -> Key ()+cast (Key k) = Key k++-------------------------------------------------------------------------------++newtype Value = Value { unValue :: Prefixed }+ deriving (Show, Monoid, IsString)++class Val a where+ value :: a -> Value++instance Val Text where+ value t = Value (Plain t)++newtype Literal = Literal Text+ deriving (Show, Monoid, IsString)++instance Val Literal where+ value (Literal t) = Value (Plain ("\"" <> replace "\"" "\\\"" t <> "\""))++instance Val Integer where+ value = fromString . show++instance Val Double where+ value = fromString . show++instance Val Value where+ value = id++instance Val a => Val (Maybe a) where+ value Nothing = ""+ value (Just a) = value a++instance (Val a, Val b) => Val (a, b) where+ value (a, b) = value a <> " " <> value b++instance (Val a, Val b) => Val (Either a b) where+ value (Left a) = value a+ value (Right a) = value a++instance Val a => Val [a] where+ value xs = intersperse "," (map value xs)++intersperse :: Monoid a => a -> [a] -> a+intersperse _ [] = mempty+intersperse s (x:xs) = foldl (\a b -> a <> s <> b) x xs++-------------------------------------------------------------------------------++noCommas :: Val a => [a] -> Value+noCommas xs = intersperse " " (map value xs)++infixr !++(!) :: a -> b -> (a, b)+(!) = (,)+
+ src/Clay/Pseudo.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+module Clay.Pseudo where++import Data.Text (Text)++import Clay.Selector++-- List of specific pseudo classes, from:+-- https://developer.mozilla.org/en-US/docs/CSS/Pseudo-classes++after, before :: Refinement++after = ":after"+before = ":before"++link, visited, active, hover, focus, firstChild :: Refinement++link = ":link"+visited = ":visited"+active = ":active"+hover = ":hover"+focus = ":focus"+firstChild = ":first-child"++firstOfType, lastOfType, empty, target, checked, enabled, disabled :: Refinement++firstOfType = ":first-of-type"+lastOfType = ":last-of-type"+empty = ":empty"+target = ":target"+checked = ":checked"+enabled = ":enabled"+disabled = ":disabled"++nthChild, nthLastChild, nthOfType :: Text -> Refinement++nthChild n = func "nth-child" [n]+nthLastChild n = func "nth-last-child" [n]+nthOfType n = func "nth-of-type" [n]+
+ src/Clay/Render.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE OverloadedStrings #-}+module Clay.Render+( Config (..)+, pretty+, compact+, render+, putCss+, renderWith+)+where++import Control.Applicative+import Control.Monad.Writer+import Data.Either+import Data.Foldable (foldMap)+import Data.List (sort)+import Data.Maybe+import Data.Text (Text)+import Data.Text.Lazy.Builder+import Prelude hiding (filter, (**))++import qualified Data.Text as Text+import qualified Data.Text.Lazy as Lazy+import qualified Data.Text.Lazy.IO as Lazy++import Clay.Stylesheet hiding (Child, query)+import Clay.Property+import Clay.Selector++import qualified Clay.Stylesheet as Rule++data Config = Config+ { indentation :: Builder+ , newline :: Builder+ , sep :: Builder+ , warn :: Bool+ , align :: Bool+ }++-- | Configuration to print to a pretty human readable CSS output.++pretty :: Config+pretty = Config " " "\n" " " True True++-- | Configuration to print to a compacted unreadable CSS output.++compact :: Config+compact = Config "" "" "" False False++-- | Render to CSS using the default configuration (`pretty`) and directly+-- print to the standard output.++putCss :: Css -> IO ()+putCss = Lazy.putStr . render++-- | Render a stylesheet with the default configuration. The pretty printer is+-- used by default.++render :: Css -> Lazy.Text+render = renderWith pretty []++-- | Render a stylesheet with a custom configuration and an optional outer+-- scope.++renderWith :: Config -> [App] -> Css -> Lazy.Text+renderWith cfg top (S c)+ = toLazyText+ . rules cfg top+ . execWriter+ $ c++rules :: Config -> [App] -> [Rule] -> Builder+rules cfg sel rs = mconcat+ [ rule cfg sel (mapMaybe property rs)+ , newline cfg+ , (\(a, b) -> rules cfg (a : sel) b) `foldMap` mapMaybe nested rs+ , (\(a, b) -> query cfg a sel b) `foldMap` mapMaybe queries rs+ ]+ where property (Property k v) = Just (k, v)+ property _ = Nothing+ nested (Nested a ns ) = Just (a, ns)+ nested _ = Nothing+ queries (Query q ns ) = Just (q, ns)+ queries _ = Nothing++query :: Config -> MediaQuery -> [App] -> [Rule] -> Builder+query cfg q sel rs =+ mconcat+ [ mediaQuery q+ , newline cfg+ , "{"+ , newline cfg+ , rules cfg sel rs+ , "}"+ , newline cfg+ ]++mediaQuery :: MediaQuery -> Builder+mediaQuery (MediaQuery no ty fs) =+ mconcat+ [ "@media "+ , case no of+ Nothing -> ""+ Just Not -> "not "+ Just Only -> "only "+ , mediaType ty+ , mconcat ((" and " <>) . feature <$> fs)+ ]++mediaType :: MediaType -> Builder+mediaType (MediaType (Value v)) = fromText (plain v)++feature :: Feature -> Builder+feature (Feature k mv) =+ case mv of+ Nothing -> fromText k+ Just (Value v) -> mconcat+ [ "("+ , fromText k+ , ": "+ , fromText (plain v)+ , ")"+ ]++rule :: Config -> [App] -> [(Key (), Value)] -> Builder+rule _ _ [] = mempty+rule cfg sel props =+ let xs = collect =<< props+ in mconcat+ [ selector cfg (merger sel)+ , newline cfg+ , "{"+ , newline cfg+ , properties cfg xs+ , "}"+ , newline cfg+ ]++merger :: [App] -> Selector+merger [] = error "this should be fixed!"+merger (x:xs) =+ case x of+ Rule.Child s -> case xs of [] -> s; _ -> merger xs |> s+ Sub s -> case xs of [] -> s; _ -> merger xs ** s+ Root s -> s ** merger xs+ Pop i -> merger (drop i (x:xs))+ Self f -> merger xs `with` f++collect :: (Key (), Value) -> [Either Text (Text, Text)]+collect (Key ky, Value vl) =+ case (ky, vl) of+ ( Plain k , Plain v ) -> [prop k v]+ ( Prefixed ks , Plain v ) -> flip map ks $ \(p, k) -> prop (p <> k) v+ ( Plain k , Prefixed vs ) -> flip map vs $ \(p, v) -> prop k (p <> v)+ ( Prefixed ks , Prefixed vs ) -> flip map ks $ \(p, k) -> (Left (p <> k) `maybe` prop (p <> k)) (lookup p vs)+ where prop k v = Right (k, v)++properties :: Config -> [Either Text (Text, Text)] -> Builder+properties cfg xs =+ let width = 1 + maximum (Text.length . fst <$> rights xs)+ ind = indentation cfg+ new = newline cfg+ in flip foldMap xs $ \p ->+ case p of+ Left w -> if warn cfg then ind <> "/* no value for " <> fromText w <> " */" <> new else mempty+ Right (k, v) ->+ let pad = if align cfg then fromText (Text.replicate (width - Text.length k) " ") else ""+ in mconcat [ind, fromText k, pad, ":", sep cfg, fromText v, ";", new]++selector :: Config -> Selector -> Builder+selector cfg = intersperse ("," <> newline cfg) . rec+ where rec (In (SelectorF ft p)) = (<> filter ft) <$>+ case p of+ Star -> ["*"]+ Elem t -> [fromText t]+ Child a b -> ins " > " <$> rec a <*> rec b+ Deep a b -> ins " " <$> rec a <*> rec b+ Adjacent a b -> ins " + " <$> rec a <*> rec b+ Combined a b -> join ((:) <$> rec a <*> (pure <$> rec b))+ where ins s a b = (a <> s <> b)++predicate :: Predicate -> Builder+predicate ft = mconcat $+ case ft of+ Id a -> [ "#", fromText a ]+ Class a -> [ ".", fromText a ]+ Attr a -> [ "[", fromText a, "]" ]+ AttrVal a v -> [ "[", fromText a, "='", fromText v, "']" ]+ AttrEnds a v -> [ "[", fromText a, "$='", fromText v, "']" ]+ AttrSpace a v -> [ "[", fromText a, "~='", fromText v, "']" ]+ AttrHyph a v -> [ "[", fromText a, "|='", fromText v, "']" ]+ Pseudo a -> [ ":", fromText a ]+ PseudoFunc a p -> [ ":", fromText a, "(", intersperse "," (map fromText p), ")" ]++filter :: Refinement -> Builder+filter = foldMap predicate . sort . unFilter+
+ src/Clay/Selector.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE+ OverloadedStrings+ , FlexibleInstances+ , GeneralizedNewtypeDeriving+ #-}+module Clay.Selector where++import Control.Applicative+import Data.Monoid+import Data.String+import Data.Text (Text)+import Prelude hiding (foldl)++import qualified Data.Text as Text++-- | The star selector applies to all elements. Maps to @*@ in CSS.++star :: Selector+star = In (SelectorF (Refinement []) Star)++-- | Select elements by name. The preferred syntax is to enable+-- @OverloadedStrings@ and actually just use @\"element-name\"@ or use one of+-- the predefined elements from "Clay.Elements".++element :: Text -> Selector+element e = In (SelectorF (Refinement []) (Elem e))++-- | Named alias for `**`.++deep :: Selector -> Selector -> Selector+deep a b = In (SelectorF (Refinement []) (Deep a b))++-- | The deep selector composer. Maps to @sel1 sel2@ in CSS.++(**) :: Selector -> Selector -> Selector+(**) = deep++-- | Named alias for `|>`.++child :: Selector -> Selector -> Selector+child a b = In (SelectorF (Refinement []) (Child a b))++-- | The child selector composer. Maps to @sel1 > sel2@ in CSS.++(|>) :: Selector -> Selector -> Selector+(|>) = child++-- | The adjacent selector composer. Maps to @sel1 + sel2@ in CSS.++(|+) :: Selector -> Selector -> Selector+(|+) a b = In (SelectorF (Refinement []) (Adjacent a b))++-- | Named alias for `#`.++with :: Selector -> Refinement -> Selector+with (In (SelectorF (Refinement fs) e)) (Refinement ps) = In (SelectorF (Refinement (fs ++ ps)) e)++-- | The filter selector composer, adds a filter to a selector. Maps to+-- something like @sel#filter@ or @sel.filter@ in CSS, depending on the filter.++(#) :: Selector -> Refinement -> Selector+(#) = with++-- | Filter elements by id. The preferred syntax is to enable+-- @OverloadedStrings@ and use @\"#id-name\"@.++byId :: Text -> Refinement+byId = Refinement . pure . Id++-- | Filter elements by class. The preferred syntax is to enable+-- @OverloadedStrings@ and use @\".class-name\"@.++byClass :: Text -> Refinement+byClass = Refinement . pure . Class++-- | Filter elements by pseudo selector or pseudo class. The preferred syntax+-- is to enable @OverloadedStrings@ and use @\":pseudo-selector\"@ or use one+-- of the predefined ones from "Clay.Pseudo".++pseudo :: Text -> Refinement+pseudo = Refinement . pure . Pseudo++-- | Filter elements by pseudo selector functions. The preferred way is to use+-- one of the predefined functions from "Clay.Pseudo".++func :: Text -> [Text] -> Refinement+func f = Refinement . pure . PseudoFunc f++-- | Filter elements based on the presence of a certain attribute. The+-- preferred syntax is to enable @OverloadedStrings@ and use+-- @\"\@attr\"@ or use one of the predefined ones from "Clay.Attributes".++attr :: Text -> Refinement+attr = Refinement . pure . Attr++-- | Filter elements based on the presence of a certain attribute with the+-- specified value.++(@=) :: Text -> Text -> Refinement+(@=) a = Refinement . pure . AttrVal a++-- | Filter elements based on the presence of a certain attribute that ends+-- with the specified value.++($=) :: Text -> Text -> Refinement+($=) a = Refinement . pure . AttrEnds a++-- | Filter elements based on the presence of a certain attribute that have the+-- specified value contained in a space separated list.++(~=) :: Text -> Text -> Refinement+(~=) a = Refinement . pure . AttrSpace a++-- | Filter elements based on the presence of a certain attribute that have the+-- specified value contained in a hyphen separated list.++(|=) :: Text -> Text -> Refinement+(|=) a = Refinement . pure . AttrHyph a++-------------------------------------------------------------------------------++data Predicate+ = Id Text+ | Class Text+ | Attr Text+ | AttrVal Text Text+ | AttrEnds Text Text+ | AttrSpace Text Text+ | AttrHyph Text Text+ | Pseudo Text+ | PseudoFunc Text [Text]+ deriving (Eq, Ord, Show)++newtype Refinement = Refinement { unFilter :: [Predicate] }++instance IsString Refinement where+ fromString = filterFromText . fromString++filterFromText :: Text -> Refinement+filterFromText t = Refinement $+ case Text.uncons t of+ Just ('#', s) -> [Id s]+ Just ('.', s) -> [Class s]+ Just (':', s) -> [Pseudo s]+ Just ('@', s) -> [Attr s]+ _ -> [Attr t]++-------------------------------------------------------------------------------++data Path f+ = Star+ | Elem Text+ | Child f f+ | Deep f f+ | Adjacent f f+ | Combined f f++newtype Fix f = In { out :: f (Fix f) }++data SelectorF a = SelectorF Refinement (Path a)++type Selector = Fix SelectorF++instance IsString (Fix SelectorF) where+ fromString = text . fromString++text :: Text -> Selector+text t = In $+ case Text.uncons t of+ Just ('#', s) -> SelectorF (Refinement [Id s]) Star+ Just ('.', s) -> SelectorF (Refinement [Class s]) Star+ _ -> SelectorF (Refinement []) (Elem t)++instance Monoid (Fix SelectorF) where+ mempty = error "Selector is a semigroup"+ mappend a b = In (SelectorF (Refinement []) (Combined a b))+
+ src/Clay/Size.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE+ EmptyDataDecls+ , OverloadedStrings+ , GeneralizedNewtypeDeriving+ , FlexibleInstances+ #-}+module Clay.Size+(++-- * Size type.+ Size+, Abs+, Rel++-- * Size constructors.++, px+, pt+, em+, ex+, pct++-- * Shorthands for mutli size-valued properties.++, sym+, sym2+, sym3++-- * Angle type.++, Angle+, Deg+, Rad++-- * Constructing angles.++, deg+, rad++)+where++import Data.Monoid+import Data.Text (pack)++import Clay.Common+import Clay.Property+import Clay.Stylesheet++-------------------------------------------------------------------------------++-- | Sizes can be relative like percentages.+data Rel++-- | Sizes can be absolute like pixels, points, etc.+data Abs++newtype Size a = Size Value+ deriving (Val, Auto, Normal, Inherit, None, Other)++-- | Size in pixels.++px :: Integer -> Size Abs+px i = Size (value (pack (show i) <> "px"))++-- | Size in points.++pt :: Double -> Size Abs+pt i = Size (value (pack (show i) <> "pt"))++-- | Size in em's.++em :: Double -> Size Abs+em i = Size (value (pack (show i) <> "em"))++-- | Size in ex'es.++ex :: Double -> Size Abs+ex i = Size (value (pack (show i) <> "ex"))++-- | Size in percentages.++pct :: Double -> Size Rel+pct i = Size (value (pack (show i) <> "%"))++instance Num (Size Abs) where+ fromInteger = px+ (+) = error "plus not implemented for Size"+ (*) = error "times not implemented for Size"+ abs = error "abs not implemented for Size"+ signum = error "signum not implemented for Size"++instance Fractional (Size Abs) where+ fromRational = em . fromRational++instance Num (Size Rel) where+ fromInteger = pct . fromInteger+ (+) = error "plus not implemented for Size"+ (*) = error "times not implemented for Size"+ abs = error "abs not implemented for Size"+ signum = error "signum not implemented for Size"++instance Fractional (Size Rel) where+ fromRational = pct . fromRational++-------------------------------------------------------------------------------++sym :: (Size a -> Size a -> Size a -> Size a -> Css) -> Size a -> Css+sym k a = k a a a a++sym3 :: (Size a -> Size a -> Size a -> Size a -> Css) -> Size a -> Size a -> Size a -> Css+sym3 k tb l r = k tb l tb r++sym2 :: (Size a -> Size a -> Size a -> Size a -> Css) -> Size a -> Size a -> Css+sym2 k tb lr = k tb lr tb lr++-------------------------------------------------------------------------------++data Deg+data Rad++newtype Angle a = Angle Value+ deriving (Val, Auto, Inherit, Other)++-- | Angle in degrees.++deg :: Double -> Angle Deg+deg i = Angle (value (pack (show i) <> "deg"))++-- | Angle in radians.++rad :: Double -> Angle Rad+rad i = Angle (value (pack (show i) <> "rad"))++instance Num (Angle Deg) where+ fromInteger = deg . fromInteger+ (+) = error "plus not implemented for Angle"+ (*) = error "times not implemented for Angle"+ abs = error "abs not implemented for Angle"+ signum = error "signum not implemented for Angle"++instance Fractional (Angle Deg) where+ fromRational = deg . fromRational++instance Num (Angle Rad) where+ fromInteger = rad . fromInteger+ (+) = error "plus not implemented for Angle"+ (*) = error "times not implemented for Angle"+ abs = error "abs not implemented for Angle"+ signum = error "signum not implemented for Angle"++instance Fractional (Angle Rad) where+ fromRational = rad . fromRational+
+ src/Clay/Stylesheet.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Clay.Stylesheet where++import Data.Text (Text)+import Control.Monad.Writer++import Clay.Selector hiding (Child)+import Clay.Property+import Clay.Common++newtype MediaType = MediaType Value+ deriving (Val, Other)++data NotOrOnly = Not | Only+data MediaQuery = MediaQuery (Maybe NotOrOnly) MediaType [Feature]++data Feature = Feature Text (Maybe Value)++----------------------------------------------------++data App+ = Self Refinement+ | Root Selector+ | Pop Int+ | Child Selector+ | Sub Selector++data Rule+ = Property (Key ()) Value+ | Nested App [Rule]+ | Query MediaQuery [Rule]++newtype StyleM a = S (Writer [Rule] a)+ deriving Monad++-- | The `Css` context is used to collect style rules which are mappings from+-- selectors to style properties. The `Css` type is a computation in the+-- `StyleM` monad that just collects and doesn't return anything.++type Css = StyleM ()++-- | Add a new style property to the stylesheet with the specified `Key` and+-- value. The value can be any type that is in the `Val' typeclass, with other+-- words: can be converted to a `Value`.++key :: Val a => Key a -> a -> Css+key k v = S $ tell [Property (cast k) (value v)]++-- | Add a new style property to the stylesheet with the specified `Key` and+-- value, like `key` but use a `Prefixed` key.++prefixed :: Val a => Prefixed -> a -> Css+prefixed xs = key (Key xs)++infix 4 -:++-- | The colon operator can be used to add style rules to the current context+-- for which there is no embedded version available. Both the key and the value+-- are plain text values and rendered as is to the output CSS.++(-:) :: Key Text -> Text -> Css+(-:) = key++-------------------------------------------------------------------------------++infixr 5 <?+infixr 5 ?+infixr 5 &++-- | Assign a stylesheet to a selector. When the selector is nested inside an+-- outer scope it will be composed with `deep`.++(?) :: Selector -> Css -> Css+(?) sel (S rs) = S (tell [Nested (Sub sel) (execWriter rs)])++-- | Assign a stylesheet to a selector. When the selector is nested inside an+-- outer scope it will be composed with `|>`.++(<?) :: Selector -> Css -> Css+(<?) sel (S rs) = S (tell [Nested (Child sel) (execWriter rs)])++-- | Assign a stylesheet to a filter selector. When the selector is nested+-- inside an outer scope it will be composed with the `with` selector.++(&) :: Refinement -> Css -> Css+(&) p (S rs) = S (tell [Nested (Self p) (execWriter rs)])++-- | Root is used to add style rules to the top scope.++root :: Selector -> Css -> Css+root sel (S rs) = S (tell [Nested (Root sel) (execWriter rs)])++-- | Pop is used to add style rules to selectors defined in an outer scope. The+-- counter specifies how far up the scope stack we want to add the rules.++pop :: Int -> Css -> Css+pop i (S rs) = S (tell [Nested (Pop i) (execWriter rs)])++-------------------------------------------------------------------------------++-- | Apply a set of style rules when the media type and feature queries apply.++query :: MediaType -> [Feature] -> Css -> Css+query ty fs (S rs) = S (tell [Query (MediaQuery Nothing ty fs) (execWriter rs)])++-- | Apply a set of style rules when the media type and feature queries do not apply.++queryNot :: MediaType -> [Feature] -> Css -> Css+queryNot ty fs (S rs) = S (tell [Query (MediaQuery (Just Not) ty fs) (execWriter rs)])++-- | Apply a set of style rules only when the media type and feature queries apply.++queryOnly :: MediaType -> [Feature] -> Css -> Css+queryOnly ty fs (S rs) = S (tell [Query (MediaQuery (Just Only) ty fs) (execWriter rs)])+
+ src/Clay/Text.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.Text+(+-- * Letter and word-spacing.++ letterSpacing+, wordSpacing++-- * Text-rendering.++, TextRendering+, textRendering+, optimizeSpeed, optimizeLegibility, geometricPrecision++-- * Text-shadow.++, textShadow++-- * Text-indent.++, TextIndent+, textIndent+, eachLine, hanging+, indent++-- * Text-direction.++, TextDirection+, direction+, ltr+, rtl++-- * Text-align.++, TextAlign+, textAlign+, justify, matchParent, start, end+, alignSide+, alignString++-- * White-space.++, WhiteSpace+, whiteSpace+, pre, nowrap, preWrap, preLine++-- * Text-decoration.++, TextDecoration+, textDecoration+, textDecorationStyle+, textDecorationLine+, textDecorationColor+, underline, overline, lineThrough, blink++-- * Text-transform.++, TextTransform+, textTransform+, capitalize, uppercase, lowercase, fullWidth++-- * Content.++, Content+, content+, contents+, attrContent+, stringContent+, uriContent+, openQuote, closeQuote, noOpenQuote, noCloseQuote++)+where++import Data.Monoid+import Data.String+import Data.Text (Text)++import Clay.Background+import Clay.Border+import Clay.Color+import Clay.Common+import Clay.Property+import Clay.Stylesheet+import Clay.Size++-------------------------------------------------------------------------------++letterSpacing :: Size a -> Css+letterSpacing = key "letter-spacing"++wordSpacing :: Size a -> Css+wordSpacing = key "word-spacing"++-------------------------------------------------------------------------------++newtype TextRendering = TextRendering Value+ deriving (Val, Auto, Inherit, Other)++optimizeSpeed, optimizeLegibility, geometricPrecision :: TextRendering++optimizeSpeed = TextRendering "optimizeSpeed"+optimizeLegibility = TextRendering "optimizeLegibility"+geometricPrecision = TextRendering "geometricPrecision"++textRendering :: TextRendering -> Css+textRendering = key "text-rendering"++-------------------------------------------------------------------------------++textShadow :: Size a -> Size a -> Size a -> Color -> Css+textShadow x y w c = key "text-shadow" (x ! y ! w ! c)++-------------------------------------------------------------------------------++newtype TextIndent = TextIndent Value+ deriving (Val, Inherit, Other)++eachLine, hanging :: TextIndent++eachLine = TextIndent "each-line"+hanging = TextIndent "hanging"++indent :: Size a -> TextIndent+indent = TextIndent . value++textIndent :: TextIndent -> Css+textIndent = key "text-indent"++-------------------------------------------------------------------------------++newtype TextDirection = TextDirection Value+ deriving (Val, Normal, Inherit, Other)++ltr :: TextDirection+ltr = TextDirection "ltr"++rtl :: TextDirection+rtl = TextDirection "rtl"++direction :: TextDirection -> Css+direction = key "direction"++-------------------------------------------------------------------------------++newtype TextAlign = TextAlign Value+ deriving (Val, Normal, Inherit, Other)++justify, matchParent, start, end :: TextAlign++justify = TextAlign "justify"+matchParent = TextAlign "matchParent"+start = TextAlign "start"+end = TextAlign "end"++alignSide :: Side -> TextAlign+alignSide = TextAlign . value++alignString :: Char -> TextAlign+alignString = TextAlign . value . Literal . fromString . return++textAlign :: TextAlign -> Css+textAlign = key "text-align"++-------------------------------------------------------------------------------++newtype WhiteSpace = WhiteSpace Value+ deriving (Val, Normal, Inherit, Other)++whiteSpace :: WhiteSpace -> Css+whiteSpace = key "whiteSpace"++pre, nowrap, preWrap, preLine :: WhiteSpace++pre = WhiteSpace "pre"+nowrap = WhiteSpace "nowrap"+preWrap = WhiteSpace "pre-wrap"+preLine = WhiteSpace "pre-line"++-------------------------------------------------------------------------------++newtype TextDecoration = TextDecoration Value+ deriving (Val, None, Inherit, Other)++underline, overline, lineThrough, blink :: TextDecoration++underline = TextDecoration "underline"+overline = TextDecoration "overline"+lineThrough = TextDecoration "line-through"+blink = TextDecoration "blink"++textDecorationLine :: TextDecoration -> Css+textDecorationLine = key "text-decoration-line"++textDecorationColor :: Color -> Css+textDecorationColor = key "text-decoration-color"++textDecoration :: TextDecoration -> Css+textDecoration = key "text-decoration"++textDecorationStyle :: Stroke -> Css+textDecorationStyle = key "text-decoration-style"++-------------------------------------------------------------------------------++newtype TextTransform = TextTransform Value+ deriving (Val, None, Inherit)++capitalize, uppercase, lowercase, fullWidth :: TextTransform++capitalize = TextTransform "capitalize"+uppercase = TextTransform "uppercase"+lowercase = TextTransform "lowercase"+fullWidth = TextTransform "full-width"++textTransform :: TextTransform -> Css+textTransform = key "text-transform"++-------------------------------------------------------------------------------++newtype Content = Content Value+ deriving (Val, None, Normal, Inherit)++attrContent :: Text -> Content+attrContent a = Content ("attr(" <> value a <> ")")++stringContent :: Text -> Content+stringContent = Content . value . Literal++uriContent :: Text -> Content+uriContent u = Content ("uri(" <> value (Literal u) <> ")")++openQuote, closeQuote, noOpenQuote, noCloseQuote :: Content++openQuote = Content "open-quote"+closeQuote = Content "close-quote"+noOpenQuote = Content "no-open-quote"+noCloseQuote = Content "no-close-quote"++content :: Content -> Css+content = key "content"++contents :: [Content] -> Css+contents cs = key "content" (noCommas cs)++-- TODO: counters+
+ src/Clay/Time.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.Time+(++-- * Time type.+ Time++-- * Time constructors.++, sec+, ms+)+where++import Data.Monoid+import Data.Text (pack)++import Clay.Common+import Clay.Property++-------------------------------------------------------------------------------++newtype Time = Time Value+ deriving (Val, Auto, Normal, Inherit, None, Other)++-- | Time in seconds.++sec :: Double -> Time+sec i = Time (value (pack (show i) <> "s"))++-- | Time in milliseconds.++ms :: Double -> Time+ms i = Time (value (pack (show i) <> "ms"))++instance Num Time where+ fromInteger = sec . fromInteger+ (+) = error "plus not implemented for Time"+ (*) = error "times not implemented for Time"+ abs = error "abs not implemented for Time"+ signum = error "signum not implemented for Time"++instance Fractional Time where+ fromRational = sec . fromRational+
+ src/Clay/Transform.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.Transform+(++-- * The transform propery.++ Transformation+, transform+, transforms++-- * Translating.++, translate+, translateX, translateY, translateZ+, translate3d++-- * Scaling.++, scale+, scaleX, scaleY, scaleZ+, scale3d++-- * Rotating.++, rotate+, rotateX, rotateY, rotateZ+, rotate3d++-- * Skewing.++, skew+, skewX, skewY++-- * Custom 3D transformations.++, perspective+, matrix+, matrix3d +)+where++import Data.Monoid+import Prelude hiding (Left, Right)++import Clay.Property+import Clay.Stylesheet+import Clay.Size+import Clay.Common++newtype Transformation = Transformation Value+ deriving (Val, None)++transform :: Transformation -> Css+transform = prefixed (browsers <> "transform")++transforms :: [Transformation] -> Css+transforms xs = prefixed (browsers <> "transform") (noCommas xs)++-------------------------------------------------------------------------------++scale :: Double -> Double -> Transformation+scale x y = Transformation ("scale(" <> value [x, y] <> ")")++scaleX, scaleY, scaleZ :: Double -> Transformation++scaleX x = Transformation ("scaleX(" <> value x <> ")")+scaleY y = Transformation ("scaleY(" <> value y <> ")")+scaleZ z = Transformation ("scaleZ(" <> value z <> ")")++scale3d :: Double -> Double -> Double -> Transformation+scale3d x y z = Transformation ("scale3d(" <> value [x, y, z] <> ")")++-------------------------------------------------------------------------------++rotate :: Angle a -> Angle a -> Transformation+rotate x y = Transformation ("rotate(" <> value [x, y] <> ")")++rotateX, rotateY, rotateZ :: Angle a -> Transformation++rotateX x = Transformation ("rotateX(" <> value x <> ")")+rotateY y = Transformation ("rotateY(" <> value y <> ")")+rotateZ z = Transformation ("rotateZ(" <> value z <> ")")++rotate3d :: Double -> Double -> Double -> Angle a -> Transformation+rotate3d x y z a = Transformation ("rotate3d(" <> value [value x, value y, value z, value a] <> ")")++-------------------------------------------------------------------------------++translate :: Size Abs -> Size Abs -> Transformation+translate x y = Transformation ("translate(" <> value [x, y] <> ")")++translateX, translateY, translateZ :: Size Abs -> Transformation++translateX x = Transformation ("translateX(" <> value x <> ")")+translateY y = Transformation ("translateY(" <> value y <> ")")+translateZ z = Transformation ("translateZ(" <> value z <> ")")++translate3d :: Size Abs -> Size Abs -> Size Abs -> Transformation+translate3d x y z = Transformation ("translate3d(" <> value [x, y, z] <> ")")++-------------------------------------------------------------------------------++skew :: Angle a -> Angle a -> Transformation+skew x y = Transformation ("skew(" <> value [x, y] <> ")")++skewX, skewY :: Angle a -> Transformation++skewX x = Transformation ("skewX(" <> value x <> ")")+skewY y = Transformation ("skewY(" <> value y <> ")")++-------------------------------------------------------------------------------++perspective :: Double -> Transformation+perspective p = Transformation ("perspective(" <> value p <> ")")++matrix :: Double -> Double -> Double -> Double -> Double -> Double -> Transformation+matrix u v w x y z = Transformation ("matrix3d(" <> value [ u, v, w, x, y, z ] <> ")")++matrix3d :: Double -> Double -> Double -> Double+ -> Double -> Double -> Double -> Double+ -> Double -> Double -> Double -> Double+ -> Double -> Double -> Double -> Double+ -> Transformation+matrix3d w0 x0 y0 z0+ w1 x1 y1 z1+ w2 x2 y2 z2+ w3 x3 y3 z3 =+ Transformation ("matrix3d(" <> value+ [ w0, x0, y0, z0+ , w1, x1, y1, z1+ , w2, x2, y2, z2+ , w3, x3, y3, z3+ ] <> ")")+
+ src/Clay/Transition.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE+ OverloadedStrings+ , GeneralizedNewtypeDeriving+ #-}+module Clay.Transition+(++-- * The transition propery.++ transition+, transitions++-- * Transition-property.++, transitionProperty+, transitionProperties++-- * Transition-duration.++, transitionDuration+, transitionDurations++-- * Transition-timing-function.++, TimingFunction+, transitionTimingFunction+, ease, easeIn, easeOut, easeInOut, easeLinear, stepStart, stepStop+, stepsStart, stepsStop+, cubicBezier++-- * Transition-delay.+, transitionDelay+, transitionDelays++)+where++import Data.Monoid+import Data.Text (Text)++import Clay.Common+import Clay.Property+import Clay.Stylesheet+import Clay.Time++transition :: Text -> Time -> TimingFunction -> Time -> Css+transition p d f e = prefixed (browsers <> "transition") (p ! d ! f ! e)++transitions :: [(Text, Time, TimingFunction, Time)] -> Css+transitions = prefixed (browsers <> "transition")+ . map (\(p, d, f, e) -> value (p ! d ! f ! e))++-------------------------------------------------------------------------------++transitionProperty :: Text -> Css+transitionProperty = key "transition-property"++transitionProperties :: [Text] -> Css+transitionProperties = key "transition-property"++-------------------------------------------------------------------------------++transitionDuration :: Time -> Css+transitionDuration = key "transition-duration"++transitionDurations :: [Time] -> Css+transitionDurations = key "transition-duration"++-------------------------------------------------------------------------------++newtype TimingFunction = TimingFunction Value+ deriving (Val, Other, Auto)++ease, easeIn, easeOut, easeInOut, easeLinear, stepStart, stepStop :: TimingFunction++ease = other "ease"+easeIn = other "easeIn"+easeOut = other "easeOut"+easeInOut = other "easeInOut"+easeLinear = other "easeLinear"+stepStart = other "stepStart"+stepStop = other "stepStop"++stepsStart, stepsStop :: Integer -> TimingFunction++stepsStart s = other ("steps(" <> value s <> ", end)")+stepsStop s = other ("steps(" <> value s <> ", end)")++cubicBezier :: Double -> Double -> Double -> Double -> TimingFunction+cubicBezier a b c d = other ("cubic-bezier(" <> value (a ! b ! c ! d) <> ")")++transitionTimingFunction :: TimingFunction -> Css+transitionTimingFunction = key "transition-timing-function"++-------------------------------------------------------------------------------++transitionDelay :: Time -> Css+transitionDelay = key "transition-delay"++transitionDelays :: [Time] -> Css+transitionDelays = key "transition-delay"+