diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -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. diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 --- /dev/null +++ b/CONTRIBUTING.md @@ -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 +``` diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,13 @@ +# Clay + +[![build](https://github.com/sebastiaanvisser/clay/actions/workflows/ci.yml/badge.svg)](https://github.com/sebastiaanvisser/clay/actions/workflows/ci.yml) +[![Hackage](https://img.shields.io/hackage/v/clay.svg)](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`. diff --git a/clay.cabal b/clay.cabal --- a/clay.cabal +++ b/clay.cabal @@ -1,5 +1,5 @@ Name: clay -Version: 0.12.3 +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 @@ -20,13 +20,24 @@ 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==7.8.4, - GHC==7.10.3, - GHC==8.0.1 + 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 @@ -54,6 +65,7 @@ Clay.FontFace Clay.Geometry Clay.Gradient + Clay.Grid Clay.List Clay.Media Clay.Mask @@ -68,21 +80,23 @@ Clay.Transform Clay.Transition - GHC-Options: -Wall Build-Depends: - base >= 4.5 && < 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: spec, src + Build-Tools: hspec-discover main-is: Spec.hs Build-Depends: - base >= 4.5 && < 5, - base >= 4 && < 5, - mtl >= 1 && < 2.3, - text >= 0.11 && < 1.3, - hspec-expectations >= 0.7.2 && < 0.9, - hspec >= 2.2.0 && < 2.5 - 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 diff --git a/src/Clay.hs b/src/Clay.hs --- a/src/Clay.hs +++ b/src/Clay.hs @@ -39,6 +39,7 @@ , (|>) , (#) , (|+) +, (|~) -- ** Refining selectors. @@ -112,6 +113,7 @@ , module Clay.FontFace , module Clay.Geometry , module Clay.Gradient +, module Clay.Grid , module Clay.List , module Clay.Text , module Clay.Transform @@ -155,6 +157,7 @@ import Clay.FontFace import Clay.Geometry import Clay.Gradient +import Clay.Grid import Clay.List import Clay.Size import Clay.Text hiding (pre) @@ -182,6 +185,6 @@ -- grouped with the preceding value when rendered compactly. -- -- Note that /every/ generated line in the generated content will feature the --- comment. +-- comment. -- -- An empty comment generates '@/* */@'. diff --git a/src/Clay/Animation.hs b/src/Clay/Animation.hs --- a/src/Clay/Animation.hs +++ b/src/Clay/Animation.hs @@ -142,7 +142,7 @@ infinite :: IterationCount infinite = IterationCount "infinite" -iterationCount :: Double -> IterationCount +iterationCount :: Number -> IterationCount iterationCount = IterationCount . value ------------------------------------------------------------------------------- diff --git a/src/Clay/Background.hs b/src/Clay/Background.hs --- a/src/Clay/Background.hs +++ b/src/Clay/Background.hs @@ -145,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 diff --git a/src/Clay/Border.hs b/src/Clay/Border.hs --- a/src/Clay/Border.hs +++ b/src/Clay/Border.hs @@ -56,7 +56,7 @@ ------------------------------------------------------------------------------- -border, borderTop, borderLeft, borderBottom, borderRight :: Stroke -> Size LengthUnit -> 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) diff --git a/src/Clay/Box.hs b/src/Clay/Box.hs --- a/src/Clay/Box.hs +++ b/src/Clay/Box.hs @@ -20,7 +20,6 @@ ) where -import Data.Monoid import Data.List.NonEmpty (NonEmpty) import Clay.Color @@ -82,6 +81,10 @@ -- > 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)] diff --git a/src/Clay/Color.hs b/src/Clay/Color.hs --- a/src/Clay/Color.hs +++ b/src/Clay/Color.hs @@ -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 @@ -119,14 +118,17 @@ (*.) :: 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 :: Ord a => Num a => a -> a clamp i = max (min i (fromIntegral (255 :: Integer))) (fromIntegral (0 :: Integer)) @@ -176,10 +178,10 @@ instance Val Color where value clr = case clr of - 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, ")"] + 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" diff --git a/src/Clay/Comments.hs b/src/Clay/Comments.hs --- a/src/Clay/Comments.hs +++ b/src/Clay/Comments.hs @@ -3,7 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} module Clay.Comments where -import Data.Monoid ((<>)) import Data.Maybe (isNothing) import Data.List (partition) diff --git a/src/Clay/Common.hs b/src/Clay/Common.hs --- a/src/Clay/Common.hs +++ b/src/Clay/Common.hs @@ -9,23 +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 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 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 @@ -55,32 +58,53 @@ 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 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 ] ------------------------------------------------------------------------------- diff --git a/src/Clay/Display.hs b/src/Clay/Display.hs --- a/src/Clay/Display.hs +++ b/src/Clay/Display.hs @@ -17,7 +17,7 @@ , Position , position -, static, absolute, fixed, relative +, static, absolute, fixed, relative, sticky -- * Display @@ -34,6 +34,15 @@ , scroll , overflow, overflowX, overflowY +-- * Overscroll +, Overscroll +, overscrollBehavior +, overscrollBehavior2 +, overscrollBehaviorX +, overscrollBehaviorY +, overscrollBehaviorBlock +, overscrollBehaviorInline + -- * Visibility. , Visibility @@ -70,19 +79,24 @@ -- * 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" @@ -179,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 @@ -203,7 +242,7 @@ ------------------------------------------------------------------------------- -opacity :: Double -> Css +opacity :: Number -> Css opacity = key "opacity" zIndex :: Integer -> Css @@ -239,7 +278,7 @@ instance VerticalAlign VerticalAlignValue instance VerticalAlign (Size a) -middle,vAlignSub,vAlignSuper,textTop,textBottom,vAlignTop,vAlignBottom,vAlignBaseline :: VerticalAlignValue +middle,vAlignSub,vAlignSuper,textTop,textBottom,vAlignTop,vAlignBottom,vAlignBaseline :: VerticalAlignValue middle = VerticalAlignValue "middle" vAlignSub = VerticalAlignValue "sub" @@ -250,34 +289,71 @@ 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" +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 "s-resize" -wResize = CursorValue "w-resize" -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" diff --git a/src/Clay/Filter.hs b/src/Clay/Filter.hs --- a/src/Clay/Filter.hs +++ b/src/Clay/Filter.hs @@ -52,7 +52,7 @@ blur :: Size LengthUnit -> Filter blur i = Filter ("blur(" <> value i <> ")") -brightness :: Double -> Filter +brightness :: Number -> Filter brightness i = Filter ("brightness(" <> value i <> ")") contrast :: Size Percentage -> Filter diff --git a/src/Clay/Flexbox.hs b/src/Clay/Flexbox.hs --- a/src/Clay/Flexbox.hs +++ b/src/Clay/Flexbox.hs @@ -14,19 +14,21 @@ 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, Stretch) + , Center, SpaceBetween, SpaceAround, SpaceEvenly, Stretch) alignContent :: AlignContentValue -> Css alignContent = key "align-content" @@ -107,7 +109,7 @@ newtype JustifyContentValue = JustifyContentValue Value deriving (Val, Other, Inherit, Center, FlexEnd - , FlexStart, SpaceAround, SpaceBetween) + , FlexStart, SpaceAround, SpaceBetween, SpaceEvenly, Stretch) justifyContent :: JustifyContentValue -> Css justifyContent = key "justify-content" diff --git a/src/Clay/Font.hs b/src/Clay/Font.hs --- a/src/Clay/Font.hs +++ b/src/Clay/Font.hs @@ -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) diff --git a/src/Clay/FontFace.hs b/src/Clay/FontFace.hs --- a/src/Clay/FontFace.hs +++ b/src/Clay/FontFace.hs @@ -9,8 +9,6 @@ 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) diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -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" - diff --git a/src/Clay/Gradient.hs b/src/Clay/Gradient.hs --- a/src/Clay/Gradient.hs +++ b/src/Clay/Gradient.hs @@ -36,8 +36,6 @@ ) where -import Data.Monoid - import Clay.Color import Clay.Common import Clay.Property diff --git a/src/Clay/Grid.hs b/src/Clay/Grid.hs new file mode 100644 --- /dev/null +++ b/src/Clay/Grid.hs @@ -0,0 +1,775 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExtendedDefaultRules #-} +{-# OPTIONS_GHC -Wno-type-defaults #-} + +-- | Partial implementation of +-- | . +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 diff --git a/src/Clay/List.hs b/src/Clay/List.hs --- a/src/Clay/List.hs +++ b/src/Clay/List.hs @@ -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 diff --git a/src/Clay/Mask.hs b/src/Clay/Mask.hs --- a/src/Clay/Mask.hs +++ b/src/Clay/Mask.hs @@ -57,8 +57,6 @@ ) where -import Data.Monoid - import Clay.Background import Clay.Common import Clay.Property diff --git a/src/Clay/Media.hs b/src/Clay/Media.hs --- a/src/Clay/Media.hs +++ b/src/Clay/Media.hs @@ -4,9 +4,13 @@ -- * 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 @@ -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" @@ -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")) diff --git a/src/Clay/Property.hs b/src/Clay/Property.hs --- a/src/Clay/Property.hs +++ b/src/Clay/Property.hs @@ -2,7 +2,6 @@ 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) @@ -16,9 +15,12 @@ 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) @@ -41,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 @@ -49,7 +51,7 @@ ------------------------------------------------------------------------------- newtype Value = Value { unValue :: Prefixed } - deriving (Show, Monoid, IsString, Eq) + deriving (Show, Semigroup, Monoid, IsString, Eq) class Val a where value :: a -> Value @@ -58,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)) @@ -69,15 +71,6 @@ data E5 = E5 instance HasResolution E5 where resolution _ = 100000 -instance Val Double where - value = Value . Plain . cssDoubleText - -cssDoubleText :: Double -> Text -cssDoubleText = fromString . showFixed' . realToFrac - where - showFixed' :: Fixed E5 -> String - showFixed' = showFixed True - instance Val Value where value = id @@ -100,7 +93,20 @@ intercalate :: Monoid a => a -> [a] -> a intercalate _ [] = mempty -intercalate s (x:xs) = foldl (\a b -> a <> s <> b) x xs +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 ------------------------------------------------------------------------------- diff --git a/src/Clay/Pseudo.hs b/src/Clay/Pseudo.hs --- a/src/Clay/Pseudo.hs +++ b/src/Clay/Pseudo.hs @@ -1,9 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} module Clay.Pseudo where import Data.Text (Text) -import Clay.Render (renderSelector) +import Clay.Render (renderSelector, renderRefinement) import Clay.Selector import qualified Data.Text.Lazy as Lazy @@ -64,5 +66,19 @@ nthLastOfType n = func "nth-last-of-type" [n] nthOfType n = func "nth-of-type" [n] -not :: Selector -> Refinement -not r = func "not" [Lazy.toStrict (renderSelector r)] +-- | 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) diff --git a/src/Clay/Render.hs b/src/Clay/Render.hs --- a/src/Clay/Render.hs +++ b/src/Clay/Render.hs @@ -8,16 +8,16 @@ , putCss , renderWith , renderSelector +, renderRefinement , withBanner ) where import Control.Applicative import Control.Monad.Writer -import Data.Foldable (foldMap) import Data.List (sort) import Data.Maybe -import Data.Text (Text, pack) +import Data.Text (Text) import Data.Text.Lazy.Builder import Prelude hiding ((**)) @@ -121,6 +121,10 @@ 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 @@ -148,10 +152,10 @@ ) (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 ] @@ -185,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) , ")" ] @@ -304,6 +308,7 @@ 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 diff --git a/src/Clay/Selector.hs b/src/Clay/Selector.hs --- a/src/Clay/Selector.hs +++ b/src/Clay/Selector.hs @@ -6,20 +6,12 @@ , UndecidableInstances , ViewPatterns , PatternGuards - , CPP #-} module Clay.Selector where -import Control.Applicative -import Data.Monoid import Data.String import Data.Text (Text) -import Prelude hiding (foldl) -#if MIN_VERSION_base(4,9,0) -import Data.Semigroup -#endif - import qualified Data.Text as Text -- | The star selector applies to all elements. Maps to @*@ in CSS. @@ -59,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 @@ -157,7 +154,7 @@ deriving (Eq, Ord, Show) newtype Refinement = Refinement { unFilter :: [Predicate] } - deriving (Show, Monoid) + deriving (Show, Semigroup, Monoid) instance IsString Refinement where fromString = refinementFromText . fromString @@ -182,6 +179,7 @@ | Child f f | Deep f f | Adjacent f f + | Sibling f f | Combined f f deriving Show @@ -204,12 +202,9 @@ -> with star (refinementFromText t) _ -> In $ SelectorF (Refinement []) (Elem t) -#if MIN_VERSION_base(4,9,0) instance Semigroup (Fix SelectorF) where - (<>) = mappend -#endif + a <> b = In (SelectorF (Refinement []) (Combined a b)) instance Monoid (Fix SelectorF) where - mempty = error "Selector is a semigroup" - mappend a b = In (SelectorF (Refinement []) (Combined a b)) - + mempty = error "Selector is a semigroup" + mappend = (<>) diff --git a/src/Clay/Size.hs b/src/Clay/Size.hs --- a/src/Clay/Size.hs +++ b/src/Clay/Size.hs @@ -27,12 +27,28 @@ , 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 @@ -89,8 +105,8 @@ SimpleSize Text | forall b c. SumSize (Size b) (Size c) | forall b c. DiffSize (Size b) (Size c) | - MultSize Double (Size a) | - DivSize Double (Size a) | + MultSize Number (Size a) | + DivSize Number (Size a) | OtherSize Value deriving instance Show (Size a) @@ -99,8 +115,8 @@ 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 ["(", cssDoubleText a, " * ", sizeToText b, ")"] -sizeToText (DivSize a b) = mconcat ["(", sizeToText b, " / ", cssDoubleText a, ")"] +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 @@ -119,55 +135,107 @@ nil = SimpleSize "0" -- | Unitless size (as recommended for line-height). -unitless :: Double -> Size a +unitless :: Number -> Size a unitless i = SimpleSize ((plain . unValue . value) i) -cm, mm, inches, px, pt, pc :: Double -> Size LengthUnit +cm, mm, inches, px, pt, pc :: Number -> Size LengthUnit -- | Size in centimeters. -cm i = SimpleSize (cssDoubleText i <> "cm") +cm i = SimpleSize (cssNumberText i <> "cm") -- | Size in millimeters. -mm i = SimpleSize (cssDoubleText i <> "mm") +mm i = SimpleSize (cssNumberText i <> "mm") -- | Size in inches (1in = 2.54 cm). -inches i = SimpleSize (cssDoubleText i <> "in") +inches i = SimpleSize (cssNumberText i <> "in") -- | Size in pixels. -px i = SimpleSize (cssDoubleText i <> "px") +px i = SimpleSize (cssNumberText i <> "px") -- | Size in points (1pt = 1/72 of 1in). -pt i = SimpleSize (cssDoubleText i <> "pt") +pt i = SimpleSize (cssNumberText i <> "pt") -- | Size in picas (1pc = 12pt). -pc i = SimpleSize (cssDoubleText i <> "pc") +pc i = SimpleSize (cssNumberText i <> "pc") -em, ex, rem, vw, vh, vmin, vmax :: Double -> Size LengthUnit +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 (computed cssDoubleText of the font-size). -em i = SimpleSize (cssDoubleText i <> "em") +-- | Size in em's (computed cssNumberText of the font-size). +em i = SimpleSize (cssNumberText i <> "em") -- | SimpleSize in ex'es (x-height of the first avaliable font). -ex i = SimpleSize (cssDoubleText i <> "ex") +ex i = SimpleSize (cssNumberText i <> "ex") +-- | SimpleSize in ch's (The width of the glyph "0" of the element's font). +ch i = SimpleSize (cssNumberText i <> "ch") + -- | SimpleSize in rem's (em's, but always relative to the root element). -rem i = SimpleSize (cssDoubleText i <> "rem") +rem i = SimpleSize (cssNumberText i <> "rem") +-- | SimpleSize in lh's (Line height of the element). +lh i = SimpleSize (cssNumberText i <> "lh") + +-- | SimpleSize in rlh's (lh's, but always relative to the root element). +rlh i = SimpleSize (cssNumberText i <> "rlh") + -- | SimpleSize in vw's (1vw = 1% of viewport width). -vw i = SimpleSize (cssDoubleText i <> "vw") +vw i = SimpleSize (cssNumberText i <> "vw") -- | SimpleSize in vh's (1vh = 1% of viewport height). -vh i = SimpleSize (cssDoubleText i <> "vh") +vh i = SimpleSize (cssNumberText i <> "vh") -- | SimpleSize in vmin's (the smaller of vw or vh). -vmin i = SimpleSize (cssDoubleText i <> "vmin") +vmin i = SimpleSize (cssNumberText i <> "vmin") -- | SimpleSize in vmax's (the larger of vw or vh). -vmax i = SimpleSize (cssDoubleText i <> "vmax") +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 :: Double -> Size Percentage -pct i = SimpleSize (cssDoubleText i <> "%") +pct :: Number -> Size Percentage +pct i = SimpleSize (cssNumberText i <> "%") instance Num (Size LengthUnit) where fromInteger = px . fromInteger @@ -212,17 +280,17 @@ -- | Times operator to combine sizes into calc function infixl 7 *@ -(*@) :: Double -> Size a -> Size a +(*@) :: Number -> Size a -> Size a a *@ b = MultSize a b -- | Reversed times operator to combine sizes into calc function infixl 7 @* -(@*) :: Size a -> Double -> Size a +(@*) :: Size a -> Number -> Size a a @* b = MultSize b a -- | Division operator to combine sizes into calc function infixl 7 @/ -(@/) :: Size a -> Double -> Size a +(@/) :: Size a -> Number -> Size a a @/ b = DivSize b a ------------------------------------------------------------------------------- @@ -230,10 +298,10 @@ 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 ------------------------------------------------------------------------------- @@ -247,19 +315,19 @@ 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 :: Double -> Angle Grad +grad :: Number -> Angle Grad grad i = Angle (value i <> "grad") -- | Angle in turns. -turn :: Double -> Angle Turn +turn :: Number -> Angle Turn turn i = Angle (value i <> "turn") instance Num (Angle Deg) where diff --git a/src/Clay/Stylesheet.hs b/src/Clay/Stylesheet.hs --- a/src/Clay/Stylesheet.hs +++ b/src/Clay/Stylesheet.hs @@ -6,9 +6,8 @@ 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.Semigroup (Semigroup) import Data.String (IsString) import Data.Text (Text) @@ -56,7 +55,7 @@ | Sub Selector deriving Show -data Keyframes = Keyframes Text [(Double, [Rule])] +data Keyframes = Keyframes Text [(Number, [Rule])] deriving Show data Rule @@ -83,9 +82,12 @@ type Css = StyleM () +instance Semigroup Css where + (<>) = liftA2 (<>) + instance Monoid Css where mempty = pure () - mappend = liftA2 mappend + 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 @@ -163,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 diff --git a/src/Clay/Text.hs b/src/Clay/Text.hs --- a/src/Clay/Text.hs +++ b/src/Clay/Text.hs @@ -35,6 +35,7 @@ , TextAlign , textAlign +, textAlignLast , justify, matchParent, start, end , alignSide , alignString @@ -72,14 +73,24 @@ , wordBreak , breakAll , keepAll - + -- * Overflow-wrap (and Word-wrap). , OverflowWrap , overflowWrap , wordWrap , breakWord - + +-- * Hyphenation. + +, hyphens +, hyphenateCharacter +, hyphenateLimitChars +, manual +, Hyphens +, HyphenateCharacter +, HyphenateLimit + -- * Content. , Content @@ -94,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 @@ -208,6 +218,9 @@ textAlign :: TextAlign -> Css textAlign = key "text-align" +textAlignLast :: TextAlign -> Css +textAlignLast = key "text-align-last" + ------------------------------------------------------------------------------- newtype WhiteSpace = WhiteSpace Value @@ -302,6 +315,96 @@ 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) ------------------------------------------------------------------------------- diff --git a/src/Clay/Time.hs b/src/Clay/Time.hs --- a/src/Clay/Time.hs +++ b/src/Clay/Time.hs @@ -12,7 +12,6 @@ ) where -import Data.Monoid import Data.Text (pack) import Clay.Common diff --git a/src/Clay/Transform.hs b/src/Clay/Transform.hs --- a/src/Clay/Transform.hs +++ b/src/Clay/Transform.hs @@ -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,7 +124,7 @@ 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] <> ")") ------------------------------------------------------------------------------- @@ -111,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 diff --git a/src/Clay/Transition.hs b/src/Clay/Transition.hs --- a/src/Clay/Transition.hs +++ b/src/Clay/Transition.hs @@ -25,7 +25,7 @@ , TimingFunction , transitionTimingFunction , transitionTimingFunctions -, ease, easeIn, easeOut, easeInOut, linear, stepStart, stepStop +, ease, easeIn, easeOut, easeInOut, linear, stepStart, stepEnd, stepStop , stepsStart, stepsStop , cubicBezier @@ -36,7 +36,6 @@ ) where -import Data.Monoid import Data.Text (Text) import Clay.Common @@ -75,7 +74,7 @@ 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" @@ -83,15 +82,18 @@ 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"