From 9e31b14bdf123894d04cb40cc1a6150362813f35 Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Fri, 18 Oct 2024 21:54:41 -0400 Subject: [PATCH 1/8] Implementation for aspect-ratio. --- spec/Clay/GeometrySpec.hs | 50 +++++++++++++++++++++++++++++++ src/Clay/Geometry.hs | 62 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 111 insertions(+), 1 deletion(-) create mode 100644 spec/Clay/GeometrySpec.hs diff --git a/spec/Clay/GeometrySpec.hs b/spec/Clay/GeometrySpec.hs new file mode 100644 index 0000000..8616802 --- /dev/null +++ b/spec/Clay/GeometrySpec.hs @@ -0,0 +1,50 @@ +{-#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 css = renderWith compact [] css + +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 diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs index 7d30716..812d737 100644 --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} module Clay.Geometry ( -- * Positioning. @@ -7,6 +9,12 @@ module Clay.Geometry -- * Sizing. , width, height, minWidth, minHeight, maxWidth, maxHeight +-- ** Aspect ratio. +, AspectRatio +, aspectRatio +, (%) +, withFallback + -- * Padding. , padding , paddingTop, paddingLeft, paddingRight, paddingBottom @@ -17,6 +25,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 +53,56 @@ maxHeight = key "max-height" ------------------------------------------------------------------------------- +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 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" + +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 + +aspectRatio :: AspectRatio -> Css +aspectRatio = key "aspect-ratio" + +(%) :: Integer -> Integer -> AspectRatio +(%) m n = fromRational $ (R.%) m n + +infixl 7 % + +class WithFallback a where + withFallback :: a -> a -> a + +instance WithFallback AspectRatio where + withFallback x@(AspectRatioValue "auto") y@(AspectRatio _) = + AspectRatioWithFallback (x, y) + withFallback x@(AspectRatio _) y@(AspectRatioValue "auto") = + AspectRatioWithFallback (x, y) + withFallback _ _ = + error "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 +124,3 @@ marginTop = key "margin-top" marginLeft = key "margin-left" marginRight = key "margin-right" marginBottom = key "margin-bottom" - From 2261d9ac9492c9a154af94fe750cd893512e4cf0 Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Sat, 19 Oct 2024 20:23:39 -0400 Subject: [PATCH 2/8] Add Haddock documentation for aspect ratio functionality. --- spec/Clay/GeometrySpec.hs | 5 +++- src/Clay/Geometry.hs | 58 +++++++++++++++++++++++++++++++++++++-- 2 files changed, 60 insertions(+), 3 deletions(-) diff --git a/spec/Clay/GeometrySpec.hs b/spec/Clay/GeometrySpec.hs index 8616802..e1fd788 100644 --- a/spec/Clay/GeometrySpec.hs +++ b/spec/Clay/GeometrySpec.hs @@ -14,7 +14,7 @@ import Data.Text.Lazy import Test.Hspec compactRender :: Css -> Text -compactRender css = renderWith compact [] css +compactRender = renderWith compact [] spec :: Spec spec = do @@ -48,3 +48,6 @@ spec = do 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 arbtrary other value" $ do + compactRender (aspectRatio $ other "not valid") `shouldBe` "{aspect-ratio:not valid}" diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs index 812d737..e6ee202 100644 --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -53,6 +53,16 @@ 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) @@ -61,7 +71,10 @@ 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" @@ -70,6 +83,8 @@ instance Num AspectRatio where 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" @@ -82,15 +97,54 @@ instance Val AspectRatio where 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 and 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 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 -infixl 7 % +-- The same as the normal % operator. +infixl 7 % +-- | A type class for which a type can have a value with another value as a fallback. +-- Basically, a type class for types which can use 'withFallback'. +-- +-- 'withFallback' was defined for 'AspectRatio', but this is a type class +-- because 'withFallback' is a generic name which we may want to reuse +-- for other types in the future. class WithFallback a where + -- | Returns a value where one value has another value as a fallback. + -- + -- * For 'AspectRatio', it can be used to specify that the intrinsic aspect + -- ratio should be used, but a fixed ratio can be used as a fallback. withFallback :: a -> a -> a instance WithFallback AspectRatio where @@ -99,7 +153,7 @@ instance WithFallback AspectRatio where withFallback x@(AspectRatio _) y@(AspectRatioValue "auto") = AspectRatioWithFallback (x, y) withFallback _ _ = - error "aspectRatio withFallback must be auto and a ratio in either order" + error "Arguments for aspectRatio . withFallback must be auto and a ratio in either order" ------------------------------------------------------------------------------- From 7e8151123be1ea06801b5b42718038665fd9bb5f Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Sat, 19 Oct 2024 20:24:34 -0400 Subject: [PATCH 3/8] Remove obsolete disabling of warning. --- spec/Clay/GeometrySpec.hs | 2 +- src/Clay/Geometry.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/spec/Clay/GeometrySpec.hs b/spec/Clay/GeometrySpec.hs index e1fd788..3cc62c6 100644 --- a/spec/Clay/GeometrySpec.hs +++ b/spec/Clay/GeometrySpec.hs @@ -1,4 +1,4 @@ -{-#LANGUAGE OverloadedStrings#-} +{-# LANGUAGE OverloadedStrings #-} module Clay.GeometrySpec where diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs index e6ee202..2bb9013 100644 --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-unused-top-binds #-} module Clay.Geometry ( -- * Positioning. From 9a683805972d27dd2915705a1c4e2cb22c69e926 Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Sat, 19 Oct 2024 20:26:59 -0400 Subject: [PATCH 4/8] Remove unnecessary language pragma. --- src/Clay/Geometry.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs index 2bb9013..cc34c8c 100644 --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Clay.Geometry ( From eb02caf8b6c18141f5f7cafce52e722ec12c898c Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Sun, 20 Oct 2024 11:22:32 -0400 Subject: [PATCH 5/8] Typo. --- src/Clay/Geometry.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs index cc34c8c..2edd16c 100644 --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -99,7 +99,7 @@ instance Val AspectRatio where -- 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 and to the height: +-- It can be given a fixed ratio of the width to the height: -- -- >>> renderWith compact [] $ aspectRatio (4%3) -- "{aspect-ratio:4/3}" From 75d37f835a37d185c7065dd5cd03c743da45b45c Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Sun, 20 Oct 2024 11:23:21 -0400 Subject: [PATCH 6/8] Edited for clarity. --- src/Clay/Geometry.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs index 2edd16c..68af3d1 100644 --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -110,7 +110,7 @@ instance Val AspectRatio where -- "{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 does not have one: +-- 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}" From 85b52e02a30b298cb54ed24547d2891783820093 Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Mon, 21 Oct 2024 13:47:40 -0400 Subject: [PATCH 7/8] Typo. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Manuel Bärenz --- spec/Clay/GeometrySpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/spec/Clay/GeometrySpec.hs b/spec/Clay/GeometrySpec.hs index 3cc62c6..7eb08a4 100644 --- a/spec/Clay/GeometrySpec.hs +++ b/spec/Clay/GeometrySpec.hs @@ -49,5 +49,5 @@ spec = do evaluate (compactRender $ aspectRatio $ auto `withFallback` auto) `shouldThrow` anyErrorCall evaluate (compactRender $ aspectRatio $ (4%3) `withFallback` (4%3)) `shouldThrow` anyErrorCall - it "has arbtrary other value" $ do + it "has arbitrary other value" $ do compactRender (aspectRatio $ other "not valid") `shouldBe` "{aspect-ratio:not valid}" From eb5c8b4e2944d7f4137538c39e5e2be915267d85 Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Mon, 21 Oct 2024 19:06:14 -0400 Subject: [PATCH 8/8] Do not require a type class for `withFallback`. There may come a day when `withFallback` should be used with another type of value in the `Clay.Geometry` module, but until then, it is overkill to use a type class. --- src/Clay/Geometry.hs | 30 ++++++++++-------------------- 1 file changed, 10 insertions(+), 20 deletions(-) diff --git a/src/Clay/Geometry.hs b/src/Clay/Geometry.hs index 68af3d1..ab70618 100644 --- a/src/Clay/Geometry.hs +++ b/src/Clay/Geometry.hs @@ -132,26 +132,16 @@ aspectRatio = key "aspect-ratio" -- The same as the normal % operator. infixl 7 % --- | A type class for which a type can have a value with another value as a fallback. --- Basically, a type class for types which can use 'withFallback'. --- --- 'withFallback' was defined for 'AspectRatio', but this is a type class --- because 'withFallback' is a generic name which we may want to reuse --- for other types in the future. -class WithFallback a where - -- | Returns a value where one value has another value as a fallback. - -- - -- * For 'AspectRatio', it can be used to specify that the intrinsic aspect - -- ratio should be used, but a fixed ratio can be used as a fallback. - withFallback :: a -> a -> a - -instance WithFallback AspectRatio where - 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" +-- | 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" -------------------------------------------------------------------------------