import Fudgets
import AllFudgets(idempotSP)
import ContribFudgets(titleShellF')
import HtmlF2b
import BookmarksMenuF
import ReadBookmarks
import Arrows(homeD)
import AuxWindows
import ParseURL(parseURL)
import URL(URL(..),joinURL,url2str)
import URLencode(hex)
import ToHtml
import HtmlFuns(extractTitle)
import URLFetchF
import IOUtil(getEnvi) -- !! not standard Haskell
import HbcUtils(apFst)
import DialogueIO
import Prelude hiding (IOError)

main = do optbm <- readBookmarksIO bookmarksFile
          fudlogue (wwwBrowserShellF optbm)

wwwBrowserShellF optbm =
    ---- moved here to avoid deadly embrace with nameLayoutF:
    --readBookmarksF bookmarksFile $ \ optbm ->
    loopLeftF $ titleShellF' pm "WWWBrowser" $
                nameLayoutF layout $
                wwwBrowserF optbm
  where
    pm = setSizing Static
--{-
    {-historyButtons = hvAlignNL aLeft aTop $ hBoxNL
			[leafNL "Prev",leafNL "Next"]-}
    layout =
      --marginNL 5 $
	vBoxNL [spaceNL (noStretchS False True `compS` leftS) $
	        hBoxNL [
	          vcLeafNL "HistoryButtons",
                  vcLeafNL "HomeButton",
                  vcLeafNL "Menus",
		  vcLeafNL "AuxWindowsMenu" ],
                leafNL "UrlInput",
		leafNL "PersonalToolbar",
		leafNL "HtmlF",
		leafNL "MsgDisp",
		leafNL "UrlDisp"]

    vcLeafNL = spaceNL vCenterS . leafNL
---}

wwwBrowserF optbm =
    idLeftF httpMsgDispF >==<
    loopThroughRightF urlFetchF' mainGuiF >==< menusF optbm
  where
    mainGuiF =
      (homeF >*< urlInputF >*< auxWindowsF >*< htmlDisplayF)

    httpMsgDispF = nameF "MsgDisp" $ "Progress:" `labLeftOfF` statusDisplayF

    urlFetchF' = concatMapSP post >^^=< urlFetchF >=^< stripEither
      where
    	post (Left msg) = [Right (Right msg)]
	post (Right (url,Left msg)) = [Right (Right ("Error: "++msg))]
	post (Right (url,Right doc)) = [Left htmldoc,
                                        Right (Left title)]
          where
            htmldoc@(_,html) = toHtml (docUrl url doc,doc)
            title = maybe (url2str url) id (extractTitle html)

    urlInputF = parseUrlSP >^^=< putF startUrl currentUrlF
      where
	currentUrlF = urlStringF >=^< url2str . fst . fst
	urlStringF = nameF "UrlInput"
		     ("URL:" `labLeftOfF` ({-hscrollF-} fixedStringF))

    homeF = nameF "HomeButton" $
            case parseURL homeUrl of
              Just url -> const (httpGet url) >^=< buttonF homeD >=^^< nullSP
              _ -> nullLF

htmlDisplayF =
    --placerF (revP verticalP) $
    httpReq >^=<
    inputDoneSP >^^=<
    bypassF urlDispF >==<
    absUrlF (nameF "HtmlF" $ htmlF size) >=^< apFst fst
  where
    size = Just (Point 800 600)
    urlDispF =
       nameF "UrlDisp" $
       "Link URL:" `labLeftOfF`
       statusDisplayF >=^^< idempotSP >=^< url2str.fst.stripInputMsg

statusDisplayF = hBoxF (displayF' attrs >*< spacerF vCenterS gcWarningF)
  where
    attrs = setSizing Static . setFont smallVariable .
	    setBorderWidth 0 . setMargin 2
	    -- . setBgColor bgColor
    smallVariable = "-*-helvetica-medium-r-normal--10-*-*-*-*-*-iso8859-1"

fixedStringF = stringInputF' (setSizing Static)

absUrlF f = loopThroughRightF (absF absUrlSP0) f
  where
    absUrlSP0 = getSP $ either (const absUrlSP0) input
      where
        input (url',s) = loop (url',s) $ absUrlSP url'

    absUrlSP url = getSP $ either fromLoop input
      where
        input (url',s) = loop (url',s) $ absUrlSP url'
	fromLoop uinp =
	  case tstInp id{-(apFst parseURL)-} uinp of
	    (url',method) ->
	      output (mapInp (const (joinURL url (escurl url'),method)) uinp) $
	      absUrlSP url
	 -- _ -> absUrlSP url

    output = putSP . Right
    loop = putSP . Left

    escurl (URL proto host port path fragment) =
        URL proto host port (esc path) fragment
    esc = concatMap esc1
    esc1 c = if c<=' ' then '%':hex (fromEnum c) else [c]

parseUrlSP = mapFilterSP urlP
  where urlP = fmap (httpGet.mkAbs) . parseURL
        mkAbs = joinURL cwd
        cwd = URL (Just "file") Nothing Nothing "" Nothing

menusF optbm =
  parseUrlSP >^^=<
    (nameF "Menus" $ hBoxF $ bmmF optbm >*+<documentsMenuF)
    >*+<
    (nameF "PersonalToolbar" $ ptbF optbm)
  where
    bmmF Nothing = nullF
    bmmF (Just bookmarks) = bookmarksMenuF bookmarks

    ptbF optbm =
      case optbm >>= findBookmark pToolbarFolder of
        Nothing -> nullLF
	Just menu -> toolbarF menu

    fud1 >*+< fud2 = stripEither >^=< (fud1>+<fud2)

documentsMenuF =
    hIOerrF (ReadFile docMenuFile) (const defaultMenuF) $ \ (Str s) ->
    menuF "Documents" (parse s)
  where
    defaultMenuF = docMenuF defaultDocuments
    docMenuF = menuF "Documents"

    parse = g2 . filter ((/="--").take 2) . lines
    g2 (title:url:es) = ((head.words) url,title):g2 es
    g2 _ = []

defaultDocuments =
  [("http://cth.altocumulus.org/~hallgren/wwwbrowser.html",
    "WWWBrowser home page"),
   ("http://www.altocumulus.org/Fudgets/","Fudgets home page"),
   ("http://www.htmlhelp.com/reference/wilbur/","Wilbur - HTML 3.2"),
   ("http://itcorp.com/","ITcorp.com (world's oldest web site)"),
   ("http://toastytech.com/","Nathan's Toasty Technology Page"),
   ("gemini://geminiprotocol.net/","Project Gemini")
  ]

startUrl = 
  case args of
    a:_ -> a
    _ -> homeUrl

defaultHomeUrl = "http://cth.altocumulus.org/~hallgren/wwwbrowser.html"

homeUrl        = argKey "home" defaultHomeUrl
docMenuFile    = argKey "docmenufile" (homeDir++"/.mosaic-doc-menu")
bookmarksFile  = argKey "bookmarksfile" (homeDir++"/.netscape/bookmarks.html")
pToolbarFolder = argKey "personaltoolbar" "Personal Toolbar Folder"

homeDir =
    case getEnvi "HOME" of
      Just s -> s
      _ -> error "No home directory (environment variable HOME not set?)"