{-# LANGUAGE PostfixOperators #-}

{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Css to be used in the generated HTML in the report.
-}
module Stan.Report.Css
    ( stanCss
    ) where

import Prelude hiding (div, rem, (&), (**))

import Clay hiding (brown, cols, grid)

import qualified Clay.Media as M
import qualified Data.List.NonEmpty as NE


stanCss :: Css
stanCss :: Css
stanCss = do
    Css
grid
    Selector
main_ Selector -> Css -> Css
? Css
marginAuto
    Selector
nav Selector -> Css -> Css
? do
        Color -> Css
backgroundColor Color
darkGrey
        Color -> Css
color Color
yellow
        Size Percentage -> Size Percentage -> Css
forall a. Size a -> Size a -> Css
padding2 (1Rational -> Size Percentage
%) (0Rational -> Size Percentage
%)
    -- ".nav-item" |> a ? do
    Selector
a Selector -> Css -> Css
? do
        TextDecoration -> Css
textDecoration TextDecoration
forall a. None a => a
none
        Color -> Css
color Color
yellow
        "@href" Refinement -> Css -> Css
& do
           TextDecoration -> Css
textDecoration TextDecoration
underline
           ":hover" Refinement -> Css -> Css
& FontWeight -> Css
fontWeight FontWeight
bold

    Selector
footer Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
header Selector -> Css -> Css
? do
        Display -> Css
display Display
block
        TextAlign -> Css
textAlign TextAlign
forall a. Center a => a
center
        Size Percentage -> Css
forall a. Size a -> Css
width (100Rational -> Size Percentage
%)
        Size Percentage -> Css
forall a. Size a -> Css
maxWidth (100Rational -> Size Percentage
%)
        Color -> Css
backgroundColor Color
lightGrey
        Stroke -> Size LengthUnit -> Color -> Css
borderTop Stroke
solid (Double -> Size LengthUnit
px 15) Color
darkGrey
    Selector
footer Selector -> Css -> Css
? Size Percentage -> Css
forall a. Size a -> Css
marginTop (2Rational -> Size Percentage
%)
    Selector
footer Selector -> Selector -> Selector
|> ".container" Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
marginTopBottom (Double -> Size LengthUnit
px 20)
    ".footer-link" Selector -> Selector -> Selector
** (Selector
a Selector -> Refinement -> Selector
# Refinement
hover) Selector -> Css -> Css
? (FontWeight -> Css
fontWeight FontWeight
forall a. Normal a => a
normal Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextDecoration -> Css
textDecoration TextDecoration
forall a. None a => a
none)
    ".ins-link" Selector -> Css -> Css
? do
        Css -> Css
important (TextDecoration -> Css
textDecoration TextDecoration
forall a. None a => a
none)
        Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Css
padding2 (Double -> Size LengthUnit
px 2) (Double -> Size LengthUnit
px 10)
        Color -> Css
backgroundColor Color
darkGrey
        Color -> Css
color Color
white
    ".ins-link" Selector -> Refinement -> Selector
# Refinement
hover Selector -> Css -> Css
? (Color -> Css
color Color
darkGrey Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Css
backgroundColor Color
transparent)
    Selector
pre  Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
code Selector -> Css -> Css
? (Color -> Css
backgroundColor Color
brown Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Css
color Color
white Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 1) 2 1 2)
    Selector
pre Selector -> Css -> Css
? do
        Size Percentage -> Size Percentage -> Css
forall a b. Size a -> Size b -> Css
margin2 (2Rational -> Size Percentage
%) (10Rational -> Size Percentage
%)
        Size Percentage -> Css
paddingAll 2
        Overflow -> Css
overflowX Overflow
forall a. Auto a => a
auto
    ".solutions" Selector -> Css -> Css
? do
        Size Percentage -> Size Percentage -> Css
forall a b. Size a -> Size b -> Css
margin2 (1Rational -> Size Percentage
%) (10Rational -> Size Percentage
%)
        Size Percentage -> Css
paddingAll 1
        Color -> Css
backgroundColor (Integer -> Integer -> Integer -> Float -> Color
rgba 255 246 143 0.4)
        Css -> Css
important (Css -> Css) -> Css -> Css
forall a b. (a -> b) -> a -> b
$ 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 4) 4 4 4
    (".solutions" Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> ".config-warnings") Selector -> Selector -> Selector
** Selector
ul Selector -> Css -> Css
? ListStyleType -> Css
listStyleType ListStyleType
forall a. None a => a
none
    ".solutions" Selector -> Selector -> Selector
** (Selector
li Selector -> Refinement -> Selector
# Refinement
before) Selector -> Css -> Css
? Content -> Css
content (Text -> Content
stringContent "💡")
    ".config-warnings" Selector -> Selector -> Selector
** (Selector
li Selector -> Refinement -> Selector
# Refinement
before) Selector -> Css -> Css
? Content -> Css
content (Text -> Content
stringContent "⚙️")
    Selector
table Selector -> Css -> Css
? do
        Size Percentage -> Css
forall a. Size a -> Css
width (100Rational -> Size Percentage
%) -- >> tableLayout fixed)
        Css -> Css
important (Css -> Css) -> Css -> Css
forall a b. (a -> b) -> a -> b
$ 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 4) 4 4 4
        Visibility -> Css
borderCollapse Visibility
collapse
    Selector
th Selector -> Refinement -> Selector
# Refinement
firstChild Selector -> Css -> Css
? 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 4) 0 0 0
    Selector
th Selector -> Refinement -> Selector
# Refinement
lastChild Selector -> Css -> Css
? Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
borderRadius 0 (Double -> Size LengthUnit
px 4) 0 0

    Selector
td Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
th Selector -> Css -> Css
? Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Css
padding2 Size LengthUnit
forall a. Size a
nil (Double -> Size LengthUnit
px 8)
    (".observation" Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> "#configurations" Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> "#stan-info" Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> "#severity") Selector -> Selector -> Selector
** (Selector
tr Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
td Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
th) Selector -> Css -> Css
?
        Stroke -> Size LengthUnit -> Color -> Css
border Stroke
solid (Double -> Size LengthUnit
px 1) Color
lightGrey
    ".border-shadow" Selector -> Css -> Css
? do
        NonEmpty BoxShadow -> Css
boxShadow (NonEmpty BoxShadow -> Css) -> NonEmpty BoxShadow -> Css
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow)
-> OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow
forall a b. (a -> b) -> a -> b
$ Color -> BoxShadow -> BoxShadow
bsColor (Float -> Color -> Color
setA 0.3 Color
darkGrey) (BoxShadow -> OneItem (NonEmpty BoxShadow))
-> BoxShadow -> OneItem (NonEmpty 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) 0 4 4
        Stroke -> Css
borderStyle (Value -> Stroke
forall a. Other a => Value -> a
other (Value -> Stroke) -> Value -> Stroke
forall a b. (a -> b) -> a -> b
$ Prefixed -> Value
Value (Prefixed -> Value) -> Prefixed -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Prefixed
Plain "hidden")

    ".info-name" Selector -> Css -> Css
? FontStyle -> Css
fontStyle FontStyle
italic
    ".info-data" Selector -> Css -> Css
? FontWeight -> Css
fontWeight FontWeight
bold

    "#stan-info" Selector -> Selector -> Selector
** Selector
table Selector -> Css -> Css
? Css
marginAuto
    Selector
blockquote Selector -> Css -> Css
? do
        Size Percentage -> Css
forall a. Size a -> Css
paddingLeft (2Rational -> Size Percentage
%)
        Stroke -> Size LengthUnit -> Color -> Css
borderLeft Stroke
solid (Double -> Size LengthUnit
px 4) Color
darkGrey
        NonEmpty BoxShadow -> Css
boxShadow (NonEmpty BoxShadow -> Css) -> NonEmpty BoxShadow -> Css
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow)
-> OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow
forall a b. (a -> b) -> a -> b
$ Color -> BoxShadow -> BoxShadow
bsColor Color
lightGrey (BoxShadow -> OneItem (NonEmpty BoxShadow))
-> BoxShadow -> OneItem (NonEmpty BoxShadow)
forall a b. (a -> b) -> a -> b
$ Size LengthUnit -> Size LengthUnit -> BoxShadow
forall a. Size a -> Size a -> BoxShadow
shadow (Double -> Size LengthUnit
px (-4)) 0

    ".obs-li" Selector -> Css -> Css
? Css -> Css
important (Size Percentage -> Css
marginAll 0)
    "#file" Selector -> Selector -> Selector
|> Selector
h3 Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
paddingLeft (Double -> Size LengthUnit
px 5)
    "#file" Selector -> Selector -> Selector
|> Selector
ul Selector -> Css -> Css
? ListStyleType -> Css
listStyleType ListStyleType
forall a. None a => a
none

    Css
stanCategory
    Css
stanSeverity
    Css
summarySection
    Css
collapsible

stanCategory :: Css
stanCategory :: Css
stanCategory = do
    ".cats" Selector -> Css -> Css
? (ListStyleType -> Css
listStyleType ListStyleType
forall a. None a => a
none Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Overflow -> Css
overflow Overflow
forall a. Hidden a => a
hidden Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size Percentage -> Css
paddingAll 0)
    ".inline" Selector -> Css -> Css
? Display -> Css
display Display
inline
    ".cats" Selector -> Selector -> Selector
|> Selector
li Selector -> Css -> Css
? FloatStyle -> Css
float FloatStyle
floatLeft
    Selector
td Selector -> Selector -> Selector
|> ".cats" Selector -> Selector -> Selector
|> Selector
li Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
marginTopBottom (Double -> Size LengthUnit
px 2)
    ".cat" Selector -> Css -> Css
? do
        Color -> Css
backgroundColor Color
pink
        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) (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 3)
        Display -> Css
display Display
inlineBlock
        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 0) (Double -> Size LengthUnit
px 20) (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 23)
        TextDecoration -> Css
textDecoration TextDecoration
forall a. None a => a
none
        Position -> Css
position Position
relative
        Text -> Css
transitionProperty "color"
        Time -> Css
transitionDuration (Double -> Time
sec 0.2)
    ".cat" Selector -> Refinement -> Selector
# Refinement
before Selector -> Css -> Css
? do
        Color -> Css
backgroundColor Color
white
        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 10) 10 10 10
        NonEmpty BoxShadow -> Css
boxShadow (NonEmpty BoxShadow -> Css) -> NonEmpty BoxShadow -> Css
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow)
-> OneItem (NonEmpty BoxShadow) -> NonEmpty BoxShadow
forall a b. (a -> b) -> a -> b
$ BoxShadow -> BoxShadow
BoxShadow -> OneItem (NonEmpty BoxShadow)
bsInset (BoxShadow -> OneItem (NonEmpty BoxShadow))
-> BoxShadow -> OneItem (NonEmpty BoxShadow)
forall a b. (a -> b) -> a -> b
$ Color -> BoxShadow -> BoxShadow
bsColor (Integer -> Integer -> Integer -> Float -> Color
rgba 0 0 0 0.25) (BoxShadow -> BoxShadow) -> BoxShadow -> BoxShadow
forall a b. (a -> b) -> a -> b
$
            Size LengthUnit -> Size LengthUnit -> BoxShadow
forall a. Size a -> Size a -> BoxShadow
shadow (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 1)
        Content -> Css
content (Text -> Content
stringContent "")
        Size LengthUnit -> Css
forall a. Size a -> Css
height (Double -> Size LengthUnit
px 6)
        Size LengthUnit -> Css
forall a. Size a -> Css
left (Double -> Size LengthUnit
px 10)
        Position -> Css
position Position
absolute
        Size LengthUnit -> Css
forall a. Size a -> Css
width (Double -> Size LengthUnit
px 6)
        Size LengthUnit -> Css
forall a. Size a -> Css
top (Double -> Size LengthUnit
px 10)
    Selector -> Color -> Css
catTriangle ".cat" Color
veryLightGrey
    (".inline" Selector -> Selector -> Selector
|> ".cat") Selector -> Refinement -> Selector
# Refinement
after Selector -> Css -> Css
? Color -> Css
backgroundColor Color
white
  where
    catTriangle :: Selector -> Color -> Css
catTriangle cl :: Selector
cl c :: Color
c = Selector
cl Selector -> Refinement -> Selector
# Refinement
after Selector -> Css -> Css
? do
        Color -> Css
backgroundColor Color
c
        Stroke -> Size LengthUnit -> Color -> Css
borderBottom Stroke
solid (Double -> Size LengthUnit
px 13) Color
transparent
        Stroke -> Size LengthUnit -> Color -> Css
borderLeft   Stroke
solid (Double -> Size LengthUnit
px 10) Color
pink
        Stroke -> Size LengthUnit -> Color -> Css
borderTop    Stroke
solid (Double -> Size LengthUnit
px 13) Color
transparent
        Content -> Css
content (Text -> Content
stringContent "")
        Position -> Css
position Position
absolute
        Size Percentage -> Css
forall a. Size a -> Css
right (0Rational -> Size Percentage
%) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size Percentage -> Css
forall a. Size a -> Css
top (0Rational -> Size Percentage
%)

stanSeverity :: Css
stanSeverity :: Css
stanSeverity = do
    ".severity" Selector -> Css -> Css
? do
        Display -> Css
display Display
inlineBlock
        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 1) 0 0 0
        Stroke -> Size LengthUnit -> Color -> Css
border Stroke
solid (Double -> Size LengthUnit
px 1) Color
darkGrey
        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 4) (Double -> Size LengthUnit
px 4) (Double -> Size LengthUnit
px 4) (Double -> Size LengthUnit
px 4)
        Size Any -> Css
forall a. Size a -> Css
lineHeight (Double -> Size Any
forall a. Double -> Size a
unitless 1)
    ".severityText" Selector -> Css -> Css
? Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Css
padding2 (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 15)
    ".severityStyle"        Selector -> Css -> Css
? Color -> Css
severityCss Color
cyan
    ".severityPerformance"  Selector -> Css -> Css
? Color -> Css
severityCss Color
blue
    ".severityPotentialBug" Selector -> Css -> Css
? Color -> Css
severityCss Color
magenta
    ".severityWarning"      Selector -> Css -> Css
? Color -> Css
severityCss Color
yellow
    ".severityError"        Selector -> Css -> Css
? Color -> Css
severityCss Color
red

    ".remove"  Selector -> Css -> Css
? Color -> Css
configActionsCss Color
red
    ".include" Selector -> Css -> Css
? Color -> Css
configActionsCss Color
green
    ".exclude" Selector -> Css -> Css
? Color -> Css
configActionsCss Color
yellow
    ".ignore"  Selector -> Css -> Css
? Color -> Css
configActionsCss Color
orange
  where
    configActionsCss :: Color -> Css
    configActionsCss :: Color -> Css
configActionsCss c :: Color
c = Color -> Css
color Color
black Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Css
backgroundColor (Float -> Color -> Color
setA 0.5 Color
c)

    severityCss :: Color -> Css
    severityCss :: Color -> Css
severityCss c :: Color
c = do
        Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Css
padding2 (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 15)
        Size Percentage -> Css
forall a. Size a -> Css
height (100Rational -> Size Percentage
%)
        Color -> Css
backgroundColor Color
c
        BackgroundClip -> Css
backgroundClip (BackgroundClip -> Css) -> BackgroundClip -> Css
forall a b. (a -> b) -> a -> b
$ BoxType -> BackgroundClip
boxClip BoxType
paddingBox
        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 4) (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 0) (Double -> Size LengthUnit
px 4)
        Stroke -> Size LengthUnit -> Color -> Css
borderRight Stroke
solid (Double -> Size LengthUnit
px 1) Color
darkGrey

collapsible :: Css
collapsible :: Css
collapsible = do
    ".collapsible" Selector -> Css -> Css
? do
        Size Percentage -> Css
forall a. Size a -> Css
width (100Rational -> Size Percentage
%)
        Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 1.125)
        Css -> Css
important (Size Percentage -> Css
forall a. Size a -> Css
marginLeft (0Rational -> Size Percentage
%) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size Percentage -> Css
forall a. Size a -> Css
marginBottom (0Rational -> Size Percentage
%) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size Percentage -> Css
forall a. Size a -> Css
marginRight (0Rational -> Size Percentage
%))
        Color -> Css
backgroundColor Color
darkGrey
        Color -> Css
color Color
white
        CursorValue Value -> Css
forall a. Cursor a => a -> Css
cursor CursorValue Value
pointer
        TextAlign -> Css
textAlign (Side -> TextAlign
alignSide Side
sideLeft)

    ".active" Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> (".collapsible" Selector -> Refinement -> Selector
# Refinement
hover) Selector -> Css -> Css
? Color -> Css
backgroundColor Color
lightGrey

    ".collapsible" Selector -> Refinement -> Selector
# Refinement
after Selector -> Css -> Css
? do
        Content -> Css
content (Text -> Content
stringContent "\\002B")
        Color -> Css
color Color
white
        FontWeight -> Css
fontWeight FontWeight
bold
        FloatStyle -> Css
float FloatStyle
floatRight
        Size LengthUnit -> Css
forall a. Size a -> Css
marginLeft (Double -> Size LengthUnit
px 5)

    ".active" Selector -> Refinement -> Selector
# Refinement
after Selector -> Css -> Css
? Content -> Css
content (Text -> Content
stringContent "\\2212")

    ".content" Selector -> Css -> Css
? do
        Size Any -> Css
forall a. Size a -> Css
maxHeight Size Any
forall a. Size a
nil
        Overflow -> Css
overflow Overflow
forall a. Hidden a => a
hidden
        Text -> Css
transitionProperty "max-height"
        TimingFunction -> Css
transitionTimingFunction TimingFunction
easeOut
        Time -> Css
transitionDuration (Double -> Time
sec 0.2)
        Color -> Css
backgroundColor Color
veryLightGrey
    ".content" Selector -> Selector -> Selector
|> Selector
div Selector -> Css -> Css
?
        Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
padding 0 0 0 (Double -> Size LengthUnit
px 18)

summarySection :: Css
summarySection :: Css
summarySection = do
    ".sum" Selector -> Css -> Css
?
        (Display -> Css
display Display
block Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Clear -> Css
clear Clear
both Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Position -> Css
position Position
relative)
    ".sum" Selector -> Refinement -> Selector
# Refinement
before Selector -> Css -> Css
? do
        Content -> Css
content (Text -> Content
stringContent "")
        Size LengthUnit -> Css
forall a. Size a -> Css
width (Double -> Size LengthUnit
rem 4) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size LengthUnit -> Css
forall a. Size a -> Css
height (Double -> Size LengthUnit
rem 4)
        FloatStyle -> Css
float FloatStyle
floatLeft
        Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
margin 0 (Double -> Size LengthUnit
rem 1.5) (Double -> Size LengthUnit
rem 0.75) 0
        BackgroundImage -> Css
backgroundImage (BackgroundImage -> Css) -> BackgroundImage -> Css
forall a b. (a -> b) -> a -> b
$ Direction -> Ramp -> BackgroundImage
linearGradient (Value -> Direction
forall a. Other a => Value -> a
other (Value -> Direction) -> Value -> Direction
forall a b. (a -> b) -> a -> b
$ Prefixed -> Value
Value (Prefixed -> Value) -> Prefixed -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Prefixed
Plain "to bottom right")
            [ (Color
color1, 25)
            , (Color
color2, 100)
            ]
        Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Color -> Css
forall a. Size a -> Size a -> Size a -> Color -> Css
textShadow 0 0 (Double -> Size LengthUnit
px 2) Color
color1;
        Size Percentage
-> Size Percentage -> Size Percentage -> Size Percentage -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
borderRadius (50Rational -> Size Percentage
%) 50 50 50
        Display -> Css
display Display
inlineFlex
        AlignItemsValue -> Css
alignItems AlignItemsValue
forall a. Center a => a
center
        JustifyContentValue -> Css
justifyContent JustifyContentValue
forall a. Center a => a
center
        "shape-outside" Key Text -> Text -> Css
-: "ellipse()"
        Integer -> Css
zIndex 1

    ".sum" Selector -> Refinement -> Selector
# Refinement
after Selector -> Css -> Css
? do
        Size LengthUnit -> Css
forall a. Size a -> Css
width (Double -> Size LengthUnit
rem 2) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size LengthUnit -> Css
forall a. Size a -> Css
height (Double -> Size LengthUnit
rem 2)
        Position -> Css
position Position
absolute
        Size LengthUnit -> Css
forall a. Size a -> Css
top (Double -> Size LengthUnit
px 0) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size LengthUnit -> Css
forall a. Size a -> Css
left (Double -> Size LengthUnit
px 0)
        Content -> Css
content (Text -> Content
stringContent "")
        Color -> Css
backgroundColor Color
color1
        Integer -> Css
zIndex (-1)
        Size LengthUnit -> Size LengthUnit -> Css
forall a. Size a -> Size a -> Css
borderTopLeftRadius (Double -> Size LengthUnit
px 3) (Double -> Size LengthUnit
px 3)
  where
    color1, color2 :: Color
    color1 :: Color
color1 = Color
darkGrey
    color2 :: Color
color2 = Color
veryLightGrey

grid :: Css
grid :: Css
grid = do
    (Selector
html Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> Selector
body) Selector -> Css -> Css
? do
        Size Percentage -> Css
forall a. Size a -> Css
height (100Rational -> Size Percentage
%)
        Size Percentage -> Css
forall a. Size a -> Css
width (100Rational -> Size Percentage
%)
        Size Percentage -> Css
marginAll 0
        Size Percentage -> Css
paddingAll 0
        Size Percentage -> Css
forall a. Size a -> Css
left (0Rational -> Size Percentage
%)
        Size Percentage -> Css
forall a. Size a -> Css
top (0Rational -> Size Percentage
%)
        [Text] -> [GenericFontFamily] -> Css
fontFamily [] [GenericFontFamily
sansSerif]
        Size Percentage -> Css
forall a. Size a -> Css
fontSize (100Rational -> Size Percentage
%)
        Color -> Css
color Color
darkGrey
        Size Any -> Css
forall a. Size a -> Css
lineHeight (Double -> Size Any
forall a. Double -> Size a
unitless 1.5)
    Selector
h1 Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 2.5)
    Selector
h2 Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 2)
    Selector
h3 Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 1.375)
    Selector
h4 Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 1.125)
    Selector
h5 Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 1)
    Selector
h6 Selector -> Css -> Css
? Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 0.875)
    Selector
p Selector -> Css -> Css
? (Size LengthUnit -> Css
forall a. Size a -> Css
fontSize (Double -> Size LengthUnit
rem 1.125) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FontWeight -> Css
fontWeight (Integer -> FontWeight
weight 200) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size Any -> Css
forall a. Size a -> Css
lineHeight (Double -> Size Any
forall a. Double -> Size a
unitless 1.8))
    ".centre" Selector -> Css -> Css
? (TextAlign -> Css
textAlign TextAlign
forall a. Center a => a
center Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Css
marginAuto)
    ".container" Selector -> Css -> Css
? (Size Percentage -> Css
forall a. Size a -> Css
width (90Rational -> Size Percentage
%) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Css
marginAuto)
    ".row" Selector -> Css -> Css
? (Position -> Css
position Position
relative Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size Percentage -> Css
forall a. Size a -> Css
width (100Rational -> Size Percentage
%))
    ".row [class^='col']" Selector -> Css -> Css
? do
        FloatStyle -> Css
float FloatStyle
floatLeft
        Size LengthUnit -> Size Percentage -> Css
forall a b. Size a -> Size b -> Css
margin2 (Double -> Size LengthUnit
rem 0.5) (2Rational -> Size Percentage
%)
        Size LengthUnit -> Css
forall a. Size a -> Css
minHeight (Double -> Size LengthUnit
rem 0.125)
    NonEmpty Selector -> Selector
forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty Selector
colClasses Selector -> Css -> Css
? Size Percentage -> Css
forall a. Size a -> Css
width (96Rational -> Size Percentage
%)
    NonEmpty Selector -> Css
colsGrid NonEmpty Selector
colClassesSm
    ".row" Selector -> Refinement -> Selector
# Refinement
after Selector -> Css -> Css
? do
        Content -> Css
content (Text -> Content
stringContent "")
        Display -> Css
display Display
displayTable
        Clear -> Css
clear Clear
both
    ".hidden-sm" Selector -> Css -> Css
? Display -> Css
display Display
displayNone
    Double -> Css -> Css
mediaQuery 33.75 (Css -> Css) -> Css -> Css
forall a b. (a -> b) -> a -> b
$ ".container" Selector -> Css -> Css
? Size Percentage -> Css
forall a. Size a -> Css
width (80Rational -> Size Percentage
%)
    Double -> Css -> Css
mediaQuery 45 (Css -> Css) -> Css -> Css
forall a b. (a -> b) -> a -> b
$ NonEmpty Selector -> Css
colsGrid NonEmpty Selector
colClasses
    Double -> Css -> Css
mediaQuery 60 (Css -> Css) -> Css -> Css
forall a b. (a -> b) -> a -> b
$ ".container" Selector -> Css -> Css
? (Size Percentage -> Css
forall a. Size a -> Css
width (75Rational -> Size Percentage
%) Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size LengthUnit -> Css
forall a. Size a -> Css
maxWidth (Double -> Size LengthUnit
rem 60))

    ".grey-bg" Selector -> Css -> Css
? (Color -> Css
backgroundColor Color
darkGrey Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Css
color Color
white)
    ".very-light-bg" Selector -> Css -> Css
? Color -> Css
backgroundColor Color
veryLightGrey
  where
    cols :: NonEmpty Text
    cols :: NonEmpty Text
cols = (Int -> Text) -> NonEmpty Int -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((".col-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall b a. (Show a, IsString b) => a -> b
show) (NonEmpty Int -> NonEmpty Text) -> NonEmpty Int -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ (1 :: Int) Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [2..12]

    colClasses, colClassesSm :: NonEmpty Selector
    colClasses :: NonEmpty Selector
colClasses   = (Text -> Selector) -> NonEmpty Text -> NonEmpty Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Selector
element NonEmpty Text
cols
    colClassesSm :: NonEmpty Selector
colClassesSm = (Text -> Selector) -> NonEmpty Text -> NonEmpty Selector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Selector
element (Text -> Selector) -> (Text -> Text) -> Text -> Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-sm")) NonEmpty Text
cols

    colsGrid :: NonEmpty Selector -> Css
    colsGrid :: NonEmpty Selector -> Css
colsGrid classes :: NonEmpty Selector
classes = NonEmpty Css -> Css
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (NonEmpty Css -> Css) -> NonEmpty Css -> Css
forall a b. (a -> b) -> a -> b
$ (Selector -> Rational -> Css)
-> NonEmpty Selector -> NonEmpty Rational -> NonEmpty Css
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\cl :: Selector
cl per :: Rational
per -> Selector
cl Selector -> Css -> Css
? Size Percentage -> Css
forall a. Size a -> Css
width (Rational
per Rational -> Size Percentage
%)) NonEmpty Selector
classes NonEmpty Rational
w

    w :: NonEmpty Rational
    w :: NonEmpty Rational
w = 4.33 Rational -> [Rational] -> NonEmpty Rational
forall a. a -> [a] -> NonEmpty a
:| [12.66, 21, 29.33, 37.66, 46, 54.33, 62.66, 71, 79.33, 87.66, 96]

    mediaQuery :: Double -> Css -> Css
    mediaQuery :: Double -> Css -> Css
mediaQuery x :: Double
x = MediaType -> [Feature] -> Css -> Css
query MediaType
M.screen [Size LengthUnit -> Feature
M.minWidth (Double -> Size LengthUnit
em Double
x)]

marginAuto :: Css
marginAuto :: Css
marginAuto = Size Any -> Css
forall a. Size a -> Css
marginLeft Size Any
forall a. Auto a => a
auto Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size Any -> Css
forall a. Size a -> Css
marginRight Size Any
forall a. Auto a => a
auto

marginAll :: Size Percentage -> Css
marginAll :: Size Percentage -> Css
marginAll x :: Size Percentage
x = Size Percentage
-> Size Percentage -> Size Percentage -> Size Percentage -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
margin Size Percentage
x Size Percentage
x Size Percentage
x Size Percentage
x

margin2 :: Size a -> Size b -> Css
margin2 :: Size a -> Size b -> Css
margin2 x :: Size a
x y :: Size b
y = Size a -> Css
forall a. Size a -> Css
marginTopBottom Size a
x Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size b -> Css
forall a. Size a -> Css
marginLeftRight Size b
y

marginTopBottom :: Size a -> Css
marginTopBottom :: Size a -> Css
marginTopBottom x :: Size a
x = Size a -> Css
forall a. Size a -> Css
marginTop Size a
x Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size a -> Css
forall a. Size a -> Css
marginBottom Size a
x

marginLeftRight :: Size a -> Css
marginLeftRight :: Size a -> Css
marginLeftRight x :: Size a
x = Size a -> Css
forall a. Size a -> Css
marginLeft Size a
x Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Size a -> Css
forall a. Size a -> Css
marginRight Size a
x

paddingAll :: Size Percentage -> Css
paddingAll :: Size Percentage -> Css
paddingAll x :: Size Percentage
x = Size Percentage
-> Size Percentage -> Size Percentage -> Size Percentage -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
padding Size Percentage
x Size Percentage
x Size Percentage
x Size Percentage
x

padding2 :: Size a -> Size a -> Css
padding2 :: Size a -> Size a -> Css
padding2 x :: Size a
x y :: Size a
y = Size a -> Size a -> Size a -> Size a -> Css
forall a. Size a -> Size a -> Size a -> Size a -> Css
padding Size a
x Size a
y Size a
x Size a
y

(%) :: Rational -> Size Percentage
% :: Rational -> Size Percentage
(%) = Rational -> Size Percentage
forall a. Fractional a => Rational -> a
fromRational

lightGrey, darkGrey, veryLightGrey, brown :: Color
lightGrey :: Color
lightGrey = Integer -> Integer -> Integer -> Color
rgb 189 189 189
darkGrey :: Color
darkGrey = Integer -> Integer -> Integer -> Color
rgb 97 97 97
veryLightGrey :: Color
veryLightGrey = Integer -> Integer -> Integer -> Color
rgb 241 241 241
brown :: Color
brown = Integer -> Integer -> Integer -> Color
rgb 78 52 46