{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Some commonly useful CSS styles
module Rib.Extra.CSS where

import Clay
import qualified Data.Text as T
import Lucid
import Relude

-- | Stock CSS for the <kbd> element
--
-- Based on the MDN demo at,
-- https://developer.mozilla.org/en-US/docs/Web/HTML/Element/kbd
mozillaKbdStyle :: Css
mozillaKbdStyle :: Css
mozillaKbdStyle = do
  Color -> Css
backgroundColor (Color -> Css) -> Color -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Color
rgb 238 238 238
  Color -> Css
color (Color -> Css) -> Color -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Color
rgb 51 51 51
  (Size LengthUnit
 -> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css)
-> Size LengthUnit -> Css
forall a. (a -> a -> a -> a -> Css) -> a -> Css
sym Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
borderRadius (Double -> Size LengthUnit
px 3)
  Stroke -> Size LengthUnit -> Color -> Css
border Stroke
solid (Double -> Size LengthUnit
px 1) (Color -> Css) -> Color -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Color
rgb 180 180 180
  Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
padding (Double -> Size LengthUnit
px 2) (Double -> Size LengthUnit
px 4) (Double -> Size LengthUnit
px 2) (Double -> Size LengthUnit
px 4)
  NonEmpty BoxShadow -> Css
boxShadow (NonEmpty BoxShadow -> Css) -> NonEmpty BoxShadow -> Css
forall a b. (a -> b) -> a -> b
$
    (Color -> BoxShadow -> BoxShadow
bsColor (Integer -> Integer -> Integer -> Float -> Color
rgba 0 0 0 0.2) (BoxShadow -> BoxShadow) -> BoxShadow -> BoxShadow
forall a b. (a -> b) -> a -> b
$ Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> BoxShadow
forall a. Size a -> Size a -> Size a -> BoxShadow
shadowWithBlur (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 1) (Double -> Size LengthUnit
px 1))
      BoxShadow -> [BoxShadow] -> NonEmpty BoxShadow
forall a. a -> [a] -> NonEmpty a
:| [(Color -> BoxShadow -> BoxShadow
bsColor (Integer -> Integer -> Integer -> Float -> Color
rgba 255 255 255 0.7) (BoxShadow -> BoxShadow) -> BoxShadow -> BoxShadow
forall a b. (a -> b) -> a -> b
$ BoxShadow -> BoxShadow
bsInset (BoxShadow -> BoxShadow) -> BoxShadow -> BoxShadow
forall a b. (a -> b) -> a -> b
$ Size LengthUnit
-> Size LengthUnit
-> Size LengthUnit
-> Size LengthUnit
-> BoxShadow
forall a. Size a -> Size a -> Size a -> Size a -> BoxShadow
shadowWithSpread (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 2) (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 0))]
  Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Double -> Size LengthUnit
em 0.85
  FontWeight -> Css
fontWeight (FontWeight -> Css) -> FontWeight -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> FontWeight
weight 700
  Size LengthUnit -> Css
forall a. Size a -> Css
lineHeight (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Double -> Size LengthUnit
px 1
  WhiteSpace -> Css
whiteSpace WhiteSpace
nowrap

-- | Include the specified Google Fonts
googleFonts :: Monad m => [Text] -> HtmlT m ()
googleFonts :: [Text] -> HtmlT m ()
googleFonts fs :: [Text]
fs =
  let fsEncoded :: Text
fsEncoded = Text -> [Text] -> Text
T.intercalate "|" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace " " "+" (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
fs
      fsUrl :: Text
fsUrl = "https://fonts.googleapis.com/css?family=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fsEncoded Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "&display=swap"
   in Text -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
stylesheet Text
fsUrl

-- | Include the specified stylesheet URL
stylesheet :: Monad m => Text -> HtmlT m ()
stylesheet :: Text -> HtmlT m ()
stylesheet x :: Text
x = [Attribute] -> HtmlT m ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
link_ [Text -> Attribute
rel_ "stylesheet", Text -> Attribute
href_ Text
x]