Add support for aspect-ratio CSS property.

spec/Clay/GeometrySpec.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Clay.GeometrySpec where
+
+import Clay.Common
+import Clay.Geometry
+import Clay.Render
+import Clay.Stylesheet
+
+import Control.Exception (evaluate)
+import qualified Data.Ratio as R
+import Data.Text.Lazy
+
+import Test.Hspec
+
+compactRender :: Css -> Text
+compactRender = renderWith compact []
+
+spec :: Spec
+spec = do
+  describe "aspect-ratio" $ do
+    it "has ratio" $ do
+      compactRender (aspectRatio (2%1)) `shouldBe` "{aspect-ratio:2/1}"
+      compactRender (aspectRatio (4%3)) `shouldBe` "{aspect-ratio:4/3}"
+      compactRender (aspectRatio (8%6)) `shouldBe` "{aspect-ratio:4/3}"
+
+    it "has rational ratio" $ do
+      compactRender (aspectRatio $ fromRational $ 2 R.% 1) `shouldBe` "{aspect-ratio:2/1}"
+      compactRender (aspectRatio $ fromRational $ 4 R.% 3) `shouldBe` "{aspect-ratio:4/3}"
+      compactRender (aspectRatio $ fromRational $ 8 R.% 6) `shouldBe` "{aspect-ratio:4/3}"
+
+    it "has auto value" $ do
+      compactRender (aspectRatio auto) `shouldBe` "{aspect-ratio:auto}"
+
+    it "has inherit value" $ do
+      compactRender (aspectRatio inherit) `shouldBe` "{aspect-ratio:inherit}"
+
+    it "has initial value" $ do
+      compactRender (aspectRatio initial) `shouldBe` "{aspect-ratio:initial}"
+
+    it "has unset value" $ do
+      compactRender (aspectRatio unset) `shouldBe` "{aspect-ratio:unset}"
+
+    it "has auto value and fallback ratio" $ do
+      compactRender (aspectRatio $ auto `withFallback` (4%3)) `shouldBe` "{aspect-ratio:auto 4/3}"
+      compactRender (aspectRatio $ (4%3) `withFallback` auto) `shouldBe` "{aspect-ratio:4/3 auto}"
+
+    it "does not allow invalid fallbacks" $ do
+      evaluate (compactRender $ aspectRatio $ auto `withFallback` auto) `shouldThrow` anyErrorCall
+      evaluate (compactRender $ aspectRatio $ (4%3) `withFallback` (4%3)) `shouldThrow` anyErrorCall
+
+    it "has arbitrary other value" $ do
+      compactRender (aspectRatio $ other "not valid") `shouldBe` "{aspect-ratio:not valid}"

src/Clay/Geometry.hs

@@ -7,6 +7,12 @@ module Clay.Geometry
 -- * Sizing.
 , width, height, minWidth, minHeight, maxWidth, maxHeight
 
+-- ** Aspect ratio.
+, AspectRatio
+, aspectRatio
+, (%)
+, withFallback
+
 -- * Padding.
 , padding
 , paddingTop, paddingLeft, paddingRight, paddingBottom
@@ -17,6 +23,9 @@ module Clay.Geometry
 )
 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 @@ maxHeight = key "max-height"
 
 -------------------------------------------------------------------------------
 
+-- | 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 @@ marginTop     = key "margin-top"
 marginLeft    = key "margin-left"
 marginRight   = key "margin-right"
 marginBottom  = key "margin-bottom"
-