{- | 
  Simple stupid output of common types of html 
-}
module Happstack.Helpers.HtmlOutput.Common where
import Happstack.Server.SimpleHTTP
import Control.Monad (mplus)
import Text.StringTemplate
import Text.StringTemplate.Helpers
import Data.List
import Safe (atMay)
import Data.String.Utils
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L

-- | fullUrlLink \"http://www.google.com\"
-- | for when you want a link that the anchor text is the full url. eg, for displaying a url for darcs get.
fullUrlLink :: FilePath -> String
fullUrlLink url = simpleLink (url,url)

-- | simpleLink (\"http://www.google.com\",\"google is a nice way to look for information\")
simpleLink :: (FilePath,String) -> String
simpleLink (url,anchortext) = render1 [("url",url),("anchortext",anchortext)] "<a href=\"$url$\">$anchortext$</a>"

{- | 
  like simpleLink, but a link tag is class=attention

  if class attention is defined via css you can get some useful behavior. I typically do something like the following, in a global css file:

a.attention:link {color: orange}

a.attention:active {color: orange}

a.attention:visited {color: orange}

a.attention:hover {color: orange}


-} 
simpleAttentionLink :: (String, String) -> String
simpleAttentionLink (url,anchortext) = 
  render1 [("url",url),("anchortext",anchortext)] "<a class=attention href=\"$url$\">$anchortext$</a>"

{- |
   width and height args blank blank if you don't want to specify this

  simpleImage (url, alttext) (width, height) = ...
-}
simpleImage :: (FilePath,String) -> (String,String) -> String
simpleImage (url, alttext) (width, height) =
    render1 [("url",url),("alttext",alttext),("width",width),("height",height)] "<img src=\"$url$\" alt=\"$alttext$\" width=$width$ height=$height$>"

  
-- | format a list of text vertically by putting list items in paragraphs
paintVHtml :: [String] -> String
paintVHtml = concatMap p 
  where p s = render1 [("s",s)] "<p>$s$</p>"

{- | 
  paintTable mbHeaderCells datacells mbPagination = ...

  mbHeaderCells: text for header cells, if you want them. Can use html formatting if desired.
  
  pagination also optional
-}
paintTable :: Maybe [String]       -- ^ optional header rows
              -> [[String]]        -- ^ table cells
              -> Maybe Pagination  -- ^ optional pagination
              -> String
paintTable mbHeaderRows = 
  case mbHeaderRows of
    Just rs -> paintTable' defTableF defTrF defSpacerRow (Just (rs,defTrF))
    Nothing -> paintTable' defTableF defTrF defSpacerRow Nothing
  where 
    defTableF rows = render1 [("rows",rows)] "<table> $ rows $ </table>"
    defTrFMeh row = render1 [("row",row)] "<tr> $ row $ </tr>" 
    defTdF cell = render1 [("cell",cell)] "<td> $cell$ </td>"
    defSpacerRow = ("",False)
    defTrF cells = defTrFMeh . concat .  map defTdF $ cells


{- | 
  paintTable' tableF trF spacerRow mbHeaderStuff datacells mbPagination =

  helper function for a table with pagination

  see paintTable for an example of how this can be used
-}
paintTable' :: (String -> String)                      -- ^ table tag function
               -> ([String] -> String)                 -- ^ row tag function, input is table cell contents
               -> (String,Bool)                              -- ^ (spacer row, more padding) 
                                                             --   (use ("",False) for no spacer rows)
                                                             -- if more padding is true, prepend and append spacers

               -> Maybe ([String], [String] -> String) -- ^ optional (header rows, header row tag function)
               -> [[String]]                           -- ^ table cells                
               -> Maybe Pagination                     -- ^ optional pagination 
               -> String
paintTable' _ _ _ _ [] _ = ""
paintTable' tableF trF (spacerRow,morePadding) mbHeaderStuff datacells mbPagination =
  let trows = case mbHeaderStuff of
                Just (headerCells, htrF) -> htrF headerCells ++ rows
                Nothing -> rows
        where rows = let rows' = join spacerRow . map trF $  tableCells
                     in if morePadding
                       then spacerRow ++ rows' ++ spacerRow
                       else rows'
              tableCells :: [[String]]
              tableCells = maybe datacells (getPaginatedCells datacells) mbPagination 
      paginationBar :: String
      paginationBar = maybe "" (paintPaginationBar datacells) mbPagination 
  in ( tableF trows ) ++ paginationBar





        




biggerfont x = "<font size=+1>" ++ x ++ "</font>"

-- import Text.StringTemplate hiding (directoryGroup)
data Pagination = Pagination {  currentbar :: Int
                              , resultsPerBar :: Int                              
                              , currentpage :: Int
                              , resultsPerPage :: Int 
                              , baselink :: String
                              , paginationtitle :: String 
                             }

--tpr = paginationRanges (Pagination 1 10000 1 3 "" "") tbl -- [["blee","blah","bloo"],["mee","mah","moo"]]
--  where tbl = map (const ["blee","blah","bloo"]) [1..10]
--paginationRanges :: Pagination -> [[String]] -> [ ([(Int,[String])], (Int, Int) ) ]
--paginationRanges pg datacells = barRanges = splitList (resultsPerPage pg) datacells 
      
--barRanges pg datacells = splitList (resultsPerBar pg) $ zip datacells [1..]
-- tp = paintPaginationBar [[]] (Pagination 1 10000 1 20 "" "")


-- variable nomenclature is kind of poor here
-- think of "bar" as the outer loop and "page" as the inner loop
paintPaginationBar :: [[String]] -> Pagination -> String
paintPaginationBar datacells pg | resultsPerPage pg > length datacells = ""
                                | otherwise =
  let paintresultsbar (barindex, ( xs,(fr,to)) ) =  
        let attrs = [("currentbar",show barindex)
                     , ("resultsPerBar",show $ resultsPerBar pg)
                     , ("currentpage", show 1)
                     , ("resultsPerPage",show $ resultsPerPage pg)
                     , ("from",show fr)
                     , ("to",show to)]

        in if (currentbar pg) == barindex
              then let paintresultspage (pageindex, (xs,(fr,to))) =
                         let adjust = (barindex-1)*(resultsPerBar pg) 
                             attrs = [("currentbar",show barindex)
                                      , ("resultsPerBar",show $ resultsPerBar pg)
                                      , ("currentpage", show pageindex)
                                      , ("resultsPerPage",show $ resultsPerPage pg)
                                      , ("from",show $ adjust + fr)
                                      , ("to",show $ adjust + to)]
                         in if currentpage pg == pageindex
                            then render1 attrs pagselected 
                            else render1 attrs pagunselected 
                       pglinks = map paintresultspage $ zip [1..] ( splitList (resultsPerPage pg) xs )
                   in concat . intersperse " | " $ pglinks 
              else render1 attrs pagunselected 
      -- barlinks = map paintbarlinks $ zip [1..] 
      barlinks = map paintresultsbar $ zip [1..] ( splitList (resultsPerBar pg) datacells )
      pagselected = "<a class=menuitemSelected href=$baselink$?currentbar=$currentbar$&resultsPerBar=$resultsPerBar$&currentpage=$currentpage$&resultsPerPage=$resultsPerPage$> $from$ - $to$ </a>"
      pagunselected = "<a class=menuitem href=$baselink$?currentbar=$currentbar$&resultsPerBar=$resultsPerBar$&currentpage=$currentpage$&resultsPerPage=$resultsPerPage$> $from$ - $to$ </a>"
  in (paginationtitle pg) ++ ( concat . intersperse " | " $ barlinks )



getPaginatedCells :: [[String]] -> Pagination -> [[String]]
getPaginatedCells [] _ = [[]]
getPaginatedCells datacells pg = 
  let  currb = (currentbar pg)-1       
  in case splitList (resultsPerBar pg) datacells  `atMay` currb of
    Nothing -> [["getPaginatedCells, index not in range, currb: " ++ (show currb) ]]
    Just (datacells2, (_,_) ) -> 
        let currp = (currentpage pg)-1 
        in case splitList (resultsPerPage pg) datacells2  `atMay` currp of
          Nothing -> [["getPaginatedCells, index not in range, currp: " ++ (show currp) ]]
          Just (res,(_,_)) -> res

-- splitList 3 [1..11]
-- [([(1,1),(2,2),(3,3)],(1,3)),([(4,4),(5,5),(6,6)],(4,6)),([(7,7),(8,8),(9,9)],(7,9)),([(10,10),(11,11)],(10,11))]
-- the result is a list of (indexed sublist,(fist index, last index))
--splitList :: Int -> [b] -> [([b], (Int, Int))]
splitList n x = let
  part = splitList' n ( zip [1..] x) 
  bounded = map (\l -> (map snd l,bounds l)) part
  bounds [] = (0,0)
  bounds l@((_,_):_) = (fst . head $ l,fst . last $ l)
  in bounded
  where 
    splitList' :: Int -> [a] -> [[a]]
    splitList' _ [] = []
    splitList' n l@(x:xs) =
      let (a,b') = genericSplitAt n l
          b = splitList' n b'
      in  a : b

-- | substitute newlines with <br>
newlinesToHtmlLines :: String -> String
newlinesToHtmlLines = concatMap formatnewlines
  where formatnewlines c = if c == '\n' then "<br>" else [c]

{- | 
The checkbox form element has optional attribute "checked". 

If this attribute is present, readcheckbox returns true, otherwise false.

use in conjunction with checkStringIfTrue, when, eg, writing StringTemplate code that renders a from with a box that might or not be checked. Something like: 

attrs = [ ... , ("somethingIsChecked", checkedStringIfTrue $ someBoolVal ) ... ]
-}
readcheckbox :: String -> RqData Bool
readcheckbox checkboxname = (return . (=="on") =<< look checkboxname `mplus` return "") 


{- | 
useful hack for dealing with checkboxes in HAppS. Maybe there's a better way?

checkedStringIfTrue p = if p then \"checked\" else \"\"
-}
checkedStringIfTrue :: Bool -> String
checkedStringIfTrue p = if p then "checked" else ""

-- | Render a list of strings as an unordered list (<ul>...</ul>)
paintVUL :: [String] -> String
paintVUL xs = "<ul>" ++ (concatMap (\mi -> "<li>" ++ mi ++ "</li>") xs) ++ "</ul>"

-- | Render a list of strings as an ordered list (<ol>...</ol>)
paintVOL :: [String] -> String
paintVOL xs = "<ol>" ++ (concatMap (\mi -> "<li>" ++ mi ++ "</li>") xs) ++ "</ol>"

-- | render a list of strings horizontally, separated by \" | \"
paintHBars :: [String] -> String
paintHBars = intercalate " | " 

newtype HtmlString = HtmlString String
instance ToMessage HtmlString where
  toContentType _ = B.pack "text/html"
  toMessage (HtmlString s) = L.pack s