{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Blank.Types.Font where

import           Control.Applicative
import           Control.Monad

import           Data.Char
import           Data.Default.Class
import           Data.Ix (Ix)
import           Data.Maybe
import           Data.String
import qualified Data.Text as TS
import           Data.Text (Text)
import qualified Data.Text.Lazy.Builder as B (singleton)

import           Graphics.Blank.JavaScript
import           Graphics.Blank.Parser
import           Graphics.Blank.Types
import           Graphics.Blank.Types.CSS

import           Prelude.Compat

import qualified Text.ParserCombinators.ReadP as ReadP
import           Text.ParserCombinators.ReadP hiding ((<++), choice, pfail)
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
import           Text.ParserCombinators.ReadPrec (ReadPrec, (<++), lift, pfail)
import           Text.Read (Read(..), readListPrecDefault)

import           TextShow (TextShow(..), Builder, FromTextShow(..), showbSpace)

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

-- | A data type that can represent a browser font.
class CanvasFont a where
    -- | Convert a value into a JavaScript string representing a font value.
    jsCanvasFont :: a -> Builder

instance CanvasFont Text where
    jsCanvasFont :: Text -> Builder
jsCanvasFont = Text -> Builder
jsText

instance CanvasFont Font where
    jsCanvasFont :: Font -> Builder
jsCanvasFont = Font -> Builder
jsFont

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

-- | A CSS-style font data type.
data Font = FontProperties
  {   Font -> FontStyle
fontStyle   :: FontStyle
    , Font -> FontVariant
fontVariant :: FontVariant
    , Font -> FontWeight
fontWeight  :: FontWeight
    , Font -> FontSize
fontSize    :: FontSize
    , Font -> LineHeight
lineHeight  :: LineHeight
    , Font -> [FontFamily]
fontFamily  :: [FontFamily]
  } -- ^ A font specified by its individual longhand properties.
  | CaptionFont      -- ^ The font used for captioned controls (e.g., buttons, drop-downs, etc.)
  | IconFont         -- ^ The font used to label icons.
  | MenuFont         -- ^ The font used in menus (e.g., dropdown menus and menu lists).
  | MessageBoxFont   -- ^ The font used in dialog boxes.
  | SmallCaptionFont -- ^ The font used for labeling small controls.
  | StatusBarFont    -- ^ The font used in window status bars.
  deriving (Font -> Font -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c== :: Font -> Font -> Bool
Eq, Eq Font
Font -> Font -> Bool
Font -> Font -> Ordering
Font -> Font -> Font
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Font -> Font -> Font
$cmin :: Font -> Font -> Font
max :: Font -> Font -> Font
$cmax :: Font -> Font -> Font
>= :: Font -> Font -> Bool
$c>= :: Font -> Font -> Bool
> :: Font -> Font -> Bool
$c> :: Font -> Font -> Bool
<= :: Font -> Font -> Bool
$c<= :: Font -> Font -> Bool
< :: Font -> Font -> Bool
$c< :: Font -> Font -> Bool
compare :: Font -> Font -> Ordering
$ccompare :: Font -> Font -> Ordering
Ord)

-- |
-- Creates a new font from the 'FontFamily' list, using the 'Default' instances
-- for the other five longhand properties. If you only wish to change certain
-- properties and leave the others alone, this provides a convenient mechanism
-- for doing so:
--
-- @
-- ('defFont' ["Gill Sans Extrabold", 'sansSerif']) {
--     'fontStyle'  = 'italic'
--   , 'fontSize'   = 12 # 'px'
--   , 'lineHeight' = 14 # 'px'
-- }
-- @
defFont :: [FontFamily] -> Font
defFont :: [FontFamily] -> Font
defFont = FontStyle
-> FontVariant
-> FontWeight
-> FontSize
-> LineHeight
-> [FontFamily]
-> Font
FontProperties forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def

-- | Shorthand for 'CaptionFont'.
caption :: Font
caption :: Font
caption = Font
CaptionFont

-- | Shorthand for 'IconFont'.
icon :: Font
icon :: Font
icon = Font
IconFont

-- | Shorthand for 'MenuFont'.
menu :: Font
menu :: Font
menu = Font
MenuFont

-- | Shorthand for 'MessageBoxFont'.
messageBox :: Font
messageBox :: Font
messageBox = Font
MessageBoxFont

-- | Shorthand for 'SmallCaptionFont'.
smallCaption :: Font
smallCaption :: Font
smallCaption = Font
SmallCaptionFont

-- | Shorthand for 'StatusBarFont'.
statusBar :: Font
statusBar :: Font
statusBar = Font
StatusBarFont

instance IsString Font where
    fromString :: String -> Font
fromString = forall a. Read a => String -> a
read

instance JSArg Font where
    showbJS :: Font -> Builder
showbJS = Font -> Builder
jsFont

jsFont :: Font -> Builder
jsFont :: Font -> Builder
jsFont = Builder -> Builder
jsLiteralBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => a -> Builder
showb

instance Read Font where
    readPrec :: ReadPrec Font
readPrec = do
        forall a. ReadP a -> ReadPrec a
lift ReadP ()
skipSpaces
        forall a. [ReadPrec a] -> ReadPrec a
ReadPrec.choice
            [ Font
CaptionFont      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"caption")
            , Font
IconFont         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"icon")
            , Font
MenuFont         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"menu")
            , Font
MessageBoxFont   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"message-box")
            , Font
SmallCaptionFont forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"small-caption")
            , Font
StatusBarFont    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"status-bar")
            , Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
            ]
    readListPrec :: ReadPrec [Font]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

-- | Like 'Either', but with three possibilities instead of two.
data OneOfThree a b c = One a | Two b | Three c

-- |
-- The formal syntax for the font CSS property
-- (https://developer.mozilla.org/en-US/docs/Web/CSS/font#Syntax) is surprisingly complex.
-- It requires that font-style, font-variant, and font-weight must be defined, if any,
-- before the font-size value. Furthermore, each of those three properties may only be defined at
-- most once, and the relative order of the three does not matter. This is a tall order for the
-- Text.ParserCombinators modules, so we use a heavily monadic utility function to detect
-- make it easier to catch bad input. The three Maybe arguments each represent whether its
-- respective property has not (Nothing) or has (Just) been read. If it has been read, then
-- readFontProperties will not attempt to parse it again.
--
-- readFontProperties will proceed to parse the remaining Font longhand properties once
-- either all three of the first properties have been parsed, or when it is unsuccessful at
-- parsing any of the first three properties.
readFontProperties :: Maybe FontStyle -> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties :: Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties Maybe FontStyle
style Maybe FontVariant
variant Maybe FontWeight
weight =
    -- If all three properties have been parsed, proceed to the remaining three properties.
    if forall a. Maybe a -> Bool
isJust Maybe FontStyle
style Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe FontVariant
variant Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe FontWeight
weight
       then Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties' Maybe FontStyle
style Maybe FontVariant
variant Maybe FontWeight
weight
       else do
               -- If the property has already been parsed, do not parse it again.
           let parseCheck :: Maybe a -> ReadPrec a -> ReadPrec a
               parseCheck :: forall a. Maybe a -> ReadPrec a -> ReadPrec a
parseCheck Maybe a
mb ReadPrec a
parser = if forall a. Maybe a -> Bool
isJust Maybe a
mb then forall a. ReadPrec a
pfail else ReadPrec a
parser

               readStyle, readVariant, readWeight :: ReadPrec (OneOfThree FontStyle FontVariant FontWeight)
               readStyle :: ReadPrec (OneOfThree FontStyle FontVariant FontWeight)
readStyle   = forall a b c. a -> OneOfThree a b c
One   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> ReadPrec a -> ReadPrec a
parseCheck Maybe FontStyle
style forall a. Read a => ReadPrec a
readPrec
               readVariant :: ReadPrec (OneOfThree FontStyle FontVariant FontWeight)
readVariant = forall a b c. b -> OneOfThree a b c
Two   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> ReadPrec a -> ReadPrec a
parseCheck Maybe FontVariant
variant forall a. Read a => ReadPrec a
readPrec
               readWeight :: ReadPrec (OneOfThree FontStyle FontVariant FontWeight)
readWeight  = forall a b c. c -> OneOfThree a b c
Three forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> ReadPrec a -> ReadPrec a
parseCheck Maybe FontWeight
weight forall a. Read a => ReadPrec a
readPrec

           -- First attempt to parse font-style, then font-variant, then font-weight (unless one
           -- of them has already been parsed, in which case skip to the next property parser.
           Maybe (OneOfThree FontStyle FontVariant FontWeight)
prop <- forall a. ReadPrec a -> ReadPrec (Maybe a)
maybeReadPrec forall a b. (a -> b) -> a -> b
$ ReadPrec (OneOfThree FontStyle FontVariant FontWeight)
readStyle forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
<++ ReadPrec (OneOfThree FontStyle FontVariant FontWeight)
readVariant forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
<++ ReadPrec (OneOfThree FontStyle FontVariant FontWeight)
readWeight
           -- Check to see which property, if any, was parsed.
           case Maybe (OneOfThree FontStyle FontVariant FontWeight)
prop of
               Just (One FontStyle
style') -> do
                   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe FontStyle
style) forall a. ReadPrec a
pfail -- Safeguard to ensure a property is not parsed twice.
                   Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties (forall a. a -> Maybe a
Just FontStyle
style') Maybe FontVariant
variant Maybe FontWeight
weight
               Just (Two FontVariant
variant') -> do
                   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe FontVariant
variant) forall a. ReadPrec a
pfail
                   Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties Maybe FontStyle
style (forall a. a -> Maybe a
Just FontVariant
variant') Maybe FontWeight
weight
               Just (Three FontWeight
weight') -> do
                   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe FontWeight
weight) forall a. ReadPrec a
pfail
                   Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties Maybe FontStyle
style Maybe FontVariant
variant (forall a. a -> Maybe a
Just FontWeight
weight')
               -- If no properties were parsed, proceed to the remaining three properties.
               Maybe (OneOfThree FontStyle FontVariant FontWeight)
Nothing -> Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties' Maybe FontStyle
style Maybe FontVariant
variant Maybe FontWeight
weight

-- |
-- Parses the remaining three Font longhand properties (font-size, line-height, and
-- font-family). Make sure to also parse the forward slash, if any, that separates
-- the font-size and line-height properties.
readFontProperties' :: Maybe FontStyle -> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties' :: Maybe FontStyle
-> Maybe FontVariant -> Maybe FontWeight -> ReadPrec Font
readFontProperties' Maybe FontStyle
mbStyle Maybe FontVariant
mbVariant Maybe FontWeight
mbWeight =
  FontStyle
-> FontVariant
-> FontWeight
-> FontSize
-> LineHeight
-> [FontFamily]
-> Font
FontProperties (forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe FontStyle
mbStyle) (forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe FontVariant
mbVariant) (forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def Maybe FontWeight
mbWeight)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadP a -> ReadPrec a
lift (forall a. a -> ReadP a -> ReadP a
option forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ ReadP ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ReadP Char
char Char
'/' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ReadPrec a -> ReadP a
unlift forall a. Read a => ReadPrec a
readPrec)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ReadP a -> ReadPrec a
lift ((Char -> Bool) -> ReadP String
munch1 Char -> Bool
isSpace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Read a => ReadPrec a
readPrec)

instance Show Font where
    showsPrec :: Int -> Font -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow Font where
    showb :: Font -> Builder
showb (FontProperties FontStyle
style FontVariant
variant FontWeight
weight FontSize
size LineHeight
height' [FontFamily]
family)
        = forall a. TextShow a => a -> Builder
showb FontStyle
style
       forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace
       forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb FontVariant
variant
       forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace
       forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb FontWeight
weight
       forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace
       forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb FontSize
size
       forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.singleton Char
'/'
       forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb LineHeight
height'
       forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace
       forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb [FontFamily]
family
    showb Font
CaptionFont      = Builder
"caption"
    showb Font
IconFont         = Builder
"icon"
    showb Font
MenuFont         = Builder
"menu"
    showb Font
MessageBoxFont   = Builder
"message-box"
    showb Font
SmallCaptionFont = Builder
"small-caption"
    showb Font
StatusBarFont    = Builder
"status-bar"

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

-- | Specifies if a 'Font' is italic or oblique.
data FontStyle = NormalStyle  -- ^ Selects a font classified as normal (default).
               | ItalicStyle  -- ^ Selects a font that is labeled italic, or if one is not available,
                              --   one labeled oblique.
               | ObliqueStyle -- ^ Selects a font that is labeled oblique.
  deriving (FontStyle
forall a. a -> a -> Bounded a
maxBound :: FontStyle
$cmaxBound :: FontStyle
minBound :: FontStyle
$cminBound :: FontStyle
Bounded, Int -> FontStyle
FontStyle -> Int
FontStyle -> [FontStyle]
FontStyle -> FontStyle
FontStyle -> FontStyle -> [FontStyle]
FontStyle -> FontStyle -> FontStyle -> [FontStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
$cenumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
enumFromTo :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromTo :: FontStyle -> FontStyle -> [FontStyle]
enumFromThen :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromThen :: FontStyle -> FontStyle -> [FontStyle]
enumFrom :: FontStyle -> [FontStyle]
$cenumFrom :: FontStyle -> [FontStyle]
fromEnum :: FontStyle -> Int
$cfromEnum :: FontStyle -> Int
toEnum :: Int -> FontStyle
$ctoEnum :: Int -> FontStyle
pred :: FontStyle -> FontStyle
$cpred :: FontStyle -> FontStyle
succ :: FontStyle -> FontStyle
$csucc :: FontStyle -> FontStyle
Enum, FontStyle -> FontStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontStyle -> FontStyle -> Bool
$c/= :: FontStyle -> FontStyle -> Bool
== :: FontStyle -> FontStyle -> Bool
$c== :: FontStyle -> FontStyle -> Bool
Eq, Ord FontStyle
(FontStyle, FontStyle) -> Int
(FontStyle, FontStyle) -> [FontStyle]
(FontStyle, FontStyle) -> FontStyle -> Bool
(FontStyle, FontStyle) -> FontStyle -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (FontStyle, FontStyle) -> Int
$cunsafeRangeSize :: (FontStyle, FontStyle) -> Int
rangeSize :: (FontStyle, FontStyle) -> Int
$crangeSize :: (FontStyle, FontStyle) -> Int
inRange :: (FontStyle, FontStyle) -> FontStyle -> Bool
$cinRange :: (FontStyle, FontStyle) -> FontStyle -> Bool
unsafeIndex :: (FontStyle, FontStyle) -> FontStyle -> Int
$cunsafeIndex :: (FontStyle, FontStyle) -> FontStyle -> Int
index :: (FontStyle, FontStyle) -> FontStyle -> Int
$cindex :: (FontStyle, FontStyle) -> FontStyle -> Int
range :: (FontStyle, FontStyle) -> [FontStyle]
$crange :: (FontStyle, FontStyle) -> [FontStyle]
Ix, Eq FontStyle
FontStyle -> FontStyle -> Bool
FontStyle -> FontStyle -> Ordering
FontStyle -> FontStyle -> FontStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontStyle -> FontStyle -> FontStyle
$cmin :: FontStyle -> FontStyle -> FontStyle
max :: FontStyle -> FontStyle -> FontStyle
$cmax :: FontStyle -> FontStyle -> FontStyle
>= :: FontStyle -> FontStyle -> Bool
$c>= :: FontStyle -> FontStyle -> Bool
> :: FontStyle -> FontStyle -> Bool
$c> :: FontStyle -> FontStyle -> Bool
<= :: FontStyle -> FontStyle -> Bool
$c<= :: FontStyle -> FontStyle -> Bool
< :: FontStyle -> FontStyle -> Bool
$c< :: FontStyle -> FontStyle -> Bool
compare :: FontStyle -> FontStyle -> Ordering
$ccompare :: FontStyle -> FontStyle -> Ordering
Ord)

-- | Shorthand for 'ItalicStyle'.
italic :: FontStyle
italic :: FontStyle
italic = FontStyle
ItalicStyle

-- | Shorthand for 'ObliqueStyle'.
oblique :: FontStyle
oblique :: FontStyle
oblique = FontStyle
ObliqueStyle

instance Default FontStyle where
    def :: FontStyle
def = FontStyle
NormalStyle

instance IsString FontStyle where
    fromString :: String -> FontStyle
fromString = forall a. Read a => String -> a
read

instance NormalProperty FontStyle

instance Read FontStyle where
    readPrec :: ReadPrec FontStyle
readPrec = forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ do
        ReadP ()
skipSpaces
        forall a. [ReadP a] -> ReadP a
ReadP.choice
            [ FontStyle
NormalStyle  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"normal"
            , FontStyle
ItalicStyle  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"italic"
            , FontStyle
ObliqueStyle forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"oblique"
            ]
    readListPrec :: ReadPrec [FontStyle]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Show FontStyle where
    showsPrec :: Int -> FontStyle -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow FontStyle where
    showb :: FontStyle -> Builder
showb FontStyle
NormalStyle  = Builder
"normal"
    showb FontStyle
ItalicStyle  = Builder
"italic"
    showb FontStyle
ObliqueStyle = Builder
"oblique"

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

-- | Specifies the face of a 'Font'.
data FontVariant = NormalVariant    -- ^ A normal font face (default).
                 | SmallCapsVariant -- ^ A font face with small capital letters for lowercase characters.
  deriving (FontVariant
forall a. a -> a -> Bounded a
maxBound :: FontVariant
$cmaxBound :: FontVariant
minBound :: FontVariant
$cminBound :: FontVariant
Bounded, Int -> FontVariant
FontVariant -> Int
FontVariant -> [FontVariant]
FontVariant -> FontVariant
FontVariant -> FontVariant -> [FontVariant]
FontVariant -> FontVariant -> FontVariant -> [FontVariant]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontVariant -> FontVariant -> FontVariant -> [FontVariant]
$cenumFromThenTo :: FontVariant -> FontVariant -> FontVariant -> [FontVariant]
enumFromTo :: FontVariant -> FontVariant -> [FontVariant]
$cenumFromTo :: FontVariant -> FontVariant -> [FontVariant]
enumFromThen :: FontVariant -> FontVariant -> [FontVariant]
$cenumFromThen :: FontVariant -> FontVariant -> [FontVariant]
enumFrom :: FontVariant -> [FontVariant]
$cenumFrom :: FontVariant -> [FontVariant]
fromEnum :: FontVariant -> Int
$cfromEnum :: FontVariant -> Int
toEnum :: Int -> FontVariant
$ctoEnum :: Int -> FontVariant
pred :: FontVariant -> FontVariant
$cpred :: FontVariant -> FontVariant
succ :: FontVariant -> FontVariant
$csucc :: FontVariant -> FontVariant
Enum, FontVariant -> FontVariant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontVariant -> FontVariant -> Bool
$c/= :: FontVariant -> FontVariant -> Bool
== :: FontVariant -> FontVariant -> Bool
$c== :: FontVariant -> FontVariant -> Bool
Eq, Ord FontVariant
(FontVariant, FontVariant) -> Int
(FontVariant, FontVariant) -> [FontVariant]
(FontVariant, FontVariant) -> FontVariant -> Bool
(FontVariant, FontVariant) -> FontVariant -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (FontVariant, FontVariant) -> Int
$cunsafeRangeSize :: (FontVariant, FontVariant) -> Int
rangeSize :: (FontVariant, FontVariant) -> Int
$crangeSize :: (FontVariant, FontVariant) -> Int
inRange :: (FontVariant, FontVariant) -> FontVariant -> Bool
$cinRange :: (FontVariant, FontVariant) -> FontVariant -> Bool
unsafeIndex :: (FontVariant, FontVariant) -> FontVariant -> Int
$cunsafeIndex :: (FontVariant, FontVariant) -> FontVariant -> Int
index :: (FontVariant, FontVariant) -> FontVariant -> Int
$cindex :: (FontVariant, FontVariant) -> FontVariant -> Int
range :: (FontVariant, FontVariant) -> [FontVariant]
$crange :: (FontVariant, FontVariant) -> [FontVariant]
Ix, Eq FontVariant
FontVariant -> FontVariant -> Bool
FontVariant -> FontVariant -> Ordering
FontVariant -> FontVariant -> FontVariant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontVariant -> FontVariant -> FontVariant
$cmin :: FontVariant -> FontVariant -> FontVariant
max :: FontVariant -> FontVariant -> FontVariant
$cmax :: FontVariant -> FontVariant -> FontVariant
>= :: FontVariant -> FontVariant -> Bool
$c>= :: FontVariant -> FontVariant -> Bool
> :: FontVariant -> FontVariant -> Bool
$c> :: FontVariant -> FontVariant -> Bool
<= :: FontVariant -> FontVariant -> Bool
$c<= :: FontVariant -> FontVariant -> Bool
< :: FontVariant -> FontVariant -> Bool
$c< :: FontVariant -> FontVariant -> Bool
compare :: FontVariant -> FontVariant -> Ordering
$ccompare :: FontVariant -> FontVariant -> Ordering
Ord)

-- | Shorthand for 'SmallCapsVariant'.
smallCaps :: FontVariant
smallCaps :: FontVariant
smallCaps = FontVariant
SmallCapsVariant

instance Default FontVariant where
    def :: FontVariant
def = FontVariant
NormalVariant

instance IsString FontVariant where
    fromString :: String -> FontVariant
fromString = forall a. Read a => String -> a
read

instance NormalProperty FontVariant

instance Read FontVariant where
    readPrec :: ReadPrec FontVariant
readPrec = forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ do
      ReadP ()
skipSpaces
      (FontVariant
NormalVariant forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"normal") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FontVariant
SmallCapsVariant forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"small-caps")
    readListPrec :: ReadPrec [FontVariant]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Show FontVariant where
    showsPrec :: Int -> FontVariant -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow FontVariant where
    showb :: FontVariant -> Builder
showb FontVariant
NormalVariant    = Builder
"normal"
    showb FontVariant
SmallCapsVariant = Builder
"small-caps"

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

-- |
-- Specifies the boldness of a 'Font'. Note that 'FontWeight' is an instance of
-- 'Num' so that the nine numeric weights can be used directly. For example:
--
-- @
-- ('defFont' ['sansSerif']) { 'fontWeight' = 900 }
-- @
--
-- Attempting to use a numeric weight other than the nine given will result in
-- a runtime error.
data FontWeight = NormalWeight -- ^ Default.
                | BoldWeight
                | BolderWeight
                | LighterWeight
                | Weight100
                | Weight200
                | Weight300
                | Weight400
                | Weight500
                | Weight600
                | Weight700
                | Weight800
                | Weight900
  deriving (FontWeight
forall a. a -> a -> Bounded a
maxBound :: FontWeight
$cmaxBound :: FontWeight
minBound :: FontWeight
$cminBound :: FontWeight
Bounded, Int -> FontWeight
FontWeight -> Int
FontWeight -> [FontWeight]
FontWeight -> FontWeight
FontWeight -> FontWeight -> [FontWeight]
FontWeight -> FontWeight -> FontWeight -> [FontWeight]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontWeight -> FontWeight -> FontWeight -> [FontWeight]
$cenumFromThenTo :: FontWeight -> FontWeight -> FontWeight -> [FontWeight]
enumFromTo :: FontWeight -> FontWeight -> [FontWeight]
$cenumFromTo :: FontWeight -> FontWeight -> [FontWeight]
enumFromThen :: FontWeight -> FontWeight -> [FontWeight]
$cenumFromThen :: FontWeight -> FontWeight -> [FontWeight]
enumFrom :: FontWeight -> [FontWeight]
$cenumFrom :: FontWeight -> [FontWeight]
fromEnum :: FontWeight -> Int
$cfromEnum :: FontWeight -> Int
toEnum :: Int -> FontWeight
$ctoEnum :: Int -> FontWeight
pred :: FontWeight -> FontWeight
$cpred :: FontWeight -> FontWeight
succ :: FontWeight -> FontWeight
$csucc :: FontWeight -> FontWeight
Enum, FontWeight -> FontWeight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontWeight -> FontWeight -> Bool
$c/= :: FontWeight -> FontWeight -> Bool
== :: FontWeight -> FontWeight -> Bool
$c== :: FontWeight -> FontWeight -> Bool
Eq, Ord FontWeight
(FontWeight, FontWeight) -> Int
(FontWeight, FontWeight) -> [FontWeight]
(FontWeight, FontWeight) -> FontWeight -> Bool
(FontWeight, FontWeight) -> FontWeight -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (FontWeight, FontWeight) -> Int
$cunsafeRangeSize :: (FontWeight, FontWeight) -> Int
rangeSize :: (FontWeight, FontWeight) -> Int
$crangeSize :: (FontWeight, FontWeight) -> Int
inRange :: (FontWeight, FontWeight) -> FontWeight -> Bool
$cinRange :: (FontWeight, FontWeight) -> FontWeight -> Bool
unsafeIndex :: (FontWeight, FontWeight) -> FontWeight -> Int
$cunsafeIndex :: (FontWeight, FontWeight) -> FontWeight -> Int
index :: (FontWeight, FontWeight) -> FontWeight -> Int
$cindex :: (FontWeight, FontWeight) -> FontWeight -> Int
range :: (FontWeight, FontWeight) -> [FontWeight]
$crange :: (FontWeight, FontWeight) -> [FontWeight]
Ix, Eq FontWeight
FontWeight -> FontWeight -> Bool
FontWeight -> FontWeight -> Ordering
FontWeight -> FontWeight -> FontWeight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontWeight -> FontWeight -> FontWeight
$cmin :: FontWeight -> FontWeight -> FontWeight
max :: FontWeight -> FontWeight -> FontWeight
$cmax :: FontWeight -> FontWeight -> FontWeight
>= :: FontWeight -> FontWeight -> Bool
$c>= :: FontWeight -> FontWeight -> Bool
> :: FontWeight -> FontWeight -> Bool
$c> :: FontWeight -> FontWeight -> Bool
<= :: FontWeight -> FontWeight -> Bool
$c<= :: FontWeight -> FontWeight -> Bool
< :: FontWeight -> FontWeight -> Bool
$c< :: FontWeight -> FontWeight -> Bool
compare :: FontWeight -> FontWeight -> Ordering
$ccompare :: FontWeight -> FontWeight -> Ordering
Ord)

-- | Shorthand for 'BoldWeight'.
bold :: FontWeight
bold :: FontWeight
bold = FontWeight
BoldWeight

-- | Shorthand for 'BolderWeight'.
bolder :: FontWeight
bolder :: FontWeight
bolder = FontWeight
BolderWeight

-- | Shorthand for 'LighterWeight'.
lighter :: FontWeight
lighter :: FontWeight
lighter = FontWeight
LighterWeight

fontWeightError :: a
fontWeightError :: forall a. a
fontWeightError = forall a. HasCallStack => String -> a
error String
"invalid font-weight operation"

instance Default FontWeight where
    def :: FontWeight
def = FontWeight
NormalWeight

instance IsString FontWeight where
    fromString :: String -> FontWeight
fromString = forall a. Read a => String -> a
read

instance NormalProperty FontWeight

instance Num FontWeight where
    + :: FontWeight -> FontWeight -> FontWeight
(+)    = forall a. a
fontWeightError
    (-)    = forall a. a
fontWeightError
    * :: FontWeight -> FontWeight -> FontWeight
(*)    = forall a. a
fontWeightError
    abs :: FontWeight -> FontWeight
abs    = forall a. a
fontWeightError
    signum :: FontWeight -> FontWeight
signum = forall a. a
fontWeightError
    fromInteger :: Integer -> FontWeight
fromInteger Integer
100 = FontWeight
Weight100
    fromInteger Integer
200 = FontWeight
Weight200
    fromInteger Integer
300 = FontWeight
Weight300
    fromInteger Integer
400 = FontWeight
Weight400
    fromInteger Integer
500 = FontWeight
Weight500
    fromInteger Integer
600 = FontWeight
Weight600
    fromInteger Integer
700 = FontWeight
Weight700
    fromInteger Integer
800 = FontWeight
Weight800
    fromInteger Integer
900 = FontWeight
Weight900
    fromInteger Integer
_   = forall a. a
fontWeightError

instance Read FontWeight where
    readPrec :: ReadPrec FontWeight
readPrec = forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ do
        ReadP ()
skipSpaces
        forall a. [ReadP a] -> ReadP a
ReadP.choice
            [ FontWeight
NormalWeight  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"normal"
            , FontWeight
BoldWeight    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"bold"
            , FontWeight
BolderWeight  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"bolder"
            , FontWeight
LighterWeight forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"lighter"
            , FontWeight
Weight100     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"100"
            , FontWeight
Weight200     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"200"
            , FontWeight
Weight300     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"300"
            , FontWeight
Weight400     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"400"
            , FontWeight
Weight500     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"500"
            , FontWeight
Weight600     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"600"
            , FontWeight
Weight700     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"700"
            , FontWeight
Weight800     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"800"
            , FontWeight
Weight900     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string   String
"900"
            ]
    readListPrec :: ReadPrec [FontWeight]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Show FontWeight where
    showsPrec :: Int -> FontWeight -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow FontWeight where
    showb :: FontWeight -> Builder
showb FontWeight
NormalWeight  = Builder
"normal"
    showb FontWeight
BoldWeight    = Builder
"bold"
    showb FontWeight
BolderWeight  = Builder
"bolder"
    showb FontWeight
LighterWeight = Builder
"lighter"
    showb FontWeight
Weight100     = Builder
"100"
    showb FontWeight
Weight200     = Builder
"200"
    showb FontWeight
Weight300     = Builder
"300"
    showb FontWeight
Weight400     = Builder
"400"
    showb FontWeight
Weight500     = Builder
"500"
    showb FontWeight
Weight600     = Builder
"600"
    showb FontWeight
Weight700     = Builder
"700"
    showb FontWeight
Weight800     = Builder
"800"
    showb FontWeight
Weight900     = Builder
"900"

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

-- | The desired height of 'Font' glyphs.
--
-- ==== __Examples__
--
-- @
-- ('defFont' ['sansSerif']) { 'fontSize' = 'xxSmall' }
-- ('defFont' ['sansSerif']) { 'fontSize' = 30 # 'pt' }
-- ('defFont' ['sansSerif']) { 'fontSize' = 50 # 'percent' }
-- @
data FontSize = XXSmallSize
              | XSmallSize
              | SmallSize
              | MediumSize -- ^ Default.
              | LargeSize
              | XLargeSize
              | XXLargeSize
              | LargerSize
              | SmallerSize
              | FontSizeLength Length
              | FontSizePercentage Percentage
  deriving (FontSize -> FontSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontSize -> FontSize -> Bool
$c/= :: FontSize -> FontSize -> Bool
== :: FontSize -> FontSize -> Bool
$c== :: FontSize -> FontSize -> Bool
Eq, Eq FontSize
FontSize -> FontSize -> Bool
FontSize -> FontSize -> Ordering
FontSize -> FontSize -> FontSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontSize -> FontSize -> FontSize
$cmin :: FontSize -> FontSize -> FontSize
max :: FontSize -> FontSize -> FontSize
$cmax :: FontSize -> FontSize -> FontSize
>= :: FontSize -> FontSize -> Bool
$c>= :: FontSize -> FontSize -> Bool
> :: FontSize -> FontSize -> Bool
$c> :: FontSize -> FontSize -> Bool
<= :: FontSize -> FontSize -> Bool
$c<= :: FontSize -> FontSize -> Bool
< :: FontSize -> FontSize -> Bool
$c< :: FontSize -> FontSize -> Bool
compare :: FontSize -> FontSize -> Ordering
$ccompare :: FontSize -> FontSize -> Ordering
Ord)

-- | Shorthand for 'XXSmallSize'.
xxSmall :: FontSize
xxSmall :: FontSize
xxSmall = FontSize
XXSmallSize

-- | Shorthand for 'XSmallSize'.
xSmall :: FontSize
xSmall :: FontSize
xSmall = FontSize
XSmallSize

-- | Shorthand for 'SmallSize'.
small :: FontSize
small :: FontSize
small = FontSize
SmallSize

-- | Shorthand for 'MediumSize'.
medium :: FontSize
medium :: FontSize
medium = FontSize
MediumSize

-- | Shorthand for 'LargeSize'.
large :: FontSize
large :: FontSize
large = FontSize
LargeSize

-- | Shorthand for 'XLargeSize'.
xLarge :: FontSize
xLarge :: FontSize
xLarge = FontSize
XLargeSize

-- | Shorthand for 'XXLargeSize'.
xxLarge :: FontSize
xxLarge :: FontSize
xxLarge = FontSize
XXLargeSize

-- | Shorthand for 'LargerSize'.
larger :: FontSize
larger :: FontSize
larger = FontSize
LargerSize

-- | Shorthand for 'SmallerSize'.
smaller :: FontSize
smaller :: FontSize
smaller = FontSize
SmallerSize

instance Default FontSize where
    def :: FontSize
def = FontSize
MediumSize

instance IsString FontSize where
    fromString :: String -> FontSize
fromString = forall a. Read a => String -> a
read

instance LengthProperty FontSize where
    fromLength :: Length -> FontSize
fromLength = Length -> FontSize
FontSizeLength

instance PercentageProperty FontSize where
    percent :: Percentage -> FontSize
percent = Percentage -> FontSize
FontSizePercentage

instance Read FontSize where
    readPrec :: ReadPrec FontSize
readPrec = do
        forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ ReadP ()
skipSpaces
        forall a. [ReadPrec a] -> ReadPrec a
ReadPrec.choice
            [ FontSize
XXSmallSize        forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"xx-small")
            , FontSize
XSmallSize         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"x-small")
            , FontSize
SmallSize          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"small")
            , FontSize
MediumSize         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"medium")
            , FontSize
LargeSize          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"large")
            , FontSize
XLargeSize         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"x-large")
            , FontSize
XXLargeSize        forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"xx-large")
            , FontSize
LargerSize         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"larger")
            , FontSize
SmallerSize        forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"smaller")
            , Length -> FontSize
FontSizeLength     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec
            , Percentage -> FontSize
FontSizePercentage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. ReadP a -> ReadPrec a
lift (Char -> ReadP Char
char Char
'%')
            ]
    readListPrec :: ReadPrec [FontSize]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Show FontSize where
    showsPrec :: Int -> FontSize -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow FontSize where
    showb :: FontSize -> Builder
showb FontSize
XXSmallSize            = Builder
"xx-small"
    showb FontSize
XSmallSize             = Builder
"x-small"
    showb FontSize
SmallSize              = Builder
"small"
    showb FontSize
MediumSize             = Builder
"medium"
    showb FontSize
LargeSize              = Builder
"large"
    showb FontSize
XLargeSize             = Builder
"x-large"
    showb FontSize
XXLargeSize            = Builder
"xx-large"
    showb FontSize
LargerSize             = Builder
"larger"
    showb FontSize
SmallerSize            = Builder
"smaller"
    showb (FontSizeLength Length
l)     = forall a. TextShow a => a -> Builder
showb Length
l
    showb (FontSizePercentage Percentage
p) = Percentage -> Builder
jsDouble Percentage
p forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.singleton Char
'%'

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

-- | The height of the line boxes in a 'Font'.
--
-- ==== __Examples__
--
-- @
-- ('defFont' ['sansSerif']) { 'lineHeight' = 'normal' }
-- ('defFont' ['sansSerif']) { 'lineHeight' = 50 }
-- ('defFont' ['sansSerif']) { 'lineHeight' = 30 # 'em' }
-- ('defFont' ['sansSerif']) { 'lineHeight' = 70 # 'percent' }
-- @
data LineHeight = NormalLineHeight -- ^ Default.
                | LineHeightNumber Double
                | LineHeightLength Length
                | LineHeightPercentage Percentage
  deriving (LineHeight -> LineHeight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineHeight -> LineHeight -> Bool
$c/= :: LineHeight -> LineHeight -> Bool
== :: LineHeight -> LineHeight -> Bool
$c== :: LineHeight -> LineHeight -> Bool
Eq, Eq LineHeight
LineHeight -> LineHeight -> Bool
LineHeight -> LineHeight -> Ordering
LineHeight -> LineHeight -> LineHeight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineHeight -> LineHeight -> LineHeight
$cmin :: LineHeight -> LineHeight -> LineHeight
max :: LineHeight -> LineHeight -> LineHeight
$cmax :: LineHeight -> LineHeight -> LineHeight
>= :: LineHeight -> LineHeight -> Bool
$c>= :: LineHeight -> LineHeight -> Bool
> :: LineHeight -> LineHeight -> Bool
$c> :: LineHeight -> LineHeight -> Bool
<= :: LineHeight -> LineHeight -> Bool
$c<= :: LineHeight -> LineHeight -> Bool
< :: LineHeight -> LineHeight -> Bool
$c< :: LineHeight -> LineHeight -> Bool
compare :: LineHeight -> LineHeight -> Ordering
$ccompare :: LineHeight -> LineHeight -> Ordering
Ord)

lineHeightError :: a
lineHeightError :: forall a. a
lineHeightError = forall a. HasCallStack => String -> a
error String
"no arithmetic for line-height"

instance Default LineHeight where
    def :: LineHeight
def = LineHeight
NormalLineHeight

instance Fractional LineHeight where
    / :: LineHeight -> LineHeight -> LineHeight
(/)   = forall a. a
lineHeightError
    recip :: LineHeight -> LineHeight
recip = forall a. a
lineHeightError
    fromRational :: Rational -> LineHeight
fromRational = Percentage -> LineHeight
LineHeightNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational

instance IsString LineHeight where
    fromString :: String -> LineHeight
fromString = forall a. Read a => String -> a
read

instance LengthProperty LineHeight where
    fromLength :: Length -> LineHeight
fromLength = Length -> LineHeight
LineHeightLength

instance NormalProperty LineHeight

instance Num LineHeight where
    + :: LineHeight -> LineHeight -> LineHeight
(+)    = forall a. a
lineHeightError
    (-)    = forall a. a
lineHeightError
    * :: LineHeight -> LineHeight -> LineHeight
(*)    = forall a. a
lineHeightError
    abs :: LineHeight -> LineHeight
abs    = forall a. a
lineHeightError
    signum :: LineHeight -> LineHeight
signum = forall a. a
lineHeightError
    fromInteger :: Integer -> LineHeight
fromInteger = Percentage -> LineHeight
LineHeightNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

instance PercentageProperty LineHeight where
    percent :: Percentage -> LineHeight
percent = Percentage -> LineHeight
LineHeightPercentage

instance Read LineHeight where
    readPrec :: ReadPrec LineHeight
readPrec = do
        forall a. ReadP a -> ReadPrec a
lift ReadP ()
skipSpaces
        forall a. [ReadPrec a] -> ReadPrec a
ReadPrec.choice
            [ LineHeight
NormalLineHeight     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
stringCI String
"normal")
            , Percentage -> LineHeight
LineHeightNumber     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec
            , Length -> LineHeight
LineHeightLength     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec
            , Percentage -> LineHeight
LineHeightPercentage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. ReadP a -> ReadPrec a
lift (Char -> ReadP Char
char Char
'%')
            ]
    readListPrec :: ReadPrec [LineHeight]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Show LineHeight where
    showsPrec :: Int -> LineHeight -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow LineHeight where
    showb :: LineHeight -> Builder
showb LineHeight
NormalLineHeight         = Builder
"normal"
    showb (LineHeightNumber Percentage
n)     = Percentage -> Builder
jsDouble Percentage
n
    showb (LineHeightLength Length
l)     = forall a. TextShow a => a -> Builder
showb Length
l
    showb (LineHeightPercentage Percentage
p) = Percentage -> Builder
jsDouble Percentage
p forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.singleton Char
'%'

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

-- |
-- The name of a 'Font' family. Note that both 'FontFamily' and @['FontFamily']@
-- are instances of 'IsString', so it is possible to produce 'FontFamily' values
-- in several different ways. For example, these are all of type 'FontFamily':
--
-- @
-- 'FontFamilyName' "Gill Sans Extrabold"
-- "Gill Sans Extrabold" :: 'FontFamily'
-- 'serif'
-- "serif" :: 'FontFamily'
-- @
--
-- These are all of type @['FontFamily']@:
--
-- @
-- ['FontFamilyName' \"Helvetica\", 'serif']
-- [\"Helvetica\", "serif"] :: ['FontFamily']
-- "Helvetica, serif" :: ['FontFamily']
-- @
data FontFamily = FontFamilyName Text -- ^ The name of a custom font family.
                | SerifFamily         -- ^ A generic font family where glyphs have
                                      --   serifed endings.
                | SansSerifFamily     -- ^ A generic font family where glyphs do not
                                      --   have serifed endings.
                | MonospaceFamily     -- ^ A generic font family where all glyphs have
                                      --   the same fixed width.
                | CursiveFamily       -- ^ A generic font family with cursive glyphs.
                | FantasyFamily       -- ^ A generic font family where glyphs have
                                      --   decorative, playful representations.
  deriving (FontFamily -> FontFamily -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontFamily -> FontFamily -> Bool
$c/= :: FontFamily -> FontFamily -> Bool
== :: FontFamily -> FontFamily -> Bool
$c== :: FontFamily -> FontFamily -> Bool
Eq, Eq FontFamily
FontFamily -> FontFamily -> Bool
FontFamily -> FontFamily -> Ordering
FontFamily -> FontFamily -> FontFamily
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontFamily -> FontFamily -> FontFamily
$cmin :: FontFamily -> FontFamily -> FontFamily
max :: FontFamily -> FontFamily -> FontFamily
$cmax :: FontFamily -> FontFamily -> FontFamily
>= :: FontFamily -> FontFamily -> Bool
$c>= :: FontFamily -> FontFamily -> Bool
> :: FontFamily -> FontFamily -> Bool
$c> :: FontFamily -> FontFamily -> Bool
<= :: FontFamily -> FontFamily -> Bool
$c<= :: FontFamily -> FontFamily -> Bool
< :: FontFamily -> FontFamily -> Bool
$c< :: FontFamily -> FontFamily -> Bool
compare :: FontFamily -> FontFamily -> Ordering
$ccompare :: FontFamily -> FontFamily -> Ordering
Ord)

-- | Shorthand for 'SerifFamily'.
serif :: FontFamily
serif :: FontFamily
serif = FontFamily
SerifFamily

-- | Shorthand for 'SansSerifFamily'.
sansSerif :: FontFamily
sansSerif :: FontFamily
sansSerif = FontFamily
SansSerifFamily

-- | Shorthand for 'MonospaceFamily'.
monospace :: FontFamily
monospace :: FontFamily
monospace = FontFamily
MonospaceFamily

-- | Shorthand for 'CursiveFamily'.
cursive :: FontFamily
cursive :: FontFamily
cursive = FontFamily
CursiveFamily

-- | Shorthand for 'FantasyFamily'.
fantasy :: FontFamily
fantasy :: FontFamily
fantasy = FontFamily
FantasyFamily

instance IsString FontFamily where
    fromString :: String -> FontFamily
fromString = forall a. Read a => String -> a
read

-- |
-- There are two separate 'IsString' instances for 'FontFamily' so that single font
-- families and lists of font families alike can be converted from string literals.
instance IsString [FontFamily] where
    fromString :: String -> [FontFamily]
fromString = forall a. Read a => String -> a
read

instance Read FontFamily where
    readPrec :: ReadPrec FontFamily
readPrec = forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ do
        ReadP ()
skipSpaces
        forall a. [ReadP a] -> ReadP a
ReadP.choice
          [ FontFamily
SerifFamily     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"serif"
          , FontFamily
SansSerifFamily forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"sans-serif"
          , FontFamily
MonospaceFamily forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"monospace"
          , FontFamily
CursiveFamily   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"cursive"
          , FontFamily
FantasyFamily   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
stringCI String
"fantasy"
          , let quoted :: Char -> ReadP a -> ReadP a
quoted Char
quote = forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (Char -> ReadP Char
char Char
quote) (Char -> ReadP Char
char Char
quote)
             in forall {a}. Char -> ReadP a -> ReadP a
quoted Char
'"' (Maybe Char -> ReadP FontFamily
readFontFamily forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Char
'"')
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Char -> ReadP a -> ReadP a
quoted Char
'\'' (Maybe Char -> ReadP FontFamily
readFontFamily forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Char
'\'')
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Char -> ReadP FontFamily
readFontFamily forall a. Maybe a
Nothing
          ]

    -- readListPrec is overloaded so that it will read in a comma-separated list of
    -- family names not delimited by square brackets, as per the CSS syntax.
    readListPrec :: ReadPrec [FontFamily]
readListPrec = forall a. ReadP a -> ReadPrec a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy1 (forall a. ReadPrec a -> ReadP a
unlift forall a. Read a => ReadPrec a
readPrec) forall a b. (a -> b) -> a -> b
$ ReadP ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ReadP Char
char Char
','

readFontFamily :: Maybe Char -> ReadP FontFamily
readFontFamily :: Maybe Char -> ReadP FontFamily
readFontFamily Maybe Char
mQuote = do
    String
name <- case Maybe Char
mQuote of
        Just Char
quote -> (Char -> Bool) -> ReadP String
munch (forall a. Eq a => a -> a -> Bool
/= Char
quote)
        Maybe Char
Nothing    -> [String] -> String
unwords forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy1 ReadP String
cssIdent ((Char -> Bool) -> ReadP String
munch1 Char -> Bool
isSpace)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FontFamily
FontFamilyName forall a b. (a -> b) -> a -> b
$ String -> Text
TS.pack String
name

instance Show FontFamily where
    showsPrec :: Int -> FontFamily -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow
    showList :: [FontFamily] -> ShowS
showList    = forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromTextShow a
FromTextShow

instance TextShow FontFamily where
    showb :: FontFamily -> Builder
showb (FontFamilyName Text
name) = forall a. TextShow a => a -> Builder
showb Text
name
    showb FontFamily
SerifFamily           = Builder
"serif"
    showb FontFamily
SansSerifFamily       = Builder
"sans-serif"
    showb FontFamily
MonospaceFamily       = Builder
"monospace"
    showb FontFamily
CursiveFamily         = Builder
"cursive"
    showb FontFamily
FantasyFamily         = Builder
"fantasy"

    -- Omit the square brackets when showing a list of font families so that
    -- it matches the CSS syntax.
    showbList :: [FontFamily] -> Builder
showbList = forall a. (a -> Builder) -> [a] -> Builder
jsList forall a. TextShow a => a -> Builder
showb

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

-- | A convenient way to use the 'Default' normal value for several 'Font'
-- longhand properties.
class Default a => NormalProperty a where
    -- | The default value for a CSS property. For example, it can be used
    -- like this:
    --
    -- @
    -- ('defFont' ['sansSerif']) { 'lineHeight' = 'normal' }
    -- @
    normal :: a
    normal = forall a. Default a => a
def