{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}

module Text.Blaze.Extra where

import Control.Monad
import Data.Monoid
import Prelude                     hiding (head,div)
import Text.Blaze.Html5            as H hiding (map)
import Text.Blaze.Html5.Attributes as A
import Text.Blaze.Internal         (Attributable)
import Network.URI.Params
import Network.URI
import Text.Printf
import Data.List (intercalate)

-- | Add an class to an element.
(!.) :: (Attributable h) => h -> AttributeValue -> h
elem !. className = elem ! class_ className

-- | Add an id to an element.
(!#) :: (Attributable h) => h -> AttributeValue -> h
elem !# idName = elem ! A.id idName

-- | Render a list of lines (separated by \n) to HTML.
linesToHtml :: String -> Html
linesToHtml str = forM_ (lines str) $ \line -> do toHtml line; br

-- | Intercalate some HTML.
htmlIntercalate :: Html -> [Html] -> Html
htmlIntercalate _ [x] = x
htmlIntercalate sep (x:xs) = do x; sep; htmlIntercalate sep xs
htmlIntercalate _ []  = mempty

-- | Make a list of html into a comma separated html.
htmlCommas :: [Html] -> Html
htmlCommas = htmlIntercalate ", "

-- | Set a parameter of a URI, as an attribute.
hrefSet :: URI -> String -> String -> Attribute
hrefSet uri key value = hrefURI updated where
  updated = updateUrlParam key value uri

-- | Provide a URI as an attribute for href.
hrefURI :: URI -> Attribute
hrefURI uri = href (toValue (showURI uri)) where
  showURI URI{..} = uriPath ++ uriQuery

-- | Create an href from a path and association list of parameters.
-- Usage:
--
-- @hrefAssoc \"/search\" [(\"query\", \"foo\"), (\"mode\", \"bar\")]@
--
-- Creates: @href \"/search?query=foo&mode=bar\"@
hrefAssoc :: String -> [(String,String)] -> Attribute
hrefAssoc path qs = href (toValue uri) where
  uri = "/" ++ path ++ "?" ++ intercalate "&" (map (uncurry (printf "%s=%s")) qs)

-- | Link to a CSS stylesheet.
css :: H.AttributeValue -> H.Html
css link = H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href link

-- | Link to a javscript file.
js :: H.AttributeValue -> H.Html
js link = H.script ! A.type_ "text/JavaScript" ! A.src link $ ""

-- | Create a link.
linkTo :: H.AttributeValue -> H.Html -> H.Html
linkTo url = H.a ! A.href url

-- | Create a form with method = \"POST\" that posts to the given url.
postForm :: String -> H.Html -> H.Html
postForm uri = H.form ! A.action (H.toValue uri) ! A.method "post"