module Template ( template ) where

import IO
import Data.Generics
import Time
import Locale ( defaultTimeLocale )
import List ( intersperse, transpose, sort )
import System.Random hiding ( split )
import System.Directory -- ( doesFileExist )
import Data.Maybe ( catMaybes )
import Char ( isLower )

import Doc
import Mmlparse
import Doc2Html
import XHTML
import HTML
import Useful
import OTP

-- horizontal align 2 elements
a <<>> b = matrix2tableClass "horiz" [[[a], [b]]]

horz a b c = matrix2tableClass "horiz" [[[a], [b], [c]]]

-- vertical align 2 elements
a /// b = matrix2tableClass "vert" [[ [a] ],
                                    [ [b] ]]

-- something more nifty
mytable a b = elm "table" ["class"-->"mytable"] rows
    where rows = [elm "tr" [] tds]
          tds  = [elm "td" ["class"-->"goleft"] [a],
                  elm "td" ["class"-->"goright"] [b]]

iframe = around "iframe"

--elm "a" ["id"-->name, "href"-->target] [elm "img" ["src"-->"/images/search-blank.gif", "alt"-->name] []]

searchbar_form = elm "form" form_attrs [formtable]
    where form_attrs = ["action"-->"javascript:submit();", "id"-->"searchform", "name"-->"f"]
          formtable = horz xbutton (txt "") xinput
          xinput = "input" `with` ["size"-->"60", "id"-->"field",
                                   "name"-->"q", "type"-->"text"]
--          xbutton = "input" `with` ["name"-->"btnG", "id"-->"image", "class"-->"search",
--                                    "type"-->"image", "src"-->"/images/search-blank.gif", "maxlength"-->"256"]
          xbutton = "input" `with` ["name"-->"btnG", 
                                    "type"-->"submit", "value"-->"&nbsp;&nbsp; Search &nbsp;&nbsp;", "maxlength"-->"256"]

tdClass name cs = elm "td" ["class"-->name] cs
tdClass2 name cs = elm "td" ["colspan"-->"2", "class"-->name] cs
tdClassN n name cs = elm "td" ["colspan"-->show n, "class"-->name] cs
tr = around "tr"

center el = around "center" [el]

pageLayout loggedin atitle quote author left message pageName xs = {-center-} elm "table" ["class"-->"bigtable"] [row1, row2, row3]
    where row1 = tr [tdClass2 "paneTopLeft" (topleft_top loggedin pageName atitle)]
          row2 = tr [tdClass "paneLeft" left,       tdClass "paneContent" (message ++ xs)]
          row3 = tr [tdClass "paneLeftBottom" bottom_left, tdClass "paneFooter" (footer quote author)]

----------------------------------------------
-- BUTTONS
----------------------------------------------

--makeFlipper name target = elm "a" ["id"-->name, "href"-->target] [elm "img" ["src"-->"/images/blank.gif", "alt"-->name] []]
makeFlipper name target = elm "a" ["href"-->target] [txt name]
--makeFlipper name target = elm "a" ["href"-->target] [imgSrcAlt ("/images/"++name++".png") name]

loginBtn  p = makeFlipper "login"  ("/index.cgi?action=login&page=" ++ p)
logoutBtn p = makeFlipper "logout" ("/index.cgi?action=logout&page=" ++ p)
newBtn    p = makeFlipper "add"    ("/index.cgi?action=add&page=" ++ p)
pdfBtn    p = makeFlipper "pdf"    ("/index.cgi?action=viewpdf&page=" ++ p)
editBtn   p = makeFlipper "edit"   ("/index.cgi?action=edit&page=" ++ p ++ "#Top")

loggedoutBtns p = [pdfBtn p, loginBtn p]
loggedinBtns p = [editBtn p, pdfBtn p, newBtn p, logoutBtn p]


banner = imgSrcAlt "http://www.updike.org/images/updike8org.png" "UPDIKE.ORG"

buttons loggedin p = intersperse spacePad2 (if loggedin then loggedinBtns p else loggedoutBtns p)

--  [elm "p" ["class"-->"goright"] (intersperse spacePad2 buttons)]
--------------------------    where lbuttons = [lbut "pdf", lbut "login", banner]
--    where buttons = (if loggedin then loggedinBtns p else loggedoutBtns p) --  ++ [banner]

----------------------------------------------

fig8 = elm "a" ["href"-->"/index.cgi?Fig8"] [imgSrcAlt "/images/fig8-small.png" "Hypnotic Figure Eight Klein Bottle Emblem"]

spacePad = txt "&nbsp;"
spacePad2 = txt "&nbsp;&nbsp;&nbsp;&nbsp;"
blankline = txt "&nbsp;<br />"
-- header heading top banner part, whatumcallit
topleft_top loggedin p atitle = [mytable (fig8 <<>> (h1 [spacePad, spacePad, spacePad, txt ""] -- ///
                                                -- imgSrcAlt "/images/banner.png" "home of Jared Updike on the web
  						     ))
                        (elm "p" ["class"-->"goright"] (intersperse spacePad buttons))]
    where buttons = if loggedin then loggedinBtns p else loggedoutBtns p

ppClass c es = elm "p" ["class"-->c] es

bottom_left = [pp extras]

footer quote author = [pp [txt "&nbsp;"]]

{-
footer quote author = [ppClass "goright" [txt quote],
                       ppClass "goright" [ii [txt$ "&nbsp;&nbsp;&nbsp;&mdash;"++author]],
                       pp [txt "Copyright (C) 2007 Jared Updike"]]
-}
hiddeninput k v = "input" `with` ["type"-->"hidden", "name"-->k, "value"-->v]


loginform pageName otp =
    elm "form" ["method"-->"post", "id"-->"loginform", "name"-->"f",
                "action"-->("/index.cgi?action=validate&page="++pageName), "onsubmit"-->"scramble();"]
            ([matrix2tableClass "horiz" [[ [txt "Username&nbsp;"],[xusername] ] ,
                                         [ [txt "Password&nbsp;"],[xpassword] ] ,
                                         [ []                    ,[xsubmit  ] ]] , xhidden])
      where xusername = "input" `with` ["size"-->"20", "name"-->"username", "type"-->"text"]
            xpassword = "input" `with` ["size"-->"20", "name"-->"password", "type"-->"password"]
            xsubmit   = "input" `with` ["type"-->"submit", "value"-->"Log In"]
            xhidden   = hiddeninput "otp" otp

jscriptAts = ["type"-->"text/javascript"]
script fname = "script" `with` (jscriptAts ++ ["src"-->fname])

linkcssAts = ["rel"-->"stylesheet", "type"-->"text/css"]
linkcss fname = "link" `with` (linkcssAts ++ ["href"-->fname])

scripts somescripts =
    (if sIFRuse then sIFRinclude else []) ++ somescripts ++
    [ comment ["[if gte IE 5.5000]>",
               "<script type=\"text/javascript\" src=\"scripts/pngfix_map.js\"></script>",
               "<![endif]"]] -- <!-- ... --> gets added

---- sIFR stuff ----
--------------------
sIFRuse = False

sIFRinclude = ["link" `with` ["href"-->"css/sIFR-screen.css", "rel"-->"stylesheet", "media"-->"screen",
                              "type"-->"text/css"],
               "link" `with` ["href"-->"css/sIFR-print.css", "rel"-->"stylesheet", "media"-->"print",
                              "type"-->"text/css"],
            script "/scripts/sifr.js",
            script "/scripts/sifr-addons.js"]

sIFR = Comm "" [blah] "" --elm "script" jscriptAts [Comm "//<![CDATA[" sIFRscriptlines "//]]>"]
    where blah = "<script type=\"text/javascript\">\n//<![CDATA[\n" ++ sIFRscriptlines ++ "//]]>\n"
                 ++ "</script>\n"

white = "ffffff"
black = "000000"
skyblue = "5eb4ff"

sIFRscriptlines = "if (typeof sIFR == \"function\") {\n" ++ replacers ++ "};\n"
    where replacers = concatMap replacer [("body h1", black, white),
                                          ("body h2", black, white),
                                          ("body h3", white, skyblue),
                                          ("body h4", black, white)]
          replacer (selector,col,bgcol) = "sIFR.replaceElement(named({sSelector:\""++selector++"\", sFlashSrc:\"tradegothic.swf\", sColor:\"#"++col++"\", sLinkColor:\"#000000\", sBgColor:\"#"++bgcol++"\", sHoverColor:\"#CCCCCC\"}));\n"
------------------------
---- end sIFR stuff ----

validateUrlCSS = "http://jigsaw.w3.org/css-validator/validator?uri=http://www.updike.org/"
validateUrlXHTML = "http://validator.w3.org/check?uri=http://www.updike.org/"
--"http://validator.w3.org/check?uri=referer"

extras = [lnk validateUrlXHTML [validateIconXHTML],
          lnk validateUrlCSS   [validateIconCSS],
          txt "&nbsp;&nbsp;&nbsp;"]
    where validateIconXHTML = imgSrcAlt "/images/w3c-valid-xhtml.gif" "Valid XHTML 1.0 Transitional!"
          validateIconCSS   = imgSrcAlt "/images/w3c-valid-css.gif"   "Valid CSS!"


----------- Variable substitution

type Env = [(String, Elem)]
type XMLEnv = [(String, XML)]

-- stage 1: substitute in the structured Document

defaultEnv = [("edit", Txt ".")]

varSubst :: Env -> Elem -> Elem
varSubst env = varInt
    where varInt (VarInt es) = lookupper es
          varInt x           = x
          lookupper es       =
              let k = (stringize es) in
              case lookup k env of
                Nothing      -> VarInt es
                Just v       -> v
subst :: Env -> Document -> Document
subst env = everywhere (mkT (varSubst env))

-- stage 2: substitute XML

xmlvarSubst :: XMLEnv -> XML -> XML
xmlvarSubst env = varInt
    where varInt (Hole es) = lookupper es
          varInt x         = x
          lookupper k      =
              case lookup k env of
                Nothing      -> tt [txt $ "<<" ++ k ++ ">>"]
                Just v       -> v
xmlSubst :: XMLEnv -> [XML] -> [XML]
xmlSubst env = everywhere (mkT (xmlvarSubst env))

tryfilter = replace "%s" "<b>QUERY</b><br />" . replace "?" "?<br />" . eat "http://" . eat "http://www."

items2table items = matrix2table$ [[bb [txt "Keyword&nbsp;&nbsp;&nbsp;"]], [bb [txt "URL"]]] : pairs
    where pairs = [[[txt a], [txt$ tryfilter b]] | (a:b:_) <- (map (split ',') items)]

getLink :: Document -> [Elem]
getLink = everything (++) ([] `mkQ` lnkMatcher)
  where lnkMatcher :: Elem -> [Elem]
        lnkMatcher e@(Lnk _ _) = [e]
        lnkMatcher _           = []

-- bullet = txt "&#x2218" --ring operator or composition dot
bullet = txt "&bull;" -- => bullet = txt "&#x2022" -- black bullet
--bullet = txt "&#x25cb" -- white circle

linkLike :: FilePath -> [String] -> String -> IO [XML]
linkLike root ortags link = do
   cnts <- readFile (root++"links/"++link++".tags")
   let linktags = filter (/="") $ lines cnts -- (\x -> x /= "" && (not $ isLower $ head x)) $ lines cnts
   let cond = any (`elem` ortags) linktags ||
              (filter (not . isLower . head) ortags == [] && filter (not . isLower . head) linktags == [])
   if cond
      then do cs <- readFile (root++"links/"++link++".txt")
              let d  = doc cs
              let ls = getLink d
              return $ if length ls > 0 then
                          [lnk ("/index.cgi?action=edit&page=links/"++link) [bullet], txt " &nbsp; ", elemToXML $ head ls, br]
                        else []
      else return []

linksLike :: FilePath -> [String] -> IO [XML]
linksLike root tags = do
   files <- getDirectoryContents (root ++ "/links")
   let possible_links = map (replace ".tags" "") $ filter (`contains` ".tags") files
   links <- mapM (linkLike root tags) possible_links
   return$ concat links

getNewOTP :: Int -> Bool -> IO String
getNewOTP secs needed = do
   if not needed then return "<unused>"
      else do
        pw <- otpNew secs
        return pw

getXmlEnv pageName root newPage isLogin loggedin = do
   let pageFilename = root++pageName++".txt"
--   cnts <- readFile "/scripts/search.js"
--   let items = tail $ takeWhile (/="//END")
--                    $ dropWhile (/="//BEGIN")
--                    $ lines
--                    $ filter (/= '"') cnts
   allstr <- readFile (root++"tags.txt")
   let alltags = lines allstr
   --let tagstrs = unlines alltagstr --zip (map show [1..22]) (map odd [1..22])
   fileExists <- doesFileExist (root++pageName++".tags")
   somestr <- if fileExists then readFile (root++pageName++".tags") else return ""
   let sometags = filter (/="") $ lines somestr
   let tags = zip alltags (map (`elem` sometags) alltags)
   editpageform <- editform tags pageName pageFilename newPage
   links <- linksLike root sometags
   otp <- getNewOTP 30 isLogin
   return [("searchbar", searchbar_form)
          ,("loginform", loginform pageName otp)
--          ,("searchhelp", items2table items)
          ,("editpage", editpageform)
          ,("renamepage", renamepageform pageName)
          ,("numlinks", txt $ show (length links `div` 4))
          ,("buttons", pp (buttons loggedin pageName))
          ,("links", pp links)  --(map (\x->"li" `around` [x]) links))
          ]

textarea cnts = elm "textarea" ["name"-->"content", "cols"-->"72", "rows"-->"20"] [txt $ cnts]

maketagcheckbox ("", _)          = [spacePad]
maketagcheckbox (label, checked) = ["input" `with` checkedAtt++["type"-->"checkbox",
                                                    "name"-->("TAG_"++(tagencode label))],
                                 txt (' ':label), spacePad, spacePad]
   where checkedAtt = if checked then ["checked"-->"on"] else []

tagcheckboxtable labels = matrix2table rows
   where n       = length labels
         n'      = numrows*numcols
         labels' = labels ++ replicate (n'-n) empty
         empty   = ("", False)
         numrows = (n+numcols-1) `div` numcols
         numcols = 3
         cols    = let f [] = []
                       f xs = let (x,rest) = splitAt numrows xs
                                in x : f rest
                     in f $ map maketagcheckbox labels
         rows    = transpose cols

renamepageform oldpagename =
    elm "form" ["method"-->"post", "id"-->"loginform", "name"-->"f",
                "action"-->("/index.cgi?action=movepage&page="++oldpagename)]
            ([matrix2tableClass "horiz" [[ [txt "Old page name&nbsp;"],[txt oldpagename] ] ,
                                         [ [txt "New page name&nbsp;"],[xnewpage] ] ,
                                         [ [ ]                        ,[xsubmit  ] ]] ])  -- ++ xhiddens)
      where xnewpage  = "input" `with` ["size"-->"40", "name"-->"newpagename", "type"-->"text"]
            xsubmit   = "input" `with` ["type"-->"submit", "value"-->"Rename page"]

-- <a name="Top"></a> ==> ["a" `with` ["name"-->"Top"] ]

editform tags page filename newPage = do
--   let (newPage, newtitle) = case newpagetitle of { Nothing -> (False, "") ; Just a -> (True, a) }
   cnts <- if newPage then return "" else do { cnts' <- readFile filename; return $ fixEndingNewlines cnts' }
   let editTitleLine = [ txt page, spacePad, spacePad, spacePad, spacePad, spacePad, spacePad,
                         elm "a" ["style"-->"font-size: 68%;",
                                  "href"-->("/index.cgi?action=rename&page="++page)] [txt "(Rename)"] ]
   let addTitleLine  = [ xtitle ]
   let firstLine = if newPage then addTitleLine else editTitleLine
--   let targetpage = if newPage then page else newtitle
   return $ elm "form" ["method"-->"post", "id"-->"loginform", "name"-->"f",
                        "action"-->("/index.cgi?action=modify")]
                ([matrix2tableClass "horiz"
                        [[ firstLine
                         ],
                         [ [textarea cnts] ],
                         -- [ [bb [txt "Tags"]] ],
                         -- [ xtags ],
                         [ [bb [txt "Tags"], spacePad, spacePad, spacePad, xtagsbox] ],
                         [ [xsubmit,
                            spacePad, spacePad, spacePad, spacePad, spacePad, spacePad,
                            spacePad, spacePad, spacePad, spacePad, spacePad, spacePad,
                            aa ("/index.cgi?"++page) "Cancel"] ]
                        ]
                       ] ++ xhiddens)
             where xtitle   = "input" `with` ["size"-->"20", "name"-->"page", "type"-->"text",
                                              "value"-->page]
                   xtagsbox = divv "statesautocomplete" [ xtagsinput, divv "statescontainer" [] ]
                   xtagsinput = "input" `with` ["size"-->"65", "id"-->"tagsbox", "name"-->"tagsbox", "type"-->"text",
                                              "value"--> xtagsstr]
--                   xtagsbox = "input" `with` ["size"-->"65", "name"-->"tagsbox", "type"-->"text",
--                                              "value"--> xtagsstr]
                   xtagsstr = concat $ intersperse ", " $ sort $ filter (/="") keepers
                               where keepers = map (\(x,checked) -> if checked then x else "") tags
                   xsubmit  = "input" `with` ["type"-->"submit", "value"-->"Submit these changes"]
                   --xcancel  = "input" `with` ["type"-->"button", "value"-->"Cancel",
                   --                           "onClick"-->("/index.cgi?"++page)]
                   xhiddens = [ hiddeninput "action" "modify",
                                hiddeninput "page" page ]
                   xtags    = [ tagcheckboxtable tags ]

divv id x = Elm "div" ["id"-->id] x

-- find holes in the document

findVarSubsts :: Document -> [String]
findVarSubsts = everything (++) ([] `mkQ` varIntMatcher)
  where varIntMatcher :: Elem -> [String]
        varIntMatcher (VarInt es) = [stringize es]
        varIntMatcher _           = []

lmap :: (Eq a) => [(a,b)] -> [a] -> [b]
lmap env xs = catMaybes (map (\k-> lookup k env) xs)

-- find the first Head4 for use as the Title

findHead4sSubsts :: Document -> [String]
findHead4sSubsts = everything (++) ([] `mkQ` head4Matcher)
  where head4Matcher :: TopElem -> [String]
        head4Matcher (SpecPar Head4 es) = [stringize es]
        head4Matcher _                  = []

-- certain widgets need certain javascript files loaded (these
-- javascripts are also responsible to move the cursor where they want
-- it in a startup() function

widgetsScriptsEnv =
    [("searchbar", [script "/scripts/search.js"])
    ,("editpage", [script "http://yui.yahooapis.com/2.3.1/build/yahoo-dom-event/yahoo-dom-event.js?_yuiversion=2.3.1",
                   script "http://yui.yahooapis.com/2.3.1/build/animation/animation.js?_yuiversion=2.3.1",
                   script "http://yui.yahooapis.com/2.3.1/build/autocomplete/autocomplete-min.js?_yuiversion=2.3.1",
                   linkcss "http://yui.yahooapis.com/2.3.1/build/fonts/fonts-min.css?_yuiversion=2.3.1",
                   linkcss "http://yui.yahooapis.com/2.3.1/build/autocomplete/assets/skins/sam/autocomplete.css?_yuiversion=2.3.1",
                   script "2data.py"
                   ])
    ,("loginform", [script "/scripts/login.js"])
    ,("renamepage", [script "/scripts/rename.js"])
    ]

noTimeDiff = TimeDiff { tdYear = 0, tdMonth = 0, tdDay = 0, tdHour = 0, tdMin = 0, tdSec = 0, tdPicosec = 0 }

--- MAIN I/O -----------------------------------

template loggedin messagestr pageName root filename = do
     mytemplate <- readFile "/home/public/template.html"

     titlestr <- readFile (root++"titles.txt")
     let possibletitles = filter (/="") (lines titlestr)
     rint <- (randomIO :: IO Int)
     let rindex = rint `mod` (length possibletitles)
     let atitle = possibletitles !! rindex
     leftstr <- readFile (root++"navigation.txt")
     let navigation = doc2xml $ doc leftstr
     --linkstr <- readFile (root++"links.txt")
     --let links = doc2xml $ doc linkstr
     let newPage = filename `endsWith` "add.txt"
     let isLogin = filename `endsWith` "login.txt"

     time' <- getClockTime
     let time = addToClockTime (noTimeDiff { tdHour = -8 }) time'
     ctime <- toCalendarTime time
     -- let CalendarTime { ctHour = utchour } = ctime'
     -- let ctime = ctime' -- { ctHour = (utchour+16) `mod` 24 } -- PST is -8 hours
     -- --let datestr    = formatCalendarTime defaultTimeLocale "%Y%m%d%H%M%S" ctime
     let datestr1 = formatCalendarTime defaultTimeLocale "%A, " ctime
     let datestr2 = formatCalendarTime defaultTimeLocale "%d %B %Y" ctime

     -- chop leading zero off day of the month number
     let datestr = datestr1 ++ (if head datestr2 == '0' then tail datestr2 else datestr2)
     
     let env = ("date", Txt datestr):defaultEnv

     let quote = "Quote me as saying I was mis-quoted."
     let author = "Groucho Marx"

     -- read in the input file or stdin if filename is - or lop off - if there are more characters and use the tail as the string, i.e. -text data
     s <- if filename=="-" then getContents else (if head filename == '-' then return (tail filename) else readFile filename)
     let d = subst env $ doc s
     xmlEnv <- getXmlEnv pageName root newPage isLogin loggedin
     let xs = xmlSubst xmlEnv (doc2xml d) -- get rid of all holes
     let xmlString = xmlToStr xs
     let left = xmlSubst xmlEnv (navigation) --  ++ links)
     let leftString = xmlToStr left

     let message = if messagestr /= "" then [ppClass "message" [aa ("/articles/"++pageName) "X", txt " ", txt messagestr]] else []
     let messagefinal = xmlToStr message
     let body = hbody ["onload"-->"startup();"]
                  ([pageLayout loggedin atitle quote author left message pageName xs] ++ (if sIFRuse then [sIFR] else []))
     let somescripts = concat $ lmap widgetsScriptsEnv (findVarSubsts d)
     let somescriptstr = xmlToStr somescripts
     let title_maybe = findHead4sSubsts d
     let title = if title_maybe == [] then pageName else head title_maybe
     let page = xhtmlPage title "css/alpha.css" (scripts somescripts) body
     let buttonstr = xmlToStr $ buttons loggedin pageName
     --putStrLn $ page
     putStrLn $ templateReplace mytemplate  -- ("@buttons", buttonstr)
                                           [ ("@content", messagefinal ++ xmlString)
                                           , ("@navigation", leftString)
                                           , ("@title", title)
                                           , ("@scripts", somescriptstr)
                                           ]


templateReplace templ pairs = unlines . map doReplace . lines $ templ
  where
    doReplace x@('@':rest) = elookup x pairs
    doReplace x            = x
    elookup a kv = case lookup a kv of
                     Nothing -> ""
                     Just b -> b

{-
templateReplace templ []           = templ
templateReplace templ ((a,b):rest) = templateReplace (replace a b templ) rest
-}

-- main = template False "" "-"

-- tester = template False "" "/home/jared/alpha/login.txt"