clay 0.10.1 → 0.16.1
raw patch · 35 files changed
Files
- CHANGELOG +163/−0
- CONTRIBUTING.md +53/−0
- README.md +13/−0
- clay.cabal +36/−24
- spec/Spec.hs +4/−0
- src/Clay.hs +32/−2
- src/Clay/Animation.hs +1/−1
- src/Clay/Background.hs +4/−3
- src/Clay/Border.hs +14/−7
- src/Clay/Box.hs +134/−5
- src/Clay/Color.hs +116/−19
- src/Clay/Comments.hs +29/−0
- src/Clay/Common.hs +89/−26
- src/Clay/Display.hs +108/−30
- src/Clay/Filter.hs +9/−9
- src/Clay/Flexbox.hs +120/−0
- src/Clay/Font.hs +2/−1
- src/Clay/FontFace.hs +8/−3
- src/Clay/Geometry.hs +103/−1
- src/Clay/Gradient.hs +3/−5
- src/Clay/Grid.hs +775/−0
- src/Clay/List.hs +1/−2
- src/Clay/Mask.hs +0/−2
- src/Clay/Media.hs +42/−6
- src/Clay/Property.hs +30/−17
- src/Clay/Pseudo.hs +32/−3
- src/Clay/Render.hs +117/−66
- src/Clay/Selector.hs +29/−18
- src/Clay/Size.hs +247/−40
- src/Clay/Stylesheet.hs +51/−5
- src/Clay/Text.hs +197/−8
- src/Clay/Time.hs +0/−1
- src/Clay/Transform.hs +61/−17
- src/Clay/Transition.hs +22/−12
- src/Test.hs +0/−13
+ CHANGELOG view
@@ -0,0 +1,163 @@+CHANGELOG++ 0.16.1:+ - Add support for overscroll-behaviour+ Thanks to Sylvain Henry++ 0.16.0:+ - Add grid size and location support.+ - Derive `Stretch` for justified content+ - Add `AspectRatio`+ - Promote `not` to a type class+ - Render CSS refinements+ - Bugfixes & improved test suite+ Thanks to Leonard Monnier, Yoo Chung, Skyfold, qwbarch, David Fox++ 0.15.0:+ - Add `all` media type.+ - Support `prefers-color-scheme` media feature.+ - Use `matrix` rather than `matrix3d`+ - Add media type `all`+ - Add some relative units+ - Add CSS properties related to hyphenation+ - Use `Number` type instead of `Double` as an argument type in many places+ - Fix rendering of `Number` type+ Thanks to Yoo Chung, Charles Bayley and David Fox++ 0.14.0:+ - Drop support for GHC 8.2+ - Added `text-align-last`+ - Fix typo in `stepsStart`+ - Added clay-examples+ - Fix `cubicBezier` and other issues+ Thanks to Vasiliy Yorkin, Florian Grignon, Nick Saunders, David Fox, Ben Sima, Murakami Kennzo, Owen Shepherd, Anton Gushcha, Temur Saidkhodjaev, Rob Bassi, Alex Sayers, and further contributors.++ 0.13.3:+ - Improve README+ - Relax types for `sym2` and `sym3` combinators+ - Add new cursors+ Thanks to Sridhar Ratnakumar, Brad Ediger and Alexandre Esteves.++ 0.13.2:+ - Bump hspec versions+ Thanks to Julien Dehos and Sean Parsons.++ 0.13.1:+ - 'Clay.Size': Add 'sticky: Position'.+ - Adhere to Semigroup-Monoid-Hierarchy+ - 'Clay.Transition': Add 'stepEnd: TimingFunction'+ Thanks to Sean Parsons, Elliot Cameron, Simon Jakobi and Olivier Sohn.++ 0.13.0:+ - Added commenting to append comment to a property.+ - Comments are displayed by default in pretty but not compact mode.+ - Rewrite boxShadow functionality with BoxShadow newtype for arguments.+ - Added 'important' to append !important to values.+ - Update eachLine and hanging to work as spec (for textIndent).+ - Rename (internal) intersperse function to intercalate.+ - Not pseudo takes selector.+ Thanks to dbaynard and sebastiaanvisser.++ 0.10 -> 0.10.1+ - Expose a render function for single selectors.+ - Added super for vertical-align.+ - Added support for border-collapse.+ - Allow initial for the content property.+ - Added support for CSS import.+ Thanks to Heather, Collin J. Doering, Fraser Murray and Jonathan Fischoff.++ 0.9 -> 0.10+ - Bumped up text requirement.+ - Added cursor property.+ - Added vertical-align property.+ - Removed Abs constraint from Geometry functions.+ - Added support for rem dimensions.+ - Added support for ListStyle.+ Thanks to Lorenzo Bolla, Fraser Murray, Heather and Sergey!++ 0.9 -> 0.9.0.1+ - Fixed bug in easing properties.++ 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!++ 0.8 -> 0.8.0.1+ - Widened dependency on text.+ Thanks to bgamari.++ 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.++ 0.6 -> 0.7+ - Stop printing banner in compact mode.+ - Generic font family as datatype.+ - Only drop final semicolon if doing compact printing.++ 0.5.1 -> 0.6+ - Simplified implementation of size rendering.+ - Implemented @font-face construct. By James Fisher.+ - Make hsl(a) colors actually print percentage values.+ - Changed the renderer to haul @font-face to the top level.++ 0.5 -> 0.5.1+ - Fixed bug in fontFamily renderer.++ 0.4 -> 0.5+ - Generalized the borderRadius function.+ - Fixed some small issues in Dynamic.++ 0.3 -> 0.4+ - Added dynamic presentation. (thanks to chrisdone)+ - Float now has its own value, don't incorrectly share side. (thanks to chrisdone)+ - Added nil size constructor.+ - Slightly improved the gradient syntax.+ - Expose the Propery module by default.+ - Introduced shared 'all' value.++ 0.2 -> 0.3+ - Fixed value grammar of radial gradients.+ - Added mask related properties.+ - Allow multiple box-shadows.+ - Added filter property.+ - Also render value prefix when both key and value are prefixed.++ 0.1.1 -> 0.2+ - Rotate takes only one argument.+ - Added opacity property.+ - Print Clay banner in CSS comments by default.+ - Fixed bug in font-family rendering (Firefox only).+ - Added outline related properties.+ - Fixed bug in monospace font family.++ 0.1 -> 0.1.1+ - Fixed bug in visibility property.+ Thanks to Conrad Indiono for the pull request.++ 0.0.1 -> 0.1++ - Fixed bug in combined selector rendering.+ - Fixed bug in font familty fallback category rendering.+ - Added maxWidth and maxHeight.+ - Fixed example code.+ - Fixed overflowX/overflowY bug.+ - Added some show instance for debugging purposes.+ - Don't print the star (*) selector in the case of refinements.+ - Refinements applied to the top level magically introduce star selector.+ Thanks to listx, bergmark, Cynede, chrisdone, Primigenus, Sigrlami for the+ pull requests and bug reports.
+ CONTRIBUTING.md view
@@ -0,0 +1,53 @@+# Build setup++Ideally, you build this project with [`nix`](https://nixos.org/nix/):++```+git clone git@github.com:sebastiaanvisser/clay.git+cd clay+nix-build+```++This will build `clay` for the current default version of GHC.+To build for a particular version,+set the `GHC_VERSION` environment variable:++```+GHC_VERSION=ghc881 nix-build+```++To find out which GHC versions our nix setup provides:++```+$ nix eval '(builtins.attrNames (import (builtins.fetchTarball (import ./nix/nixpkgs.nix)) {}).haskell.compiler)'+[ "ghc8102Binary" "ghc8102BinaryMinimal" "ghc8104" "ghc865Binary" "ghc884" "ghc901" "ghcHEAD" "integer-simple" "native-bignum" ]+```++# Building your pull request++You are heartily encouraged to close an issue by contributing a pull request that fixes it :)+To test whether your fix will build,+ideally you should build it for all GHC versions:++```+nix-build all-ghcs.nix+```++You can see all supported versions in `.travis.yml`.+If your fix breaks an older version, do not despair.+As long as the last three versions work,+you can delete older GHC versions from `.travis.yml` in your pull request,+and deprecation of that version will be considered.++If you fix an important bug or contribute a new feature,+consider adding a line to `CHANGELOG` describing what you have changed.++# Running tests locally++Tests will be run with the above `nix-build` calls, but if you want to run them+without doing a full nix build, you can do so with cabal:++```+nix-shell+cabal test+```
+ README.md view
@@ -0,0 +1,13 @@+# Clay++[](https://github.com/sebastiaanvisser/clay/actions/workflows/ci.yml)+[](https://hackage.haskell.org/package/clay)++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 [the project homepage](http://fvisser.nl/clay).++The API documentation can be found in the top level module `Clay`.
clay.cabal view
@@ -1,5 +1,5 @@ Name: clay-Version: 0.10.1+Version: 0.16.1 Synopsis: CSS preprocessor as embedded Haskell. Description: Clay is a CSS preprocessor like LESS and Sass, but implemented as an embedded@@ -10,14 +10,6 @@ The project is described on <http://fvisser.nl/clay>. . The API documentation can be found in the top level module "Clay".- .- > 0.10 -> 0.10.1- > - Expose a render function for single selectors.- > - Added super for vertical-align.- > - Added support for border-collapse.- > - Allow initial for the content property.- > - Added support for CSS import.- > Thanks to Heather, Collin J. Doering, Fraser Murray and Jonathan Fischoff. Author: Sebastiaan Visser@@ -28,9 +20,25 @@ License: BSD3 License-File: LICENSE Category: Web, Graphics-Cabal-Version: >= 1.8+Cabal-Version: >= 1.10 Build-Type: Simple +Extra-Source-Files:+ README.md CHANGELOG CONTRIBUTING.md++Tested-With:+ GHC==8.4.4,+ GHC==8.6.5,+ GHC==8.8.4,+ GHC==8.10.7,+ GHC==9.0.2,+ GHC==9.2.2,+ GHC==9.4.2,+ GHC==9.6.6,+ GHC==9.8.1,+ GHC==9.10.1,+ GHC==9.12.1+ Source-Repository head Type: git Location: git://github.com/sebastiaanvisser/clay.git@@ -46,15 +54,18 @@ Clay.Border Clay.Box Clay.Color+ Clay.Comments Clay.Common Clay.Dynamic Clay.Display Clay.Elements Clay.Filter+ Clay.Flexbox Clay.Font Clay.FontFace Clay.Geometry Clay.Gradient+ Clay.Grid Clay.List Clay.Media Clay.Mask@@ -69,22 +80,23 @@ Clay.Transform Clay.Transition - GHC-Options: -Wall Build-Depends:- base >= 4 && < 5,- mtl >= 1 && < 2.3,- text >= 0.11 && < 1.3+ base >= 4.11 && < 4.22,+ mtl >= 1,+ text >= 0.11+ GHC-Options: -Wall -Wcompat+ Default-Language: Haskell2010 Test-Suite Test-Clay Type: exitcode-stdio-1.0- HS-Source-Dirs: src- Main-Is: Test.hs+ HS-Source-Dirs: spec, src+ Build-Tools: hspec-discover+ 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- Ghc-Options: -Wall-+ base >= 4.11 && < 4.22,+ mtl >= 1,+ text >= 0.11,+ hspec >= 2.2.0,+ hspec-discover >= 2.2.0+ GHC-Options: -Wall -Wcompat+ Default-Language: Haskell2010
+ spec/Spec.hs view
@@ -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
src/Clay.hs view
@@ -22,6 +22,10 @@ , (-:) +-- ** Comments+-- $comments+, commenting+ -- * The selector language. , Selector@@ -35,6 +39,7 @@ , (|>) , (#) , (|+)+, (|~) -- ** Refining selectors. @@ -69,8 +74,12 @@ , fontFace --- * Import other CSS files+-- * !important +, important++-- * Import other CSS files+ , importUrl -- * Pseudo elements and classes.@@ -99,10 +108,12 @@ , module Clay.Box , module Clay.Display , module Clay.Dynamic+, module Clay.Flexbox , module Clay.Font , module Clay.FontFace , module Clay.Geometry , module Clay.Gradient+, module Clay.Grid , module Clay.List , module Clay.Text , module Clay.Transform@@ -117,7 +128,7 @@ ) where -import Prelude hiding ((**))+import Prelude () import Clay.Render import Clay.Stylesheet@@ -137,13 +148,16 @@ import Clay.Box import Clay.Color import Clay.Time+import Clay.Comments (commenting) 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 import Clay.Gradient+import Clay.Grid import Clay.List import Clay.Size import Clay.Text hiding (pre)@@ -158,3 +172,19 @@ -- 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.++-- $comments+--+-- It is occasionally useful to output comments in the generated css.+-- 'commenting' appends comments (surrounded by '@ /* @' and '@ */@') to the+-- values of the supplied 'Css' as+--+-- > key: value /* comment */;+--+-- Placing the comments before the semicolon ensures they are obviously+-- grouped with the preceding value when rendered compactly.+--+-- Note that /every/ generated line in the generated content will feature the+-- comment.+--+-- An empty comment generates '@/* */@'.
src/Clay/Animation.hs view
@@ -142,7 +142,7 @@ infinite :: IterationCount infinite = IterationCount "infinite" -iterationCount :: Double -> IterationCount+iterationCount :: Number -> IterationCount iterationCount = IterationCount . value -------------------------------------------------------------------------------
src/Clay/Background.hs view
@@ -84,6 +84,8 @@ , Location , Loc+, Val+, location ) where @@ -143,13 +145,12 @@ ------------------------------------------------------------------------------- newtype BackgroundSize = BackgroundSize Value- deriving (Val, Other, Inherit)+ deriving (Val, Other, Inherit, Contain) instance Auto BackgroundSize where auto = auto `by` auto -contain, cover :: BackgroundSize+cover :: BackgroundSize -contain = BackgroundSize "contain" cover = BackgroundSize "cover" by :: Size a -> Size b -> BackgroundSize
src/Clay/Border.hs view
@@ -28,6 +28,7 @@ -- * Collapsing borders model for a table , borderCollapse+, borderSpacing, borderSpacing2 ) where @@ -55,7 +56,7 @@ ------------------------------------------------------------------------------- -border, borderTop, borderLeft, borderBottom, borderRight :: Stroke -> Size Abs -> Color -> Css+border, borderTop, borderLeft, borderBottom, borderRight :: Size LengthUnit -> Stroke -> Color -> Css border a b c = key "border" (a ! b ! c) borderTop a b c = key "border-top" (a ! b ! c)@@ -85,10 +86,10 @@ borderTopStyle = key "border-top-style" borderBottomStyle = key "border-bottom-style" -borderWidth4 :: Size Abs -> Size Abs -> Size Abs -> Size Abs -> Css+borderWidth4 :: Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css borderWidth4 a b c d = key "border-width" (a ! b ! c ! d) -borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth :: Size Abs -> Css+borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth :: Size LengthUnit -> Css borderWidth = key "border-width" borderLeftWidth = key "border-left-width"@@ -98,7 +99,7 @@ ------------------------------------------------------------------------------- -outline, outlineTop, outlineLeft, outlineBottom, outlineRight :: Stroke -> Size Abs -> Color -> Css+outline, outlineTop, outlineLeft, outlineBottom, outlineRight :: Stroke -> Size LengthUnit -> Color -> Css outline a b c = key "outline" (a ! b ! c) outlineTop a b c = key "outline-top" (a ! b ! c)@@ -128,10 +129,10 @@ outlineTopStyle = key "outline-top-style" outlineBottomStyle = key "outline-bottom-style" -outlineWidth4 :: Size Abs -> Size Abs -> Size Abs -> Size Abs -> Css+outlineWidth4 :: Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css outlineWidth4 a b c d = key "outline-width" (a ! b ! c ! d) -outlineWidth, outlineLeftWidth, outlineRightWidth, outlineTopWidth, outlineBottomWidth :: Size Abs -> Css+outlineWidth, outlineLeftWidth, outlineRightWidth, outlineTopWidth, outlineBottomWidth :: Size LengthUnit -> Css outlineWidth = key "outline-width" outlineLeftWidth = key "outline-left-width"@@ -139,7 +140,7 @@ outlineTopWidth = key "outline-top-width" outlineBottomWidth = key "outline-bottom-width" -outlineOffset :: Size Abs -> Css+outlineOffset :: Size LengthUnit -> Css outlineOffset = key "outline-offset" -------------------------------------------------------------------------------@@ -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)
src/Clay/Box.hs view
@@ -3,13 +3,24 @@ ( BoxType , paddingBox, borderBox, contentBox , boxSizing+-- * @box-shadow@+-- $box-shadow , boxShadow+, shadow+, shadowWithBlur+, shadowWithSpread+, bsInset+, bsColor+-- ** Deprecated+-- $box-shadow-deprecated+, boxShadow'+, boxShadowWithSpread , boxShadows , insetBoxShadow ) where -import Data.Monoid+import Data.List.NonEmpty (NonEmpty) import Clay.Color import Clay.Common@@ -36,13 +47,131 @@ ------------------------------------------------------------------------------- -boxShadow :: Size a -> Size a -> Size a -> Color -> Css-boxShadow x y w c = prefixed (browsers <> "box-shadow") (x ! y ! w ! c)+-- $box-shadow+--+-- === Formal argument syntax+--+-- > none | <shadow>#+-- > where +-- > <shadow> = inset? && <length>{2,4} && <color>?+-- > +-- > where +-- > <color> = <rgb()> | <rgba()> | <hsl()> | <hsla()> | <hex-color> | <named-color> | currentcolor | <deprecated-system-color>+-- > +-- > where +-- > <rgb()> = rgb( [ [ <percentage>{3} | <number>{3} ] [ / <alpha-value> ]? ] | [ [ <percentage>#{3} | <number>#{3} ] , <alpha-value>? ] )+-- > <rgba()> = rgba( [ [ <percentage>{3} | <number>{3} ] [ / <alpha-value> ]? ] | [ [ <percentage>#{3} | <number>#{3} ] , <alpha-value>? ] )+-- > <hsl()> = hsl( [ <hue> <percentage> <percentage> [ / <alpha-value> ]? ] | [ <hue>, <percentage>, <percentage>, <alpha-value>? ] )+-- > <hsla()> = hsla( [ <hue> <percentage> <percentage> [ / <alpha-value> ]? ] | [ <hue>, <percentage>, <percentage>, <alpha-value>? ] )+-- > +-- > where +-- > <alpha-value> = <number> | <percentage>+-- > <hue> = <number> | <angle> -boxShadows :: [(Size a, Size a, Size a, Color)] -> Css-boxShadows = prefixed (browsers <> "box-shadow") . map (\(a, b, c, d) -> a ! b ! c ! d)+newtype BoxShadow = BoxShadow Value+ deriving (Val, Inherit, Initial, Unset, None, Other) +-- | This function will usually take a singleton list, but requiring a (non-empty)+-- list prevents accidentally applying the modifiers ('bsInset', 'bsColor')+-- incorrectly.+--+-- 'pure' (from "Control.Applicative") creates a singleton list.+--+-- > boxShadow . pure $ none+-- > boxShadow . pure $ shadow (px 1) (px 1)+--+-- Use with @{-# LANGUAGE OverloadedLists #-}@ for the simplest list syntax.+-- Note that sometimes when @{-# LANGUAGE OverloadedLists #-}@ is active, GHC+-- has troubles identifying what type the list should be converted to. Examples:+-- 1) "forM_ [0..10] $ \x -> ..."+-- 2) "[left, top, right, bottom] `forM_` ($ pct 4)"+--+-- > boxShadow [none]+-- > boxShadow [shadow (px 1) (px 1)]+--+-- This is recommended for supplying multiple 'BoxShadow' values.+--+-- > boxShadow [shadowWithBlur (em 2) (em 1), bsInset . bsColor red $ shadow (px 1) (px 2)]+boxShadow :: NonEmpty BoxShadow -> Css+boxShadow = prefixed (browsers <> "box-shadow") . value++shadow+ :: Size a -- ^ Horizontal offset+ -> Size a -- ^ Vertical offset+ -> BoxShadow+shadow x y = BoxShadow . value $ (x ! y)++shadowWithBlur+ :: Size a -- ^ Horizontal offset+ -> Size a -- ^ Vertical offset+ -> Size a -- ^ Blur radius+ -> BoxShadow+shadowWithBlur x y w = BoxShadow . value $ (x ! y ! w)++-- | While this function is the correct type to work with the 'sym', 'sym2'+-- or 'sym3' functions, such applications are unlikely to be meaningful.+shadowWithSpread+ :: Size a -- ^ Horizontal offset+ -> Size a -- ^ Vertical offset+ -> Size a -- ^ Blur radius+ -> Size a -- ^ Spread radius+ -> BoxShadow+shadowWithSpread x y blurRadius spreadRadius =+ BoxShadow . value $ (x ! y ! blurRadius ! spreadRadius)++-- | Adapt the provided @box-shadow@ with the @inset@ prefix.+-- +-- > boxShadow . pure . bsInset+bsInset :: BoxShadow -> BoxShadow+bsInset (BoxShadow v) = BoxShadow . value $ ("inset" :: Value, v)++-- | Supply a color to the provided @box-shadow@.+bsColor :: Color -> BoxShadow -> BoxShadow+bsColor c (BoxShadow v) = BoxShadow . value $ (v, c)+infixr 9 `bsColor`+ ------------------------------------------------------------------------------- +-- $box-shadow-deprecated+--+-- The old implementation was both restrictive and slightly off-spec. It+-- shall be discontinued in a future release. The 'boxShadow' name has already+-- been taken, so the functionality that used to provide is now provided by+-- 'boxShadow\''.++-- | This is the drop-in replacement for the old 'boxShadow' function (< 0.13).+-- It is possible to continue for now+boxShadow' :: Size a -> Size a -> Size a -> Color -> Css+boxShadow' x y w c = prefixed (browsers <> "box-shadow") (x ! y ! w ! c)+{-# DEPRECATED boxShadow' "This function is only present for compatibility purposes and will be removed." #-}++-- | Replace calls to this function as follows (using -XOverloadedLists)+--+-- > boxShadowWithSpread x y rb rs c+--+-- > boxShadow [c `bsColor` shadowWithSpread x y rb rs]+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)+{-# DEPRECATED boxShadowWithSpread "This function has been replaced with shadowWithSpread and bsColor and will be removed." #-}++-- | Replace calls to this function as follows (using -XOverloadedLists)+--+-- > boxShadows [(x1, y1, rb1, c1), (x2, y2, rb2, c2)]+--+-- > boxShadow+-- > [ c1 `bsColor` shadowWithBlur x1 y1 rb1+-- > , c2 `bsColor` shadowWithBlur x2 y2 rb2+-- > ]+boxShadows :: [(Size a, Size a, Size a, Color)] -> Css+boxShadows = prefixed (browsers <> "box-shadow") . map (\(a, b, c, d) -> a ! b ! c ! d)+{-# DEPRECATED boxShadows "This function is replaced with boxShadow and will be removed." #-}++-- | Replace calls to this function as follows (using -XOverloadedLists)+--+-- > insetBoxShadow s x y rb c+--+-- > boxShadow [bsInset $ c `bsColor` shadowWithBlur x y rb] 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)+{-# DEPRECATED insetBoxShadow "This function has been replaced with shadowWithSpread, bsInset and bsColor and will be removed." #-}
src/Clay/Color.hs view
@@ -2,11 +2,10 @@ module Clay.Color where import Data.Char (isHexDigit)-import Data.Monoid import Data.String-import Data.Text (Text) import Text.Printf +import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Read as Text @@ -16,24 +15,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,41 +54,139 @@ 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 (*.) (Rgba r g b a) i = Rgba (clamp (r * i)) (clamp (g * i)) (clamp (b * i)) a (*.) o _ = o+infixl 7 *. (+.) :: Color -> Integer -> Color (+.) (Rgba r g b a) i = Rgba (clamp (r + i)) (clamp (g + i)) (clamp (b + i)) a (+.) o _ = o+infixl 6 +. (-.) :: Color -> Integer -> Color (-.) (Rgba r g b a) i = Rgba (clamp (r - i)) (clamp (g - i)) (clamp (b - i)) a (-.) o _ = o+infixl 6 -. -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 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 a -> Value $mconcat ["hsla(", p h, ",", f s, ",", f l, ",", ah a, ")"]+ 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 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 +201,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
+ src/Clay/Comments.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE OverloadedStrings #-}+module Clay.Comments where++import Data.Maybe (isNothing)+import Data.List (partition)++import Clay.Stylesheet++-- | Annotate the supplied 'Css' with the supplied comment.+-- Comments work with 'OverloadedStrings'. This will annotate every non-nested+-- value.+commenting :: CommentText -> Css -> Css+commenting c css = foldMap (rule . addComment c) $ runS css+infixl 3 `commenting`++-- The last case indicates there may be something wrong in the typing, as+-- it shouldn't be possible to comment a wrong rule. In practice, this implementation+-- means only the directly applied property rule is affected, i.e. no nested+-- rules. That could be changed by adding recursive cases.+addComment :: CommentText -> Rule -> Rule+addComment c (Property (PartitionComments xs (Just cs)) k v) = let c1 = Comment $ cs <> "; " <> c in+ Property (c1 : xs) k v+addComment c (Property ms k v ) = Property (Comment c : ms) k v+addComment _ r = r++pattern PartitionComments :: [Modifier] -> Maybe CommentText -> [Modifier]+pattern PartitionComments xs cs <- (fmap (foldMap _Comment) . partition (isNothing . _Comment) -> (xs, cs))
src/Clay/Common.hs view
@@ -9,21 +9,26 @@ module Clay.Common where +import Data.Text (Text) import Clay.Property import Data.String (IsString)-import Data.Monoid (Monoid, (<>)) ------------------------------------------------------------------------------- -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+class Contain a where contain :: a+class Revert a where revert :: a+class RevertLayer a where revertLayer :: 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,29 +36,75 @@ 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"+allValue :: Value+allValue = "all"+autoValue :: Value+autoValue = "auto"+baselineValue :: Value+baselineValue = "baseline"+centerValue :: Value+centerValue = "center"+inheritValue :: Value+inheritValue = "inherit"+normalValue :: Value+normalValue = "normal"+noneValue :: Value+noneValue = "none"+visibleValue :: Value+visibleValue = "visible"+hiddenValue :: Value+hiddenValue = "hidden"+initialValue :: Value+initialValue = "initial"+unsetValue :: Value+unsetValue = "unset"+containValue :: Value+containValue = "contain"+revertValue :: Value+revertValue = "revert"+revertLayerValue :: Value+revertLayerValue = "revert-layer" +instance All Value where all = allValue+instance Auto Value where auto = autoValue+instance Baseline Value where baseline = baselineValue+instance Center Value where center = centerValue+instance Inherit Value where inherit = inheritValue+instance Normal Value where normal = normalValue+instance None Value where none = noneValue+instance Visible Value where visible = visibleValue+instance Hidden Value where hidden = hiddenValue+instance Other Value where other = id+instance Initial Value where initial = initialValue+instance Unset Value where unset = unsetValue+instance Contain Value where contain = containValue+instance Revert Value where revert = revertValue+instance RevertLayer Value where revertLayer = revertLayerValue+ ------------------------------------------------------------------------------- -- | Common list browser prefixes to make experimental properties work in -- different browsers. +webkitPrefix :: (Text, Text)+webkitPrefix = ( "-webkit-", "" )++emptyPrefix :: (Text, Text)+emptyPrefix = ( "", "" )++webkit :: Prefixed+webkit = Prefixed $+ [ webkitPrefix+ , emptyPrefix+ ]+ browsers :: Prefixed-browsers = Prefixed- [ ( "-webkit-", "" )- , ( "-moz-", "" )- , ( "-ms-", "" )- , ( "-o-", "" )- , ( "", "" )+browsers = Prefixed $+ [ webkitPrefix+ , ( "-moz-", "" )+ , ( "-ms-", "" )+ , ( "-o-", "" )+ , emptyPrefix ] -------------------------------------------------------------------------------@@ -63,3 +114,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)
src/Clay/Display.hs view
@@ -17,13 +17,13 @@ , Position , position-, static, absolute, fixed, relative+, static, absolute, fixed, relative, sticky -- * Display , Display , display-, inline, block, listItem, runIn, inlineBlock, table, inlineTable, tableRowGroup+, inline, block, listItem, runIn, inlineBlock, table, displayTable, inlineTable, tableRowGroup , tableHeaderGroup, tableFooterGroup, tableRow, tableColumnGroup, tableColumn , tableCell, tableCaption, displayNone, displayInherit, flex , inlineFlex, grid, inlineGrid@@ -34,6 +34,15 @@ , scroll , overflow, overflowX, overflowY +-- * Overscroll+, Overscroll+, overscrollBehavior+, overscrollBehavior2+, overscrollBehaviorX+, overscrollBehaviorY+, overscrollBehaviorBlock+, overscrollBehaviorInline+ -- * Visibility. , Visibility@@ -65,24 +74,29 @@ -- * Vertical align. , VerticalAlign(..)-, baseline, middle, vAlignSub, vAlignSuper, textTop, textBottom, vAlignTop, vAlignBottom+, middle, vAlignSub, vAlignSuper, textTop, textBottom, vAlignTop, vAlignBottom, vAlignBaseline -- * Cursor , Cursor(..)-, crosshair, cursorDefault, pointer, move, eResize, neResize, nwResize, nResize, seResize, swResize, sResize, wResize, cursorText, wait, cursorProgress, help, cursorUrl- +, cursorUrl+, cursorDefault+, contextMenu, help, pointer, cursorProgress, wait+, cell, crosshair, cursorText, vText+, alias, cursorCopy, move, noDrop, notAllowed, grab, grabbing+, allScroll, colResize, rowResize, nResize, eResize, sResize, wResize+, neResize, nwResize, seResize, swResize, ewResize, nsResize, neswResize, nwseResize+, zoomIn, zoomOut ) where -import Data.Monoid import Data.String import Clay.Size import Clay.Property import Clay.Stylesheet import Clay.Common-import Data.Text (Text) +import Data.Text (Text) ------------------------------------------------------------------------------- @@ -116,12 +130,13 @@ newtype Position = Position Value deriving (Val, Other, Inherit) -static, absolute, fixed, relative :: Position+static, absolute, fixed, relative, sticky :: Position static = Position "static" absolute = Position "absolute" fixed = Position "fixed" relative = Position "relative"+sticky = Position $ Value (webkit <> Plain "sticky") position :: Position -> Css position = key "position"@@ -131,7 +146,7 @@ newtype Display = Display Value deriving (Val, Other, None, Inherit) -inline, block, listItem, runIn, inlineBlock, table, inlineTable, tableRowGroup,+inline, block, listItem, runIn, inlineBlock, table, displayTable, inlineTable, tableRowGroup, tableHeaderGroup, tableFooterGroup, tableRow, tableColumnGroup, tableColumn, tableCell, tableCaption, displayNone, displayInherit, flex, inlineFlex, grid, inlineGrid :: Display@@ -141,6 +156,8 @@ listItem = Display "list-item" runIn = Display "runIn" inlineBlock = Display "inline-block"+displayTable = Display "table"+{-# DEPRECATED table "Use `displayTable` instead." #-} table = Display "table" inlineTable = Display "inline-table" tableRowGroup = Display "table-row-Group"@@ -177,8 +194,32 @@ ------------------------------------------------------------------------------- +newtype Overscroll = Overscroll Value+ deriving (Val, Other, None, Auto, Contain, Inherit, Initial, Unset, Revert, RevertLayer)++-- | Specify both X and Y overscroll at once+overscrollBehavior :: Overscroll -> Css+overscrollBehavior = key "overscroll-behavior"++overscrollBehavior2 :: Overscroll -> Overscroll -> Css+overscrollBehavior2 x y = key "overscroll-behavior" (x ! y)++overscrollBehaviorX :: Overscroll -> Css+overscrollBehaviorX = key "overscroll-behavior-x"++overscrollBehaviorY :: Overscroll -> Css+overscrollBehaviorY = key "overscroll-behavior-y"++overscrollBehaviorBlock :: Overscroll -> Css+overscrollBehaviorBlock = key "overscroll-behavior-block"++overscrollBehaviorInline :: Overscroll -> Css+overscrollBehaviorInline = key "overscroll-behavior-inline"++-------------------------------------------------------------------------------+ newtype Visibility = Visibility Value- deriving (Val, Other, Auto, Inherit, Hidden, Visible)+ deriving (Val, Other, Inherit, Hidden, Unset, Visible) separate, collapse :: Visibility @@ -201,7 +242,7 @@ ------------------------------------------------------------------------------- -opacity :: Double -> Css+opacity :: Number -> Css opacity = key "opacity" zIndex :: Integer -> Css@@ -232,50 +273,87 @@ verticalAlign :: a -> Css verticalAlign = key "vertical-align" -newtype VerticalAlignValue a = VerticalAlignValue Value deriving (Val)+newtype VerticalAlignValue = VerticalAlignValue Value deriving (Val, Baseline) -instance VerticalAlign (VerticalAlignValue a)+instance VerticalAlign VerticalAlignValue instance VerticalAlign (Size a) -baseline,middle,vAlignSub,vAlignSuper,textTop,textBottom,vAlignTop,vAlignBottom :: VerticalAlignValue Value+middle,vAlignSub,vAlignSuper,textTop,textBottom,vAlignTop,vAlignBottom,vAlignBaseline :: VerticalAlignValue -baseline = VerticalAlignValue "baseline" middle = VerticalAlignValue "middle" vAlignSub = VerticalAlignValue "sub"+vAlignBaseline = baseline vAlignSuper = VerticalAlignValue "super" textTop = VerticalAlignValue "text-top" textBottom = VerticalAlignValue "text-bottom" vAlignTop = VerticalAlignValue "top" vAlignBottom = VerticalAlignValue "bottom" -------------------------------------------------------------------------------- +------------------------------------------------------------------------------- class (Val a) => Cursor a where cursor :: a -> Css cursor = key "cursor" -newtype CursorValue a = CursorValue Value deriving (Val,Inherit,Auto)+newtype CursorValue a = CursorValue Value deriving (Val,Inherit,Auto,None) instance Cursor (CursorValue a) -crosshair,cursorDefault,pointer,move,eResize,neResize,nwResize,nResize,seResize,swResize,sResize,wResize,cursorText,wait,cursorProgress,help :: CursorValue Value- -crosshair = CursorValue "crosshair"-cursorDefault = CursorValue "cursorDefault"+cursorUrl :: Text -> CursorValue Value+cursorUrl u = CursorValue $ value ("url(\"" <> u <> "\")")++-- Using the classification from https://developer.mozilla.org/en-US/docs/Web/CSS/cursor+cursorDefault+ , contextMenu, help, pointer, cursorProgress, wait+ , cell, crosshair, cursorText, vText+ , alias, cursorCopy, move, noDrop, notAllowed, grab, grabbing+ , allScroll, colResize, rowResize, nResize, eResize, sResize, wResize+ , neResize, nwResize, seResize, swResize, ewResize, nsResize, neswResize, nwseResize+ , zoomIn, zoomOut :: CursorValue Value++-- General+cursorDefault = CursorValue "default"++-- Links & status+contextMenu = CursorValue "context-menu"+help = CursorValue "help" pointer = CursorValue "pointer"+cursorProgress = CursorValue "progress"+wait = CursorValue "wait"++-- Selection+cell = CursorValue "cell"+crosshair = CursorValue "crosshair"+cursorText = CursorValue "text"+vText = CursorValue "vertical-text"++-- Drag & drop+alias = CursorValue "alias"+cursorCopy = CursorValue "copy" move = CursorValue "move"+noDrop = CursorValue "no-drop"+notAllowed = CursorValue "not-allowed"+grab = CursorValue "grab"+grabbing = CursorValue "grabbing"++-- Resizing & scrolling+allScroll = CursorValue "all-scroll"+colResize = CursorValue "col-resize"+rowResize = CursorValue "row-resize"+nResize = CursorValue "n-resize" eResize = CursorValue "e-resize"+sResize = CursorValue "s-resize"+wResize = CursorValue "w-resize"+ neResize = CursorValue "ne-resize" nwResize = CursorValue "nw-resize"-nResize = CursorValue "n-resize" seResize = CursorValue "se-resize" swResize = CursorValue "sw-resize"-sResize = CursorValue "sResize"-wResize = CursorValue "sResize"-cursorText = CursorValue "text"-wait = CursorValue "wait"-cursorProgress = CursorValue "progress"-help = CursorValue "help"+ewResize = CursorValue "ew-resize"+nsResize = CursorValue "ns-resize"+neswResize = CursorValue "nesw-resize"+nwseResize = CursorValue "nwse-resize" -cursorUrl :: Text -> CursorValue Value-cursorUrl u = CursorValue $ value ("url(\"" <> u <> "\")")+-- Zooming+zoomIn = CursorValue "zoom-in"+zoomOut = CursorValue "zoom-out"
src/Clay/Filter.hs view
@@ -49,33 +49,33 @@ url :: Text -> Filter url u = Filter ("url(" <> value u <> ")") -blur :: Size Abs -> Filter+blur :: Size LengthUnit -> Filter blur i = Filter ("blur(" <> value i <> ")") -brightness :: Double -> Filter+brightness :: Number -> Filter brightness i = Filter ("brightness(" <> value i <> ")") -contrast :: Size Rel -> Filter+contrast :: Size Percentage -> Filter contrast i = Filter ("contrast(" <> value i <> ")") -dropShadow :: Size Abs -> Size Abs -> Size Abs -> Color -> Filter+dropShadow :: Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Color -> Filter dropShadow x y s c = Filter ("drop-shadow(" <> value (x ! y ! s ! c) <> ")") -grayscale :: Size Rel -> Filter+grayscale :: Size Percentage -> Filter grayscale g = Filter ("grayscale(" <> value g <> ")") hueRotate :: Angle a -> Filter hueRotate h = Filter ("hue-rotate(" <> value h <> ")") -invert :: Size Rel -> Filter+invert :: Size Percentage -> Filter invert i = Filter ("invert(" <> value i <> ")") -opacity :: Size Rel -> Filter+opacity :: Size Percentage -> Filter opacity i = Filter ("opacity(" <> value i <> ")") -saturate :: Size Rel -> Filter+saturate :: Size Percentage -> Filter saturate i = Filter ("saturate(" <> value i <> ")") -sepia :: Size Rel -> Filter+sepia :: Size Percentage -> Filter sepia i = Filter ("sepia(" <> value i <> ")")
+ src/Clay/Flexbox.hs view
@@ -0,0 +1,120 @@+{-# 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 SpaceEvenly a where spaceEvenly :: 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 SpaceEvenly Value where spaceEvenly = "space-evenly"+instance Stretch Value where stretch = "stretch"++-------------------------------------------------------------------------------++newtype AlignContentValue = AlignContentValue Value+ deriving (Val, Other, Inherit, FlexStart, FlexEnd+ , Center, SpaceBetween, SpaceAround, SpaceEvenly, 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, SpaceEvenly, Stretch)++justifyContent :: JustifyContentValue -> Css+justifyContent = key "justify-content"++-------------------------------------------------------------------------------++order :: Int -> Css+order i = key "order" (fromString (show i) :: Value)
src/Clay/Font.hs view
@@ -102,7 +102,8 @@ [GenericFontFamily] instance Val (Required a) where- value (Required a Nothing c d) = value (a ! (Literal <$> c) ! d)+ value (Required a Nothing c d) = value a <> " " <> (value $ Literal <$> c) <> sep <> value d+ where sep = if null c || null d then "" else "," value (Required a (Just b) c d) = value ((value a <> "/" <> value b) ! (Literal <$> c) ! d) instance Font ( Required a)
src/Clay/FontFace.hs view
@@ -9,20 +9,25 @@ import Clay.Property (Prefixed (Plain), Value(Value), Val (value), quote) import Clay.Stylesheet (Css, key) -import Data.Monoid ((<>))-import Data.Functor((<$>)) import Data.Maybe (fromMaybe) import Data.Text (Text) ------------------------------------------------------------------------------- -data FontFaceFormat = WOFF | TrueType | OpenType | EmbeddedOpenType | SVG+data FontFaceFormat+ = WOFF+ | WOFF2+ | TrueType+ | OpenType+ | EmbeddedOpenType+ | SVG deriving Show -- | name of format according to CSS specification formatName :: FontFaceFormat -> Text formatName format = case format of WOFF -> "woff"+ WOFF2 -> "woff2" TrueType -> "truetype" OpenType -> "opentype" EmbeddedOpenType -> "embedded-opentype"
src/Clay/Geometry.hs view
@@ -7,6 +7,12 @@ -- * Sizing. , width, height, minWidth, minHeight, maxWidth, maxHeight +-- ** Aspect ratio.+, AspectRatio+, aspectRatio+, (%)+, withFallback+ -- * Padding. , padding , paddingTop, paddingLeft, paddingRight, paddingBottom@@ -17,6 +23,9 @@ ) where +import qualified Data.Ratio as R+import Data.String (fromString)+import Clay.Common import Clay.Property import Clay.Stylesheet import Clay.Size@@ -42,6 +51,100 @@ ------------------------------------------------------------------------------- +-- | Represents an aspect ratio for use with 'aspectRatio'.+--+-- A fixed ratio can be formed from two integers:+--+-- >>> let _ = 4%3 :: AspectRatio+--+-- An aspect ratio can also be converted from a 'Rational':+--+-- >>> let _ = fromRational 0.5 :: AspectRatio+--+data AspectRatio = AspectRatio Rational+ | AspectRatioValue Value+ | AspectRatioWithFallback (AspectRatio, AspectRatio)++instance Auto AspectRatio where auto = AspectRatioValue auto+instance Inherit AspectRatio where inherit = AspectRatioValue inherit+instance Initial AspectRatio where initial = AspectRatioValue initial+instance Unset AspectRatio where unset = AspectRatioValue unset+instance Other AspectRatio where other = AspectRatioValue++-- | An 'AspectRatio' can be converted from an 'Integer',+-- but other operations are not supported.+instance Num AspectRatio where+ fromInteger = AspectRatio . toRational+ (+) = error "plus not implemented for AspectRatio"+ (*) = error "times not implemented for AspectRatio"+ abs = error "abs not implemented for AspectRatio"+ signum = error "signum not implemented for AspectRatio"+ negate = error "negate not implemented for AspectRatio"++-- | An 'AspectRatio' can be converted from a 'Rational',+-- but other operations are not supported.+instance Fractional AspectRatio where+ fromRational = AspectRatio+ recip = error "recip not implemented for AspectRatio"++instance Val AspectRatio where+ value (AspectRatioValue v) = v+ value (AspectRatio r) = v+ where v = fromString $ numerator <> "/" <> denominator :: Value+ numerator = show (R.numerator r)+ denominator = show (R.denominator r)+ value (AspectRatioWithFallback (a, b)) = value a <> " " <> value b++-- | Defines the width to height ratio of an element.+-- At least one of the width or height must be of automatic size,+-- otherwise the aspect ratio will be ignored.+--+-- It can be given a fixed ratio of the width to the height:+--+-- >>> renderWith compact [] $ aspectRatio (4%3)+-- "{aspect-ratio:4/3}"+--+-- It can also be the intrinsic aspect ratio for the element:+--+-- >>> renderWith compact [] $ aspectRatio auto+-- "{aspect-ratio:auto}"+--+-- It can be told to use the intrinsic aspect ratio for the element,+-- but to use a fixed ratio while it is unknown or if the element does not have one:+--+-- >>> renderWith compact [] $ aspectRatio $ auto `withFallback` (4%3)+-- "{aspect-ratio:auto 4/3}"+--+-- Corresponds to the+-- [@aspect-ratio@](https://developer.mozilla.org/en-US/docs/Web/CSS/aspect-ratio)+-- property in CSS.+aspectRatio :: AspectRatio -> Css+aspectRatio = key "aspect-ratio"++-- | The aspect ratio of the width to the height for use with 'aspectRatio'.+--+-- Note that this is /not/ the same @%@ operator from the "Data.Ratio" module,+-- although they do both semantically represent ratios. The same symbol is used+-- to signify that the return value is a ratio.+(%) :: Integer -> Integer -> AspectRatio+(%) m n = fromRational $ (R.%) m n++-- The same as the normal % operator.+infixl 7 %++-- | Returns an aspect ratio specifying that the intrinsic aspect+-- ratio should be used, but when it is unknown or there is none,+-- a fixed ratio can be used as a fallback.+withFallback :: AspectRatio -> AspectRatio -> AspectRatio+withFallback x@(AspectRatioValue "auto") y@(AspectRatio _) =+ AspectRatioWithFallback (x, y)+withFallback x@(AspectRatio _) y@(AspectRatioValue "auto") =+ AspectRatioWithFallback (x, y)+withFallback _ _ =+ error "Arguments for aspectRatio . withFallback must be auto and a ratio in either order"++-------------------------------------------------------------------------------+ padding :: Size a -> Size a -> Size a -> Size a -> Css padding a b c d = key "padding" (a ! b ! c ! d) @@ -63,4 +166,3 @@ marginLeft = key "margin-left" marginRight = key "margin-right" marginBottom = key "margin-bottom"-
src/Clay/Gradient.hs view
@@ -36,15 +36,13 @@ ) where -import Data.Monoid- import Clay.Color import Clay.Common import Clay.Property import Clay.Size import Clay.Background -type Ramp = [(Color, Size Rel)]+type Ramp = [(Color, Size Percentage)] ------------------------------------------------------------------------------- @@ -81,7 +79,7 @@ ellipse :: Extend -> Radial ellipse ext = Radial ("ellipse " <> value ext) -circular :: Size Abs -> Radial+circular :: Size LengthUnit -> Radial circular radius = Radial (value (radius, radius)) elliptical :: Size a -> Size a -> Radial@@ -115,5 +113,5 @@ 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)]+shortcut g f t = g [(f, (pct 0)), (t, (pct 100))]
+ src/Clay/Grid.hs view
@@ -0,0 +1,775 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}++-- | Partial implementation of+-- | <https://alligator.io/css/css-grid-layout-grid-areas grid area CSS API>.+module Clay.Grid+(+ -- * Grid+ --+ -- $gridIntro+ gridGap+ , gridTemplateColumns++ -- * Size and location+ --+ -- $sizeAndLocationIntro++ -- ** Data types and type classes+ , GridLine+ , ToGridLine+ , GridLines2+ , ToGridLines2+ , GridLines4+ , ToGridLines4+ , OneGridLine+ , TwoGridLines+ , ThreeGridLines+ , FourGridLines+ , CustomIdentGrid+ , customIdentToText+ , partialMkCustomIdentGrid+ , ToSpan++ -- ** Style properties+ --+ -- $invalidValues+ , gridArea+ , gridColumn+ , gridColumnStart+ , gridColumnEnd+ , gridRow+ , gridRowStart+ , gridRowEnd++ -- ** Keywords+ , (//)+ , span_+)+where++import qualified Clay.Common as Com+import Clay.Property (Val, Value, noCommas, value)+import Clay.Size (Size)+import Clay.Stylesheet (Css, key)+import Data.Char (isNumber)+import Data.Text (Text)+import qualified Data.Text as T+import Prelude++-- $gridIntro+-- @grid-gap@ and @grid-template@ CSS properties.+--+-- === Example+-- For the below CSS code:+--+-- @+-- .grid1 {+-- display: grid;+-- width: max-content;+-- }+--+-- .grid3 {+-- display: grid;+-- width: max-content;+-- }+--+-- \@media (min-width: 40.0rem) {+-- .grid3 {+-- display: grid;+-- grid-template-columns: 1fr 1fr 1fr;+-- grid-gap: 1rem;+-- width: max-content;+-- }+-- }+-- @+--+-- The corresponding clay code is:+--+-- @+-- ".grid1" ? do+-- display grid+-- width maxContent+-- ".grid3" ? do+-- display grid+-- width maxContent+-- query M.screen [M.minWidth (rem 40)] $ ".grid3" ? do+-- display grid+-- gridTemplateColumns [fr 1, fr 1, fr 1]+-- gridGap $ rem 1+-- width maxContent+-- @++-- | Property sets the gaps (gutters) between rows and columns.+gridGap :: Size a -> Css+gridGap = key "grid-gap"++-- | Property defines the line names and track sizing functions of the grid columns.+gridTemplateColumns :: [Size a] -> Css+gridTemplateColumns = key "grid-template-columns" . noCommas++-- $sizeAndLocationIntro+--+-- == CSS documentation+-- The below functions are based on+-- [MDN Web Docs](https://developer.mozilla.org/en-US/docs/Web/CSS)+-- CSS documentation.+--+-- === __Naming note__+-- In this documentation, as the functions are polymorphic we sometimes+-- refer to the CSS types as used in the+-- [mdm web docs_](https://developer.mozilla.org/en-US/docs/Web/CSS)+-- rather than the Haskell types.+-- For example, @grid-line@ is used instead of 'GridLine' as a the argument+-- might be provided as a 'GridLine' but also as an 'Integer', 'String', etc.+--+-- == Pragma+-- #pragma#+-- If you want to avoid specifying the types of the arguments, enable+-- the @ExtendedDefaultRules@ GHC language pragma as well as the+-- @-Wno-type-defaults@ GHC option to avoid compilation warnings.+--+-- @+-- {-# LANGUAGE ExtendedDefaultRules #-}+-- {-# OPTIONS_GHC -Wno-type-defaults #-}+-- @+--+-- === __Examples__+-- With the above enabled, you can write:+--+-- >> gridRowStart 2+--+-- >> gridRowStart "somegridarea"+--+-- If you do not enable those, then you must write:+--+-- >> gridRowStart (2 :: Integer)+--+-- >> gridRowStart ("somegridarea" :: String)+--+-- === __Note__+-- If you decide to enable the above, it is advisable to have your Clay+-- CSS code in its own module, so the behaviour of the rest of your code+-- is not affected.+--+-- == Examples+-- Examples are provided through the documentation for the various functions.+-- Further examples can be found in the source code of the test suite+-- in the GridSpec.hs module.++-- | A @grid-line@ value.+--+-- A @grid-line@ value specifies a size and location in a grid.+--+-- === __Note__+-- To know more about @grid-line@ value, see for example the documentation of+-- the [grid-row-start](https://developer.mozilla.org/en-US/docs/Web/CSS/grid-row-start)+-- CSS property.+data GridLine++ -- | 'Integer' value.+ --+ -- __NOTE:__ 'Integer' value of 0 is invalid.+ = Coordinate Integer++ -- | @custom-ident@ with an optional 'Integer' value.+ --+ -- __NOTE:__ 'Integer' value of 0 is invalid.+ | GridLineCustomIdent CustomIdentGrid (Maybe Integer)++ -- | @span@ CSS keyword with an optional @custom-ident@+ -- | and/or 'Integer' value.+ --+ -- __NOTE:__ negative 'Integer' or 0 are invalid.+ | Span (Maybe CustomIdentGrid) (Maybe Integer)++ -- | Other grid line values: @auto@, @inherit@, @initial@, @unset@.+ | OtherGridLine Value+ deriving (Eq, Show)++class ToGridLine a where+ -- | Convert the provided type to a 'GridLine'.+ toGridLine :: a -> GridLine++instance ToGridLine GridLine where+ toGridLine = id++instance ToGridLine Integer where+ -- | __NOTE:__ 'Integer' value of 0 is invalid.+ toGridLine = Coordinate++-- | @custom-ident@ value.+instance ToGridLine CustomIdentGrid where+ toGridLine x = GridLineCustomIdent x Nothing++-- | @custom-ident@ value.+instance ToGridLine String where+ toGridLine = toGridLine . partialMkCustomIdentGrid . T.pack++-- | Both @custom-ident@ and `Integer` values, provided as a pair.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLine (CustomIdentGrid, Integer) where+ toGridLine (x, y) = GridLineCustomIdent x (Just y)++-- | Both @custom-ident@ and `Integer` values, provided as a pair.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLine (String, Integer) where+ toGridLine (x, y) = toGridLine (partialMkCustomIdentGrid $ T.pack x, y)++-- | One or two @grid-line@ values.+data GridLines2+ -- | One @grid-line@ value.+ = One2 OneGridLine+ -- | Two @grid-line@ values.+ | Two2 TwoGridLines++class ToGridLines2 a where++ -- | Convert the provided type to 'GridLines2' (one or two @grid-line@ values).+ toGridLines2 :: a -> GridLines2++-- | One @grid-line@ value.+instance ToGridLines2 GridLine where+ toGridLines2 = One2 . OneGridLine++-- | One @grid-line@ value.+instance ToGridLines2 OneGridLine where+ toGridLines2 = One2++-- | Two @grid-line@ values.+instance ToGridLines2 TwoGridLines where+ toGridLines2 = Two2++-- | One or two @grid-line@ values.+instance ToGridLines2 GridLines2 where+ toGridLines2 = id++-- | One 'Integer' value.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLines2 Integer where+ toGridLines2 = toGridLines2 . toGridLine++-- | One @custom-ident@ value.+instance ToGridLines2 CustomIdentGrid where+ toGridLines2 = toGridLines2 . toGridLine++-- | One @custom-ident@ value.+instance ToGridLines2 String where+ toGridLines2 = toGridLines2 . toGridLine++-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLines2 (CustomIdentGrid, Integer) where+ toGridLines2 = toGridLines2 . toGridLine++-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLines2 (String, Integer) where+ toGridLines2 = toGridLines2 . toGridLine++-- | One, two, three or four @grid-line@ values.+data GridLines4++ -- | One @grid-line@ value.+ = One4 OneGridLine++ -- | Two @grid-line@ values.+ | Two4 TwoGridLines++ -- | Three @grid-line@ values.+ | Three4 ThreeGridLines++ -- | Four @grid-line@ values.+ | Four4 FourGridLines++class ToGridLines4 a where+ -- | Convert the provided type to 'GridLines4'+ -- (one, two, three or four @grid-line@ values).+ toGridLines4 :: a -> GridLines4++-- | One @grid-line@ value.+instance ToGridLines4 GridLine where+ toGridLines4 = One4 . OneGridLine++-- | One @grid-line@ value.+instance ToGridLines4 OneGridLine where+ toGridLines4 = One4++-- | Two @grid-line@ values.+instance ToGridLines4 TwoGridLines where+ toGridLines4 = Two4++-- | Three @grid-line@ values.+instance ToGridLines4 ThreeGridLines where+ toGridLines4 = Three4++-- | Four @grid-line@ values.+instance ToGridLines4 FourGridLines where+ toGridLines4 = Four4++-- | One, two, three or four @grid-line@ values.+instance ToGridLines4 GridLines4 where+ toGridLines4 = id++-- | One 'Integer' value.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLines4 Integer where+ toGridLines4 = toGridLines4 . toGridLine++-- | One @custom-ident@ value.+instance ToGridLines4 CustomIdentGrid where+ toGridLines4 = toGridLines4 . toGridLine++-- | One @custom-ident@ value.+instance ToGridLines4 String where+ toGridLines4 = toGridLines4 . toGridLine++-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLines4 (CustomIdentGrid, Integer) where+ toGridLines4 = toGridLines4 . toGridLine++-- | One time both a @custom-ident@ and 'Integer' values, provided as a pair.+--+-- __NOTE:__ 'Integer' value of 0 is invalid.+instance ToGridLines4 (String, Integer) where+ toGridLines4 = toGridLines4 . toGridLine++-- | One 'GridLine' value.+newtype OneGridLine = OneGridLine GridLine++-- | Two 'GridLine' values.+data TwoGridLines = TwoGridLines GridLine GridLine++-- | Three 'GridLine' values.+data ThreeGridLines = ThreeGridLines GridLine GridLine GridLine++-- | Four 'GridLine' values.+data FourGridLines = FourGridLines GridLine GridLine GridLine GridLine++-- | CSS @custom-ident@.+--+-- The data constructor is not exported. Use the 'partialMkCustomIdentGrid'+-- smart constructor to create a 'CustomIdentGrid'.+--+-- === __Note__+-- In CSS, some values for @custom-ident@ are invalid depending on the CSS+-- property the @custom-ident@ is used with.+-- Consequently, the @custom-ident@ is only for CSS grid.+newtype CustomIdentGrid = CustomIdentGrid Text deriving (Eq, Ord, Read, Show)++-- | Convert a 'CustomIdentGrid' to 'Text'.+--+-- === __Note__+-- The function is defined on its own as the newtype constructor+-- of 'CustomIdentGrid'is not exported.+customIdentToText :: CustomIdentGrid -> Text+customIdentToText (CustomIdentGrid x) = x++-- | Create a 'CustomIdentGrid'.+--+-- __WARNING__: this function is partial. An error will be raised if:+--+-- * "span" is provided as a value (this is a reserved keyword in this context)+-- * a number is provided as first character+-- * __If__ a hyphen (-) is provided as first character:+--+-- ** a number is provided as second character+-- ** a hyphen (-) is provided as second character.+--+-- === __Note__+-- The above is a partial implementation of the CSS custom-ident naming rules.+-- If you stick to the following charset @[a-zA-z0-9-_]@ the checks will be effective+-- and your CSS custom-ident will be a valid one.+-- On the other hand, the following will not be checked:+--+-- * character escaping (for example @\?@) or unicode+-- * characters provided as hexadecimal number (for example @\0x03BB@)+-- * characters outside of the above charset.+--+-- More information regarding this topic can be found on+-- [mdm web docs_](https://developer.mozilla.org/en-US/docs/Web/CSS/custom-ident)+partialMkCustomIdentGrid :: Text -> CustomIdentGrid+partialMkCustomIdentGrid "span" = error "Custom-ident for a grid property cannot be named span"+partialMkCustomIdentGrid txt = checkText+ where+ checkText = checkHead (fst unconsTxt)++ checkHead :: Char -> CustomIdentGrid+ checkHead c+ | isNumber c = error "Custom-ident cannot start with a number"+ | c == '-' = checkSecond second+ | otherwise = CustomIdentGrid txt++ checkSecond (Just s)+ | s == '-' =+ error "Custom-ident cannot start with two hyphens"+ | isNumber s =+ error "Custom-ident cannot start with a hyphen followed by a number"+ | otherwise = CustomIdentGrid txt+ checkSecond Nothing = CustomIdentGrid txt++ unconsTxt = case T.uncons txt of+ Nothing -> error "Custom-ident cannot be empty"+ Just (f, r) -> (f, r)++ second :: Maybe Char+ second = fst <$> T.uncons (snd unconsTxt)++-- $invalidValues+--+-- #partial#+-- The below functions are partial. They will raise an error if+-- provided with a @grid-line@ value which is:+--+-- * an 'Integer' value of 0+-- * a pair with an 'Integer' component of value 0+-- * a 'span_' function provided with an 'Integer' value of 0 or negative+-- * a 'span_' function provided with a pair value with+-- an 'Integer' component of 0 or negative.+-- * an invalid @custom-ident@ value, see 'partialMkCustomIdentGrid'.++-- | Property shorthand specifies a grid item's size and location+-- within a grid.+--+-- One to four @grid-line@ values can be specified.+-- Grid-line values must be separated by a '(//)' operator.+--+-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".+--+-- ==== __Examples__+--+-- The below examples assume that the @ExtendedDefaultRules@ GHC language+-- pragma is enabled. See above "Clay.Grid#pragma".+--+-- > gridArea (auto :: GridLine)+--+-- > gridArea "somegridarea"+--+-- > gridArea $ ("somegridarea", 4) // ("someothergridarea", 2)+--+-- > gridArea $ 1 // 3 // 4+gridArea :: ToGridLines4 a => a -> Css+gridArea x = key "grid-area" (partialToGridLines4 x)++-- | Property shorthand specifies a grid item's size and location+-- within a grid column.+--+-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".+--+-- ==== __Examples__+--+-- The below examples assume that the @ExtendedDefaultRules@ GHC language+-- pragma is enabled. See above "Clay.Grid#pragma".+--+-- > gridColumn (auto :: GridLine)+--+-- > gridColumn $ span_ 3+--+-- > gridColumn $ span_ ("somegridarea", 5)+--+-- > gridColumn $ span_ 3 // 6+gridColumn :: ToGridLines2 a => a -> Css+gridColumn x = key "grid-column" (partialToGridLines2 x)++-- | Property specifies a grid item's start position within the grid column.+--+-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".+--+-- ==== __Examples__+--+-- The below examples assume that the @ExtendedDefaultRules@ GHC language+-- pragma is enabled. See above "Clay.Grid#pragma".+--+-- > gridColumnStart (inherit :: GridLine)+--+-- > gridColumnStart 2+--+-- > gridColumnStart ("somegridarea", 4)+--+-- > gridColumnStart $ span_ ("somegridarea", 5)+gridColumnStart :: ToGridLine a => a -> Css+gridColumnStart x = key "grid-column-start" (partialToGridLine x)++-- | Property specifies a grid item's end position within the grid column.+--+-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".+--+-- ==== __Examples__+--+-- The below examples assume that the @ExtendedDefaultRules@ GHC language+-- pragma is enabled. See above "Clay.Grid#pragma".+--+-- > gridColumnEnd (initial :: GridLine)+--+-- > gridColumnEnd 2+--+-- > gridColumnEnd "somegridarea"+--+-- > gridColumnEnd $ span_ "somegridarea"+gridColumnEnd :: ToGridLine a => a -> Css+gridColumnEnd x = key "grid-column-end" (partialToGridLine x)++-- | Property shorthand specifies a grid item's size and location+-- within a grid row.+--+-- One or two @grid-line@ values can be specified.+-- @grid-line@ values must be separated by a '(//)' operator.+--+-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".+--+-- ==== __Examples__+--+-- The below examples assume that the @ExtendedDefaultRules@ GHC language+-- pragma is enabled. See above "Clay.Grid#pragma".+--+-- > gridRow (unset :: GridLine)+--+-- > gridRow $ span_ 3+--+-- > gridRow $ span_ 3 // 6+--+-- > gridRow $ span_ ("somegridarea", 5) // span_ 2+gridRow :: ToGridLines2 a => a -> Css+gridRow x = key "grid-row" (partialToGridLines2 x)++-- | Property specifies a grid item's start position within the grid row.+--+-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".+--+-- ==== __Examples__+--+-- The below examples assume that the @ExtendedDefaultRules@ GHC language+-- pragma is enabled. See above "Clay.Grid#pragma".+--+-- > gridRowStart (initial :: GridLine)+--+-- > gridRowStart (-2)+--+-- > gridRowStart $ span_ "somegridarea"+--+-- > gridRowStart "somegridarea"+gridRowStart :: ToGridLine a => a -> Css+gridRowStart x = key "grid-row-start" (partialToGridLine x)++-- | Property specifies a grid item's end position within the grid row.+--+-- __WARNING:__ this function is partial. See above "Clay.Grid#partial".+--+-- ==== __Examples__+--+-- The below examples assume that the @ExtendedDefaultRules@ GHC language+-- pragma is enabled. See above "Clay.Grid#pragma".+--+-- > gridRowEnd (auto :: GridLine)+--+-- > gridRowEnd (-2)+--+-- > gridRowEnd ("somegridarea", 4)+--+-- > gridRowEnd $ span_ 3+gridRowEnd :: ToGridLine a => a -> Css+gridRowEnd x = key "grid-row-end" (partialToGridLine x)++class Slash a r | a -> r where+ -- | `/` CSS operator.+ -- Separates @grid-line@ values.+ (//) :: ToGridLine b => a -> b -> r++instance Slash GridLine TwoGridLines where+ x // y = TwoGridLines x (toGridLine y)++instance Slash Integer TwoGridLines where+ x // y = TwoGridLines (toGridLine x) (toGridLine y)++instance Slash CustomIdentGrid TwoGridLines where+ x // y = TwoGridLines (toGridLine x) (toGridLine y)++instance Slash String TwoGridLines where+ x // y = TwoGridLines (toGridLine x) (toGridLine y)++instance Slash (CustomIdentGrid, Integer) TwoGridLines where+ x // y = TwoGridLines (toGridLine x) (toGridLine y)++instance Slash (String, Integer) TwoGridLines where+ x // y = TwoGridLines (toGridLine x) (toGridLine y)++instance Slash TwoGridLines ThreeGridLines where+ (TwoGridLines xx xy) // y = ThreeGridLines xx xy (toGridLine y)++instance Slash ThreeGridLines FourGridLines where+ (ThreeGridLines xx xy xz) // y = FourGridLines xx xy xz (toGridLine y)++class ToSpan a where++ -- | @span@ CSS keyword, contributes to the grid item's placement.+ span_ :: a -> GridLine++-- | Contributes the nth grid line to the grid item's placement.+--+-- __NOTE:__ negative 'Integer' or 0 values are invalid.+instance ToSpan Integer where+ span_ x = Span Nothing (Just x)++-- | One line from the provided name is counted.+instance ToSpan String where+ span_ x = Span (Just . partialMkCustomIdentGrid $ T.pack x) Nothing++-- | Nth lines from the provided name are counted.+--+-- __NOTE:__ negative 'Integer' or 0 values are invalid.+instance ToSpan (String, Integer) where+ span_ (x, y) = Span (Just . partialMkCustomIdentGrid $ T.pack x) (Just y)++-- | Keyword indicating that the property contributes nothing+-- to the grid item's placement.+instance Com.Auto GridLine where+ auto = OtherGridLine $ value ("auto" :: Text)++-- | Keyword `inherit` applied to a 'GridLine'.+instance Com.Inherit GridLine where+ inherit = OtherGridLine $ value ("inherit" :: Text)++-- | Keyword `initial` applied to a 'GridLine'.+instance Com.Initial GridLine where+ initial = OtherGridLine $ value ("initial" :: Text)++-- | Keyword `unset` applied to a 'GridLine'.+instance Com.Unset GridLine where+ unset = OtherGridLine $ value ("unset" :: Text)++-- | Convertion of 'GridLine' to 'Clay.Property.Value'.+instance Val GridLine where+ value (OtherGridLine val) = val+ value (Coordinate x) = value x+ value (GridLineCustomIdent x y) =+ value $ customIdentToText x <> foldMap ((" " <>) . tshow) y+ value (Span x y) =+ value $ "span" <> foldMap ((" " <>)+ . customIdentToText) x <> foldMap ((" " <>) . tshow) y++instance Val OneGridLine where+ value (OneGridLine x) = value x++instance Val TwoGridLines where+ value (TwoGridLines x y) =+ value x <> value (" / " :: Text) <> value y++instance Val ThreeGridLines where+ value (ThreeGridLines x y z) =+ value x+ <> value (" / " :: Text) <> value y+ <> value (" / " :: Text) <> value z++instance Val FourGridLines where+ value (FourGridLines xx xy xz yx) =+ value xx+ <> value (" / " :: Text) <> value xy+ <> value (" / " :: Text) <> value xz+ <> value (" / " :: Text) <> value yx++instance Val GridLines2 where+ value (One2 x) = value x+ value (Two2 x) = value x++instance Val GridLines4 where+ value (One4 x) = value x+ value (Two4 x) = value x+ value (Three4 x) = value x+ value (Four4 x) = value x++-- | Private partial function checking a 'GridLine'.+--+-- An error is raised when:+-- - An 'Integer' value of 0 is provided.+-- - A negative 'Integer' value is provided for a 'Span' constructor.+--+-- Otherwise, the initially provided 'GridLine' value is returned.+partialCheckGridLine :: GridLine -> GridLine+partialCheckGridLine gridLine = case gridLine of+ Coordinate 0 -> errorValue 0+ GridLineCustomIdent _ (Just 0) -> errorValue 0+ s@(Span _ (Just n)) -> if n < 1+ then errorValue n+ else s+ _ -> gridLine+ where+ errorValue n = error ("Value " ++ show n ++ " is invalid")++-- | Private partial function checking 'OneGridLine'.+--+-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.+partialCheckOneGridLine :: OneGridLine -> OneGridLine+partialCheckOneGridLine (OneGridLine gridLine) =+ OneGridLine (partialCheckGridLine gridLine)++-- | Private partial function checking 'TwoGridLines'.+--+-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.+partialCheckTwoGridLines :: TwoGridLines -> TwoGridLines+partialCheckTwoGridLines (TwoGridLines gridLine1 gridLine2) =+ TwoGridLines (partialCheckGridLine gridLine1) (partialCheckGridLine gridLine2)++-- | Private partial function checking 'ThreeGridLines'.+--+-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.+partialCheckThreeGridLines :: ThreeGridLines -> ThreeGridLines+partialCheckThreeGridLines (ThreeGridLines gridLine1 gridLine2 gridLine3) =+ ThreeGridLines+ (partialCheckGridLine gridLine1)+ (partialCheckGridLine gridLine2)+ (partialCheckGridLine gridLine3)++-- | Private partial function checking 'FourGridLines'.+--+-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.+partialCheckFourGridLines :: FourGridLines -> FourGridLines+partialCheckFourGridLines+ (FourGridLines gridLine1 gridLine2 gridLine3 gridLine4) =+ FourGridLines+ (partialCheckGridLine gridLine1)+ (partialCheckGridLine gridLine2)+ (partialCheckGridLine gridLine3)+ (partialCheckGridLine gridLine4)++-- | Private partial function converting its argument to 'GridLine'.+--+-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.+partialToGridLine :: ToGridLine a => a -> GridLine+partialToGridLine = partialCheckGridLine . toGridLine++-- | Private partial function converting its argument to 'GridLines2'.+--+-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.+partialToGridLines2 :: ToGridLines2 a => a -> GridLines2+partialToGridLines2 x = partialGridLine' gridLines+ where+ gridLines = toGridLines2 x+ partialGridLine' (One2 gl) = One2 (partialCheckOneGridLine gl)+ partialGridLine' (Two2 gl) = Two2 (partialCheckTwoGridLines gl)++-- | Private partial function converting its argument to 'GridLines4'.+--+-- An error is raised if an invalid value is found, see 'partialCheckGridLine'.+partialToGridLines4 :: ToGridLines4 a => a -> GridLines4+partialToGridLines4 x = partialGridLine' gridLines+ where+ gridLines = toGridLines4 x+ partialGridLine' (One4 gl) = One4 (partialCheckOneGridLine gl)+ partialGridLine' (Two4 gl) = Two4 (partialCheckTwoGridLines gl)+ partialGridLine' (Three4 gl) = Three4 (partialCheckThreeGridLines gl)+ partialGridLine' (Four4 gl) = Four4 (partialCheckFourGridLines gl)++-- | Private utility function to show 'Text' instead of 'String'.+tshow :: Show a => a -> Text+tshow = T.pack . show
src/Clay/List.hs view
@@ -36,7 +36,6 @@ ) where -import Data.Monoid import Data.Text (Text) import Clay.Common@@ -75,7 +74,7 @@ listStyleType = key "list-style-type" newtype ListStylePosition = ListStylePosition Value- deriving (Val, Initial, Inherit, None, Other)+ deriving (Val, Initial, Inherit, Other) inside, outside :: ListStylePosition
src/Clay/Mask.hs view
@@ -57,8 +57,6 @@ ) where -import Data.Monoid- import Clay.Background import Clay.Common import Clay.Property
src/Clay/Media.hs view
@@ -4,16 +4,20 @@ -- * Media types. - aural, braille, handheld, print, projection-, screen, tty, tv, embossed+ all, screen, print +-- ** Deprecated.++-- | These media types were deprecated by Media Queries 4.+, aural, braille, handheld, projection, tty, tv, embossed+ -- * Geometrical features. , width, minWidth, maxWidth, height, minHeight, maxHeight, deviceWidth , minDeviceWidth, maxDeviceWidth, deviceHeight, minDeviceHeight , maxDeviceHeight --- * Aspect ration features.+-- * Aspect ratio features. , aspectRatio, minAspectRatio, maxAspectRatio, deviceAspectRatio , minDeviceAspectRatio, maxDeviceAspectRatio@@ -33,6 +37,16 @@ , Resolution , dpi , dppx++-- * Preference related features.++, prefersColorScheme++-- ** Preference related values.++, ColorScheme+, light+, dark ) where@@ -40,7 +54,7 @@ import Data.Text (Text, pack) import Data.Monoid -import Clay.Common+import Clay.Common hiding (all) import Clay.Size import Clay.Property import Clay.Stylesheet@@ -49,14 +63,18 @@ ------------------------------------------------------------------------------- -aural, braille, handheld, print, projection+all, aural, braille, handheld, print, projection , screen, tty, tv, embossed :: MediaType +-- | Suitable for all devices.+all = MediaType "all" aural = MediaType "aural" braille = MediaType "braille" handheld = MediaType "handheld"+-- | Intended primarily for printed material or in a print layout. print = MediaType "print" projection = MediaType "projection"+-- | Intended primarily for screen-based devices. screen = MediaType "screen" tty = MediaType "tty" tv = MediaType "tv"@@ -72,7 +90,7 @@ width, minWidth, maxWidth, height, minHeight, maxHeight, deviceWidth , minDeviceWidth, maxDeviceWidth, deviceHeight, minDeviceHeight- , maxDeviceHeight :: Size Abs -> Feature+ , maxDeviceHeight :: Size LengthUnit -> Feature width = with "width" minWidth = with "min-width"@@ -132,3 +150,21 @@ dppx :: Integer -> Resolution dppx i = Resolution (value (pack (show i) <> "dppx")) +-------------------------------------------------------------------------------++-- | Feature detecting whether user prefers light or dark color scheme.+prefersColorScheme :: ColorScheme -> Feature+prefersColorScheme = with "prefers-color-scheme"++-- | A color scheme preferred by a user.+newtype ColorScheme = ColorScheme Value+ deriving (Val, Other)++-- | User indicates that they prefer a light theme with their interface,+-- or that they have not indicated a preference.+light :: ColorScheme+light = ColorScheme (value (pack "light"))++-- | User indicates that they prefer a dark theme with their interface.+dark :: ColorScheme+dark = ColorScheme (value (pack "dark"))
src/Clay/Property.hs view
@@ -2,22 +2,25 @@ module Clay.Property where import Control.Arrow (second)-import Control.Monad.Writer import Data.Fixed (Fixed, HasResolution (resolution), showFixed) import Data.List (partition, sort)+import Data.List.NonEmpty (NonEmpty, toList) import Data.Maybe import Data.String 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) +instance Semigroup Prefixed where+ (<>) = merge+ instance Monoid Prefixed where mempty = ""- mappend = merge+ mappend = (<>) merge :: Prefixed -> Prefixed -> Prefixed merge (Plain x ) (Plain y ) = Plain (x <> y)@@ -40,7 +43,7 @@ ------------------------------------------------------------------------------- newtype Key a = Key { unKeys :: Prefixed }- deriving (Show, Monoid, IsString)+ deriving (Show, Semigroup, Monoid, IsString) cast :: Key a -> Key () cast (Key k) = Key k@@ -48,7 +51,7 @@ ------------------------------------------------------------------------------- newtype Value = Value { unValue :: Prefixed }- deriving (Show, Monoid, IsString)+ deriving (Show, Semigroup, Monoid, IsString, Eq) class Val a where value :: a -> Value@@ -57,7 +60,7 @@ value t = Value (Plain t) newtype Literal = Literal Text- deriving (Show, Monoid, IsString)+ deriving (Show, Semigroup, Monoid, IsString) instance Val Literal where value (Literal t) = Value (Plain (quote t))@@ -68,12 +71,6 @@ data E5 = E5 instance HasResolution E5 where resolution _ = 100000 -instance Val Double where- value = fromString . showFixed' . realToFrac- where- showFixed' :: Fixed E5 -> String- showFixed' = showFixed True- instance Val Value where value = id @@ -89,16 +86,32 @@ value (Right a) = value a instance Val a => Val [a] where- value xs = intersperse "," (map value xs)+ value xs = intercalate "," (map value xs) -intersperse :: Monoid a => a -> [a] -> a-intersperse _ [] = mempty-intersperse s (x:xs) = foldl (\a b -> a <> s <> b) x xs+instance Val a => Val (NonEmpty a) where+ value = value . toList +intercalate :: Monoid a => a -> [a] -> a+intercalate _ [] = mempty+intercalate s (x:xs) = foldl (\a b -> a `mappend` s `mappend` b) x xs+ ------------------------------------------------------------------------------- +-- | A number type to represent the CSS @number@ type.+-- It has fixed precision, supporting up to 5 decimal places.+newtype Number = Number { unNumber :: Fixed E5 }+ deriving (Enum, Eq, Fractional, Num, Ord, Read, Real, RealFrac, Show)++instance Val Number where+ value = Value . Plain . cssNumberText++cssNumberText :: Number -> Text+cssNumberText = fromString . showFixed True . unNumber++-------------------------------------------------------------------------------+ noCommas :: Val a => [a] -> Value-noCommas xs = intersperse " " (map value xs)+noCommas xs = intercalate " " (map value xs) infixr !
src/Clay/Pseudo.hs view
@@ -1,18 +1,30 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} module Clay.Pseudo where import Data.Text (Text) +import Clay.Render (renderSelector, renderRefinement) import Clay.Selector +import qualified Data.Text.Lazy as Lazy+ -- 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"@@ -53,3 +65,20 @@ nthLastChild n = func "nth-last-child" [n] nthLastOfType n = func "nth-last-of-type" [n] nthOfType n = func "nth-of-type" [n]++-- | The 'not' pseudo selector can be applied to both a 'Refinement'+--+-- > input # not checked+-- +-- or a 'Selector'+--+-- > not p++class Not a where+ not :: a -> Refinement++instance Not Selector where+ not r = func "not" [Lazy.toStrict (renderSelector r)]++instance Not Refinement where+ not r = func "not" (Lazy.toStrict <$> renderRefinement r)
src/Clay/Render.hs view
@@ -4,42 +4,46 @@ , pretty , compact , render+, htmlInline , putCss , renderWith- , renderSelector+, renderRefinement+, withBanner ) 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.List (sort)+import Data.Maybe+import Data.Text (Text)+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 , sep :: Builder+ , lbrace :: Builder+ , rbrace :: Builder , finalSemicolon :: Bool , warn :: Bool , align :: Bool , banner :: Bool+ , comments :: Bool } -- | Configuration to print to a pretty human readable CSS output.@@ -49,10 +53,13 @@ { indentation = " " , newline = "\n" , sep = " "+ , lbrace = "{"+ , rbrace = "}" , finalSemicolon = True , warn = True , align = True , banner = True+ , comments = True } -- | Configuration to print to a compacted unreadable CSS output.@@ -62,12 +69,31 @@ { indentation = "" , newline = "" , sep = ""+ , lbrace = "{"+ , rbrace = "}" , finalSemicolon = False , warn = False , align = False , banner = False+ , comments = False } +-- | Configuration to print to a compacted unreadable CSS output for embedding inline with HTML.++htmlInline :: Config+htmlInline = Config+ { indentation = ""+ , newline = ""+ , sep = ""+ , lbrace = ""+ , rbrace = ""+ , finalSemicolon = False+ , warn = False+ , align = False+ , banner = False+ , comments = False+ }+ -- | Render to CSS using the default configuration (`pretty`) and directly -- print to the standard output. @@ -95,14 +121,20 @@ renderSelector :: Selector -> Lazy.Text renderSelector = toLazyText . selector compact +-- | Render a CSS `Refinement`.+renderRefinement :: Refinement -> [Lazy.Text]+renderRefinement r = toLazyText . predicate <$> unFilter r+ ------------------------------------------------------------------------------- renderBanner :: Config -> Lazy.Text -> Lazy.Text renderBanner cfg- | banner cfg = (<> b)+ | banner cfg = withBanner | otherwise = id- where b = "\n/* Generated with Clay, http://fvisser.nl/clay */" +withBanner :: Lazy.Text -> Lazy.Text+withBanner = (<> "\n/* Generated with Clay, http://fvisser.nl/clay */")+ kframe :: Config -> Keyframes -> Builder kframe cfg (Keyframes ident xs) = foldMap@@ -110,20 +142,20 @@ mconcat [ "@" <> fromText browser <> "keyframes " , fromText ident , newline cfg- , "{"+ , lbrace cfg , newline cfg , foldMap (frame cfg) xs- , "}"+ , rbrace cfg , newline cfg , newline cfg ] ) (unPrefixed browsers) -frame :: Config -> (Double, [Rule]) -> Builder+frame :: Config -> (Number, [Rule]) -> Builder frame cfg (p, rs) = mconcat- [ fromText (pack (show p))+ [ fromText (cssNumberText p) , "% " , rules cfg [] rs ]@@ -133,10 +165,10 @@ mconcat [ mediaQuery q , newline cfg- , "{"+ , lbrace cfg , newline cfg , rules cfg sel rs- , "}"+ , rbrace cfg , newline cfg ] @@ -157,7 +189,7 @@ feature :: Feature -> Builder feature (Feature k mv) = case mv of- Nothing -> fromText k+ Nothing -> mconcat [ "(", fromText k, ")" ] Just (Value v) -> mconcat [ "(" , fromText k , ": " , fromText (plain v) , ")" ] @@ -177,18 +209,18 @@ , (\(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- imports (Import i ) = Just i- imports _ = Nothing+ where property (Property m k v) = Just (m, 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+ imports (Import i ) = Just i+ imports _ = Nothing imp :: Config -> Text -> Builder imp cfg t =@@ -198,18 +230,20 @@ , ");" , newline cfg ] +-- | A key-value pair with associated comment.+type KeyVal = ([Modifier], Key (), Value) -rule :: Config -> [App] -> [(Key (), Value)] -> Builder+rule :: Config -> [App] -> [KeyVal] -> Builder rule _ _ [] = mempty rule cfg sel props = let xs = collect =<< props in mconcat [ selector cfg (merger sel) , newline cfg- , "{"+ , lbrace cfg , newline cfg , properties cfg xs- , "}"+ , rbrace cfg , newline cfg ] @@ -223,34 +257,50 @@ Pop i -> merger (drop i (x:xs)) Self f -> case xs of [] -> star `with` f; _ -> merger xs `with` f -collect :: (Key (), Value) -> [Either Text (Text, Text)]-collect (Key ky, Value vl) =- case (ky, vl) of+data Representation+ = Warning Text+ | KeyValRep [Modifier] Text Text+ deriving (Show)++keys :: [Representation] -> [Text]+keys = mapMaybe f+ where+ f (KeyValRep _ k _) = Just k+ f _ = Nothing++collect :: KeyVal -> [Representation]+collect (ms, 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) . mappend p)) (lookup p vs)- where prop k v = Right (k, v)+ ( Prefixed ks , Prefixed vs ) -> flip map ks $ \(p, k) -> (Warning (p <> k) `maybe` (prop (p <> k) . mappend p)) (lookup p vs)+ where prop k v = KeyValRep ms k v -properties :: Config -> [Either Text (Text, Text)] -> Builder+properties :: Config -> [Representation] -> Builder properties cfg xs =- let width = 1 + maximum (Text.length . fst <$> rights xs)+ let width = 1 + maximum (Text.length <$> keys xs) ind = indentation cfg new = newline cfg finalSemi = if finalSemicolon cfg then ";" else ""- in (<> new) $ (<> finalSemi) $ intersperse (";" <> new) $ flip map xs $ \p ->+ in (<> new) $ (<> finalSemi) $ intercalate (";" <> new) $ flip map xs $ \p -> case p of- Left w -> if warn cfg+ Warning w -> if warn cfg then ind <> "/* no value for " <> fromText w <> " */" <> new else mempty- Right (k, v) ->+ KeyValRep ms 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]+ imptant = maybe "" ((" " <>) . fromText) . foldMap _Important $ ms+ comm = case (foldMap _Comment ms, comments cfg) of+ (Just c, True) -> " /* " <> fromText (unCommentText c) <> " */"+ _ -> mempty+ in mconcat [ind, fromText k, pad, ":", sep cfg, fromText v, imptant, comm] selector :: Config -> Selector -> Builder-selector cfg = intersperse ("," <> newline cfg) . rec+selector Config { lbrace = "", rbrace = "" } = rec+ where rec _ = ""+selector cfg = intercalate ("," <> newline cfg) . rec where rec (In (SelectorF (Refinement ft) p)) = (<> foldMap predicate (sort ft)) <$> case p of Star -> if null ft then ["*"] else [""]@@ -258,22 +308,23 @@ Child a b -> ins " > " <$> rec a <*> rec b Deep a b -> ins " " <$> rec a <*> rec b Adjacent a b -> ins " + " <$> rec a <*> rec b+ Sibling a b -> ins " ~ " <$> rec a <*> rec b Combined a b -> rec a ++ 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, "']" ]- 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, "(", intercalate "," (map fromText p), ")" ]+ PseudoElem a -> [ "::", fromText a ]
src/Clay/Selector.hs view
@@ -1,18 +1,16 @@ {-# LANGUAGE OverloadedStrings , FlexibleInstances- , FlexibleContexts , GeneralizedNewtypeDeriving , StandaloneDeriving , UndecidableInstances+ , ViewPatterns+ , PatternGuards #-} 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 @@ -53,6 +51,11 @@ (|+) :: Selector -> Selector -> Selector (|+) a b = In (SelectorF (Refinement []) (Adjacent a b)) +-- | The general sibling selector composer. Maps to @sel1 ~ sel2@ in CSS.++(|~) :: Selector -> Selector -> Selector+(|~) a b = In (SelectorF (Refinement []) (Sibling a b))+ -- | Named alias for `#`. with :: Selector -> Refinement -> Selector@@ -132,6 +135,7 @@ (|=) :: Text -> Text -> Refinement (|=) a = Refinement . pure . AttrHyph a + ------------------------------------------------------------------------------- data Predicate@@ -146,20 +150,24 @@ | AttrHyph Text Text | Pseudo Text | PseudoFunc Text [Text]+ | PseudoElem Text deriving (Eq, Ord, Show) newtype Refinement = Refinement { unFilter :: [Predicate] }- deriving Show+ deriving (Show, Semigroup, Monoid) instance IsString Refinement where- fromString = filterFromText . fromString+ fromString = refinementFromText . fromString -filterFromText :: Text -> Refinement-filterFromText t = Refinement $+refinementFromText :: Text -> Refinement+refinementFromText t = Refinement $ 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] @@ -171,6 +179,7 @@ | Child f f | Deep f f | Adjacent f f+ | Sibling f f | Combined f f deriving Show @@ -184,16 +193,18 @@ type Selector = Fix SelectorF instance IsString (Fix SelectorF) where- fromString = text . fromString+ fromString = selectorFromText . fromString -text :: Text -> Selector-text t = In $+selectorFromText :: Text -> Selector+selectorFromText t = case Text.uncons t of- Just ('#', s) -> SelectorF (Refinement [Id s]) Star- Just ('.', s) -> SelectorF (Refinement [Class s]) Star- _ -> SelectorF (Refinement []) (Elem t)+ Just (c, _) | elem c ("#.:@" :: [Char])+ -> with star (refinementFromText t)+ _ -> In $ SelectorF (Refinement []) (Elem t) -instance Monoid (Fix SelectorF) where- mempty = error "Selector is a semigroup"- mappend a b = In (SelectorF (Refinement []) (Combined a b))+instance Semigroup (Fix SelectorF) where+ a <> b = In (SelectorF (Refinement []) (Combined a b)) +instance Monoid (Fix SelectorF) where+ mempty = error "Selector is a semigroup"+ mappend = (<>)
src/Clay/Size.hs view
@@ -1,27 +1,63 @@ {-# LANGUAGE- EmptyDataDecls- , OverloadedStrings+ OverloadedStrings , GeneralizedNewtypeDeriving , FlexibleInstances+ , ExistentialQuantification+ , StandaloneDeriving+ , TypeFamilies+ , EmptyDataDecls #-} module Clay.Size ( -- * Size type. Size-, Abs-, Rel+, LengthUnit+, Percentage , nil+, unitless -- * Size constructors. +, cm+, mm+, inches , px , pt+, pc , em , ex+, ch , pct , rem+, lh+, rlh+, vw+, vh+, vmin+, vmax+, vb+, vi+, svw+, svh+, lvw+, lvh+, dvw+, dvh+, fr+, maxContent+, minContent+, available+, fitContent +-- * Calculation operators for calc++, (@+@)+, (@-@)+, (@*)+, (*@)+, (@/)+ -- * Shorthands for properties that can be applied separately to each box side. , sym@@ -33,17 +69,22 @@ , Angle , Deg , Rad+, Grad+, Turn -- * Constructing angles. , deg , rad+, grad+, turn ) where import Data.Monoid import Prelude hiding (rem)+import Data.Text (Text) import Clay.Common import Clay.Property@@ -51,61 +92,164 @@ ------------------------------------------------------------------------------- --- | Sizes can be relative like percentages or rems.-data Rel+-- | Sizes can be given using a length unit (e.g. em, px).+data LengthUnit --- | Sizes can be absolute like pixels, points, etc.-data Abs+-- | Sizes can be given in percentages.+data Percentage -newtype Size a = Size Value- deriving (Val, Auto, Normal, Inherit, None, Other)+-- | When combining percentages with units using calc, we get a combination+data Combination +data Size a =+ SimpleSize Text |+ forall b c. SumSize (Size b) (Size c) |+ forall b c. DiffSize (Size b) (Size c) |+ MultSize Number (Size a) |+ DivSize Number (Size a) |+ OtherSize Value++deriving instance Show (Size a)++sizeToText :: Size a -> Text+sizeToText (SimpleSize txt) = txt+sizeToText (SumSize a b) = mconcat ["(", sizeToText a, " + ", sizeToText b, ")"]+sizeToText (DiffSize a b) = mconcat ["(", sizeToText a, " - ", sizeToText b, ")"]+sizeToText (MultSize a b) = mconcat ["(", cssNumberText a, " * ", sizeToText b, ")"]+sizeToText (DivSize a b) = mconcat ["(", sizeToText b, " / ", cssNumberText a, ")"]+sizeToText (OtherSize a) = plain $ unValue a++instance Val (Size a) where+ value (SimpleSize a) = value a+ value (OtherSize a) = a+ value s = Value $ browsers <> Plain ("calc" <> sizeToText s)++instance Auto (Size a) where auto = OtherSize Clay.Common.autoValue+instance Normal (Size a) where normal = OtherSize Clay.Common.normalValue+instance Inherit (Size a) where inherit = OtherSize Clay.Common.inheritValue+instance None (Size a) where none = OtherSize Clay.Common.noneValue+instance Other (Size a) where other a = OtherSize a++-- | Zero size. nil :: Size a-nil = Size "0"+nil = SimpleSize "0" +-- | Unitless size (as recommended for line-height).+unitless :: Number -> Size a+unitless i = SimpleSize ((plain . unValue . value) i)++cm, mm, inches, px, pt, pc :: Number -> Size LengthUnit++-- | Size in centimeters.+cm i = SimpleSize (cssNumberText i <> "cm")++-- | Size in millimeters.+mm i = SimpleSize (cssNumberText i <> "mm")++-- | Size in inches (1in = 2.54 cm).+inches i = SimpleSize (cssNumberText i <> "in")+ -- | Size in pixels.+px i = SimpleSize (cssNumberText i <> "px") -px :: Integer -> Size Abs-px i = Size (value i <> "px")+-- | Size in points (1pt = 1/72 of 1in).+pt i = SimpleSize (cssNumberText i <> "pt") --- | Size in points.+-- | Size in picas (1pc = 12pt).+pc i = SimpleSize (cssNumberText i <> "pc") -pt :: Double -> Size Abs-pt i = Size (value i <> "pt")+em, ex, ch, rem, lh, rlh, vw, vh, vmin, vmax, vb, vi, svw, svh, lvw, lvh, dvw, dvh, fr :: Number -> Size LengthUnit --- | Size in em's.+-- | Size in em's (computed cssNumberText of the font-size).+em i = SimpleSize (cssNumberText i <> "em") -em :: Double -> Size Abs-em i = Size (value i <> "em")+-- | SimpleSize in ex'es (x-height of the first avaliable font).+ex i = SimpleSize (cssNumberText i <> "ex") --- | Size in ex'es.+-- | SimpleSize in ch's (The width of the glyph "0" of the element's font).+ch i = SimpleSize (cssNumberText i <> "ch") -ex :: Double -> Size Abs-ex i = Size (value i <> "ex")+-- | SimpleSize in rem's (em's, but always relative to the root element).+rem i = SimpleSize (cssNumberText i <> "rem") --- | Size in percentages.+-- | SimpleSize in lh's (Line height of the element).+lh i = SimpleSize (cssNumberText i <> "lh") -pct :: Double -> Size Rel-pct i = Size (value i <> "%")+-- | SimpleSize in rlh's (lh's, but always relative to the root element).+rlh i = SimpleSize (cssNumberText i <> "rlh") --- | Size in rem's.+-- | SimpleSize in vw's (1vw = 1% of viewport width).+vw i = SimpleSize (cssNumberText i <> "vw") -rem :: Double -> Size Rel-rem i = Size (value i <> "rem")+-- | SimpleSize in vh's (1vh = 1% of viewport height).+vh i = SimpleSize (cssNumberText i <> "vh") -instance Num (Size Abs) where- fromInteger = px+-- | SimpleSize in vmin's (the smaller of vw or vh).+vmin i = SimpleSize (cssNumberText i <> "vmin")++-- | SimpleSize in vmax's (the larger of vw or vh).+vmax i = SimpleSize (cssNumberText i <> "vmax")++-- | SimpleSize in vb's (1vb = 1% of the parent's size in the direction of the root element's block axis).+vb i = SimpleSize (cssNumberText i <> "vb")++-- | SimpleSize in vi's (1vi = 1% of the parent's size in the direction of the root element's inline axis).+vi i = SimpleSize (cssNumberText i <> "vi")++-- | SimpleSize in svw's (1svw = 1% of the small viewport's width).+svw i = SimpleSize (cssNumberText i <> "svw")++-- | SimpleSize in svh's (1svh = 1% of the small viewport's height).+svh i = SimpleSize (cssNumberText i <> "svh")++-- | SimpleSize in lvw's (1lvw = 1% of the large viewport's width).+lvw i = SimpleSize (cssNumberText i <> "lvw")++-- | SimpleSize in lvh's (1lvh = 1% of the large viewport's height).+lvh i = SimpleSize (cssNumberText i <> "lvh")++-- | SimpleSize in dvw's (1dvw = 1% of the dynamic viewport's width).+dvw i = SimpleSize (cssNumberText i <> "dvw")++-- | SimpleSize in dvh's (1dvh = 1% of the dynamic viewport's height).+dvh i = SimpleSize (cssNumberText i <> "dvh")++-- | 'SimpleSize' in fr's (a fractional unit and 1fr is for 1 part of the available space in grid areas).+fr i = SimpleSize (cssNumberText i <> "fr")++-- | SimpleSize for the intrinsic preferred width.+maxContent :: Size LengthUnit+maxContent = SimpleSize "max-content"++-- | SimpleSize for the intrinsic minimum width.+minContent :: Size LengthUnit+minContent = SimpleSize "min-content"++-- | SimpleSize for the containing block width minus horizontal margin, border, and padding.+available :: Size LengthUnit+available = SimpleSize "available"++-- | The larger of the intrinsic minimum width or the smaller of the intrinsic preferred width and the available width.+fitContent :: Size LengthUnit+fitContent = SimpleSize "fit-content"++-- | SimpleSize in percents.+pct :: Number -> Size Percentage+pct i = SimpleSize (cssNumberText i <> "%")++instance Num (Size LengthUnit) where+ fromInteger = px . 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" negate = error "negate not implemented for Size" -instance Fractional (Size Abs) where- fromRational = em . fromRational+instance Fractional (Size LengthUnit) where+ fromRational = px . fromRational recip = error "recip not implemented for Size" -instance Num (Size Rel) where+instance Num (Size Percentage) where fromInteger = pct . fromInteger (+) = error "plus not implemented for Size" (*) = error "times not implemented for Size"@@ -113,39 +257,79 @@ signum = error "signum not implemented for Size" negate = error "negate not implemented for Size" -instance Fractional (Size Rel) where+instance Fractional (Size Percentage) where fromRational = pct . fromRational recip = error "recip not implemented for Size" +-- | Type family to define what is the result of a calc operation++type family SizeCombination sa sb where+ SizeCombination Percentage Percentage = Percentage+ SizeCombination LengthUnit LengthUnit = LengthUnit+ SizeCombination a b = Combination++-- | Plus operator to combine sizes into calc function+infixl 6 @+@+(@+@) :: Size a -> Size b -> Size (SizeCombination a b)+a @+@ b = SumSize a b++-- | Minus operator to combine sizes into calc function+infixl 6 @-@+(@-@) :: Size a -> Size b -> Size (SizeCombination a b)+a @-@ b = DiffSize a b++-- | Times operator to combine sizes into calc function+infixl 7 *@+(*@) :: Number -> Size a -> Size a+a *@ b = MultSize a b++-- | Reversed times operator to combine sizes into calc function+infixl 7 @*+(@*) :: Size a -> Number -> Size a+a @* b = MultSize b a++-- | Division operator to combine sizes into calc function+infixl 7 @/+(@/) :: Size a -> Number -> Size a+a @/ b = DivSize b a+ ------------------------------------------------------------------------------- sym :: (a -> a -> a -> a -> Css) -> a -> Css sym k a = k a a a a -sym3 :: (a -> a -> a -> a -> Css) -> a -> a -> a -> Css+sym3 :: (tb -> l -> tb -> r -> Css) -> tb -> l -> r -> Css sym3 k tb l r = k tb l tb r -sym2 :: (a -> a -> a -> a -> Css) -> a -> a -> Css+sym2 :: (tb -> lr -> tb -> lr -> Css) -> tb -> lr -> Css sym2 k tb lr = k tb lr tb lr ------------------------------------------------------------------------------- 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 :: Number -> Angle Deg deg i = Angle (value i <> "deg") -- | Angle in radians.--rad :: Double -> Angle Rad+rad :: Number -> Angle Rad rad i = Angle (value i <> "rad") +-- | Angle in gradians (also knows as gons or grades).+grad :: Number -> Angle Grad+grad i = Angle (value i <> "grad")++-- | Angle in turns.+turn :: Number -> Angle Turn+turn i = Angle (value i <> "turn")+ instance Num (Angle Deg) where fromInteger = deg . fromInteger (+) = error "plus not implemented for Angle"@@ -170,3 +354,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"
src/Clay/Stylesheet.hs view
@@ -1,9 +1,14 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} module Clay.Stylesheet where import Control.Applicative import Control.Arrow (second)-import Control.Monad.Writer hiding (All)+import Control.Monad.Writer (Writer, execWriter, tell)+import Data.Maybe (isJust)+import Data.String (IsString) import Data.Text (Text) import Clay.Selector hiding (Child)@@ -24,6 +29,22 @@ data Feature = Feature Text (Maybe Value) deriving Show +newtype CommentText = CommentText { unCommentText :: Text }+ deriving (Show, IsString, Semigroup, Monoid)++data Modifier+ = Important+ | Comment CommentText+ deriving (Show)++_Important :: Modifier -> Maybe Text+_Important Important = Just "!important"+_Important (Comment _) = Nothing++_Comment :: Modifier -> Maybe CommentText+_Comment (Comment c) = Just c+_Comment Important = Nothing+ ------------------------------------------------------------------------------- data App@@ -34,11 +55,11 @@ | Sub Selector deriving Show -data Keyframes = Keyframes Text [(Double, [Rule])]+data Keyframes = Keyframes Text [(Number, [Rule])] deriving Show data Rule- = Property (Key ()) Value+ = Property [Modifier] (Key ()) Value | Nested App [Rule] | Query MediaQuery [Rule] | Face [Rule]@@ -61,12 +82,19 @@ type Css = StyleM () +instance Semigroup Css where+ (<>) = liftA2 (<>)++instance Monoid Css where+ mempty = pure ()+ 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 -- words: can be converted to a `Value`. key :: Val a => Key a -> a -> Css-key k v = rule $ 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.@@ -137,7 +165,7 @@ ------------------------------------------------------------------------------- -keyframes :: Text -> [(Double, Css)] -> Css+keyframes :: Text -> [(Number, Css)] -> Css keyframes n xs = rule $ Keyframe (Keyframes n (map (second runS) xs)) keyframesFromTo :: Text -> Css -> Css -> Css@@ -156,3 +184,21 @@ importUrl :: Text -> Css importUrl l = rule $ Import l +-------------------------------------------------------------------------------++-- | Indicate the supplied css should override css declarations that would+-- otherwise take precedence.+--+-- Use sparingly.+important :: Css -> Css+important = foldMap (rule . addImportant) . runS++-- The last case indicates there may be something wrong in the typing, as+-- it shouldn't be possible to make a non-property important. In practice,+-- this implementation means only the directly applied property rule is+-- affected, i.e. no nested rules. That could be changed by adding recursive cases.+addImportant :: Rule -> Rule+addImportant (Property ms@(filter (isJust . _Important) -> (_:_)) k v) =+ Property ms k v+addImportant (Property ms k v ) = Property (Important : ms) k v+addImportant r = r
src/Clay/Text.hs view
@@ -17,6 +17,7 @@ , textShadow -- * Text-indent.+-- $text-indent , TextIndent , textIndent@@ -34,6 +35,7 @@ , TextAlign , textAlign+, textAlignLast , justify, matchParent, start, end , alignSide , alignString@@ -59,6 +61,36 @@ , textTransform , capitalize, uppercase, lowercase, fullWidth +-- * Text-overflow.++, TextOverflow+, textOverflow+, overflowClip, overflowEllipsis++-- * Word-break.++, WordBreak+, wordBreak+, breakAll+, keepAll++-- * Overflow-wrap (and Word-wrap).++, OverflowWrap+, overflowWrap+, wordWrap+, breakWord++-- * Hyphenation.++, hyphens+, hyphenateCharacter+, hyphenateLimitChars+, manual+, Hyphens+, HyphenateCharacter+, HyphenateLimit+ -- * Content. , Content@@ -73,9 +105,8 @@ ) where -import Data.Monoid import Data.String-import Data.Text (Text)+import Data.Text (Text, pack) import Clay.Background import Clay.Border@@ -114,14 +145,38 @@ ------------------------------------------------------------------------------- +-- $text-indent+--+-- Supply a length — optionally annotated with @each-line@ or @hanging@ or+-- both, or a global value. It is possible to apply the same annotation+-- multiple times, but it has no defined effect.+--+-- Note browser support is currently (March 2018) non-existent, but the+-- Prince typesetting system supports the syntax.+--+-- === Formal argument syntax+--+-- > <length-percentage> && hanging? && each-line?+-- > where+-- > <length-percentage> = <length> | <percentage>+ newtype TextIndent = TextIndent Value- deriving (Val, Inherit, Other)+ deriving (Val, Inherit, Initial, Unset, Other) -eachLine, hanging :: TextIndent+-- | An internal function that ensures each-line and hanging are processed+-- correctly.+tagTextIndent :: Value -> TextIndent -> TextIndent+tagTextIndent v (TextIndent v0) = TextIndent . value $ (v0, v) -eachLine = TextIndent "each-line"-hanging = TextIndent "hanging"+-- | Annotate the supplied 'TextIndent' with @each-line@ or @hanging@ or+-- both.+--+-- > eachLine . hanging . indent $ px 3 :: TextIndent+eachLine, hanging :: TextIndent -> TextIndent +eachLine = tagTextIndent "each-line"+hanging = tagTextIndent "hanging"+ indent :: Size a -> TextIndent indent = TextIndent . value @@ -145,12 +200,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" @@ -163,6 +218,9 @@ textAlign :: TextAlign -> Css textAlign = key "text-align" +textAlignLast :: TextAlign -> Css+textAlignLast = key "text-align-last"+ ------------------------------------------------------------------------------- newtype WhiteSpace = WhiteSpace Value@@ -216,6 +274,137 @@ textTransform :: TextTransform -> Css textTransform = key "text-transform"++-------------------------------------------------------------------------------++newtype WordBreak = WordBreak Value+ deriving (Val, Inherit, Initial, Unset, Normal)++breakAll, keepAll :: WordBreak++breakAll = WordBreak "break-all"+keepAll = WordBreak "keep-all"++wordBreak :: WordBreak -> Css++wordBreak = key "word-break"++-------------------------------------------------------------------------------++newtype OverflowWrap = OverflowWrap Value+ deriving (Val, Inherit, Initial, Unset, Normal)++breakWord :: OverflowWrap++breakWord = OverflowWrap "break-word"++overflowWrap, wordWrap :: OverflowWrap -> Css++wordWrap = key "word-wrap"+overflowWrap = key "overflow-wrap"++-------------------------------------------------------------------------------++newtype TextOverflow = TextOverflow Value+ deriving (Val, None, Inherit, Initial)++overflowClip, overflowEllipsis :: TextOverflow++overflowClip = TextOverflow "clip"+overflowEllipsis = TextOverflow "ellipsis"++textOverflow :: TextOverflow -> Css+textOverflow = key "text-overflow"++-------------------------------------------------------------------------------++-- | Type for values which can be provided to 'hyphens'.+newtype Hyphens = Hyphens Value+ deriving (Val, None, Auto, Initial, Inherit, Unset, Other)++-- | Specifies how words should be hyphenated.+--+-- Possible values are:+--+-- ['none']: No hyphenation.+-- Words will not be hyphenated even if it is explicitly suggested for a word.+--+-- ['manual']: Manual hyphenation.+-- Specific characters such as @­@ in a word will suggest break points.+-- This is the default.+--+-- ['auto']: Automatic hyphenation.+-- The browser is free to hyphenate words as it sees fit.+-- However, explicitly suggested break points will take precedence.+--+-- For example,+--+-- >>> hyphens auto+--+-- The hyphenation rules depend on the language,+-- which must be specified by the @lang@ attribute.+--+-- For reference, see+-- [@hyphens@](https://developer.mozilla.org/en-US/docs/Web/CSS/hyphens).+hyphens :: Hyphens -> Css+hyphens = key "hyphens"++-- | Value for 'hyphens' specifying that hyphenation be manual.+manual :: Hyphens+manual = Hyphens "manual"+-- 'manual' feels like it should be a function and type class in Clay.Common,+-- but @hyphens@ is the only CSS property which uses it as a specified value.++-- | Type for values which can be provided to 'hyphenateCharacter'.+newtype HyphenateCharacter = HyphenateCharacter Value+ deriving (Val, Auto, Initial, Inherit, Unset, Other)++-- Allow a 'HyphenateCharacter' value to be specified directly with a string.+instance IsString HyphenateCharacter where+ fromString = HyphenateCharacter . Value . Plain . quote . pack++-- | Customizes the character used for hyphenation.+--+-- For example,+--+-- >>> hyphenateCharacter "~"+--+-- For reference, see+-- [@hyphenate-character@](https://developer.mozilla.org/en-US/docs/Web/CSS/hyphenate-character).+hyphenateCharacter :: HyphenateCharacter -> Css+hyphenateCharacter = key "hyphenate-character"++-- | Type for values which can be provded to 'hyphenateLimitChars'.+newtype HyphenateLimit = HyphenateLimit Value+ deriving (Val, Auto, Initial, Inherit, Unset, Other)++-- Allow a 'HyphenateLimit' value to be specified directly with a number.+instance Num HyphenateLimit where+ fromInteger = HyphenateLimit . value+ (+) = error "plus not implemented for HyphenateLimit"+ (*) = error "times not implemented for HyphenateLimit"+ abs = error "abs not implemented for HyphenateLimit"+ signum = error "signum not implemented for HyphenateLimit"+ negate = error "negate not implemented for HyphenateLimit"++-- | Adjusts the minumum number of characters involved in hyphenation.+--+-- I.e., specifies the minumum number of characters allowed in a breakable word,+-- before a break point, and after a break point when hyphenating a word.+--+-- For example,+--+-- >>> hyphenateLimitChars 14 auto auto+--+-- For reference, see+-- [@hyphenate-limit-chars@](https://developer.mozilla.org/en-US/docs/Web/CSS/hyphenate-limit-chars).+hyphenateLimitChars+ :: HyphenateLimit -- ^ Minimum length of a word which can be hyphenated.+ -> HyphenateLimit -- ^ Minimum number of characters allowed before a break point.+ -> HyphenateLimit -- ^ Minimum number of characters allowed after a break point.+ -> Css+hyphenateLimitChars word before after =+ key "hyphenate-limit-chars" (word ! before ! after) -------------------------------------------------------------------------------
src/Clay/Time.hs view
@@ -12,7 +12,6 @@ ) where -import Data.Monoid import Data.Text (pack) import Clay.Common
src/Clay/Transform.hs view
@@ -7,6 +7,18 @@ Transformation , transform , transforms+, TransformStyle+, transformStyle+, flat+, preserve3d+, TransformBox+, transformBox+, transformContentBox+, transformBorderBox+, fillBox+, strokeBox+, viewBox+, transformOrigin -- * Translating. @@ -39,7 +51,6 @@ ) where -import Data.Monoid import Prelude hiding (Left, Right) import Clay.Property@@ -58,16 +69,48 @@ ------------------------------------------------------------------------------- -scale :: Double -> Double -> Transformation+newtype TransformStyle = TransformStyle Value+ deriving (Val, Inherit, Initial, Unset)++transformStyle :: TransformStyle -> Css+transformStyle = prefixed (browsers <> "transform-style")++flat, preserve3d :: TransformStyle+flat = TransformStyle "flat"+preserve3d = TransformStyle "preserve-3d"++-------------------------------------------------------------------------------++newtype TransformBox = TransformBox Value+ deriving (Val, Inherit, Initial, Unset)++transformBox :: TransformBox -> Css+transformBox = prefixed (browsers <> "transform-box")++transformContentBox, transformBorderBox, fillBox, strokeBox, viewBox :: TransformBox+transformContentBox = TransformBox "contentBox"+transformBorderBox = TransformBox "borderBox"+fillBox = TransformBox "fillBox"+strokeBox = TransformBox "strokeBox"+viewBox = TransformBox "viewBox"++-------------------------------------------------------------------------------++transformOrigin :: [Size a] -> Css+transformOrigin = prefixed (browsers <> "transform-origin") . noCommas++-------------------------------------------------------------------------------++scale :: Number -> Number -> Transformation scale x y = Transformation ("scale(" <> value [x, y] <> ")") -scaleX, scaleY, scaleZ :: Double -> Transformation+scaleX, scaleY, scaleZ :: Number -> 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 :: Number -> Number -> Number -> Transformation scale3d x y z = Transformation ("scale3d(" <> value [x, y, z] <> ")") -------------------------------------------------------------------------------@@ -81,22 +124,23 @@ rotateY y = Transformation ("rotateY(" <> value y <> ")") rotateZ z = Transformation ("rotateZ(" <> value z <> ")") -rotate3d :: Double -> Double -> Double -> Angle a -> Transformation+rotate3d :: Number -> Number -> Number -> 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] <> ")")+translate :: Size a -> Size b -> Transformation+translate x y = Transformation ("translate(" <> value [value x, value y] <> ")") -translateX, translateY, translateZ :: Size Abs -> Transformation+translateX, translateY :: Size LengthUnit -> Transformation+translateZ :: Size LengthUnit -> 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] <> ")")+translate3d :: Size a -> Size b -> Size LengthUnit -> Transformation+translate3d x y z = Transformation ("translate3d(" <> value [value x, value y, value z] <> ")") ------------------------------------------------------------------------------- @@ -110,16 +154,16 @@ ------------------------------------------------------------------------------- -perspective :: Double -> Transformation+perspective :: Number -> 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 ] <> ")")+matrix :: Number -> Number -> Number -> Number -> Number -> Number -> Transformation+matrix u v w x y z = Transformation ("matrix(" <> value [ u, v, w, x, y, z ] <> ")") -matrix3d :: Double -> Double -> Double -> Double- -> Double -> Double -> Double -> Double- -> Double -> Double -> Double -> Double- -> Double -> Double -> Double -> Double+matrix3d :: Number -> Number -> Number -> Number + -> Number -> Number -> Number -> Number+ -> Number -> Number -> Number -> Number+ -> Number -> Number -> Number -> Number -> Transformation matrix3d w0 x0 y0 z0 w1 x1 y1 z1
src/Clay/Transition.hs view
@@ -24,7 +24,8 @@ , TimingFunction , transitionTimingFunction-, ease, easeIn, easeOut, easeInOut, linear, stepStart, stepStop+, transitionTimingFunctions+, ease, easeIn, easeOut, easeInOut, linear, stepStart, stepEnd, stepStop , stepsStart, stepsStop , cubicBezier @@ -35,7 +36,6 @@ ) where -import Data.Monoid import Data.Text (Text) import Clay.Common@@ -47,8 +47,9 @@ 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))+transitions [] = key "transition" (none :: Value)+transitions x = prefixed (browsers <> "transition")+ $ map (\(p, d, f, e) -> value (p ! d ! f ! e)) x ------------------------------------------------------------------------------- @@ -56,22 +57,24 @@ transitionProperty = key "transition-property" transitionProperties :: [Text] -> Css-transitionProperties = key "transition-property"+transitionProperties [] = key "transition-property" (none :: Value)+transitionProperties x = key "transition-property" x ------------------------------------------------------------------------------- transitionDuration :: Time -> Css transitionDuration = key "transition-duration" -transitionDurations :: [Time] -> Css-transitionDurations = key "transition-duration"+transitionDurations :: [Time] -> Css +transitionDurations [] = key "transition-duration" (none :: Value)+transitionDurations x = key "transition-duration" x ------------------------------------------------------------------------------- newtype TimingFunction = TimingFunction Value deriving (Val, Other, Auto) -ease, easeIn, easeOut, easeInOut, linear, stepStart, stepStop :: TimingFunction+ease, easeIn, easeOut, easeInOut, linear, stepStart, stepEnd, stepStop :: TimingFunction ease = other "ease" easeIn = other "ease-in"@@ -79,18 +82,25 @@ easeInOut = other "ease-in-out" linear = other "linear" stepStart = other "step-start"-stepStop = other "step-stop"+stepEnd = other "step-end" +stepStop = stepEnd+{-# DEPRECATED stepStop "Use `stepEnd` instead." #-}+ stepsStart, stepsStop :: Integer -> TimingFunction -stepsStart s = other ("steps(" <> value s <> ", end)")+stepsStart s = other ("steps(" <> value s <> ", start)") 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) <> ")")+cubicBezier :: Number -> Number -> Number -> Number -> TimingFunction+cubicBezier a b c d = other ("cubic-bezier(" <> value [a, b, c, d] <> ")") transitionTimingFunction :: TimingFunction -> Css transitionTimingFunction = key "transition-timing-function"++transitionTimingFunctions :: [TimingFunction] -> Css+transitionTimingFunctions [] = key "transition-timing-function" (none :: Value)+transitionTimingFunctions x = key "transition-timing-function" x -------------------------------------------------------------------------------
− src/Test.hs
@@ -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 ()) @?= ""- ]