{-# OPTIONS_GHC -fglasgow-exts #-}
-----------------------------------------------------------------------------
--
-- Module      :  IDE.Leksah
-- Copyright   :  (c) Juergen Nicklisch-Franken (aka Jutaro)
-- License     :  GNU-GPL
--
-- Maintainer  :  Juergen Nicklisch-Franken <jnf at arcor.de>
-- Stability   :  experimental
-- Portability :  portable
--
--
--  Main function of Genuine Haskell Face, an Haskell IDE written in Haskell
--
---------------------------------------------------------------------------------

module IDE.Leksah (
    runMain
) where

import Graphics.UI.Gtk
import Control.Monad.Reader
import Control.Concurrent
import Data.IORef
import Data.Maybe
import Data.List(sort)
import qualified Data.Map as Map
import System.Console.GetOpt
import System.Environment
import GHC
import Config
import Data.Version
import Prelude hiding(catch)
import System.FilePath
import System.Directory


import Paths_leksah
import IDE.SaveSession
import IDE.Core.State
import IDE.SourceCandy
import IDE.Utils.File
import IDE.Framework.ViewFrame
import IDE.Framework.MakeEditor
import IDE.Framework.Parameters
import IDE.Menu
import IDE.Preferences
import IDE.Keymap
import IDE.SourceEditor
import IDE.SpecialEditors
import IDE.Metainfo.Info
import IDE.Metainfo.SourceCollector
import IDE.Metainfo.InterfaceCollector
import IDE.Log(getLog,appendLog)
import IDE.InfoPane
import IDE.ModulesPane


-- ---------------------------------------------------------------------
-- Command line options
--

data Flag =  UninstalledProject String | Collect | Rebuild | Sources | VersionF | DebugF
       deriving (Show,Eq)

options :: [OptDescr Flag]
options =   [Option ['r'] ["Rebuild"] (NoArg Rebuild)
                "Cleans all .pack files and rebuild everything"
         ,   Option ['c'] ["Collect"] (NoArg Collect)
                "Collects new information in .pack files"
         ,   Option ['u'] ["Uninstalled"] (ReqArg UninstalledProject "FILE")
                "Gather info about an uninstalled package"
         ,   Option ['s'] ["Sources"] (NoArg Sources)
                "Gather info about pathes to sources"
         ,   Option ['v'] ["Version"] (NoArg VersionF)
                "Show the version number of ide"
         ,   Option ['d'] ["Debug"] (NoArg DebugF)
                "Write ascii pack files"]

ideOpts :: [String] -> IO ([Flag], [String])
ideOpts argv =
    case getOpt Permute options argv of
          (o,n,[]  ) -> return (o,n)
          (_,_,errs) -> ioError $userError $concat errs ++ usageInfo header options
    where header = "Usage: ide [OPTION...] files..."


-- ---------------------------------------------------------------------
-- | Main function
--

runMain = handleTopExceptions $do
    args            <-  getArgs
    (o,_)          <-  ideOpts args
    let uninstalled =   filter (\x -> case x of
                                        UninstalledProject _ -> True
                                        _                    -> False) o
    if elem VersionF o
        then do sysMessage Normal $ "Leksah an IDE for Haskell, version " ++ showVersion version
        else
            if elem Sources o
                then do
                    buildSourceForPackageDB
                    sysMessage Normal "rebuild SourceForPackageDB"
                else if elem Rebuild o
                        || elem Collect o
                        || not (null uninstalled)
                    then do
                        libDir          <-  getSysLibDir
#if __GHC__ > 670
                        session     <-  newSession (Just libDir)
#else
                        session     <-  newSession JustTypecheck (Just libDir)
#endif
                        dflags0         <-  getSessionDynFlags session
                        setSessionDynFlags session dflags0
                        let version     =   cProjectVersion
                        let uninstalled =   filter (\x -> case x of UninstalledProject _ -> True
                                                                    _                    -> False) o
                        let writeAscii = elem DebugF o
                        if length uninstalled > 0
                            then mapM_ (collectUninstalled writeAscii session version)
                                    $ map (\ (UninstalledProject x) -> x) uninstalled
                            else do
                                sources             <-  getSourcesMap
                                collectInstalled' writeAscii session version (elem Rebuild o) sources
                    else startGUI

-- ---------------------------------------------------------------------
-- | Start the GUI

startGUI :: IO ()
startGUI = do
--    sysMessage Normal "Leksah says welcome"
    st          <-  initGUI
    when rtsSupportsBoundThreads
        (sysMessage Normal "Linked with -threaded")
    timeoutAddFull (yield >> return True) priorityHigh 25
    mapM_ (sysMessage Normal) st
    uiManager   <-  uiManagerNew
    newIcons
    hasConfigDir' <- hasConfigDir
    when (not hasConfigDir') firstStart
    prefsPath   <-  getConfigFilePathForLoad "Default.prefs"
    prefs       <-  readPrefs prefsPath
    keysPath    <-  getConfigFilePathForLoad $keymapName prefs ++ ".keymap"
    keyMap      <-  parseKeymap keysPath
    let accelActions = setKeymap (keyMap :: KeymapI) actions
    specialKeys <-  buildSpecialKeys keyMap accelActions
    candyPath   <-  getConfigFilePathForLoad
                        (case sourceCandy prefs of
                                    Nothing     ->   "Default.candy"
                                    Just name   ->   name ++ ".candy")
    candySt     <-  parseCandy candyPath
    win         <-  windowNew
    dataDir     <-  getDataDir
    let iconPath = dataDir </> "data" </> "leksah.png"
    iconExists  <-  doesFileExist iconPath
    when iconExists $
        windowSetIconFromFile win iconPath
    libDir      <-  getSysLibDir
#if __GHC__ > 670
    session     <-  newSession (Just libDir)
#else
    session     <-  newSession JustTypecheck (Just libDir)
#endif
    dflags0     <-  getSessionDynFlags session
    setSessionDynFlags session dflags0
    let ide = IDE
          {   window        =   win
          ,   uiManager     =   uiManager
          ,   panes         =   Map.empty
          ,   activePane    =   Nothing
          ,   paneMap       =   Map.empty
          ,   layout        =   (TerminalP Nothing (-1))
          ,   specialKeys   =   specialKeys
          ,   specialKey    =   Nothing
          ,   candy         =   candySt
          ,   prefs         =   prefs
--          ,   packages      =   []
          ,   activePack    =   Nothing
          ,   errors        =   []
          ,   currentErr    =   Nothing
          ,   accessibleInfo     =   Nothing
          ,   currentInfo   =   Nothing
          ,   session       =   session
          ,   handlers      =   Map.empty}
    ideR        <-  newIORef ide
    runReaderT (initInfo :: IDEAction) ideR
    menuDescription' <- menuDescription
    (acc,menus) <-  runReaderT (makeMenu uiManager accelActions menuDescription') ideR
    when (length menus /= 3) $ throwIDE ("Failed to build menu" ++ show (length menus))
    windowAddAccelGroup win acc
    nb          <-  newNotebook
    widgetSetName nb $"root"
    statusBar   <-  buildStatusbar ideR
    vb          <-  vBoxNew False 1  -- Top-level vbox
    widgetSetName vb "topBox"
    boxPackStart vb (menus !! 0) PackNatural 0
    boxPackStart vb nb PackGrow 0
    boxPackEnd vb statusBar PackNatural 0
    win `onDelete` (\ _ -> do runReaderT quit ideR; return True)
    win `onKeyPress` (\ e -> runReaderT (handleSpecialKeystrokes e) ideR)
    containerAdd win vb
    runReaderT (setCandyState (isJust (sourceCandy prefs))) ideR
    let (x,y)   =   defaultSize prefs
    windowSetDefaultSize win x y
    runReaderT (do
        registerEvents menus
        recoverSession :: IDEAction) ideR
    widgetShowAll win
    mainGUI

--
-- | Callback function for onKeyPress of the main window, so preprocess any key
--
handleSpecialKeystrokes :: Event -> IDEM Bool
handleSpecialKeystrokes (Key _ _ _ mods _ _ _ keyVal name mbChar) = do
    bs <- getCandyState
    when bs $ editKeystrokeCandy mbChar
    sk  <- readIDE specialKey
    sks <- readIDE specialKeys
    sb <- getSBSpecialKeys
    case sk of
        Nothing -> do
            case Map.lookup (keyVal,sort mods) sks of
                Nothing -> do
                    lift $statusbarPop sb 1
                    lift $statusbarPush sb 1 ""
                    return False
                Just map -> do
                    sb <- getSBSpecialKeys
                    let sym = printMods mods ++ name
                    lift $statusbarPop sb 1
                    lift $statusbarPush sb 1 sym
                    modifyIDE_ (\ide -> return (ide{specialKey = Just (map,sym)}))
                    return True
        Just (map,sym) -> do
            case Map.lookup (keyVal,sort mods) map of
                Nothing -> do
                    sb <- getSBSpecialKeys
                    lift $statusbarPop sb 1
                    lift $statusbarPush sb 1 $sym ++ printMods mods ++ name ++ "?"
                    return ()
                Just (AD actname _ _ _ ideAction _ _) -> do
                    sb <- getSBSpecialKeys
                    lift $statusbarPop sb 1
                    lift $statusbarPush sb 1
                        $sym ++ " " ++ printMods mods ++ name ++ "=" ++ actname
                    ideAction
            modifyIDE_ (\ide -> return (ide{specialKey = Nothing}))
            return True
    where
    printMods :: [Modifier] -> String
    printMods []    = ""
    printMods (m:r) = show m ++ printMods r
handleSpecialKeystrokes _ = return True

registerEvents :: [Widget] -> IDEAction
registerEvents tbl =    do
    stRef   <-  ask
    registerEvent stRef LogMessageS (Left logHandler)
    registerEvent stRef GetToolbarS (Left tbHandler)
    registerEvent stRef SelectInfoS (Left siHandler)
    registerEvent stRef SelectIdentS (Left sidHandler)
    registerEvent stRef CurrentInfoS (Left ciuHandler)
    registerEvent stRef ActivePackS (Left apHandler)

    return ()
    where
        logHandler e@(LogMessage s t) =   do
            (log :: IDELog)          <-  getLog
            lift $ appendLog log s t
            return e
        logHandler _ =   throwIDE "Leksah>>registerEvents: Impossible event"

        tbHandler (GetToolbar _) =   return (GetToolbar tbl)
        tbHandler _ =   throwIDE "Leksah>>registerEvents: Impossible event"

        siHandler e@(SelectInfo str) =   do
            setSymbol str
            return e
        siHandler _ =   throwIDE "Leksah>>registerEvents: Impossible event"

        sidHandler e@(SelectIdent id) =   do
            selectIdentifier id
            return e
        sidHandler _ =   throwIDE "Leksah>>registerEvents: Impossible event"

        ciuHandler CurrentInfo =   do
            reloadKeepSelection
            return CurrentInfo
        ciuHandler _ =   throwIDE "Leksah>>registerEvents: Impossible event"

        apHandler ActivePack =   do
            infoForActivePackage :: IDEAction
            return ActivePack
        apHandler _ =   throwIDE "Leksah>>registerEvents: Impossible event"



--
-- | Called when leksah ist first called
--
fDescription :: FieldDescription Prefs
fDescription =
        mkField
            (paraName <<<- ParaName "Paths under which haskell sources may be found"
                $ paraDirection  <<<- ParaDirection Vertical
                    $ emptyParams)
            sourceDirectories
            (\b a -> a{sourceDirectories = b})
            (filesEditor Nothing FileChooserActionSelectFolder "Select folders")

firstStart :: IO ()
firstStart = do
    prefsPath   <-  getConfigFilePathForLoad "Default.prefs"
    prefs       <-  readPrefs prefsPath
    dialog      <- windowNew
    vb          <- vBoxNew False 0
    bb          <- hButtonBoxNew
    ok          <- buttonNewFromStock "gtk-ok"
    cancel      <- buttonNewFromStock "gtk-cancel"
    boxPackStart bb ok PackNatural 0
    boxPackStart bb cancel PackNatural 0
    label       <- labelNew (Just ("Welcome to Leksah, an IDE for Haskell.\n" ++
        "At the first start, Leksah will collect metadata about your installed haskell packages.\n" ++
        "Select folders under which you have installed Haskell packages with sources below and click add.\n" ++
        "It may take some time before Leksah starts up."))
    (widget, setInj, getExt,notifier)
                <- fieldEditor fDescription prefs
    ok `onClicked` (do
        mbNewPrefs <- extract prefs [getExt]
        case mbNewPrefs of
            Nothing -> return ()
            Just newPrefs -> do
                fp <- getConfigFilePathForSave "Default.prefs"
                writePrefs fp newPrefs
                widgetDestroy dialog
                mainQuit
                firstBuild)
    cancel `onClicked` (do
        widgetDestroy dialog
        mainQuit)
    dialog `onDelete` (\_ -> do
        widgetDestroy dialog
        mainQuit
        return True)
    boxPackStart vb label PackGrow 7
    boxPackStart vb widget PackGrow 7
    boxPackEnd vb bb PackNatural 7
    containerAdd dialog vb
    widgetSetSizeRequest dialog 700 400
    widgetShowAll dialog
    mainGUI
    return ()

firstBuild :: IO ()
firstBuild = do
    libDir          <-  getSysLibDir
#if __GHC__ > 670
    session     <-  newSession (Just libDir)
#else
    session     <-  newSession JustTypecheck (Just libDir)
#endif
    dflags0         <-  getSessionDynFlags session
    setSessionDynFlags session dflags0
    let version     =   cProjectVersion
    buildSourceForPackageDB
    sources             <-  getSourcesMap
    collectInstalled' False session version True sources