{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
module Clay.Text
(
-- * Letter and word-spacing.

  letterSpacing
, wordSpacing

-- * Text-rendering.

, TextRendering
, textRendering
, optimizeSpeed, optimizeLegibility, geometricPrecision

-- * Text-shadow.

, textShadow

-- * Text-indent.
-- $text-indent

, TextIndent
, textIndent
, eachLine, hanging
, indent

-- * Text-direction.

, TextDirection
, direction
, ltr
, rtl

-- * Text-align.

, TextAlign
, textAlign
, textAlignLast
, justify, matchParent, start, end
, alignSide
, alignString

-- * White-space.

, WhiteSpace
, whiteSpace
, pre, nowrap, preWrap, preLine

-- * Text-decoration.

, TextDecoration
, textDecoration
, textDecorationStyle
, textDecorationLine
, textDecorationColor
, underline, overline, lineThrough, blink

-- * Text-transform.

, TextTransform
, textTransform
, capitalize, uppercase, lowercase, fullWidth

-- * Text-overflow.

, TextOverflow
, textOverflow
, overflowClip, overflowEllipsis

-- * Word-break.

, WordBreak
, wordBreak
, breakAll
, keepAll

-- * Overflow-wrap (and Word-wrap).

, OverflowWrap
, overflowWrap
, wordWrap
, breakWord

-- * Hyphenation.

, hyphens
, hyphenateCharacter
, hyphenateLimitChars
, manual
, Hyphens
, HyphenateCharacter
, HyphenateLimit

-- * Content.

, Content
, content
, contents
, attrContent
, stringContent
, uriContent
, urlContent
, openQuote, closeQuote, noOpenQuote, noCloseQuote

)
where

import Data.String
import Data.Text (Text, pack)

import Clay.Background
import Clay.Border
import Clay.Color
import Clay.Common
import Clay.Property
import Clay.Stylesheet
import Clay.Size

-------------------------------------------------------------------------------

letterSpacing :: Size a -> Css
letterSpacing :: forall a. Size a -> Css
letterSpacing = Key (Size a) -> Size a -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a)
"letter-spacing"

wordSpacing :: Size a -> Css
wordSpacing :: forall a. Size a -> Css
wordSpacing = Key (Size a) -> Size a -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a)
"word-spacing"

-------------------------------------------------------------------------------

newtype TextRendering = TextRendering Value
  deriving (TextRendering -> Value
(TextRendering -> Value) -> Val TextRendering
forall a. (a -> Value) -> Val a
$cvalue :: TextRendering -> Value
value :: TextRendering -> Value
Val, TextRendering
TextRendering -> Auto TextRendering
forall a. a -> Auto a
$cauto :: TextRendering
auto :: TextRendering
Auto, TextRendering
TextRendering -> Inherit TextRendering
forall a. a -> Inherit a
$cinherit :: TextRendering
inherit :: TextRendering
Inherit, Value -> TextRendering
(Value -> TextRendering) -> Other TextRendering
forall a. (Value -> a) -> Other a
$cother :: Value -> TextRendering
other :: Value -> TextRendering
Other)

optimizeSpeed, optimizeLegibility, geometricPrecision :: TextRendering

optimizeSpeed :: TextRendering
optimizeSpeed      = Value -> TextRendering
TextRendering Value
"optimizeSpeed"
optimizeLegibility :: TextRendering
optimizeLegibility = Value -> TextRendering
TextRendering Value
"optimizeLegibility"
geometricPrecision :: TextRendering
geometricPrecision = Value -> TextRendering
TextRendering Value
"geometricPrecision"

textRendering :: TextRendering -> Css
textRendering :: TextRendering -> Css
textRendering = Key TextRendering -> TextRendering -> Css
forall a. Val a => Key a -> a -> Css
key Key TextRendering
"text-rendering"

-------------------------------------------------------------------------------

textShadow :: Size a -> Size a -> Size a -> Color -> Css
textShadow :: forall a. Size a -> Size a -> Size a -> Color -> Css
textShadow Size a
x Size a
y Size a
w Color
c = Key (Size a, (Size a, (Size a, Color)))
-> (Size a, (Size a, (Size a, Color))) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a, (Size a, (Size a, Color)))
"text-shadow" (Size a
x Size a
-> (Size a, (Size a, Color)) -> (Size a, (Size a, (Size a, Color)))
forall a b. a -> b -> (a, b)
! Size a
y Size a -> (Size a, Color) -> (Size a, (Size a, Color))
forall a b. a -> b -> (a, b)
! Size a
w Size a -> Color -> (Size a, Color)
forall a b. a -> b -> (a, b)
! Color
c)

-------------------------------------------------------------------------------

-- $text-indent
--
-- Supply a length — optionally annotated with @each-line@ or @hanging@ or
-- both, or a global value. It is possible to apply the same annotation
-- multiple times, but it has no defined effect.
--
-- Note browser support is currently (March 2018) non-existent, but the
-- Prince typesetting system supports the syntax.
--
-- === Formal argument syntax
--
-- > <length-percentage> && hanging? && each-line?
-- > where
-- > <length-percentage> = <length> | <percentage>

newtype TextIndent = TextIndent Value
  deriving (TextIndent -> Value
(TextIndent -> Value) -> Val TextIndent
forall a. (a -> Value) -> Val a
$cvalue :: TextIndent -> Value
value :: TextIndent -> Value
Val, TextIndent
TextIndent -> Inherit TextIndent
forall a. a -> Inherit a
$cinherit :: TextIndent
inherit :: TextIndent
Inherit, TextIndent
TextIndent -> Initial TextIndent
forall a. a -> Initial a
$cinitial :: TextIndent
initial :: TextIndent
Initial, TextIndent
TextIndent -> Unset TextIndent
forall a. a -> Unset a
$cunset :: TextIndent
unset :: TextIndent
Unset, Value -> TextIndent
(Value -> TextIndent) -> Other TextIndent
forall a. (Value -> a) -> Other a
$cother :: Value -> TextIndent
other :: Value -> TextIndent
Other)

-- | An internal function that ensures each-line and hanging are processed
-- correctly.
tagTextIndent :: Value -> TextIndent -> TextIndent
tagTextIndent :: Value -> TextIndent -> TextIndent
tagTextIndent Value
v (TextIndent Value
v0) = Value -> TextIndent
TextIndent (Value -> TextIndent)
-> ((Value, Value) -> Value) -> (Value, Value) -> TextIndent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value, Value) -> Value
forall a. Val a => a -> Value
value ((Value, Value) -> TextIndent) -> (Value, Value) -> TextIndent
forall a b. (a -> b) -> a -> b
$ (Value
v0, Value
v)

-- | Annotate the supplied 'TextIndent' with @each-line@ or @hanging@ or
-- both.
--
-- > eachLine . hanging . indent $ px 3 :: TextIndent
eachLine, hanging :: TextIndent -> TextIndent

eachLine :: TextIndent -> TextIndent
eachLine = Value -> TextIndent -> TextIndent
tagTextIndent Value
"each-line"
hanging :: TextIndent -> TextIndent
hanging  = Value -> TextIndent -> TextIndent
tagTextIndent Value
"hanging"

indent :: Size a -> TextIndent
indent :: forall a. Size a -> TextIndent
indent = Value -> TextIndent
TextIndent (Value -> TextIndent) -> (Size a -> Value) -> Size a -> TextIndent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size a -> Value
forall a. Val a => a -> Value
value

textIndent :: TextIndent -> Css
textIndent :: TextIndent -> Css
textIndent = Key TextIndent -> TextIndent -> Css
forall a. Val a => Key a -> a -> Css
key Key TextIndent
"text-indent"

-------------------------------------------------------------------------------

newtype TextDirection = TextDirection Value
  deriving (TextDirection -> Value
(TextDirection -> Value) -> Val TextDirection
forall a. (a -> Value) -> Val a
$cvalue :: TextDirection -> Value
value :: TextDirection -> Value
Val, TextDirection
TextDirection -> Normal TextDirection
forall a. a -> Normal a
$cnormal :: TextDirection
normal :: TextDirection
Normal, TextDirection
TextDirection -> Inherit TextDirection
forall a. a -> Inherit a
$cinherit :: TextDirection
inherit :: TextDirection
Inherit, Value -> TextDirection
(Value -> TextDirection) -> Other TextDirection
forall a. (Value -> a) -> Other a
$cother :: Value -> TextDirection
other :: Value -> TextDirection
Other)

ltr :: TextDirection
ltr :: TextDirection
ltr = Value -> TextDirection
TextDirection Value
"ltr"

rtl :: TextDirection
rtl :: TextDirection
rtl = Value -> TextDirection
TextDirection Value
"rtl"

direction :: TextDirection -> Css
direction :: TextDirection -> Css
direction = Key TextDirection -> TextDirection -> Css
forall a. Val a => Key a -> a -> Css
key Key TextDirection
"direction"

-------------------------------------------------------------------------------

newtype TextAlign = TextAlign Value
  deriving (TextAlign -> Value
(TextAlign -> Value) -> Val TextAlign
forall a. (a -> Value) -> Val a
$cvalue :: TextAlign -> Value
value :: TextAlign -> Value
Val, TextAlign
TextAlign -> Normal TextAlign
forall a. a -> Normal a
$cnormal :: TextAlign
normal :: TextAlign
Normal, TextAlign
TextAlign -> Inherit TextAlign
forall a. a -> Inherit a
$cinherit :: TextAlign
inherit :: TextAlign
Inherit, Value -> TextAlign
(Value -> TextAlign) -> Other TextAlign
forall a. (Value -> a) -> Other a
$cother :: Value -> TextAlign
other :: Value -> TextAlign
Other, TextAlign
TextAlign -> Center TextAlign
forall a. a -> Center a
$ccenter :: TextAlign
center :: TextAlign
Center)

justify, matchParent, start, end :: TextAlign

justify :: TextAlign
justify     = Value -> TextAlign
TextAlign Value
"justify"
matchParent :: TextAlign
matchParent = Value -> TextAlign
TextAlign Value
"match-parent"
start :: TextAlign
start       = Value -> TextAlign
TextAlign Value
"start"
end :: TextAlign
end         = Value -> TextAlign
TextAlign Value
"end"

alignSide :: Side -> TextAlign
alignSide :: Side -> TextAlign
alignSide = Value -> TextAlign
TextAlign (Value -> TextAlign) -> (Side -> Value) -> Side -> TextAlign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Side -> Value
forall a. Val a => a -> Value
value

alignString :: Char -> TextAlign
alignString :: Char -> TextAlign
alignString = Value -> TextAlign
TextAlign (Value -> TextAlign) -> (Char -> Value) -> Char -> TextAlign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Value
forall a. Val a => a -> Value
value (Literal -> Value) -> (Char -> Literal) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Literal
Literal (Text -> Literal) -> (Char -> Text) -> Char -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Char -> String) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

textAlign :: TextAlign -> Css
textAlign :: TextAlign -> Css
textAlign = Key TextAlign -> TextAlign -> Css
forall a. Val a => Key a -> a -> Css
key Key TextAlign
"text-align"

textAlignLast :: TextAlign -> Css
textAlignLast :: TextAlign -> Css
textAlignLast = Key TextAlign -> TextAlign -> Css
forall a. Val a => Key a -> a -> Css
key Key TextAlign
"text-align-last"

-------------------------------------------------------------------------------

newtype WhiteSpace = WhiteSpace Value
  deriving (WhiteSpace -> Value
(WhiteSpace -> Value) -> Val WhiteSpace
forall a. (a -> Value) -> Val a
$cvalue :: WhiteSpace -> Value
value :: WhiteSpace -> Value
Val, WhiteSpace
WhiteSpace -> Normal WhiteSpace
forall a. a -> Normal a
$cnormal :: WhiteSpace
normal :: WhiteSpace
Normal, WhiteSpace
WhiteSpace -> Inherit WhiteSpace
forall a. a -> Inherit a
$cinherit :: WhiteSpace
inherit :: WhiteSpace
Inherit, Value -> WhiteSpace
(Value -> WhiteSpace) -> Other WhiteSpace
forall a. (Value -> a) -> Other a
$cother :: Value -> WhiteSpace
other :: Value -> WhiteSpace
Other)

whiteSpace :: WhiteSpace -> Css
whiteSpace :: WhiteSpace -> Css
whiteSpace = Key WhiteSpace -> WhiteSpace -> Css
forall a. Val a => Key a -> a -> Css
key Key WhiteSpace
"white-space"

pre, nowrap, preWrap, preLine :: WhiteSpace

pre :: WhiteSpace
pre     = Value -> WhiteSpace
WhiteSpace Value
"pre"
nowrap :: WhiteSpace
nowrap  = Value -> WhiteSpace
WhiteSpace Value
"nowrap"
preWrap :: WhiteSpace
preWrap = Value -> WhiteSpace
WhiteSpace Value
"pre-wrap"
preLine :: WhiteSpace
preLine = Value -> WhiteSpace
WhiteSpace Value
"pre-line"

-------------------------------------------------------------------------------

newtype TextDecoration = TextDecoration Value
  deriving (TextDecoration -> Value
(TextDecoration -> Value) -> Val TextDecoration
forall a. (a -> Value) -> Val a
$cvalue :: TextDecoration -> Value
value :: TextDecoration -> Value
Val, TextDecoration
TextDecoration -> None TextDecoration
forall a. a -> None a
$cnone :: TextDecoration
none :: TextDecoration
None, TextDecoration
TextDecoration -> Inherit TextDecoration
forall a. a -> Inherit a
$cinherit :: TextDecoration
inherit :: TextDecoration
Inherit, Value -> TextDecoration
(Value -> TextDecoration) -> Other TextDecoration
forall a. (Value -> a) -> Other a
$cother :: Value -> TextDecoration
other :: Value -> TextDecoration
Other)

underline, overline, lineThrough, blink :: TextDecoration

underline :: TextDecoration
underline   = Value -> TextDecoration
TextDecoration Value
"underline"
overline :: TextDecoration
overline    = Value -> TextDecoration
TextDecoration Value
"overline"
lineThrough :: TextDecoration
lineThrough = Value -> TextDecoration
TextDecoration Value
"line-through"
blink :: TextDecoration
blink       = Value -> TextDecoration
TextDecoration Value
"blink"

textDecorationLine :: TextDecoration -> Css
textDecorationLine :: TextDecoration -> Css
textDecorationLine = Key TextDecoration -> TextDecoration -> Css
forall a. Val a => Key a -> a -> Css
key Key TextDecoration
"text-decoration-line"

textDecorationColor :: Color -> Css
textDecorationColor :: Color -> Css
textDecorationColor = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"text-decoration-color"

textDecoration :: TextDecoration -> Css
textDecoration :: TextDecoration -> Css
textDecoration = Key TextDecoration -> TextDecoration -> Css
forall a. Val a => Key a -> a -> Css
key Key TextDecoration
"text-decoration"

textDecorationStyle :: Stroke -> Css
textDecorationStyle :: Stroke -> Css
textDecorationStyle = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"text-decoration-style"

-------------------------------------------------------------------------------

newtype TextTransform = TextTransform Value
  deriving (TextTransform -> Value
(TextTransform -> Value) -> Val TextTransform
forall a. (a -> Value) -> Val a
$cvalue :: TextTransform -> Value
value :: TextTransform -> Value
Val, TextTransform
TextTransform -> None TextTransform
forall a. a -> None a
$cnone :: TextTransform
none :: TextTransform
None, TextTransform
TextTransform -> Inherit TextTransform
forall a. a -> Inherit a
$cinherit :: TextTransform
inherit :: TextTransform
Inherit)

capitalize, uppercase, lowercase, fullWidth :: TextTransform

capitalize :: TextTransform
capitalize = Value -> TextTransform
TextTransform Value
"capitalize"
uppercase :: TextTransform
uppercase  = Value -> TextTransform
TextTransform Value
"uppercase"
lowercase :: TextTransform
lowercase  = Value -> TextTransform
TextTransform Value
"lowercase"
fullWidth :: TextTransform
fullWidth  = Value -> TextTransform
TextTransform Value
"full-width"

textTransform :: TextTransform -> Css
textTransform :: TextTransform -> Css
textTransform = Key TextTransform -> TextTransform -> Css
forall a. Val a => Key a -> a -> Css
key Key TextTransform
"text-transform"

-------------------------------------------------------------------------------

newtype WordBreak = WordBreak Value
  deriving (WordBreak -> Value
(WordBreak -> Value) -> Val WordBreak
forall a. (a -> Value) -> Val a
$cvalue :: WordBreak -> Value
value :: WordBreak -> Value
Val, WordBreak
WordBreak -> Inherit WordBreak
forall a. a -> Inherit a
$cinherit :: WordBreak
inherit :: WordBreak
Inherit, WordBreak
WordBreak -> Initial WordBreak
forall a. a -> Initial a
$cinitial :: WordBreak
initial :: WordBreak
Initial, WordBreak
WordBreak -> Unset WordBreak
forall a. a -> Unset a
$cunset :: WordBreak
unset :: WordBreak
Unset, WordBreak
WordBreak -> Normal WordBreak
forall a. a -> Normal a
$cnormal :: WordBreak
normal :: WordBreak
Normal)

breakAll, keepAll :: WordBreak

breakAll :: WordBreak
breakAll = Value -> WordBreak
WordBreak Value
"break-all"
keepAll :: WordBreak
keepAll  = Value -> WordBreak
WordBreak Value
"keep-all"

wordBreak :: WordBreak -> Css

wordBreak :: WordBreak -> Css
wordBreak = Key WordBreak -> WordBreak -> Css
forall a. Val a => Key a -> a -> Css
key Key WordBreak
"word-break"

-------------------------------------------------------------------------------

newtype OverflowWrap = OverflowWrap Value
  deriving (OverflowWrap -> Value
(OverflowWrap -> Value) -> Val OverflowWrap
forall a. (a -> Value) -> Val a
$cvalue :: OverflowWrap -> Value
value :: OverflowWrap -> Value
Val, OverflowWrap
OverflowWrap -> Inherit OverflowWrap
forall a. a -> Inherit a
$cinherit :: OverflowWrap
inherit :: OverflowWrap
Inherit, OverflowWrap
OverflowWrap -> Initial OverflowWrap
forall a. a -> Initial a
$cinitial :: OverflowWrap
initial :: OverflowWrap
Initial, OverflowWrap
OverflowWrap -> Unset OverflowWrap
forall a. a -> Unset a
$cunset :: OverflowWrap
unset :: OverflowWrap
Unset, OverflowWrap
OverflowWrap -> Normal OverflowWrap
forall a. a -> Normal a
$cnormal :: OverflowWrap
normal :: OverflowWrap
Normal)

breakWord :: OverflowWrap

breakWord :: OverflowWrap
breakWord = Value -> OverflowWrap
OverflowWrap Value
"break-word"

overflowWrap, wordWrap :: OverflowWrap -> Css

wordWrap :: OverflowWrap -> Css
wordWrap     = Key OverflowWrap -> OverflowWrap -> Css
forall a. Val a => Key a -> a -> Css
key Key OverflowWrap
"word-wrap"
overflowWrap :: OverflowWrap -> Css
overflowWrap = Key OverflowWrap -> OverflowWrap -> Css
forall a. Val a => Key a -> a -> Css
key Key OverflowWrap
"overflow-wrap"

-------------------------------------------------------------------------------

newtype TextOverflow = TextOverflow Value
  deriving (TextOverflow -> Value
(TextOverflow -> Value) -> Val TextOverflow
forall a. (a -> Value) -> Val a
$cvalue :: TextOverflow -> Value
value :: TextOverflow -> Value
Val, TextOverflow
TextOverflow -> None TextOverflow
forall a. a -> None a
$cnone :: TextOverflow
none :: TextOverflow
None, TextOverflow
TextOverflow -> Inherit TextOverflow
forall a. a -> Inherit a
$cinherit :: TextOverflow
inherit :: TextOverflow
Inherit, TextOverflow
TextOverflow -> Initial TextOverflow
forall a. a -> Initial a
$cinitial :: TextOverflow
initial :: TextOverflow
Initial)

overflowClip, overflowEllipsis :: TextOverflow

overflowClip :: TextOverflow
overflowClip = Value -> TextOverflow
TextOverflow Value
"clip"
overflowEllipsis :: TextOverflow
overflowEllipsis = Value -> TextOverflow
TextOverflow Value
"ellipsis"

textOverflow :: TextOverflow -> Css
textOverflow :: TextOverflow -> Css
textOverflow = Key TextOverflow -> TextOverflow -> Css
forall a. Val a => Key a -> a -> Css
key Key TextOverflow
"text-overflow"

-------------------------------------------------------------------------------

-- | Type for values which can be provided to 'hyphens'.
newtype Hyphens = Hyphens Value
  deriving (Hyphens -> Value
(Hyphens -> Value) -> Val Hyphens
forall a. (a -> Value) -> Val a
$cvalue :: Hyphens -> Value
value :: Hyphens -> Value
Val, Hyphens
Hyphens -> None Hyphens
forall a. a -> None a
$cnone :: Hyphens
none :: Hyphens
None, Hyphens
Hyphens -> Auto Hyphens
forall a. a -> Auto a
$cauto :: Hyphens
auto :: Hyphens
Auto, Hyphens
Hyphens -> Initial Hyphens
forall a. a -> Initial a
$cinitial :: Hyphens
initial :: Hyphens
Initial, Hyphens
Hyphens -> Inherit Hyphens
forall a. a -> Inherit a
$cinherit :: Hyphens
inherit :: Hyphens
Inherit, Hyphens
Hyphens -> Unset Hyphens
forall a. a -> Unset a
$cunset :: Hyphens
unset :: Hyphens
Unset, Value -> Hyphens
(Value -> Hyphens) -> Other Hyphens
forall a. (Value -> a) -> Other a
$cother :: Value -> Hyphens
other :: Value -> Hyphens
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 @&shy;@ 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 :: Hyphens -> Css
hyphens = Key Hyphens -> Hyphens -> Css
forall a. Val a => Key a -> a -> Css
key Key Hyphens
"hyphens"

-- | Value for 'hyphens' specifying that hyphenation be manual.
manual :: Hyphens
manual :: Hyphens
manual = Value -> Hyphens
Hyphens Value
"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 (HyphenateCharacter -> Value
(HyphenateCharacter -> Value) -> Val HyphenateCharacter
forall a. (a -> Value) -> Val a
$cvalue :: HyphenateCharacter -> Value
value :: HyphenateCharacter -> Value
Val, HyphenateCharacter
HyphenateCharacter -> Auto HyphenateCharacter
forall a. a -> Auto a
$cauto :: HyphenateCharacter
auto :: HyphenateCharacter
Auto, HyphenateCharacter
HyphenateCharacter -> Initial HyphenateCharacter
forall a. a -> Initial a
$cinitial :: HyphenateCharacter
initial :: HyphenateCharacter
Initial, HyphenateCharacter
HyphenateCharacter -> Inherit HyphenateCharacter
forall a. a -> Inherit a
$cinherit :: HyphenateCharacter
inherit :: HyphenateCharacter
Inherit, HyphenateCharacter
HyphenateCharacter -> Unset HyphenateCharacter
forall a. a -> Unset a
$cunset :: HyphenateCharacter
unset :: HyphenateCharacter
Unset, Value -> HyphenateCharacter
(Value -> HyphenateCharacter) -> Other HyphenateCharacter
forall a. (Value -> a) -> Other a
$cother :: Value -> HyphenateCharacter
other :: Value -> HyphenateCharacter
Other)

-- Allow a 'HyphenateCharacter' value to be specified directly with a string.
instance IsString HyphenateCharacter where
  fromString :: String -> HyphenateCharacter
fromString = Value -> HyphenateCharacter
HyphenateCharacter (Value -> HyphenateCharacter)
-> (String -> Value) -> String -> HyphenateCharacter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prefixed -> Value
Value (Prefixed -> Value) -> (String -> Prefixed) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Prefixed
Plain (Text -> Prefixed) -> (String -> Text) -> String -> Prefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
quote (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
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 :: HyphenateCharacter -> Css
hyphenateCharacter = Key HyphenateCharacter -> HyphenateCharacter -> Css
forall a. Val a => Key a -> a -> Css
key Key HyphenateCharacter
"hyphenate-character"

-- | Type for values which can be provded to 'hyphenateLimitChars'.
newtype HyphenateLimit = HyphenateLimit Value
  deriving (HyphenateLimit -> Value
(HyphenateLimit -> Value) -> Val HyphenateLimit
forall a. (a -> Value) -> Val a
$cvalue :: HyphenateLimit -> Value
value :: HyphenateLimit -> Value
Val, HyphenateLimit
HyphenateLimit -> Auto HyphenateLimit
forall a. a -> Auto a
$cauto :: HyphenateLimit
auto :: HyphenateLimit
Auto, HyphenateLimit
HyphenateLimit -> Initial HyphenateLimit
forall a. a -> Initial a
$cinitial :: HyphenateLimit
initial :: HyphenateLimit
Initial, HyphenateLimit
HyphenateLimit -> Inherit HyphenateLimit
forall a. a -> Inherit a
$cinherit :: HyphenateLimit
inherit :: HyphenateLimit
Inherit, HyphenateLimit
HyphenateLimit -> Unset HyphenateLimit
forall a. a -> Unset a
$cunset :: HyphenateLimit
unset :: HyphenateLimit
Unset, Value -> HyphenateLimit
(Value -> HyphenateLimit) -> Other HyphenateLimit
forall a. (Value -> a) -> Other a
$cother :: Value -> HyphenateLimit
other :: Value -> HyphenateLimit
Other)

-- Allow a 'HyphenateLimit' value to be specified directly with a number.
instance Num HyphenateLimit where
  fromInteger :: Integer -> HyphenateLimit
fromInteger = Value -> HyphenateLimit
HyphenateLimit (Value -> HyphenateLimit)
-> (Integer -> Value) -> Integer -> HyphenateLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Value
forall a. Val a => a -> Value
value
  + :: HyphenateLimit -> HyphenateLimit -> HyphenateLimit
(+) = String -> HyphenateLimit -> HyphenateLimit -> HyphenateLimit
forall a. HasCallStack => String -> a
error String
"plus not implemented for HyphenateLimit"
  * :: HyphenateLimit -> HyphenateLimit -> HyphenateLimit
(*) = String -> HyphenateLimit -> HyphenateLimit -> HyphenateLimit
forall a. HasCallStack => String -> a
error String
"times not implemented for HyphenateLimit"
  abs :: HyphenateLimit -> HyphenateLimit
abs = String -> HyphenateLimit -> HyphenateLimit
forall a. HasCallStack => String -> a
error String
"abs not implemented for HyphenateLimit"
  signum :: HyphenateLimit -> HyphenateLimit
signum = String -> HyphenateLimit -> HyphenateLimit
forall a. HasCallStack => String -> a
error String
"signum not implemented for HyphenateLimit"
  negate :: HyphenateLimit -> HyphenateLimit
negate = String -> HyphenateLimit -> HyphenateLimit
forall a. HasCallStack => String -> a
error String
"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 :: HyphenateLimit -> HyphenateLimit -> HyphenateLimit -> Css
hyphenateLimitChars HyphenateLimit
word HyphenateLimit
before HyphenateLimit
after =
  Key (HyphenateLimit, (HyphenateLimit, HyphenateLimit))
-> (HyphenateLimit, (HyphenateLimit, HyphenateLimit)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (HyphenateLimit, (HyphenateLimit, HyphenateLimit))
"hyphenate-limit-chars" (HyphenateLimit
word HyphenateLimit
-> (HyphenateLimit, HyphenateLimit)
-> (HyphenateLimit, (HyphenateLimit, HyphenateLimit))
forall a b. a -> b -> (a, b)
! HyphenateLimit
before HyphenateLimit
-> HyphenateLimit -> (HyphenateLimit, HyphenateLimit)
forall a b. a -> b -> (a, b)
! HyphenateLimit
after)

-------------------------------------------------------------------------------

newtype Content = Content Value
  deriving (Content -> Value
(Content -> Value) -> Val Content
forall a. (a -> Value) -> Val a
$cvalue :: Content -> Value
value :: Content -> Value
Val, Content
Content -> None Content
forall a. a -> None a
$cnone :: Content
none :: Content
None, Content
Content -> Normal Content
forall a. a -> Normal a
$cnormal :: Content
normal :: Content
Normal, Content
Content -> Inherit Content
forall a. a -> Inherit a
$cinherit :: Content
inherit :: Content
Inherit, Content
Content -> Initial Content
forall a. a -> Initial a
$cinitial :: Content
initial :: Content
Initial)

attrContent :: Text -> Content
attrContent :: Text -> Content
attrContent Text
a = Value -> Content
Content (Value
"attr(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Text -> Value
forall a. Val a => a -> Value
value Text
a Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

stringContent :: Text -> Content
stringContent :: Text -> Content
stringContent = Value -> Content
Content (Value -> Content) -> (Text -> Value) -> Text -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Value
forall a. Val a => a -> Value
value (Literal -> Value) -> (Text -> Literal) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Literal
Literal

uriContent :: Text -> Content
uriContent :: Text -> Content
uriContent Text
u = Value -> Content
Content (Value
"uri(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Literal -> Value
forall a. Val a => a -> Value
value (Text -> Literal
Literal Text
u) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

urlContent :: Text -> Content
urlContent :: Text -> Content
urlContent Text
u = Value -> Content
Content (Value
"url(" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Literal -> Value
forall a. Val a => a -> Value
value (Text -> Literal
Literal Text
u) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
")")

openQuote, closeQuote, noOpenQuote, noCloseQuote :: Content

openQuote :: Content
openQuote    = Value -> Content
Content Value
"open-quote"
closeQuote :: Content
closeQuote   = Value -> Content
Content Value
"close-quote"
noOpenQuote :: Content
noOpenQuote  = Value -> Content
Content Value
"no-open-quote"
noCloseQuote :: Content
noCloseQuote = Value -> Content
Content Value
"no-close-quote"

content :: Content -> Css
content :: Content -> Css
content = Key Content -> Content -> Css
forall a. Val a => Key a -> a -> Css
key Key Content
"content"

contents :: [Content] -> Css
contents :: [Content] -> Css
contents [Content]
cs = Key Value -> Value -> Css
forall a. Val a => Key a -> a -> Css
key Key Value
"content" ([Content] -> Value
forall a. Val a => [a] -> Value
noCommas [Content]
cs)

-- TODO: counters