packages feed

clay 0.8.0.1 → 0.9

raw patch · 17 files changed

+468/−133 lines, 17 filesdep ~mtl

Dependency ranges changed: mtl

Files

clay.cabal view
@@ -1,5 +1,5 @@ Name:     clay-Version:  0.8.0.1+Version:  0.9 Synopsis: CSS preprocessor as embedded Haskell. Description:   Clay is a CSS preprocessor like LESS and Sass, but implemented as an embedded@@ -11,9 +11,19 @@   .   The API documentation can be found in the top level module "Clay".   .-  > 0.8 -> 0.8.0.1-  >   - Widened dependency on text.-  >   Thanks to bgamari.+  > 0.8 -> 0.9+  >  - Added list-style-type property.+  >  - Added some CSS3 selectors and pseudo-classes.+  >  - Added some missing HTML5 elements.+  >  - Added keyframes support.+  >  - Fixed bug in linear in transition.+  >  - Added Initial and Unset type classes.+  >  - Added animation related styling rules.+  >  - Restored old renderer.+  >  - Fixed bunch of warnings.+  >  - Added :last-child pseudo selector.+  >  - Stub test suite+  >  Thanks to Sergei Trofimovich, Levi Ad, Ian D. Bollinger, Ben Gamari and Oly Mi!   Author:        Sebastiaan Visser@@ -36,6 +46,7 @@    Exposed-Modules:     Clay+    Clay.Animation     Clay.Attributes     Clay.Background     Clay.Border@@ -50,6 +61,7 @@     Clay.FontFace     Clay.Geometry     Clay.Gradient+    Clay.List     Clay.Media     Clay.Mask     Clay.Property@@ -66,7 +78,7 @@   GHC-Options: -Wall   Build-Depends:     base  >= 4    && < 5,-    mtl   >= 1    && < 2.2,+    mtl   >= 1    && < 2.3,     text  >= 0.11 && < 1.2  Test-Suite Test-Clay@@ -74,9 +86,11 @@   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+    base                 >= 4    && < 5,+    mtl                  >= 1    && < 2.3,+    text                 >= 0.11 && < 1.2,+    HUnit                >= 1.2  && < 1.3,+    test-framework       >= 0.8  && < 0.9,+    test-framework-hunit >= 0.3  && < 0.4   Ghc-Options: -Wall
src/Clay.hs view
@@ -45,7 +45,9 @@  , attr , (@=)+, (^=) , ($=)+, (*=) , (~=) , (|=) @@ -56,6 +58,11 @@ , queryNot , queryOnly +-- * Apply key-frame animation.++, keyframes+, keyframesFromTo+ -- * Define font-faces.  , fontFace@@ -90,9 +97,11 @@ , module Clay.FontFace , module Clay.Geometry , module Clay.Gradient+, module Clay.List , module Clay.Text , module Clay.Transform , module Clay.Transition+, module Clay.Animation , module Clay.Mask , module Clay.Filter @@ -109,7 +118,7 @@ import Clay.Selector import Clay.Property -import Clay.Pseudo+import Clay.Pseudo hiding (default_, required, root, lang) import Clay.Elements hiding (link, em) import Clay.Attributes hiding   ( content, class_, target, checked, disabled@@ -129,10 +138,12 @@ import Clay.FontFace import Clay.Geometry import Clay.Gradient+import Clay.List import Clay.Size import Clay.Text       hiding (pre) import Clay.Transform import Clay.Transition+import Clay.Animation import Clay.Mask       hiding (clear) import Clay.Filter     hiding (url, opacity)
+ src/Clay/Animation.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE+    OverloadedStrings+  , GeneralizedNewtypeDeriving+  #-}+module Clay.Animation+(++-- * The animation propery.++  animation+, animations++-- * Animation-delay.++, animationDelay+, animationDelays++-- * Animation-direction.++, AnimationDirection+, animationDirection+, animationDirections+, alternate+, reverse+, alternateReverse++-- * Animation-duration.++, animationDuration+, animationDurations++, IterationCount+, animationIterationCount+, animationIterationCounts+, infinite+, iterationCount++-- * Animation-action-name.++, AnimationName+, animationName++-- * Animation-play-state.++, PlayState+, animationPlayState+, running+, paused++-- * Animation-fill-mode.++, FillMode+, animationFillMode+, forwards+, backwards++-- * Animation-timing-function.++, animationTimingFunction++)+where++import Data.Monoid+import Data.String (IsString)+import Prelude hiding (reverse)++import Clay.Common+import Clay.Property+import Clay.Stylesheet+import Clay.Time+import Clay.Transition+++animation+  :: AnimationName+  -> Time+  -> TimingFunction+  -> Time+  -> IterationCount+  -> AnimationDirection+  -> FillMode+  -> Css+animation p de f du i di fm = prefixed (browsers <> "animation") (p ! de ! f ! du ! i ! di ! fm)++animations+  :: [ ( AnimationName+       , Time+       , TimingFunction+       , Time+       , IterationCount+       , AnimationDirection+       , FillMode+       )+     ] -> Css+animations = prefixed (browsers <> "animation")+            . map (\(p, de, f, du, i, di, fm) -> value (p ! de ! f ! du ! i ! di ! fm))++-------------------------------------------------------------------------------++animationDelay :: Time -> Css+animationDelay = prefixed (browsers <> "animation-delay")++animationDelays :: [Time] -> Css+animationDelays = prefixed (browsers <> "animation-delay")++-------------------------------------------------------------------------------++newtype AnimationDirection = AnimationDirection Value+  deriving (Val, Other, Normal)++animationDirection :: AnimationDirection -> Css+animationDirection = prefixed (browsers <> "animation-direction")++animationDirections :: [AnimationDirection] -> Css+animationDirections = prefixed (browsers <> "animation-direction")++alternate, reverse, alternateReverse :: AnimationDirection+alternate        = AnimationDirection "alternate"+reverse          = AnimationDirection "reverse"+alternateReverse = AnimationDirection "alternate-reverse"++-------------------------------------------------------------------------------++animationDuration :: Time -> Css+animationDuration = prefixed (browsers <> "animation-duration")++animationDurations :: [Time] -> Css+animationDurations = prefixed (browsers <> "animation-duration")++-------------------------------------------------------------------------------++newtype IterationCount = IterationCount Value+  deriving (Val, Other, Normal)++animationIterationCount :: IterationCount -> Css+animationIterationCount = prefixed (browsers <> "animation-iteration-count")++animationIterationCounts :: [IterationCount] -> Css+animationIterationCounts = prefixed (browsers <> "animation-iteration-count")++infinite :: IterationCount+infinite = IterationCount "infinite"++iterationCount :: Double -> IterationCount+iterationCount = IterationCount . value++-------------------------------------------------------------------------------++newtype AnimationName = AnimationName Value+  deriving (Val, Other, IsString, Initial, Inherit, Unset)++animationName :: AnimationName -> Css+animationName = prefixed (browsers <> "animation-name")++-------------------------------------------------------------------------------++newtype PlayState = PlayState Value+  deriving (Val, Other)++animationPlayState :: PlayState -> Css+animationPlayState = prefixed (browsers <> "animation-play-state")++running, paused :: PlayState+running = PlayState "running"+paused  = PlayState "paused"++-------------------------------------------------------------------------------++newtype FillMode = FillMode Value+  deriving (Val, Other, None)++animationFillMode :: FillMode -> Css+animationFillMode = prefixed (browsers <> "animation-fill-mode")++forwards, backwards :: FillMode+forwards  = FillMode "forwards"+backwards = FillMode "backwards"++-------------------------------------------------------------------------------++animationTimingFunction :: TimingFunction -> Css+animationTimingFunction = prefixed (browsers <> "animation-timing-function")+
src/Clay/Common.hs view
@@ -15,13 +15,15 @@  ------------------------------------------------------------------------------- -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 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  -- | 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@@ -37,6 +39,8 @@ 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"  -------------------------------------------------------------------------------
src/Clay/Dynamic.hs view
@@ -37,7 +37,6 @@ import Clay.Property import Clay.Stylesheet import Data.Monoid hiding (All)-import Prelude (($))  -------------------------------------------------------------------------------- -- Enabling user interface elements: the 'user-input' property
src/Clay/Elements.hs view
@@ -26,11 +26,11 @@   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+  img, input, ins, kbd, keygen, legend, li, link, main_, map, mark, math, 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, svg, table, tbody, td, template, textarea,+  tfoot, th, thead, time, tr, track, u, ul, var, video, wbr :: Selector  a = "a" address = "address"@@ -87,11 +87,13 @@ legend = "legend" li = "li" link = "link"+main_ = "main" map = "map" mark = "mark" menu = "menu" meta = "meta" meter = "meter"+math = "math" nav = "nav" noscript = "noscript" object = "object"@@ -118,9 +120,11 @@ sub = "sub" summary = "summary" sup = "sup"+svg = "svg" table = "table" tbody = "tbody" td = "td"+template = "template" textarea = "textarea" tfoot = "tfoot" th = "th"
src/Clay/Geometry.hs view
@@ -17,8 +17,6 @@ ) where -import Prelude hiding (Left, Right)- import Clay.Property import Clay.Stylesheet import Clay.Size
+ src/Clay/List.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Clay.List+( ListStyleType+, listStyleType+, disc+, decimal+, hiragana+)+where++import Clay.Common+import Clay.Property+import Clay.Stylesheet++newtype ListStyleType = ListStyleType Value+  deriving (Val, Initial, Inherit, None, Other)++disc, decimal, hiragana  :: ListStyleType++disc        = ListStyleType "disc"+decimal     = ListStyleType "decimal"+hiragana    = ListStyleType "hiragana"++listStyleType :: ListStyleType -> Css+listStyleType = key "list-style-type"
src/Clay/Property.hs view
@@ -9,7 +9,7 @@ import Data.String import Data.Text (Text, replace) -data Prefixed = Prefixed [(Text, Text)] | Plain Text+data Prefixed = Prefixed { unPrefixed :: [(Text, Text)] } | Plain { unPlain :: Text }   deriving Show  instance IsString Prefixed where
src/Clay/Pseudo.hs view
@@ -13,7 +13,7 @@ after  = ":after" before = ":before" -link, visited, active, hover, focus, firstChild :: Refinement+link, visited, active, hover, focus, firstChild, lastChild :: Refinement  link       = ":link" visited    = ":visited"@@ -21,20 +21,35 @@ hover      = ":hover" focus      = ":focus" firstChild = ":first-child"--firstOfType, lastOfType, empty, target, checked, enabled, disabled :: Refinement+lastChild  = ":last-child" -firstOfType = ":first-of-type"-lastOfType  = ":last-of-type"-empty       = ":empty"-target      = ":target"-checked     = ":checked"-enabled     = ":enabled"-disabled    = ":disabled"+checked, default_, disabled, empty, enabled, firstOfType, indeterminate,+  inRange, invalid, lastOfType, onlyChild, onlyOfType, optional,+  outOfRange, required, root, target, valid :: Refinement -nthChild, nthLastChild, nthOfType :: Text -> Refinement+checked       = ":checked"+default_      = ":default"+disabled      = ":disabled"+empty         = ":empty"+enabled       = ":enabled"+firstOfType   = ":first-of-type"+indeterminate = ":indeterminate"+inRange       = ":in-range"+invalid       = ":invalid"+lastOfType    = ":last-of-type"+onlyChild     = ":only-child"+onlyOfType    = ":only-of-type"+optional      = ":optional"+outOfRange    = ":out-of-range"+required      = ":required"+root          = ":root"+target        = ":target"+valid         = ":valid" -nthChild     n = func "nth-child"      [n]-nthLastChild n = func "nth-last-child" [n]-nthOfType    n = func "nth-of-type"    [n]+lang, nthChild, nthLastChild, nthLastOfType, nthOfType :: Text -> Refinement +lang          n = func "lang"             [n]+nthChild      n = func "nth-child"        [n]+nthLastChild  n = func "nth-last-child"   [n]+nthLastOfType n = func "nth-last-of-type" [n]+nthOfType     n = func "nth-of-type"      [n]
src/Clay/Render.hs view
@@ -15,7 +15,7 @@ import Data.Foldable (foldMap) import Data.List (sort) import Data.Maybe-import Data.Text (Text)+import Data.Text (Text, pack) import Data.Text.Lazy.Builder import Prelude hiding ((**)) @@ -23,7 +23,8 @@ import qualified Data.Text.Lazy    as Lazy import qualified Data.Text.Lazy.IO as Lazy -import Clay.Stylesheet hiding (Child, query)+import Clay.Stylesheet hiding (Child, query, rule)+import Clay.Common (browsers) import Clay.Property import Clay.Selector @@ -75,64 +76,62 @@ -- 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 -> Css -> Lazy.Text-renderWith cfg (S c)+renderWith :: Config -> [App] -> Css -> Lazy.Text+renderWith cfg top   = renderBanner cfg   . toLazyText-  . cssRules cfg-  . flattenRules-  . execWriter-  $ c+  . rules cfg top+  . runS  ------------------------------------------------------------------------------- --- | 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+  | banner cfg = (<> b)+  | otherwise  = id+  where b = "\n/* Generated with Clay, http://fvisser.nl/clay */" --------------------------------------------------------------------------------+kframe :: Config -> Keyframes -> Builder+kframe cfg (Keyframes ident xs) =+  foldMap+    ( \(browser, _) ->+      mconcat [ "@" <> fromText browser <> "keyframes "+              , fromText ident+              , newline cfg+              , "{"+              , newline cfg+              , foldMap (frame cfg) xs+              , "}"+              , newline cfg+              , newline cfg+              ]+    )+    (unPrefixed browsers) -renderBanner :: Config -> Lazy.Text -> Lazy.Text-renderBanner cfg =-  if banner cfg-  then (<> "\n/* Generated with Clay, http://fvisser.nl/clay */")-  else id+frame :: Config -> (Double, [Rule]) -> Builder+frame cfg (p, rs) =+  mconcat+    [ fromText (pack (show p))+    , "% "+    , rules cfg [] rs+    ] --------------------------------------------------------------------------------+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@@ -155,16 +154,46 @@     Just (Value v) -> mconcat       [ "(" , fromText k , ": " , fromText (plain v) , ")" ] -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+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+  ,             kframe cfg              `foldMap` mapMaybe kframes rs+  ,             face   cfg              `foldMap` mapMaybe faces   rs+  , (\(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+        kframes  (Keyframe fs ) = Just fs;+        kframes  _              = 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+      ]+ merger :: [App] -> Selector merger []     = "" -- error "this should be fixed!" merger (x:xs) =@@ -192,9 +221,13 @@       finalSemi = if finalSemicolon cfg then ";" else ""    in (<> new) $ (<> finalSemi) $ intersperse (";" <> new) $ flip map xs $ \p ->         case p of-          Left w -> if warn cfg then ind <> "/* no value for " <> fromText w <> " */" <> new else mempty+          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 ""+            let pad = if align cfg+                      then fromText (Text.replicate (width - Text.length k) " ")+                      else ""              in mconcat [ind, fromText k, pad, ":", sep cfg, fromText v]  selector :: Config -> Selector -> Builder@@ -212,13 +245,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, "']"                    ]-    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), ")" ]+    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), ")" ]+
src/Clay/Selector.hs view
@@ -102,12 +102,24 @@ (@=) :: Text -> Text -> Refinement (@=) a = Refinement . pure . AttrVal a +-- | Filter elements based on the presence of a certain attribute that begins+-- with the selected value.++(^=) :: Text -> Text -> Refinement+(^=) a = Refinement . pure . AttrBegins 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 contains+-- the specified value as a substring.++(*=) :: Text -> Text -> Refinement+(*=) a = Refinement . pure . AttrContains a+ -- | Filter elements based on the presence of a certain attribute that have the -- specified value contained in a space separated list. @@ -123,15 +135,17 @@ -------------------------------------------------------------------------------  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]+  = Id           Text+  | Class        Text+  | Attr         Text+  | AttrVal      Text Text+  | AttrBegins   Text Text+  | AttrEnds     Text Text+  | AttrContains Text Text+  | AttrSpace    Text Text+  | AttrHyph     Text Text+  | Pseudo       Text+  | PseudoFunc   Text [Text]   deriving (Eq, Ord, Show)  newtype Refinement = Refinement { unFilter :: [Predicate] }
src/Clay/Size.hs view
@@ -92,9 +92,11 @@   (*)    = error  "times not implemented for Size"   abs    = error    "abs not implemented for Size"   signum = error "signum not implemented for Size"+  negate = error "negate not implemented for Size"  instance Fractional (Size Abs) where   fromRational = em . fromRational+  recip  = error  "recip not implemented for Size"  instance Num (Size Rel) where   fromInteger = pct . fromInteger@@ -102,9 +104,11 @@   (*)    = error  "times not implemented for Size"   abs    = error    "abs not implemented for Size"   signum = error "signum not implemented for Size"+  negate = error "negate not implemented for Size"  instance Fractional (Size Rel) where   fromRational = pct . fromRational+  recip  = error  "recip not implemented for Size"  ------------------------------------------------------------------------------- @@ -141,9 +145,11 @@   (*)    = 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 Deg) where   fromRational = deg . fromRational+  recip  = error  "recip not implemented for Angle"  instance Num (Angle Rad) where   fromInteger = rad . fromInteger@@ -151,7 +157,9 @@   (*)    = 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 Rad) where   fromRational = rad . fromRational+  recip  = error  "recip not implemented for Angle"
src/Clay/Stylesheet.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Clay.Stylesheet where -import Data.Text (Text)+import Control.Applicative+import Control.Arrow (second) import Control.Monad.Writer hiding (All)+import Data.Text (Text)  import Clay.Selector hiding (Child) import Clay.Property@@ -32,16 +34,26 @@   | Sub    Selector   deriving Show +data Keyframes = Keyframes Text [(Double, [Rule])]+  deriving Show+ data Rule   = Property (Key ()) Value   | Nested   App [Rule]   | Query    MediaQuery [Rule]   | Face     [Rule]+  | Keyframe Keyframes   deriving Show  newtype StyleM a = S (Writer [Rule] a)-  deriving Monad+  deriving (Functor, Applicative, Monad) +runS :: Css -> [Rule]+runS (S a) = execWriter a++rule :: Rule -> Css+rule a = S (tell [a])+ -- | 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.@@ -53,7 +65,7 @@ -- words: can be converted to a `Value`.  key :: Val a => Key a -> a -> Css-key k v = S $ tell [Property (cast k) (value v)]+key k v = rule $ 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.@@ -80,51 +92,60 @@ -- outer scope it will be composed with `deep`.  (?) :: Selector -> Css -> Css-(?) sel (S rs) = S (tell [Nested (Sub sel) (execWriter rs)])+(?) sel rs = rule $ Nested (Sub sel) (runS 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)])+(<?) sel rs = rule $ Nested (Child sel) (runS 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)])+(&) p rs = rule $ Nested (Self p) (runS 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)])+root sel rs = rule $ Nested (Root sel) (runS 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)])+pop i rs = rule $ Nested (Pop i) (runS 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)])+query ty fs rs = rule $ Query (MediaQuery Nothing ty fs) (runS 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)])+queryNot ty fs rs = rule $ Query (MediaQuery (Just Not) ty fs) (runS 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)])+queryOnly ty fs rs = rule $ Query (MediaQuery (Just Only) ty fs) (runS rs)  ------------------------------------------------------------------------------- +keyframes :: Text -> [(Double, Css)] -> Css+keyframes n xs = rule $ Keyframe (Keyframes n (map (second runS) xs))++keyframesFromTo :: Text -> Css -> Css -> Css+keyframesFromTo n a b = keyframes n [(0, a), (100, b)]++-------------------------------------------------------------------------------+ -- | Define a new font-face.  fontFace :: Css -> Css-fontFace (S rs) = S (tell [Face (execWriter rs)])+fontFace rs = rule $ Face (runS rs)+
src/Clay/Time.hs view
@@ -39,7 +39,9 @@   (*)    = error  "times not implemented for Time"   abs    = error    "abs not implemented for Time"   signum = error "signum not implemented for Time"+  negate = error "negate not implemented for Time"  instance Fractional Time where   fromRational = sec . fromRational+  recip  = error  "recip not implemented for Time"
src/Clay/Transition.hs view
@@ -24,7 +24,7 @@  , TimingFunction , transitionTimingFunction-, ease, easeIn, easeOut, easeInOut, easeLinear, stepStart, stepStop+, ease, easeIn, easeOut, easeInOut, linear, stepStart, stepStop , stepsStart, stepsStop , cubicBezier @@ -71,13 +71,13 @@ newtype TimingFunction = TimingFunction Value   deriving (Val, Other, Auto) -ease, easeIn, easeOut, easeInOut, easeLinear, stepStart, stepStop :: TimingFunction+ease, easeIn, easeOut, easeInOut, linear, stepStart, stepStop :: TimingFunction  ease       = other "ease" easeIn     = other "easeIn" easeOut    = other "easeOut" easeInOut  = other "easeInOut"-easeLinear = other "easeLinear"+linear     = other "linear" stepStart  = other "stepStart" stepStop   = other "stepStop"
src/Test.hs view
@@ -9,5 +9,5 @@  main :: IO () main = defaultMain-  [ testCase "empty Clay produces empty compact CSS" $ renderWith compact (return ()) @?= ""+  [ testCase "empty Clay produces empty compact CSS" $ renderWith compact [] (return ()) @?= ""   ]