clay 0.7 → 0.8

raw patch · 9 files changed

+133/−70 lines, 9 filesdep +HUnitdep +test-frameworkdep +test-framework-hunitPVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• clay.cabal +21/−6
• src/Clay/Border.hs +24/−6
• src/Clay/Box.hs +6/−0
• src/Clay/Font.hs +1/−1
• src/Clay/Property.hs +8/−2
• src/Clay/Render.hs +52/−51
• src/Clay/Size.hs +4/−4
• src/Clay/Text.hs +4/−0
• src/Test.hs +13/−0

@@ -1,5 +1,5 @@ Name:     clay-Version:  0.7+Version:  0.8 Synopsis: CSS preprocessor as embedded Haskell. Description:   Clay is a CSS preprocessor like LESS and Sass, but implemented as an embedded@@ -11,10 +11,13 @@   .   The API documentation can be found in the top level module "Clay".   .-  > 0.6 -> 0.7-  >   - Stop printing banner in compact mode.-  >   - Generic font family as datatype.-  >   - Only drop final semicolon if doing compact printing.+  > 0.7 -> 0.8+  >   - Print prettier doubles.+  >   - Loosen type of sym functions.+  >   - Added some missing multi-side properties.+  >   - Added content URL support.+  >   - Added inset box shadows.+  >   Thanks Deck and James Fisher.  Author:        Sebastiaan Visser Maintainer:    Sebastiaan Visser <code@fvisser.nl>@@ -24,7 +27,7 @@ License:       BSD3 License-File:  LICENSE Category:      Web, Graphics-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 Build-Type:    Simple  Source-Repository head@@ -68,3 +71,15 @@     base  >= 4    && < 5,     mtl   >= 1    && < 2.2,     text  >= 0.11 && < 0.12++Test-Suite Test-Clay+  Type: exitcode-stdio-1.0+  HS-Source-Dirs: src+  Main-Is: Test.hs+  Build-Depends:+    base                 >= 4   && < 5,+    HUnit                >= 1.2 && < 1.3,+    test-framework       >= 0.8 && < 0.9,+    test-framework-hunit >= 0.3 && < 0.4+  Ghc-Options: -Wall+

@@ -8,16 +8,16 @@ -- * Border properties.  , border, borderTop, borderLeft, borderBottom, borderRight-, borderColor, borderLeftColor, borderRightColor, borderTopColor, borderBottomColor-, borderStyle, borderLeftStyle, borderRightStyle, borderTopStyle, borderBottomStyle-, borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth+, borderColor4, borderColor, borderLeftColor, borderRightColor, borderTopColor, borderBottomColor+, borderStyle4, borderStyle, borderLeftStyle, borderRightStyle, borderTopStyle, borderBottomStyle+, borderWidth4, borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth  -- * Outline properties.  , outline, outlineTop, outlineLeft, outlineBottom, outlineRight-, outlineColor, outlineLeftColor, outlineRightColor, outlineTopColor, outlineBottomColor-, outlineStyle, outlineLeftStyle, outlineRightStyle, outlineTopStyle, outlineBottomStyle-, outlineWidth, outlineLeftWidth, outlineRightWidth, outlineTopWidth, outlineBottomWidth+, outlineColor4, outlineColor, outlineLeftColor, outlineRightColor, outlineTopColor, outlineBottomColor+, outlineStyle4, outlineStyle, outlineLeftStyle, outlineRightStyle, outlineTopStyle, outlineBottomStyle+, outlineWidth4, outlineWidth, outlineLeftWidth, outlineRightWidth, outlineTopWidth, outlineBottomWidth , outlineOffset  -- * Border radius.@@ -59,6 +59,9 @@ borderBottom  a b c = key "border-bottom" (a ! b ! c) borderRight   a b c = key "border-right"  (a ! b ! c) +borderColor4 :: Color -> Color -> Color -> Color -> Css+borderColor4 a b c d = key "border-color" (a ! b ! c ! d)+ borderColor, borderLeftColor, borderRightColor, borderTopColor, borderBottomColor :: Color -> Css  borderColor       = key "border-color"@@ -67,6 +70,9 @@ borderTopColor    = key "border-top-color" borderBottomColor = key "border-bottom-color" +borderStyle4 :: Stroke -> Stroke -> Stroke -> Stroke -> Css+borderStyle4 a b c d = key "border-style" (a ! b ! c ! d)+ borderStyle, borderLeftStyle, borderRightStyle, borderTopStyle, borderBottomStyle :: Stroke -> Css  borderStyle       = key "border-style"@@ -75,6 +81,9 @@ borderTopStyle    = key "border-top-style" borderBottomStyle = key "border-bottom-style" +borderWidth4 :: Size Abs -> Size Abs -> Size Abs -> Size Abs -> Css+borderWidth4 a b c d = key "border-width" (a ! b ! c ! d)+ borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth :: Size Abs -> Css  borderWidth       = key "border-width"@@ -93,6 +102,9 @@ outlineBottom  a b c = key "outline-bottom" (a ! b ! c) outlineRight   a b c = key "outline-right"  (a ! b ! c) +outlineColor4 :: Color -> Color -> Color -> Color -> Css+outlineColor4 a b c d = key "outline-color" (a ! b ! c ! d)+ outlineColor, outlineLeftColor, outlineRightColor, outlineTopColor, outlineBottomColor :: Color -> Css  outlineColor       = key "outline-color"@@ -101,6 +113,9 @@ outlineTopColor    = key "outline-top-color" outlineBottomColor = key "outline-bottom-color" +outlineStyle4 :: Stroke -> Stroke -> Stroke -> Stroke -> Css+outlineStyle4 a b c d = key "outline-style" (a ! b ! c ! d)+ outlineStyle, outlineLeftStyle, outlineRightStyle, outlineTopStyle, outlineBottomStyle :: Stroke -> Css  outlineStyle       = key "outline-style"@@ -108,6 +123,9 @@ outlineRightStyle  = key "outline-right-style" outlineTopStyle    = key "outline-top-style" outlineBottomStyle = key "outline-bottom-style"++outlineWidth4 :: Size Abs -> Size Abs -> Size Abs -> Size Abs -> Css+outlineWidth4 a b c d = key "outline-width" (a ! b ! c ! d)  outlineWidth, outlineLeftWidth, outlineRightWidth, outlineTopWidth, outlineBottomWidth :: Size Abs -> Css 

@@ -5,6 +5,7 @@ , boxSizing , boxShadow , boxShadows+, insetBoxShadow ) where @@ -15,6 +16,7 @@ import Clay.Property import Clay.Stylesheet import Clay.Size+import Clay.Border  ------------------------------------------------------------------------------- @@ -40,3 +42,7 @@ boxShadows :: [(Size a, Size a, Size a, Color)] -> Css boxShadows = prefixed (browsers <> "box-shadow") . map (\(a, b, c, d) -> a ! b ! c ! d) +-------------------------------------------------------------------------------++insetBoxShadow :: Stroke -> Size a -> Size a -> Size a -> Color -> Css+insetBoxShadow x y w c z = prefixed (browsers <> "box-shadow") (x ! y ! w ! c ! z)

@@ -99,7 +99,7 @@   (Size a)   (Maybe (Size a))   [Text]-  [Text]+  [GenericFontFamily]  instance Val (Required a) where   value (Required a Nothing  c d) = value (a ! (Literal <$> c) ! d)

@@ -3,11 +3,11 @@  import Control.Arrow (second) import Control.Monad.Writer+import Data.Fixed (Fixed, HasResolution (resolution), showFixed) import Data.List (partition, sort) import Data.Maybe import Data.String import Data.Text (Text, replace)-import Text.Printf  data Prefixed = Prefixed [(Text, Text)] | Plain Text   deriving Show@@ -65,8 +65,14 @@ instance Val Integer where   value = fromString . show +data E5 = E5+instance HasResolution E5 where resolution _ = 100000+ instance Val Double where-  value = fromString . printf "%.5f"+  value = fromString . showFixed' . realToFrac+    where+      showFixed' :: Fixed E5 -> String+      showFixed' = showFixed True  instance Val Value where   value = id

@@ -75,36 +75,64 @@ -- used by default.  render :: Css -> Lazy.Text-render = renderWith pretty []+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)+renderWith :: Config -> Css -> Lazy.Text+renderWith cfg (S c)   = renderBanner cfg   . toLazyText-  . rules cfg top+  . cssRules cfg+  . flattenRules   . execWriter   $ c +-------------------------------------------------------------------------------++-- | The AST of a CSS3 file.++data Css3+  = Css3Query MediaQuery [Css3]+  | Css3Rule [App] [(Key (), Value)]+  | Css3Font       [(Key (), Value)]++flattenRules :: [Rule] -> [Css3]+flattenRules rules =+  let+    property p = case p of+      Property k v -> (k, v)+      _            -> error "only properties are allowed in @font-face"++    nestApp app css = case css of+      Css3Query q cs -> Css3Query q $ map (nestApp app) cs+      Css3Rule as ps -> Css3Rule (app:as) ps+      Css3Font ps    -> Css3Font ps++    (props, nests, qrys, faces) = foldr+      (\r (ps,ns,qs,fs) -> case r of+        Property k v -> ((k, v):ps,          ns,          qs,     fs)+        Nested a rs' -> (       ps, (a, rs'):ns,          qs,     fs)+        Query q  rs' -> (       ps,          ns, (q, rs'):qs,     fs)+        Face     rs' -> (       ps,          ns,          qs, rs':fs))+      ([],[],[],[])+      rules+  in+    (if null props then [] else [Css3Rule [] props])                      +++    concatMap (\(app, rs') -> map (nestApp app) (flattenRules rs')) nests +++    map       (\(q,   rs') -> Css3Query q (flattenRules rs'))       qrys  +++    map       (\      rs'  -> Css3Font $ map property rs')          faces++-------------------------------------------------------------------------------+ renderBanner :: Config -> Lazy.Text -> Lazy.Text renderBanner cfg =   if banner cfg   then (<> "\n/* Generated with Clay, http://fvisser.nl/clay */")   else id -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@@ -127,42 +155,15 @@     Just (Value v) -> mconcat       [ "(" , fromText k , ": " , fromText (plain v) , ")" ] -face :: Config -> [Rule] -> Builder-face cfg rs = mconcat-  [ "@font-face"-  , rules cfg [] rs-  ]--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-  , (\ns     -> face  cfg          ns) `foldMap` mapMaybe faces   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-        faces    (Face ns     ) = Just ns-        faces    _              = Nothing--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-      ]+cssRules :: Config -> [Css3] -> Builder+cssRules cfg = (mconcat .) $ map $ \c -> mconcat $ case c of+  Css3Query  q cs -> [ mediaQuery q,                        block $ cssRules cfg cs ]+  Css3Rule sel ps -> [ selector cfg (merger $ reverse sel), propertyBlock ps        ]+  Css3Font     ps -> [ "@font-face",                        propertyBlock ps        ]+  where+    propertyBlock = block . properties cfg . concatMap collect+    block inner = mconcat [ nl, "{", nl, inner, "}", nl, nl ]+    nl = newline cfg  merger :: [App] -> Selector merger []     = "" -- error "this should be fixed!"

@@ -21,7 +21,7 @@ , ex , pct --- * Shorthands for mutli size-valued properties.+-- * Shorthands for properties that can be applied separately to each box side.  , sym , sym2@@ -108,13 +108,13 @@  ------------------------------------------------------------------------------- -sym :: (Size a -> Size a -> Size a -> Size a -> Css) -> Size a -> Css+sym :: (a -> a -> a -> a -> Css) -> 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 :: (a -> a -> a -> a -> Css) -> a -> a -> 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 :: (a -> a -> a -> a -> Css) -> a -> a -> Css sym2 k tb lr = k tb lr tb lr  -------------------------------------------------------------------------------

@@ -67,6 +67,7 @@ , attrContent , stringContent , uriContent+, urlContent , openQuote, closeQuote, noOpenQuote, noCloseQuote  )@@ -229,6 +230,9 @@  uriContent :: Text -> Content uriContent u = Content ("uri(" <> value (Literal u) <> ")")++urlContent :: Text -> Content+urlContent u = Content ("url(" <> value (Literal u) <> ")")  openQuote, closeQuote, noOpenQuote, noCloseQuote :: Content 

@@ -0,0 +1,13 @@+{-# 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 ()) @?= ""+  ]