-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me 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)
--
-----------------------------------------------------------------------------

module Util.W3CSSHTML
   ( w3table, w3list, w3tags, th, td, tr, makePage, writePage
   ) where

import Data.Monoid ( (<>) )
import Ideas.Text.HTML hiding (table)
import Ideas.Text.HTML.W3CSS
import Ideas.Text.XML hiding (tag)
import qualified Ideas.Text.XML as XML (tag)
import System.Directory

w3table :: BuildXML a => Bool -> [[a]] -> a
w3table b xss
   | null xss  = mempty
   | otherwise = XML.tag "table " . table . border . bordered
               . mconcat . zipWith row [0 :: Int ..] $ xss
 where
   row i =
      let header = b && i == 0
      in element "tr" . map (if header then XML.tag "th" else XML.tag "td")

w3list :: BuildXML a => [a] -> a
w3list = w3table False . map return

w3tags :: [(String, Color)] -> HTMLBuilder
w3tags xs
   | null xs   = mempty
   | otherwise = spaced $ map f xs
 where
   f (s, c) = tag . background c . rounded Medium . marginPos Bottom . string $ s

tr :: [HTMLBuilder] -> HTMLBuilder
tr xs = if null xs then mempty else element "tr" xs

td :: HTMLBuilder -> HTMLBuilder
td = XML.tag "td"

th :: HTMLBuilder -> HTMLBuilder
th = XML.tag "th"

writePage :: String -> HTMLPage -> IO ()
writePage s p = do
   let file = "html/" ++ s ++ ".html"
   putStrLn $ "Generating " ++ file
   createDirectoryIfMissing True "html"
   writeFile file (showHTML p)

{-addCSS "https://www.w3schools.com/lib/w3-theme-blue-grey.css" -}
makePage :: String -> HTMLBuilder -> HTMLPage
makePage title contents =
 ( addStyle "body { background-color: #9b2335 }"
 . w3css
 . addCSS "http://ideas.cs.uu.nl/css/2007-chili-pepper.css"
 . htmlPage title
 . divClass "body"
 . w3class "w3-theme-d2"
 . container
 ) (h1 title <> contents)