W3CSS.hs

-----------------------------------------------------------------------------
-- Copyright 2019, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- A minimal interface for using W3.CSS, a modern CSS framework with built-in
-- responsiveness.
-- See https://www.w3schools.com/w3css/
--
-----------------------------------------------------------------------------
module Ideas.Text.HTML.W3CSS where

import Data.Char
import Data.Monoid
import Ideas.Text.HTML
import Ideas.Text.XML
import qualified Ideas.Text.XML as XML

w3css :: HTMLPage -> HTMLPage
w3css = addCSS "https://www.w3schools.com/w3css/4/w3.css"

w3class :: BuildXML a => String -> a -> a
w3class s a = ("class" .=. s) <> a

w3classIf :: BuildXML a => Bool -> String -> a -> a
w3classIf b s = if b then w3class s else id

data Color
   = Red | Pink | Purple | DeepPurple | Indigo | Blue | LightBlue
   | Cyan | Aqua | Teal | Green | LightGreen | Lime | Sand | Khaki
   | Yellow | Amber | Orange | DeepOrange | BlueGray | Brown | LightGray
   | Gray | DarkGray | Black | PaleRed | PaleYellow | PaleGreen | PaleBlue | White
 deriving Show

data Size = Tiny | Small | Medium | Large | XL | XXL | XXXL | Jumbo
 deriving (Eq, Ord)

data Position = TopLeft    | Top    | TopRight
              | CenterLeft | Center | CenterRight
              | BottomLeft | Bottom | BottomRight
 deriving (Show, Eq)

onTop, onLeft, onRight, onBottom :: Position -> Bool
onTop    = (`elem` [TopLeft, Top, TopRight])
onLeft   = (`elem` [TopLeft, CenterLeft, BottomLeft])
onRight  = (`elem` [TopRight, CenterRight, BottomRight])
onBottom = (`elem` [BottomLeft, Bottom, BottomRight])

instance Show Size where
   show Tiny   = "tiny"
   show Small  = "small"
   show Medium = "medium"
   show Large  = "large"
   show XL     = "xlarge"
   show XXL    = "xxlarge"
   show XXXL   = "xxxlarge"
   show Jumbo  = "jumbo"

uncamel :: String -> String
uncamel = concatMap f
 where
   f c = if isUpper c then ['-', toLower c] else [c]

--------------------------------------------------------------------------------
-- * Container Classes

-- | HTML container with 16px left and right padding
container :: BuildXML a => a -> a
container = XML.tag "div" . w3class "w3-container"

-- | HTML container with 16px left and right padding and 16px top and bottom margin
panel :: BuildXML a => a -> a
panel = XML.tag "div" . w3class "w3-panel"

-- | Circular badge
badge :: BuildXML a => a -> a
badge = XML.tag "span" . w3class "w3-badge"

-- | Rectangular tag
tag :: BuildXML a => a -> a
tag = XML.tag "span" . w3class "w3-tag"

-- | Unordered list
ul :: BuildXML a => [a] -> a
ul = ulWith id

-- | Unordered list
ulWith :: BuildXML a => (a -> a) -> [a] -> a
ulWith f = XML.tag "ul" . w3class "w3-ul" . f . mconcat . map (XML.tag "li")

-- | Code container
code :: BuildXML a => a -> a
code = XML.tag "div" . w3class "w3-code"

-- | Inline code container (for code snippets)
codespan :: BuildXML a => a -> a
codespan = XML.tag "code" . w3class "w3-codespan"

--------------------------------------------------------------------------------
-- * Table Classes

-- | Container for an HTML table
table :: BuildXML a => a -> a
table = XML.tag "table" .  w3class "w3-table"

-- | All properties set
tableAll :: BuildXML a => a -> a
tableAll = XML.tag "table" . w3class "w3-table-all"

-- | Striped table
striped :: BuildXML a => a -> a
striped = w3class "w3-striped"

-- | Bordered lines
bordered :: BuildXML a => a -> a
bordered = w3class "w3-bordered"

-- | Centered table
centered :: BuildXML a => a -> a
centered = w3class "w3-centered"

-- | Hoverable table
hoverable :: BuildXML a => a -> a
hoverable = w3class "w3-hoverable"

-- | Creates a responsive table
responsive :: BuildXML a => a -> a
responsive = w3class "w3-responsive"

--------------------------------------------------------------------------------
-- * Card Classes

-- | Same as w3-card-2
card :: BuildXML a => a -> a
card = w3class "w3-card"

-- | Container for any HTML content (2px bordered shadow)
card2 :: BuildXML a => a -> a
card2 = w3class "w3-card-2"

-- | Container for any HTML content (4px bordered shadow)
card4 :: BuildXML a => a -> a
card4 = w3class "w3-card-4"

--------------------------------------------------------------------------------
-- * Responsive Classes

-- | Container for one row of fluid responsive content
row :: BuildXML a => a -> a
row = w3class "w3-row"

-- | Row where all columns have a default padding
rowPadding :: BuildXML a => a -> a
rowPadding = w3class "w3-row-padding"

-- | Container for fixed size centered content
content :: BuildXML a => a -> a
content = w3class "w3-content"

-- | Half (1/2) screen column container
half :: BuildXML a => a -> a
half = w3class "w3-half"

-- | Third (1/3) screen column container
third :: BuildXML a => a -> a
third = w3class "w3-third"

-- | Two third (2/3) screen column container
twothird :: BuildXML a => a -> a
twothird = w3class "w3-twothird"

-- | Quarter (1/4) screen column container
quarter :: BuildXML a => a -> a
quarter = w3class "w3-quarter"

-- | Three quarters (3/4) screen column container
threequarter :: BuildXML a => a -> a
threequarter = w3class "w3-threequarter"

-- | Column container for any HTML content
col :: BuildXML a => a -> a
col = w3class "w3-col"

-- | Occupies the rest of the column width
rest :: BuildXML a => a -> a
rest = w3class "w3-rest"

-- | Hide content on small screens (less than 601px)
hideSmall :: BuildXML a => a -> a
hideSmall = w3class "w3-hide-small"

-- | Hide content on medium screens
hideMedium :: BuildXML a => a -> a
hideMedium = w3class "w3-hide-medium"

-- | Hide content on large screens (larger than 992px)
hideLarge :: BuildXML a => a -> a
hideLarge = w3class "w3-hide-large"

-- | Responsive image
image :: BuildXML a => a -> a
image = w3class "w3-image"

-- | Adds mobile-first responsiveness to any element. Displays elements as block elements on mobile devices.
mobile :: BuildXML a => a -> a
mobile = w3class "w3-mobile"

-- l1 - l12 Responsive sizes for large screens
-- m1 - m12 Responsive sizes for medium screens
-- s1 - s12 Responsive sizes for small screens

--------------------------------------------------------------------------------
-- * Layout Classes

-- | Container for layout columns (cells).
cellRow :: BuildXML a => a -> a
cellRow = w3class "w3-cell-row"

-- | Layout column (cell).
cell :: BuildXML a => a -> a
cell = w3class "w3-cell"

-- | Aligns content at the top of a column (cell).
cellTop :: BuildXML a => a -> a
cellTop = w3class "w3-cell-top"

-- | Aligns content at the vertical middle of a column (cell).
cellMiddle :: BuildXML a => a -> a
cellMiddle = w3class "w3-cell-middle"

-- | Aligns content at the bottom of a column (cell).
cellBottom :: BuildXML a => a -> a
cellBottom = w3class "w3-cell-bottom"

--------------------------------------------------------------------------------
-- * Bar Classes - Navigation

-- | Horizontal bar
bar :: BuildXML a => a -> a
bar = w3class "w3-bar"

-- | Vertical bar
barBlock :: BuildXML a => a -> a
barBlock = w3class "w3-bar-block"

-- | Provides common style for bar items
barItem :: BuildXML a => a -> a
barItem = w3class "w3-bar-item"

-- | Side bar
sidebar :: BuildXML a => a -> a
sidebar = w3class "w3-sidebar"

-- | Used together with w3-sidebar to create a fully automatic responsive side navigation. For this class to work, the page content must be within a "w3-main" class
collapse :: BuildXML a => a -> a
collapse = w3class "w3-collapse"

-- | Container for page content when using the w3-collapse class for responsive side navigations
mainPage :: BuildXML a => a -> a
mainPage = w3class "w3-main"

--------------------------------------------------------------------------------
-- * Dropdown Classes

-- | Clickable dropdown element
dropdownClick :: BuildXML a => a -> a
dropdownClick = w3class "w3-dropdown-click"

-- | Hoverable dropdown element
dropdownHover :: BuildXML a => a -> a
dropdownHover = w3class "w3-dropdown-hover"

--------------------------------------------------------------------------------
-- * Button Classes

-- | Rectangular button with grey background color on hover
button :: BuildXML a => String -> a -> a
button url = link url . w3class "w3-button"

-- | Rectangular button with shadows on hover
btn :: BuildXML a => String -> a -> a
btn url = link url . w3class "w3-btn"

-- | Rectangular button with ripple effect
ripple :: BuildXML a => String -> a -> a
ripple url = link url . w3class "w3-ripple"

--------------------------------------------------------------------------------
-- * Input Classes

-- | Input elements
input :: BuildXML a => a -> a
input = w3class "w3-input"

-- | Checkbox input type
check :: BuildXML a => a -> a
check = w3class "w3-check"

-- | Radio input type
radio :: BuildXML a => a -> a
radio = w3class "w3-radio"

-- | Input select element
select :: BuildXML a => a -> a
select = w3class "w3-select"

--------------------------------------------------------------------------------
-- * Modal Classes

-- | Modal container
modal :: BuildXML a => a -> a
modal = w3class "w3-modal"

-- | Modal pop-up element
modalContent :: BuildXML a => a -> a
modalContent = w3class "w3-modal-content"

-- | Tooltip element
tooltip :: BuildXML a => a -> a
tooltip = w3class "w3-tooltip"

-- | Tooltip text
tooltipText :: BuildXML a => a -> a
tooltipText = w3class "w3-text"

--------------------------------------------------------------------------------
-- * Animation Classes

-- | Animates an element from -300px to 0px
animate :: BuildXML a => Position -> a -> a
animate p = w3classIf (onTop p)    "w3-animate-top"
          . w3classIf (onLeft p)   "w3-animate-left"
          . w3classIf (onBottom p) "w3-animate-bottom"
          . w3classIf (onRight p)  "w3-animate-right"

-- | Animates an element's opacity from 0 to 1
animateOpacity :: BuildXML a => a -> a
animateOpacity = w3class "w3-animate-opacity"

-- | Animates an element from 0 to 100% in size
animateZoom :: BuildXML a => a -> a
animateZoom = w3class "w3-animate-zoom"

-- | Animates an element's opacity from 0 to 1 and 1 to 0 (fades in AND out)
animateFading :: BuildXML a => a -> a
animateFading = w3class "w3-animate-fading"

-- | Spin an icon 360 degrees
spin :: BuildXML a => a -> a
spin = w3class "w3-spin"

-- | Animates the width of an input field to 100%
animateInput :: BuildXML a => a -> a
animateInput = w3class "w3-animate-input"

--------------------------------------------------------------------------------
-- * Font and Text Classes

-- | Specifies a font size: tiny 10px, small 12px, large 18px, xlarge 24px, xxlarge 32px, xxxlarge 48px, jumbo 64px
fontSize :: BuildXML a => Size -> a -> a
fontSize = w3class . ("w3-" ++) . show

-- | Specifies a wider text
wide :: BuildXML a => a -> a
wide = w3class "w3-wide"

-- | Changes the font to serif
serif :: BuildXML a => a -> a
serif = w3class "w3-serif"

--------------------------------------------------------------------------------
-- * Display Classes

-- | Centered content
center :: BuildXML a => a -> a
center = w3class "w3-center"

-- | Floats an element to the left (float: left)
left :: BuildXML a => a -> a
left = w3class "w3-left"

-- | Floats an element to the right (float: right)
right :: BuildXML a => a -> a
right = w3class "w3-right"

-- | Left aligned text
leftAlign :: BuildXML a => a -> a
leftAlign = w3class "w3-left-align"

-- | Right aligned text
rightAlign :: BuildXML a => a -> a
rightAlign = w3class "w3-right-align"

-- | Right and left aligned text
justify :: BuildXML a => a -> a
justify = w3class "w3-justify"

-- | Circled content
circle :: BuildXML a => a -> a
circle = w3class "w3-circle"

-- | Hidden content (display:none)
hide :: BuildXML a => a -> a
hide = w3class "w3-hide"

-- | Alias of w3-show (display:block)
showBlock :: BuildXML a => a -> a
showBlock = w3class "w3-show-block"

-- | Show content as inline-block (display:inline-block)
showInlineBlock :: BuildXML a => a -> a
showInlineBlock = w3class "w3-show-inline-block"

-- | Fixed content at the top of a page
top :: BuildXML a => a -> a
top = w3class "w3-top"

-- | Fixed content at the bottom of a page
bottom :: BuildXML a => a -> a
bottom = w3class "w3-bottom"

-- | Container for w3-display-classes (position: relative)
display :: BuildXML a => Position -> a -> a
display p = w3class "w3-display-container" . w3class (f p)
 where
   f TopLeft     = "w3-display-topleft"
   f Top         = "w3-display-topmiddle"
   f TopRight    = "w3-display-topright"
   f CenterLeft  = "w3-display-left"
   f Center      = "w3-display-middle"
   f CenterRight = "w3-display-right"
   f BottomLeft  = "w3-display-bottomleft"
   f Bottom      = "w3-display-bottommiddle"
   f BottomRight = "w3-display-bottomright"

-- | Displays content on hover inside the w3-display-container
displayHover :: BuildXML a => a -> a
displayHover = w3class "w3-display-hover"

--------------------------------------------------------------------------------
-- * Effect Classes

-- | Adds opacity/transparency to an element (opacity: 0.6)
opacity :: BuildXML a => a -> a
opacity = w3class "w3-opacity"

-- | Turns off opacity/transparency (opacity: 1)
opacityOff :: BuildXML a => a -> a
opacityOff = w3class "w3-opacity-off"

-- | Adds opacity/transparency to an element (opacity: 0.75)
opacityMin :: BuildXML a => a -> a
opacityMin = w3class "w3-opacity-min"

-- | Adds opacity/transparency to an element (opacity: 0.25)
opacityMax :: BuildXML a => a -> a
opacityMax = w3class "w3-opacity-max"

-- | Adds a grayscale effect to an element (grayscale: 50%)
grayscaleMin :: BuildXML a => a -> a
grayscaleMin = w3class "w3-grayscale-min"

-- | Adds a grayscale effect to an element (grayscale: 75%)
grayscale :: BuildXML a => a -> a
grayscale = w3class "w3-grayscale"

-- | Adds a grayscale effect to an element (grayscale: 100%)
grayscaleMax :: BuildXML a => a -> a
grayscaleMax = w3class "w3-grayscale-max"

-- | Adds a sepia effect to an element (sepia: 50%)
sepiaMin :: BuildXML a => a -> a
sepiaMin = w3class "w3-sepia-min"

-- | Adds a sepia effect to an element (sepia: 75%)
sepia :: BuildXML a => a -> a
sepia = w3class "w3-sepia"

-- | Adds a sepia effect to an element (sepia: 100%)
sepiaMax :: BuildXML a => a -> a
sepiaMax = w3class "w3-sepia-max"

-- | Creates an overlay effect
overlay :: BuildXML a => a -> a
overlay = w3class "w3-overlay"

--------------------------------------------------------------------------------
-- * Background Color Classes

-- | Background color
background :: BuildXML a => Color -> a -> a
background = w3class . ("w3" ++) .  uncamel . show

-- | Transparent background-color
transparent :: BuildXML a => a -> a
transparent = w3class "w3-transparent"

--------------------------------------------------------------------------------
--  * Color Classes

-- | Hover color
hover :: BuildXML a => Color -> a -> a
hover = w3class . ("w3-hover" ++) .  uncamel . show

--------------------------------------------------------------------------------
-- * Text Color Classes

-- | Text color
textColor :: BuildXML a => Color -> a -> a
textColor = w3class . ("w3-text" ++) .  uncamel . show

--------------------------------------------------------------------------------
-- * Hover Classes

-- | Hover text color
hoverColor :: BuildXML a => Color -> a -> a
hoverColor = w3class . ("w3-hover-text" ++) .  uncamel . show

-- | Adds transparency to an element on hover (opacity: 0.6)
hoverOpacity :: BuildXML a => a -> a
hoverOpacity = w3class "w3-hover-opacity"

-- | Removes transparency from an element on hover (100% opacity)
hoverOpacityOff :: BuildXML a => a -> a
hoverOpacityOff = w3class "w3-hover-opacity-off"

-- | Adds shadow to an element on hover
hoverShadow :: BuildXML a => a -> a
hoverShadow = w3class "w3-hover-shadow"

-- | Adds a black and white (100% grayscale) effect to an element
hoverGrayscale :: BuildXML a => a -> a
hoverGrayscale = w3class "w3-hover-grayscale"

-- | Adds a sepia effect to an element on hover
hoverSepia :: BuildXML a => a -> a
hoverSepia = w3class "w3-hover-sepia"

-- | Removes hover effects from an element
hoverNone :: BuildXML a => a -> a
hoverNone = w3class "w3-hover-none"

--------------------------------------------------------------------------------
-- * Round Classes

-- | Element rounded (border-radius): small 2px, medium 4px, large 8px, xlarge 16px, xxlarge 32px
rounded :: BuildXML a => Size -> a -> a
rounded s = w3class "w3-round" . w3class ("w3-round-" ++ show s)

--------------------------------------------------------------------------------
-- * Padding Classes

-- | Small: Padding 4px top and bottom, and 8px left and right, Medium: Padding 8px top and bottom, and 16px left and right, Large: Padding 12px top and bottom, and 24px left and right.
padding :: BuildXML a => Size -> a -> a
padding s
   | s < Medium = w3class "w3-padding-small"
   | s > Medium = w3class "w3-padding-large"
   | otherwise  = w3class "w3-padding-small"

-- | Padding top and bottom: medium 16px, large 24px, xlarge 32px, xxlarge 48px, xxxlarge 64px
vpadding :: BuildXML a => Size -> a -> a
vpadding s
   | s <= Medium = w3class "w3-padding-16"
   | s == Large  = w3class "w3-padding-24"
   | s == XL     = w3class "w3-padding-32"
   | s == XXL    = w3class "w3-padding-48"
   | otherwise   = w3class "w3-padding-64"

--------------------------------------------------------------------------------
-- * Margin Classes

-- | Adds an 16px margin to an element
margin :: BuildXML a => a -> a
margin = w3class "w3-margin"

marginPos :: BuildXML a => Position -> a -> a
marginPos p = w3classIf (onTop p)    "w3-margin-top"
            . w3classIf (onLeft p)   "w3-margin-left"
            . w3classIf (onBottom p) "w3-margin-bottom"
            . w3classIf (onRight p)  "w3-margin-right"

-- | Adds an 16px top and bottom margin to an element
section :: BuildXML a => a -> a
section = w3class "w3-section"

--------------------------------------------------------------------------------
-- * Border Classes

-- | Borders (top, right, bottom, left)
border :: BuildXML a => a -> a
border = w3class "w3-border"

borderPos :: BuildXML a => Position -> a -> a
borderPos p = w3classIf (onTop p)    "w3-border-top"
            . w3classIf (onLeft p)   "w3-border-left"
            . w3classIf (onBottom p) "w3-border-bottom"
            . w3classIf (onRight p)  "w3-border-right"

-- | Removes all borders
noBorder :: BuildXML a => a -> a
noBorder = w3class "w3-border-0"

-- | Border color
borderColor :: BuildXML a => Color -> a -> a
borderColor = w3class . ("w3-border" ++) .  uncamel . show

-- | Adds a thick border (bar) to an element
barPos :: BuildXML a => Position -> a -> a
barPos p = w3classIf (onTop p)    "w3-topbar"
         . w3classIf (onLeft p)   "w3-leftbar"
         . w3classIf (onBottom p) "w3-bottombar"
         . w3classIf (onRight p)  "w3-rightbar"

--------------------------------------------------------------------------------
-- * Color themes

data ColorTheme
   = L1 | L2 | L3 | L4 | L5 -- light
   | D1 | D2 | D3 | D4 | D5 -- dark
 deriving Show

-- standard color theme
theme_, textTheme, borderTheme :: BuildXML a => a -> a
theme_      = w3class "w3-theme"
textTheme   = w3class "w3-text-theme"
borderTheme = w3class "w3-border-theme"

theme :: BuildXML a => ColorTheme -> a -> a
theme = w3class . ("w3-theme-" ++) . map toLower . show