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

module Main where

import Html

import Data.String
import Control.Monad

import Data.Text.Lazy.Builder (Builder, toLazyText)
import Text.Blaze.Html5 ((!))

import Data.ByteString.Lazy (ByteString)

import qualified Data.Text                     as S
import qualified Data.Text.Lazy                as L
import qualified Text.Blaze.Html5              as B
import qualified Text.Blaze.Html5.Attributes   as B (class_, id)
import qualified Text.Blaze.Html.Renderer.Text as RT
import qualified Text.Blaze.Html.Renderer.Utf8 as RB

import Criterion.Main

main :: IO ()
main = defaultMain
  [ bgroup "minimal"
    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeMinimal     :: B.Html     -> L.Text)     "TEST"
    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeMinimal     :: B.Html     -> ByteString) "TEST"
    , bench "string"      $ nf (render . minimal                 :: String     -> String)     "TEST"
    , bench "strict text" $ nf (render . minimal                 :: S.Text     -> S.Text)     "TEST"
    , bench "lazy text"   $ nf (render . minimal                 :: L.Text     -> L.Text)     "TEST"
    , bench "builder"     $ nf (toLazyText . render . minimal    :: Builder    -> L.Text)     "TEST"
    ]
  , bgroup "hello world"
    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeHelloWorld  :: B.Html     -> L.Text)     "TEST"
    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeHelloWorld  :: B.Html     -> ByteString) "TEST"
    , bench "string"      $ nf (render . helloWorld              :: String     -> String)     "TEST"
    , bench "strict text" $ nf (render . helloWorld              :: S.Text     -> S.Text)     "TEST"
    , bench "lazy text"   $ nf (render . helloWorld              :: L.Text     -> L.Text)     "TEST"
    , bench "builder"     $ nf (toLazyText . render . helloWorld :: Builder    -> L.Text)     "TEST"
    ]
  , bgroup "big page"
    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeBigPage     :: B.Html     -> L.Text)     "TEST"
    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeBigPage     :: B.Html     -> ByteString) "TEST"
    , bench "string"      $ nf (render . bigPage                 :: String     -> String)     "TEST"
    , bench "strict text" $ nf (render . bigPage                 :: S.Text     -> S.Text)     "TEST"
    , bench "lazy text"   $ nf (render . bigPage                 :: L.Text     -> L.Text)     "TEST"
    , bench "builder"     $ nf (toLazyText . render . bigPage    :: Builder    -> L.Text)     "TEST"
    ]
  , bgroup "big page with attributes"
    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeBigPageA    :: B.Html     -> L.Text)     "TEST"
    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeBigPageA    :: B.Html     -> ByteString) "TEST"
    , bench "string"      $ nf (render . bigPageA                :: String     -> String)     "TEST"
    , bench "strict text" $ nf (render . bigPageA                :: S.Text     -> S.Text)     "TEST"
    , bench "lazy text"   $ nf (render . bigPageA                :: L.Text     -> L.Text)     "TEST"
    , bench "builder"     $ nf (toLazyText . render . bigPageA   :: Builder    -> L.Text)     "TEST"
    ]
  , bgroup "big table"
    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeBigTable    :: (Int, Int) -> L.Text)     (4,4)
    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeBigTable    :: (Int, Int) -> ByteString) (4,4)
    , bench "string"      $ nf (render . bigTable                :: (Int, Int) -> String)     (4,4)
    , bench "strict text" $ nf (render . bigTable                :: (Int, Int) -> S.Text)     (4,4)
    , bench "lazy text"   $ nf (render . bigTable                :: (Int, Int) -> L.Text)     (4,4)
    , bench "builder"     $ nf (toLazyText . render . bigTable   :: (Int, Int) -> L.Text)     (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 "Hello World!"

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

blazeBigPageA :: B.Html -> B.Html
blazeBigPageA x =
  B.html $ do
    B.body $ do
      B.h1 ! B.id "a" $ do
        B.img
        B.strong ! B.class_ "b" $ "0"
      B.div $ do
        B.div ! B.id "c" $ "1"
      B.div $ do
        B.form ! B.class_ "d" $ do
          B.fieldset $ do
            B.div ! B.id "e" $ do
              B.div $ do
                B.label ! B.class_ "f" $ "a"
                B.select $ do
                  B.option ! B.id "g" $ "b"
                  B.option "c"
                B.div ! B.class_ "h" $ "d"
              B.i x
            B.button ! B.id "i" $ B.i "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 ?> a) => a -> 'Div > a
minimal = div_

helloWorld
  :: (IsString a, 'Title ?> a)
  => a
  ->
  'Html > ( 'Head > 'Title > a
          # 'Body > 'P > String
          )
helloWorld x =
  html_
    ( head_
      ( title_ x
      )
    # body_
      ( p_ ("Hello World!" :: String)
      )
    )

bigPage
  :: ('I ?> a)
  => a
  ->
  'Html >
  ( 'Body >
    ( 'H1 >
      ( 'Img > ()
      # 'Strong > String
      )
    # 'Div > 'Div > String
    # 'Div > 'Form > 'Fieldset >
      ( 'Div >
        ( 'Div >
          ( 'Label > String
          # 'Select >
            ( 'Option > String
            # 'Option > String
            )
          # 'Div > String
          )
        # 'I > a
        )
      # 'Button > 'I > String
      )
    )
  )
bigPage x =
  html_
    ( body_
      ( h1_
        ( img_
        # strong_ ("0" :: String)
        )
      # div_
        ( div_ ("1" :: String)
        )
      # div_
        ( form_
          ( fieldset_
            ( div_
              ( div_
                ( label_ ("a" :: String)
                # select_
                  ( option_ ("b" :: String)
                  # option_ ("c" :: String)
                  )
                # div_ ("d" :: String)
                )
              # i_ x
              )
            # button_ (i_ ("e" :: String))
            )
          )
        )
      )
    )

bigPageA
  :: ('I ?> a)
  => a
  ->
  'Html >
  ( 'Body >
    ( 'H1 :>
      ( 'Img > ()
      # 'Strong :> String
      )
    # 'Div > 'Div :> String
    # 'Div > 'Form :> 'Fieldset >
      ( 'Div :>
        ( 'Div >
          ( 'Label :> String
          # 'Select >
            ( 'Option :> String
            # 'Option > String
            )
          # 'Div :> String
          )
        # 'I > a
        )
      # 'Button :> 'I > String
      )
    )
  )
bigPageA x =
  html_
    ( body_
      ( h1_A [("id","a")]
        ( img_
        # strong_A [("class","b")] ("0" :: String)
        )
      # div_
        ( div_A [("id","c")] ("1" :: String)
        )
      # div_
        ( form_A [("class","d")]
          ( fieldset_
            ( div_A [("id","e")]
              ( div_
                ( label_A [("class","f")] ("a" :: String)
                # select_
                  ( option_A [("id","g")] ("b" :: String)
                  # option_ ("c" :: String)
                  )
                # div_A [("class","h")] ("d" :: String)
                )
              # i_ x
              )
            # button_A [("id","i")] (i_ ("e" :: String))
            )
          )
        )
      )
    )

bigTable :: (Int, Int) -> 'Table > ['Tr > ['Td > Int]]
bigTable (n, m) = table_ . replicate n . tr_ $ map td_ [1..m]