{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE DataKinds           #-}

module Main where

import Html
import qualified Html.Attribute as A

import Data.String
import Control.Monad
import Criterion.Main

import Text.Blaze.Html5 ((!))
import Text.Blaze.Html.Renderer.Utf8

import qualified Text.Blaze.Html5            as B
import qualified Text.Blaze.Html5.Attributes as BA

main :: IO ()
main = defaultMain
  [ bgroup "minimal"
    [ bench "blaze-html"   $ nf (renderHtml . blazeMinimal)     (fromString "TEST")
    , bench "type-of-html" $ nf (renderByteString . minimal)    "TEST"
    ]
  , bgroup "hello world"
    [ bench "blaze-html"   $ nf (renderHtml . blazeHelloWorld)  (fromString "TEST")
    , bench "type-of-html" $ nf (renderByteString . helloWorld) "TEST"
    ]
  , bgroup "attributes long"
    [ bench "blaze-html"   $ nf (renderHtml . blazeAttrLong)    (fromString "TEST")
    , bench "type-of-html" $ nf (renderByteString . attrLong)   "TEST"
    ]
  , bgroup "attributes short"
    [ bench "blaze-html"   $ nf (renderHtml . blazeAttrShort)   (fromString "TEST")
    , bench "type-of-html" $ nf (renderByteString . attrShort)  "TEST"
    ]
  , bgroup "big page"
    [ bench "blaze-html"   $ nf (renderHtml . blazeBigPage)     (fromString "TEST")
    , bench "type-of-html" $ nf (renderByteString . bigPage)    "TEST"
    ]
  , bgroup "big page with attributes"
    [ bench "blaze-html"   $ nf (renderHtml . blazeBigPageA)    (fromString "TEST")
    , bench "type-of-html" $ nf (renderByteString . bigPageA)   "TEST"
    ]
  , bgroup "big table"
    [ bench "blaze-html"   $ nf (renderHtml . blazeBigTable)    (4,4)
    , bench "type-of-html" $ nf (renderByteString . bigTable)   (4,4)
    ]
  ]

-- Blaze based functions

blazeMinimal :: B.Html -> B.Html
blazeMinimal = B.div

blazeHelloWorld :: B.Html -> B.Html
blazeHelloWorld x =
  B.html $ do
    B.head $ do
      B.title x
    B.body $ do
      B.p $ fromString "Hello World!"

blazeBigPage :: B.Html -> B.Html
blazeBigPage x =
  B.html $ do
    B.body $ do
      B.h1 $ do
        B.img
        B.strong $ fromString "0"
      B.div $ do
        B.div $ fromString "1"
      B.div $ do
        B.form $ do
          B.fieldset $ do
            B.div $ do
              B.div $ do
                B.label $ fromString "a"
                B.select $ do
                  B.option $ fromString "b"
                  B.option $ fromString "c"
                B.div $ fromString "d"
              B.i x
            B.button . B.i $ fromString "e"

blazeAttrShort :: B.Html -> B.Html
blazeAttrShort x
  = B.i ! BA.accesskey       (fromString "a")
  $ B.i ! BA.class_          (fromString "b")
  $ B.i ! BA.contenteditable (fromString "c")
  $ B.i ! BA.contextmenu     (fromString "d")
  $ B.i ! BA.dir             (fromString "e")
  $ B.i ! BA.draggable       (fromString "f")
  $ B.i ! BA.hidden          (fromString "g")
  $ B.i ! BA.id              (fromString "h")
  $ B.i ! BA.itemprop        (fromString "i")
  $ B.i ! BA.lang            (fromString "j")
  $ B.i ! BA.spellcheck      (fromString "k")
  $ B.i ! BA.style           (fromString "l")
  $ B.i ! BA.tabindex        (fromString "m")
  $ B.i ! BA.title           (fromString "n")
  $ x

blazeAttrLong :: B.Html -> B.Html
blazeAttrLong x
  = B.i ! BA.accesskey       (fromString "a")
        ! BA.class_          (fromString "b")
        ! BA.contenteditable (fromString "c")
        ! BA.contextmenu     (fromString "d")
        ! BA.dir             (fromString "e")
        ! BA.draggable       (fromString "f")
        ! BA.hidden          (fromString "g")
        ! BA.id              (fromString "h")
        ! BA.itemprop        (fromString "i")
        ! BA.lang            (fromString "j")
        ! BA.spellcheck      (fromString "k")
        ! BA.style           (fromString "l")
        ! BA.tabindex        (fromString "m")
        ! BA.title           (fromString "n")
        $ x

blazeBigPageA :: B.Html -> B.Html
blazeBigPageA x =
  B.html $ do
    B.body $ do
      B.h1 ! BA.id (fromString "a") $ do
        B.img
        B.strong ! BA.class_ (fromString "b") $ fromString "0"
      B.div $ do
        B.div ! BA.id (fromString "c") $ fromString "1"
      B.div $ do
        B.form ! BA.class_ (fromString "d") $ do
          B.fieldset $ do
            B.div ! BA.id (fromString "e") $ do
              B.div $ do
                B.label ! BA.class_ (fromString "f") $ fromString "a"
                B.select $ do
                  B.option ! BA.id (fromString "g") $ fromString "b"
                  B.option (fromString "c")
                B.div ! BA.class_ (fromString "h") $ fromString "d"
              B.i x
            B.button ! BA.id (fromString "i") $ B.i $ fromString "e"

blazeBigTable :: (Int, Int) -> B.Html
blazeBigTable (n, m)
  = B.table
  . replicateM_ n
  . B.tr
  $ mapM_ (B.td . fromString . show) [1..m]

-- Type of Html based functions

minimal = div_

helloWorld x =
  html_
    ( head_
      ( title_ x
      )
    # body_
      ( p_ "Hello World!"
      )
    )

bigPage x =
  html_
    ( body_
      ( h1_
        ( img_
        # strong_ (0 :: Int)
        )
      # div_
        ( div_ (1 :: Int)
        )
      # div_
        ( form_
          ( fieldset_
            ( div_
              ( div_
                ( label_ "a"
                # select_
                  ( option_ "b"
                  # option_ "c"
                  )
                # div_ "d"
                )
              # i_ x
              )
            # button_ (i_ "e")
            )
          )
        )
      )
    )

attrShort x
  = i_A (A.accesskey_       "a")
  . i_A (A.class_           "b")
  . i_A (A.contenteditable_ "c")
  . i_A (A.contextmenu_     "d")
  . i_A (A.dir_             "e")
  . i_A (A.draggable_       "f")
  . i_A (A.hidden_          "g")
  . i_A (A.id_              "h")
  . i_A (A.itemprop_        "i")
  . i_A (A.lang_            "j")
  . i_A (A.spellcheck_      "k")
  . i_A (A.style_           "l")
  . i_A (A.tabindex_        "m")
  . i_A (A.title_           "n")
  $ x

attrLong x =
  i_A ( A.accesskey_       "a"
      # A.class_           "b"
      # A.contenteditable_ "c"
      # A.contextmenu_     "d"
      # A.dir_             "e"
      # A.draggable_       "f"
      # A.hidden_          "g"
      # A.id_              "h"
      # A.itemprop_        "i"
      # A.lang_            "j"
      # A.spellcheck_      "k"
      # A.style_           "l"
      # A.tabindex_        "m"
      # A.title_           "n"
      ) x

bigPageA x =
  html_
    ( body_
      ( h1_A (A.id_ "a")
        ( img_
        # strong_A (A.class_ "b") (0 :: Int)
        )
      # div_
        ( div_A (A.id_ "c") (1 :: Int)
        )
      # div_
        ( form_A (A.class_ "d")
          ( fieldset_
            ( div_A (A.id_ "e")
              ( div_
                ( label_A (A.class_ "f") "a"
                # select_
                  ( option_A (A.id_ "g") "b"
                  # option_ "c"
                  )
                # div_A (A.class_ "h") "d"
                )
              # i_ x
              )
            # button_A (A.id_ "i") (i_ "e")
            )
          )
        )
      )
    )

bigTable (n, m) = table_ . replicate n . tr_ $ map td_ [(1::Int)..m]