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

-- 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