module Main where

-- {{{ Imports
import Hbro.Core 
import Hbro.Gui 
import Hbro.Types
import Hbro.Util 

import Control.Monad.Trans(liftIO)

import Graphics.Rendering.Pango.Layout

import Graphics.UI.Gtk.Abstract.Widget
import Graphics.UI.Gtk.Builder
import Graphics.UI.Gtk.Display.Label
import Graphics.UI.Gtk.Entry.Entry
import Graphics.UI.Gtk.Gdk.EventM
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk.Misc.Adjustment
import Graphics.UI.Gtk.Scrolling.ScrolledWindow
import Graphics.UI.Gtk.WebKit.Download
import Graphics.UI.Gtk.WebKit.NetworkRequest
import Graphics.UI.Gtk.WebKit.WebNavigationAction
import Graphics.UI.Gtk.WebKit.WebView
import Graphics.UI.Gtk.WebKit.WebSettings
import Graphics.UI.Gtk.Windows.Window

-- Remove this line in your custom hbro.hs
import Paths_hbro

import System.Environment
import System.Glib.Attributes
import System.Glib.Signals
import System.Process 
import System.Posix.Process
-- }}}

main :: IO ()
main = do
  uiFile     <- getDataFileName "examples/ui.xml" -- Remove this line in your custom hbro.hs
  configHome <- getEnv "XDG_CONFIG_HOME"
    
  hbro Configuration {
    -- Do not change this
    mError = Nothing,

    -- Directory where 0MQ sockets will be created
    mSocketDir = socketDir,

    -- XML file defining UI (used by GtkBuilder) 
    -- In your custom hbro.hs, remove the first line and use instead the second one
    mUIFile = uiFile,
    --mUIFile = configHome ++ "/hbro/ui.xml",

    -- URI to load at startup
    mHomePage = "https://www.google.com",


    -- Custom keys
    -- All callbacks are fed with the GUI instance
    -- Note 1 : for modifiers, lists are used for convenience purposes,
    --          but are transformed into sets in hbro's internal machinery,
    --          so that order and repetition don't matter
    -- Note 3 : for printable characters accessed via the shift modifier,
    --          you do have to include Shift in modifiers list
    mKeyBindings = [
--      ((modifiers,    key),           callback)
        -- Browse
        (([],           "<"),           goBack),
        (([Shift],      ">"),           goForward),
        (([],           "s"),           stopLoading),
        (([],           "<F5>"),        reload True),
        (([Shift],      "<F5>"),        reload False),
        (([],           "^"),           horizontalHome),
        (([],           "$"),           horizontalEnd),
        (([],           "<Home>"),      verticalHome),
        (([],           "<End>"),       verticalEnd),
        (([Control],    "<Home>"),      goHome),

        -- Display
        (([Shift],      "+"),           zoomIn),
        (([],           "-"),           zoomOut),
        (([],           "<F11>"),       fullscreen),
        (([],           "<Escape>"),    unfullscreen),
        (([],           "t"),           toggleStatusBar),
        (([Control],    "u"),           toggleSourceMode),

        -- Prompt
        (([],           "o"),           promptURL False), 
        (([Shift],      "O"),           promptURL True),

        -- Search
        (([Shift],      "/"),           promptFind False True True),
        (([Shift],      "?"),           promptFind False False True),
        (([],           "n"),           findNext False True True),
        (([Shift],      "N"),           findNext False False True),

        -- Copy/paste
        (([],           "y"),           copyUri),
        (([Control],    "y"),           copyTitle),
        --(([],           "p"),           pasteUri), -- /!\ UNSTABLE, can't see why...

        -- Bookmarks
        (([Control],   "d"),            addToBookmarks),
        (([Control],   "l"),            loadFromBookmarks),

        -- Others
        (([Control],    "i"),           showWebInspector),
        (([Control],    "p"),           printPage)
    ],


    -- Various web settings
    -- Commented lines correspond to default values
    -- For more details, please refer to WebSettings documentation
    mWebSettings = do
        settings <- webSettingsNew
        set settings [
            --SETTING                                      DEFAULT VALUE 
            --webSettingsCursiveFontFamily              := "serif",
            --webSettingsDefaultFontFamily              := "sans-serif",
            --webSettingsFantasyFontFamily              := ,
            --webSettingsMonospaceFontFamily            := "monospace",
            --webSettingsSansFontFamily                 := "sans-serif",
            --webSettingsSerifFontFamily                := "serif",
            --webSettingsDefaultFontSize                := ,
            --webSettingsDefaultMonospaceFontSize       := 10,
            --webSettingsMinimumFontSize                := 5,
            --webSettingsMinimumLogicalFontSize         := 5,
            --webSettingsAutoLoadImages                 := True,
            --webSettingsAutoShrinkImages               := True,
            --webSettingsDefaultEncoding                := "iso-8859-1",
            --webSettingsEditingBehavior                := EditingBehaviorWindows,
            --webSettingsEnableCaretBrowsing            := ,
            webSettingsEnableDeveloperExtras            := True,
            webSettingsEnableHtml5Database              := False,
            webSettingsEnableHtml5LocalStorage          := False,
            webSettingsEnableOfflineWebApplicationCache := True,
            webSettingsEnablePlugins                    := True,
            webSettingsEnablePrivateBrowsing            := False,
            webSettingsEnableScripts                    := True,
            webSettingsEnableSpellChecking              := True,
            webSettingsEnableUniversalAccessFromFileUris := True,
            webSettingsEnableXssAuditor                 := True,
            --webSettingsEnableSiteSpecificQuirks       := False,
            --webSettingsEnableDomPaste                 := False,
            --webSettingsEnableDefaultContextMenu       := True,
            webSettingsEnablePageCache                  := True,
            --webSettingsEnableSpatialNavigation        := False,
            --webSettingsEnforce96Dpi                   := ,
            webSettingsJSCanOpenWindowAuto              := True,
            --webSettingsPrintBackgrounds               := True,
            --webSettingsResizableTextAreas             := True,
            webSettingsSpellCheckingLang                := Just "en_US",
            --webSettingsTabKeyCyclesThroughElements    := True,
            webSettingsUserAgent                        := "Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729)"
            --webSettingsUserStylesheetUri              := Nothing,
            --webSettingsZoomStep                       := 0.1
            ]
        return settings,


    -- Custom callbacks
    mAtStartUp = \browser -> (let
            builder         = mBuilder      (mGUI browser)
            webView         = mWebView      (mGUI browser)
            scrollWindow    = mScrollWindow (mGUI browser)
            window          = mWindow       (mGUI browser)
        in do
            progressLabel   <- builderGetObject builder castToLabel "progress"
            uriLabel        <- builderGetObject builder castToLabel "uri"
            scrollLabel     <- builderGetObject builder castToLabel "scroll"
            keysLabel       <- builderGetObject builder castToLabel "keys"

            -- Default background (for status bar)
            widgetModifyBg window StateNormal (Color 0 0 10000)

            -- Scroll position in status bar
            adjustment <- scrolledWindowGetVAdjustment scrollWindow
            _ <- onValueChanged adjustment $ do
                current <- adjustmentGetValue adjustment
                lower   <- adjustmentGetLower adjustment
                upper   <- adjustmentGetUpper adjustment
                page    <- adjustmentGetPageSize adjustment
                
                case upper-lower-page of
                    0 -> labelSetMarkup scrollLabel "ALL"
                    x -> labelSetMarkup scrollLabel $ show (round $ current/x*100) ++ "%"

            -- Pressed keys in statusbar
            _ <- after webView keyPressEvent $ do
                value      <- eventKeyVal
                modifiers  <- eventModifier

                let keyString = keyToString value
                case keyString of 
                    Just string -> liftIO $ labelSetMarkup keysLabel $ "<span foreground=\"green\">" ++ show modifiers ++ escapeMarkup string ++ "</span>"
                    _           -> return ()

                return False


            -- Page load
            _ <- on webView loadStarted $ \_ -> do
                labelSetMarkup progressLabel "<span foreground=\"red\">0%</span>"

            _ <- on webView loadCommitted $ \_ -> do
                getUri <- (webViewGetUri webView)
                case getUri of 
                    Just uri -> labelSetMarkup uriLabel $ "<span weight=\"bold\" foreground=\"white\">" ++ escapeMarkup uri ++ "</span>"
                    _        -> labelSetMarkup uriLabel "<span weight=\"bold\" foreground=\"red\">ERROR</span>"

            _ <- on webView progressChanged $ \progress' ->
                labelSetMarkup progressLabel $ "<span foreground=\"yellow\">" ++ show progress' ++ "%</span>"

            _ <- on webView loadFinished $ \_ -> do
                labelSetMarkup progressLabel "<span foreground=\"green\">100%</span>"

            _ <- on webView loadError $ \_ _ _ -> do
                labelSetMarkup progressLabel "<span foreground=\"red\">ERROR</span>"
                return False

            _ <- on webView titleChanged $ \_ title ->
                set window [ windowTitle := ("hbro | " ++ title)]


            -- Special requests
            _ <- on webView downloadRequested $ \download -> do
                getUri <- downloadGetUri download
                _ <- case getUri of
                    Just uri -> downloadHandler uri 
                    _        -> return ()
                return True

            _ <- on webView mimeTypePolicyDecisionRequested $ \_ request mimetype policyDecision -> do
                getUri <- networkRequestGetUri request
                case (getUri, mimetype) of
                    --(Just uri, 'a':'p':'p':'l':'i':'c':'a':'t':'i':'o':'n':'/':_) -> downloadHandler uri
                    (Just uri, _) -> putStrLn $ mimetype ++ ": " ++ uri
                    _             -> putStrLn "FIXME"

                return False


            -- History handler
            _ <- on webView loadFinished $ \_ -> do
                getUri   <- webViewGetUri webView
                getTitle <- webViewGetTitle webView
                case (getUri, getTitle) of
                    (Just uri, Just title)  -> historyHandler uri title
                    _                       -> return ()


            -- On navigating to a new URI
            -- Return True to forbid navigation, False to allow
            _ <- on webView navigationPolicyDecisionRequested $ \_ request action policyDecision -> do
                getUri      <- networkRequestGetUri request
                reason      <- webNavigationActionGetReason action
                mouseButton <- webNavigationActionGetButton action

                case getUri of
                    Just ('m':'a':'i':'l':'t':'o':':':address) -> do
                        putStrLn $ "Mailing to: " ++ address
                        return True
                    Just uri -> 
                        case mouseButton of
                            1 -> return False -- Left button 
                            2 -> runExternalCommand ("hbro -u \"" ++ uri ++ "\"") >> return True -- Middle button
                            3 -> return False -- Right button
                            _ -> return False -- No mouse button pressed
                    _        -> return False


                
            -- On requesting new window
            _ <- on webView newWindowPolicyDecisionRequested $ \_ request action policyDecision -> do
                getUri <- networkRequestGetUri request
                case getUri of
                    Just uri -> runExternalCommand $ "hbro " ++ uri
                    _        -> putStrLn "ERROR: wrong URI given, unable to open window."

                return True

            _ <- on webView hoveringOverLink $ \title hoveredUri -> do
                getUri <- (webViewGetUri webView)
                case (hoveredUri, getUri) of
                    (Just u, _) -> labelSetMarkup uriLabel $ "<span foreground=\"#5555ff\">" ++ escapeMarkup u ++ "</span>"
                    (_, Just u) -> labelSetMarkup uriLabel $ "<span foreground=\"white\" weight=\"bold\">" ++ escapeMarkup u ++ "</span>"
                    _           -> putStrLn "FIXME"

            
            -- Favicon
            --_ <- on webView iconLoaded $ \uri -> do something

            return ()
    )}


-- Definitions
    where
        -- Constants
        scriptsDir, socketDir :: String
        scriptsDir = "~/.config/hbro/scripts/"
        socketDir  = "/tmp"

        toggleSourceMode :: Browser -> IO()
        toggleSourceMode browser = do
            currentMode <- webViewGetViewSourceMode (mWebView $ mGUI browser)
            webViewSetViewSourceMode (mWebView $ mGUI browser) (not currentMode)

        -- TODO
        toggleStatusBar :: Browser -> IO()
        toggleStatusBar browser = return()


        promptURL :: Bool -> Browser -> IO()        
        promptURL False browser = 
            prompt "Open URL" "" False browser (\b -> do 
                uri <- entryGetText (mPromptEntry $ mGUI b)
                loadURL uri b)
        promptURL _ browser = do
            uri <- webViewGetUri (mWebView $ mGUI browser)
            case uri of
                Just url -> prompt "Open URL" url False browser (\b -> do
                                u <- entryGetText (mPromptEntry $ mGUI b)
                                loadURL u b)
                _ -> return ()

        promptFind :: Bool -> Bool -> Bool -> Browser -> IO ()
        promptFind caseSensitive forward wrap browser =
            prompt "Search" "" True browser (\browser' -> do
                keyWord <- entryGetText (mPromptEntry $ mGUI browser')
                found   <- webViewSearchText (mWebView $ mGUI browser) keyWord caseSensitive forward wrap
                return ())

        findNext :: Bool -> Bool -> Bool -> Browser -> IO ()
        findNext caseSensitive forward wrap browser = do
            keyWord <- entryGetText (mPromptEntry $ mGUI browser)
            found   <- webViewSearchText (mWebView $ mGUI browser) keyWord caseSensitive forward wrap 
            return ()

        -- Copy/paste
        copyUri, copyTitle, pasteUri :: Browser -> IO()
        copyUri browser = do
            getUri <- webViewGetUri (mWebView $ mGUI browser)
            case getUri of
                Just u -> runCommand ("echo -n " ++ u ++ " | xclip") >> return ()
                _      -> return ()

        copyTitle browser = do
            getTitle <- webViewGetTitle (mWebView $ mGUI browser)
            case getTitle of
                Just t -> runCommand ("echo -n " ++ t ++ " | xclip") >> return ()
                _      -> return ()

        pasteUri browser = do
            uri <- readProcess "xclip" ["-o"] []
            loadURL uri browser


        -- Scrolling
        verticalHome, verticalEnd, horizontalHome, horizontalEnd :: Browser -> IO()
        verticalHome browser = do
            adjustment  <- scrolledWindowGetVAdjustment (mScrollWindow $ mGUI browser)
            lower       <- adjustmentGetLower adjustment

            adjustmentSetValue adjustment lower

        verticalEnd browser = do
            adjustment  <- scrolledWindowGetVAdjustment (mScrollWindow $ mGUI browser)
            upper       <- adjustmentGetUpper adjustment

            adjustmentSetValue adjustment upper

        horizontalHome browser = do
            adjustment  <- scrolledWindowGetHAdjustment (mScrollWindow $ mGUI browser)
            lower       <- adjustmentGetLower adjustment

            adjustmentSetValue adjustment lower

        horizontalEnd browser = do
            adjustment  <- scrolledWindowGetHAdjustment (mScrollWindow $ mGUI browser)
            upper       <- adjustmentGetUpper adjustment

            adjustmentSetValue adjustment upper 

        -- Handlers
        downloadHandler :: String -> IO ()
        downloadHandler uri = runExternalCommand $ "wget \"" ++ uri ++ "\""

        historyHandler :: String -> String -> IO ()
        historyHandler uri title = runCommand (scriptsDir ++ "/historyHandler.sh \"" ++ uri ++ "\" \"" ++ title ++ "\"") >> return ()


        -- Bookmarks
        addToBookmarks, loadFromBookmarks :: Browser -> IO()
        addToBookmarks browser = do
            getUri <- webViewGetUri (mWebView $ mGUI browser)
            case getUri of
                Just uri -> prompt "Bookmark with tag:" "" False browser (\b -> do 
                    tags <- entryGetText (mPromptEntry $ mGUI b)
                    runExternalCommand $ scriptsDir ++ "bookmarks.sh add " ++ uri ++ " " ++ tags)
                _        -> return ()

        loadFromBookmarks browser = do 
            pid <- getProcessID
            runExternalCommand $ scriptsDir ++ "bookmarks.sh load \"" ++ socketDir ++ "/hbro." ++ show pid ++ "\""