clay 0.10.1 → 0.11

raw patch · 19 files changed

+446/−124 lines, 19 filesdep +hspecdep +hspec-expectationsdep −HUnitdep −test-frameworkdep −test-framework-hunitnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, hspec-expectations

Dependencies removed: HUnit, test-framework, test-framework-hunit

API changes (from Hackage documentation)

Files

• clay.cabal +16/−11
• spec/Spec.hs +4/−0
• src/Clay.hs +3/−1
• src/Clay/Border.hs +7/−0
• src/Clay/Box.hs +5/−0
• src/Clay/Color.hs +110/−15
• src/Clay/Common.hs +35/−19
• src/Clay/Display.hs +4/−5
• src/Clay/Flexbox.hs +118/−0
• src/Clay/FontFace.hs +1/−1
• src/Clay/Media.hs +1/−1
• src/Clay/Property.hs +2/−2
• src/Clay/Pseudo.hs +10/−3
• src/Clay/Render.hs +30/−30
• src/Clay/Selector.hs +7/−1
• src/Clay/Size.hs +85/−20
• src/Clay/Stylesheet.hs +6/−0
• src/Clay/Text.hs +2/−2
• src/Test.hs +0/−13

@@ -1,5 +1,5 @@ Name:     clay-Version:  0.10.1+Version:  0.11 Synopsis: CSS preprocessor as embedded Haskell. Description:   Clay is a CSS preprocessor like LESS and Sass, but implemented as an embedded@@ -31,6 +31,11 @@ Cabal-Version: >= 1.8 Build-Type:    Simple +Tested-With:+  GHC==7.8.4,+  GHC==7.10.3,+  GHC==8.0.1+ Source-Repository head   Type:     git   Location: git://github.com/sebastiaanvisser/clay.git@@ -51,6 +56,7 @@     Clay.Display     Clay.Elements     Clay.Filter+    Clay.Flexbox     Clay.Font     Clay.FontFace     Clay.Geometry@@ -71,20 +77,19 @@    GHC-Options: -Wall   Build-Depends:-    base  >= 4    && < 5,+    base  >= 4.5  && < 5,     mtl   >= 1    && < 2.3,     text  >= 0.11 && < 1.3  Test-Suite Test-Clay   Type: exitcode-stdio-1.0-  HS-Source-Dirs: src-  Main-Is: Test.hs+  HS-Source-Dirs: spec, src+  main-is: Spec.hs   Build-Depends:-    base                 >= 4    && < 5,-    mtl                  >= 1    && < 2.3,-    text                 >= 0.11 && < 1.3,-    HUnit                >= 1.2  && < 1.3,-    test-framework       >= 0.8  && < 0.9,-    test-framework-hunit >= 0.3  && < 0.4+    base                 >= 4.5  && < 5,+    base                 >= 4     && < 5,+    mtl                  >= 1     && < 2.3,+    text                 >= 0.11  && < 1.3,+    hspec-expectations   >= 0.7.2 && < 0.8,+    hspec                >= 2.2.0 && < 2.3   Ghc-Options: -Wall-

@@ -0,0 +1,4 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}++-- Automatically provides a main function+-- If you have trouble with this, make sure hspec-discover is installed and in your PATH

@@ -99,6 +99,7 @@ , module Clay.Box , module Clay.Display , module Clay.Dynamic+, module Clay.Flexbox , module Clay.Font , module Clay.FontFace , module Clay.Geometry@@ -117,7 +118,7 @@ ) where -import Prelude hiding ((**))+import Prelude ()  import Clay.Render import Clay.Stylesheet@@ -140,6 +141,7 @@ import Clay.Common import Clay.Display    hiding (table) import Clay.Dynamic+import Clay.Flexbox    hiding (flex, nowrap, wrap) import Clay.Font       hiding (menu, caption, small, icon) import Clay.FontFace import Clay.Geometry

@@ -28,6 +28,7 @@  -- * Collapsing borders model for a table , borderCollapse+, borderSpacing, borderSpacing2 ) where @@ -171,3 +172,9 @@  borderCollapse :: Visibility -> Css borderCollapse = key "border-collapse"++borderSpacing :: Size a -> Css+borderSpacing a = key "border-spacing" a++borderSpacing2 :: Size a -> Size a -> Css+borderSpacing2 a b = key "border-spacing" (a ! b)

@@ -4,6 +4,7 @@ , paddingBox, borderBox, contentBox , boxSizing , boxShadow+, boxShadowWithSpread , boxShadows , insetBoxShadow )@@ -38,6 +39,10 @@  boxShadow :: Size a -> Size a -> Size a -> Color -> Css boxShadow x y w c = prefixed (browsers <> "box-shadow") (x ! y ! w ! c)++boxShadowWithSpread :: Size a -> Size a -> Size a -> Size a -> Color -> Css+boxShadowWithSpread x y blurRadius spreadRadius color =+    prefixed (browsers <> "box-shadow") (x ! y ! blurRadius ! spreadRadius ! color)  boxShadows :: [(Size a, Size a, Size a, Color)] -> Css boxShadows = prefixed (browsers <> "box-shadow") . map (\(a, b, c, d) -> a ! b ! c ! d)

@@ -16,24 +16,24 @@ -- * Color datatype.  data Color-  = Rgba Integer Integer Integer Integer-  | Hsla Integer Float   Float   Integer+  = Rgba Integer Integer Integer Float+  | Hsla Integer Float   Float   Float   | Other Value-  deriving Show+  deriving (Show, Eq)  -- * Color constructors. -rgba :: Integer -> Integer -> Integer -> Integer -> Color+rgba :: Integer -> Integer -> Integer -> Float -> Color rgba = Rgba  rgb :: Integer -> Integer -> Integer -> Color-rgb r g b = rgba r g b 255+rgb r g b = rgba r g b 1 -hsla :: Integer -> Float -> Float -> Integer -> Color+hsla :: Integer -> Float -> Float -> Float -> Color hsla = Hsla  hsl :: Integer -> Float -> Float -> Color-hsl r g b = hsla r g b 255+hsl r g b = hsla r g b 1  grayish :: Integer -> Color grayish g = rgb g g g@@ -55,11 +55,65 @@ setB b (Rgba r g _ a) = Rgba r g b a setB _ o              = o -setA :: Integer -> Color -> Color+setA :: Float -> 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 _ o              = o +-- * Color conversions.++toRgba :: Color -> Color+toRgba color =+    case color of+        Hsla h s l a -> toRgba' rgb' a+              where sextant = fromIntegral h / 60.0+                    chroma = (s *) . (1.0 -) . abs $ (2.0 * l) - 1.0+                    x = (chroma *) . (1.0 -) . abs $ (sextant `fracMod` 2) - 1.0+                    lightnessAdjustment = l - (chroma / 2.0)++                    toRgbPart component = truncate . (* 255.0) $ component + lightnessAdjustment+                    toRgba' (r, g, b) = Rgba (toRgbPart r) (toRgbPart g) (toRgbPart b)++                    rgb' | h >= 0   && h <  60 = (chroma, x     ,  0)+                         | h >= 60  && h < 120 = (x     , chroma,  0)+                         | h >= 120 && h < 180 = (0     , chroma,  x)+                         | h >= 180 && h < 240 = (0     , x     ,  chroma)+                         | h >= 240 && h < 300 = (x     , 0     ,  chroma)+                         | otherwise           = (chroma, 0     ,  x)++        c@(Rgba _ _ _ _) -> c+        +        Other _          -> error "Invalid to pass Other to toRgba."+++toHsla :: Color -> Color+toHsla color =+    case color of+        Rgba redComponent greenComponent blueComponent alphaComponent -> Hsla h (decimalRound s 3) (decimalRound l 3) alphaComponent+            where r = fromIntegral redComponent   / 255.0+                  g = fromIntegral greenComponent / 255.0+                  b = fromIntegral blueComponent  / 255.0++                  minColor = minimum [r, g, b]+                  maxColor = maximum [r, g, b]+                  delta = maxColor - minColor++                  l = (minColor + maxColor) / 2.0+                  s = if delta == 0.0 then 0.0+                      else (delta /) . (1.0 -) . abs $ (2.0 * l) - 1.0++                  h' | delta == 0.0 = 0.0+                     | r == maxColor = ((g - b) / delta) `fracMod` 6.0+                     | g == maxColor = ((b - r) / delta) + 2.0+                     | otherwise     = ((r - g) / delta) + 4.0++                  h'' = truncate $ 60 * h'+                  h = if h'' < 0 then h''+ 360 else h''++        c@(Hsla _ _ _ _) -> c+        +        Other _          -> error "Invalid to pass Other to toHsla."+ -- * Computing with colors.  (*.) :: Color -> Integer -> Color@@ -74,22 +128,63 @@ (-.) (Rgba r g b a) i = Rgba (clamp (r - i)) (clamp (g - i)) (clamp (b - i)) a (-.) o              _ = o -clamp :: Integer -> Integer-clamp i = max (min i 255) 0+clamp :: Ord a => Num a => a -> a+clamp i = max (min i (fromIntegral (255 :: Integer))) (fromIntegral (0 :: Integer)) +lighten :: Float -> Color -> Color+lighten factor color =+    case color of+        c@(Hsla {}) -> toHsla $ lighten factor (toRgba c)+        c@(Rgba {}) -> lerp factor c (Rgba 255 255 255 255)+        Other _     -> error "Other cannot be lightened."++darken :: Float -> Color -> Color+darken factor color =+    case color of+        c@(Hsla {}) -> toHsla $ darken factor (toRgba c)+        c@(Rgba {}) -> lerp factor c (Rgba 0 0 0 255)+        Other _     -> error "Other cannot be darkened."++lerp :: Float -> Color -> Color -> Color+lerp factor startColor boundColor =+    case (startColor, boundColor) of+        (Other _, _) -> error "Other cannot be lerped." +        (_, Other _) -> error "Other cannot be lerped." +        (color@(Hsla {}), bound) -> toHsla $ lerp factor (toRgba color) bound++        (start, color@(Hsla {})) -> toHsla $ lerp factor start (toRgba color)++        (Rgba r g b a, Rgba r' g' b' a') ->+            Rgba+                (lerpComponent factor r r')+                (lerpComponent factor g g')+                (lerpComponent factor b b')+                (lerpAlpha factor a a')+            where lerpComponent :: Float -> Integer -> Integer -> Integer+                  lerpComponent amount start bound =+                    let difference = bound - start+                        adjustment = truncate $ fromIntegral difference * amount+                    in clamp $ start + adjustment+                  lerpAlpha :: Float -> Float -> Float -> Float+                  lerpAlpha amount start bound =+                    let difference = bound - start+                        adjustment = fromIntegral $ (truncate $ difference * amount :: Integer)+                    in clamp $ start + adjustment+ -------------------------------------------------------------------------------  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 1.0 -> Value $mconcat ["#",  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, ",", f s, ",", f l,            ")"]+      Hsla h s l 1.0 -> Value $mconcat ["hsl(",  p h, ",", f s, ",", f l,            ")"]       Hsla h s l a   -> Value $mconcat ["hsla(", p h, ",", f s, ",", f l, ",", ah a, ")"]       Other o        -> o     where p  = fromString . show+          p' = fromString . printf "%02x"           f  = fromString . printf "%.4f%%"-          ah = fromString . printf "%.4f" . (/ (256 :: Double)) . fromIntegral+          ah = fromString . take 6 . show  instance None    Color where none    = Other "none" instance Auto    Color where auto    = Other "auto"@@ -104,9 +199,9 @@   case Text.uncons t of     Just ('#', cs) | Text.all isHexDigit 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, g, h] -> rgba (hex a b) (hex c d) (hex e f) (fromIntegral (hex g h :: Integer) / 255.0)         [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, d            ] -> rgba (hex a a) (hex b b) (hex c c) (fromIntegral (hex d d :: Integer) / 255.0)         [a, b, c               ] -> rgb  (hex a a) (hex b b) (hex c c)         _                        -> err     _                            -> err

@@ -15,15 +15,17 @@  ------------------------------------------------------------------------------- -class All     a where all     :: a-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-class Initial a where initial :: a-class Unset   a where unset   :: a+class All      a where all      :: a+class Auto     a where auto     :: a+class Baseline a where baseline :: a+class Center   a where center   :: 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+class Initial  a where initial  :: a+class Unset    a where unset    :: 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@@ -31,16 +33,18 @@  class Other   a where other   :: Value -> a -instance All     Value where all     = "all"-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-instance Initial Value where initial = "initial"-instance Unset   Value where unset   = "unset"+instance All      Value where all      = "all"+instance Auto     Value where auto     = "auto"+instance Baseline Value where baseline = "baseline"+instance Center   Value where center   = "center"+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+instance Initial  Value where initial  = "initial"+instance Unset    Value where unset    = "unset"  ------------------------------------------------------------------------------- @@ -63,3 +67,15 @@ call :: (IsString s, Monoid s) => s -> s -> s call fn arg = fn <> "(" <> arg <> ")" +-------------------------------------------------------------------------------++-- | Some auxiliary mathematical functions.++fracMod :: RealFrac a => a -> a -> a+fracMod x y = (x -) . (* y) $ evenMultiples x y+    where evenMultiples x' y' = fromIntegral (truncate (x' / y') :: Integer)++decimalRound :: RealFrac a => a -> Int -> a+decimalRound x decimalPlaces = shiftedAndRounded x / powersOf10+    where powersOf10 = 10 ^ decimalPlaces+          shiftedAndRounded x' = fromIntegral (round $ x' * powersOf10 :: Integer)

@@ -65,13 +65,13 @@ -- * Vertical align.  , VerticalAlign(..)-, baseline, middle, vAlignSub, vAlignSuper, textTop, textBottom, vAlignTop, vAlignBottom+, middle, vAlignSub, vAlignSuper, textTop, textBottom, vAlignTop, vAlignBottom  -- * Cursor  , Cursor(..) , crosshair, cursorDefault, pointer, move, eResize, neResize, nwResize, nResize, seResize, swResize, sResize, wResize, cursorText, wait, cursorProgress, help, cursorUrl-          + ) where @@ -232,14 +232,13 @@     verticalAlign :: a -> Css     verticalAlign = key "vertical-align" -newtype VerticalAlignValue a = VerticalAlignValue Value deriving (Val)+newtype VerticalAlignValue a = VerticalAlignValue Value deriving (Val, Baseline)  instance VerticalAlign (VerticalAlignValue a) instance VerticalAlign (Size a) -baseline,middle,vAlignSub,vAlignSuper,textTop,textBottom,vAlignTop,vAlignBottom :: VerticalAlignValue Value+middle,vAlignSub,vAlignSuper,textTop,textBottom,vAlignTop,vAlignBottom :: VerticalAlignValue Value -baseline = VerticalAlignValue "baseline" middle = VerticalAlignValue "middle" vAlignSub = VerticalAlignValue "sub" vAlignSuper = VerticalAlignValue "super"

@@ -0,0 +1,118 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings #-}+module Clay.Flexbox where++import Clay.Common     (Auto, Baseline, Center, Inherit, Other)+import Clay.Property+import Clay.Size       (Size)+import Clay.Stylesheet+import Data.String     (fromString)++-- | CSS Flexible Box Layout+-- http://dev.w3.org/csswg/css-flexbox-1++class FlexEnd      a where flexEnd      :: a+class FlexStart    a where flexStart    :: a+class SpaceAround  a where spaceAround  :: a+class SpaceBetween a where spaceBetween :: a+class Stretch      a where stretch      :: a++instance FlexEnd Value      where flexEnd      = "flex-end"+instance FlexStart Value    where flexStart    = "flex-start"+instance SpaceAround Value  where spaceAround  = "space-around"+instance SpaceBetween Value where spaceBetween = "space-between"+instance Stretch Value      where stretch      = "stretch"++-------------------------------------------------------------------------------++newtype AlignContentValue = AlignContentValue Value+  deriving (Val, Other, Inherit, FlexStart, FlexEnd+          , Center, SpaceBetween, SpaceAround, Stretch)++alignContent :: AlignContentValue -> Css+alignContent = key "align-content"++-------------------------------------------------------------------------------++newtype AlignItemsValue = AlignItemValue Value+  deriving (Val, Other, Inherit, Baseline+          , Center, FlexEnd, FlexStart, Stretch)++alignItems :: AlignItemsValue -> Css+alignItems = key "align-items"++-------------------------------------------------------------------------------++newtype AlignSelfValue = AlignSelfValue Value+  deriving (Val, Other, Inherit, Auto, Baseline+          , Center, FlexEnd, FlexStart, Stretch)++alignSelf :: AlignSelfValue -> Css+alignSelf = key "align-self"++-------------------------------------------------------------------------------++flex :: Int -> Int -> Size b -> Css+flex g s b = key "flex" (gs ! ss ! value b)+  where gs = fromString (show g) :: Value+        ss = fromString (show s) :: Value++-------------------------------------------------------------------------------++flexBasis :: Size a -> Css+flexBasis = key "flex-basis"++-------------------------------------------------------------------------------++newtype FlexDirection = FlexDirection Value+  deriving (Val, Other)++row, rowReverse, column, columnReverse :: FlexDirection++row           = FlexDirection "row"+rowReverse    = FlexDirection "row-reverse"+column        = FlexDirection "column"+columnReverse = FlexDirection "column-reverse"++flexDirection :: FlexDirection -> Css+flexDirection = key "flex-direction"++-------------------------------------------------------------------------------++flexFlow :: FlexDirection -> FlexWrap -> Css+flexFlow d w = key "flex-flow" (d ! w)++-------------------------------------------------------------------------------++flexGrow :: Int -> Css+flexGrow i = key "flex-grow" (fromString (show i) :: Value)++flexShrink :: Int  -> Css+flexShrink i = key "flex-shrink" (fromString (show i) :: Value)++-------------------------------------------------------------------------------++newtype FlexWrap = FlexWrap Value+  deriving (Val, Other)++nowrap, wrap, wrapReverse :: FlexWrap++nowrap = FlexWrap "nowrap"+wrap = FlexWrap "wrap"+wrapReverse = FlexWrap "wrap-reverse"++flexWrap :: FlexWrap -> Css+flexWrap = key "flex-wrap"++-------------------------------------------------------------------------------++newtype JustifyContentValue = JustifyContentValue Value+  deriving (Val, Other, Inherit, Center, FlexEnd+          , FlexStart, SpaceAround, SpaceBetween)++justifyContent :: JustifyContentValue -> Css+justifyContent = key "justify-content"++-------------------------------------------------------------------------------++order :: Int -> Css+order i = key "order" (fromString (show i) :: Value)

@@ -10,7 +10,7 @@ import Clay.Stylesheet (Css, key)  import Data.Monoid ((<>))-import Data.Functor((<$>))+import Data.Functor ((<$>)) import Data.Maybe (fromMaybe) import Data.Text (Text) 

@@ -13,7 +13,7 @@ , minDeviceWidth, maxDeviceWidth, deviceHeight, minDeviceHeight , maxDeviceHeight --- * Aspect ration features.+-- * Aspect ratio features.  , aspectRatio, minAspectRatio, maxAspectRatio, deviceAspectRatio , minDeviceAspectRatio, maxDeviceAspectRatio

@@ -10,7 +10,7 @@ import Data.Text (Text, replace)  data Prefixed = Prefixed { unPrefixed :: [(Text, Text)] } | Plain { unPlain :: Text }-  deriving Show+  deriving (Show, Eq)  instance IsString Prefixed where   fromString s = Plain (fromString s)@@ -48,7 +48,7 @@ -------------------------------------------------------------------------------  newtype Value = Value { unValue :: Prefixed }-  deriving (Show, Monoid, IsString)+  deriving (Show, Monoid, IsString, Eq)  class Val a where   value :: a -> Value

@@ -8,11 +8,18 @@ -- List of specific pseudo classes, from: -- https://developer.mozilla.org/en-US/docs/CSS/Pseudo-classes -after, before :: Refinement+-- * Pseudo elements -after  = ":after"-before = ":before"+after, before, firstLetter, firstLine, selection, backdrop :: Refinement +after       = "::after"+before      = "::before"+firstLetter = "::first-letter"+firstLine   = "::first-line"+selection   = "::selection"+backdrop    = "::backdrop"++-- * Pseudo classes link, visited, active, hover, focus, firstChild, lastChild :: Refinement  link       = ":link"

@@ -6,32 +6,32 @@ , render , putCss , renderWith- , renderSelector ) 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, pack)-import Data.Text.Lazy.Builder-import Prelude hiding ((**))+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, pack)+import           Data.Text.Lazy.Builder+import           Prelude                hiding ((**)) -import qualified Data.Text         as Text-import qualified Data.Text.Lazy    as Lazy-import qualified Data.Text.Lazy.IO as Lazy+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, rule)-import Clay.Common (browsers)-import Clay.Property-import Clay.Selector+import           Clay.Common            (browsers)+import           Clay.Property+import           Clay.Selector+import           Clay.Stylesheet        hiding (Child, query, rule) -import qualified Clay.Stylesheet as Rule+import qualified Clay.Stylesheet        as Rule + data Config = Config   { indentation    :: Builder   , newline        :: Builder@@ -264,16 +264,16 @@ 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, "']"                    ]-    AttrBegins   a v -> [ "[", fromText a, "^='", fromText v, "']"                    ]-    AttrEnds     a v -> [ "[", fromText a, "$='", fromText v, "']"                    ]-    AttrContains 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), ")" ]-+    Id           a   -> [ "#" , fromText a                                             ]+    Class        a   -> [ "." , fromText a                                             ]+    Attr         a   -> [ "[" , fromText a,                     "]"                    ]+    AttrVal      a v -> [ "[" , fromText a,  "='", fromText v, "']"                    ]+    AttrBegins   a v -> [ "[" , fromText a, "^='", fromText v, "']"                    ]+    AttrEnds     a v -> [ "[" , fromText a, "$='", fromText v, "']"                    ]+    AttrContains 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), ")" ]+    PseudoElem   a   -> [ "::", fromText a                                             ] 

@@ -5,6 +5,8 @@   , GeneralizedNewtypeDeriving   , StandaloneDeriving   , UndecidableInstances+  , ViewPatterns+  , PatternGuards   #-} module Clay.Selector where @@ -146,6 +148,7 @@   | AttrHyph     Text Text   | Pseudo       Text   | PseudoFunc   Text [Text]+  | PseudoElem   Text   deriving (Eq, Ord, Show)  newtype Refinement = Refinement { unFilter :: [Predicate] }@@ -159,7 +162,10 @@   case Text.uncons t of     Just ('#', s) -> [Id     s]     Just ('.', s) -> [Class  s]-    Just (':', s) -> [Pseudo s]+    Just (':', s)+      | Just (':',s') <- Text.uncons s+                  -> [PseudoElem s']+      | otherwise -> [Pseudo s]     Just ('@', s) -> [Attr   s]     _             -> [Attr   t] 

@@ -12,15 +12,24 @@ , Abs , Rel , nil+, unitless  -- * Size constructors. +, cm+, mm+, inches , px , pt+, pc , em , ex , pct , rem+, vw+, vh+, vmin+, vmax  -- * Shorthands for properties that can be applied separately to each box side. @@ -33,11 +42,15 @@ , Angle , Deg , Rad+, Grad+, Turn  -- * Constructing angles.  , deg , rad+, grad+, turn  ) where@@ -60,41 +73,62 @@ newtype Size a = Size Value   deriving (Val, Auto, Normal, Inherit, None, Other) +-- | Zero size. nil :: Size a nil = Size "0" --- | Size in pixels.+-- | Unitless size (as recommended for line-height).+unitless :: Double -> Size a+unitless i = Size (value i) -px :: Integer -> Size Abs-px i = Size (value i <> "px")+cm, mm, inches, px, pt, pc :: Double -> Size Abs --- | Size in points.+-- | Size in centimeters.+cm i = Size (value i <> "cm") -pt :: Double -> Size Abs+-- | Size in millimeters.+mm i = Size (value i <> "mm")++-- | Size in inches (1in = 2.54 cm).+inches i = Size (value i <> "in")++-- | Size in pixels.+px i = Size (value i <> "px")++-- | Size in points (1pt = 1/72 of 1in). pt i = Size (value i <> "pt") --- | Size in em's.+-- | Size in picas (1pc = 12pt).+pc i = Size (value i <> "pc") -em :: Double -> Size Abs-em i = Size (value i <> "em")+em, ex, pct, rem, vw, vh, vmin, vmax :: Double -> Size Rel --- | Size in ex'es.+-- | Size in em's (computed value of the font-size).+em i = Size (value i <> "em") -ex :: Double -> Size Abs+-- | Size in ex'es (x-height of the first avaliable font). ex i = Size (value i <> "ex") --- | Size in percentages.--pct :: Double -> Size Rel+-- | Size in percents. pct i = Size (value i <> "%") --- | Size in rem's.--rem :: Double -> Size Rel+-- | Size in rem's (em's, but always relative to the root element). rem i = Size (value i <> "rem") +-- | Size in vw's (1vw = 1% of viewport width).+vw i = Size (value i <> "vw")++-- | Size in vh's (1vh = 1% of viewport height).+vh i = Size (value i <> "vh")++-- | Size in vmin's (the smaller of vw or vh).+vmin i = Size (value i <> "vmin")++-- | Size in vmax's (the larger of vw or vh).+vmax i = Size (value i <> "vmax")+ instance Num (Size Abs) where-  fromInteger = px+  fromInteger = px . fromInteger   (+)    = error   "plus not implemented for Size"   (*)    = error  "times not implemented for Size"   abs    = error    "abs not implemented for Size"@@ -102,7 +136,7 @@   negate = error "negate not implemented for Size"  instance Fractional (Size Abs) where-  fromRational = em . fromRational+  fromRational = px . fromRational   recip  = error  "recip not implemented for Size"  instance Num (Size Rel) where@@ -132,20 +166,28 @@  data Deg data Rad+data Grad+data Turn  newtype Angle a = Angle Value   deriving (Val, Auto, Inherit, Other)  -- | Angle in degrees.- deg :: Double -> Angle Deg deg i = Angle (value i <> "deg")  -- | Angle in radians.- rad :: Double -> Angle Rad rad i = Angle (value i <> "rad") +-- | Angle in gradians (also knows as gons or grades).+grad :: Double -> Angle Grad+grad i = Angle (value i <> "grad")++-- | Angle in turns.+turn :: Double -> Angle Turn+turn i = Angle (value i <> "turn")+ instance Num (Angle Deg) where   fromInteger = deg . fromInteger   (+)    = error   "plus not implemented for Angle"@@ -170,3 +212,26 @@   fromRational = rad . fromRational   recip  = error  "recip not implemented for Angle" +instance Num (Angle Grad) where+  fromInteger = grad . 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"+  negate = error "negate not implemented for Angle"++instance Fractional (Angle Grad) where+  fromRational = grad . fromRational+  recip  = error  "recip not implemented for Angle"++instance Num (Angle Turn) where+  fromInteger = turn . 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"+  negate = error "negate not implemented for Angle"++instance Fractional (Angle Turn) where+  fromRational = turn . fromRational+  recip  = error  "recip not implemented for Angle"

@@ -1,4 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} module Clay.Stylesheet where  import Control.Applicative@@ -60,6 +62,10 @@ -- `StyleM` monad that just collects and doesn't return anything.  type Css = StyleM ()++instance Monoid Css where+  mempty = pure ()+  mappend = liftA2 mappend  -- | 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

@@ -145,12 +145,12 @@ -------------------------------------------------------------------------------  newtype TextAlign = TextAlign Value-  deriving (Val, Normal, Inherit, Other)+  deriving (Val, Normal, Inherit, Other, Center)  justify, matchParent, start, end :: TextAlign  justify     = TextAlign "justify"-matchParent = TextAlign "matchParent"+matchParent = TextAlign "match-parent" start       = TextAlign "start" end         = TextAlign "end" 

@@ -1,13 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where--import Test.Framework (defaultMain)-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit.Base ((@?=))--import Clay.Render (renderWith, compact)--main :: IO ()-main = defaultMain-  [ testCase "empty Clay produces empty compact CSS" $ renderWith compact [] (return ()) @?= ""-  ]