{-# OPTIONS -cpp #-}

-- ----------------------------------------------------------------------------
-- |
-- Module	: ComMain
-- Author	: Simon Marlow <simonmar@microsoft.com>
-- Copyright    : (c) Microsoft Corporation, All Rights Reserved
-- 
-- Top-level COM component wrapper
--
-- ----------------------------------------------------------------------------

module ComMain ( comComponents ) where

import VSConfig
import HaskellPackageProxy(componentInfo, clsidHaskellPackage)
import HaskellServiceProxy
import Project(clsidHaskellProject)
import Registry -- my own registry stuff
import ComDll
import Com		( CLSID, loadTypeLibEx, release )
import FilePath

#include "../../vs_haskell_ui/resource.h"

-- ----------------------------------------------------------------------------
-- The COM components in this DLL

comComponents :: [ ComponentInfo ]
comComponents = 
  [ 
    -- This is the COM component that implements our project support.  
    -- It provides the IVsPackage and IVsInstalledProduct interfaces.
    onRegister registerHaskellPackage $
    withComponentName packageName $
    withProgID "HaskellPackage.1" $
    withVerIndepProgID "HaskellPackage" $
    HaskellPackageProxy.componentInfo      
  , 
    -- This is the COM component that implements Babel's
    -- IBabelService interface.
    onRegister (registerHaskellService [".hs"] 
		  clsidHaskellService haskellServiceName) $
    withComponentName haskellServiceName $
    withProgID "HaskellBabelService.1" $
    withVerIndepProgID "HaskellBabelService" $
    HaskellServiceProxy.componentInfo
  ,
    -- We have a separate version of the language service for literate
    -- Haskell, just so we can override the colorLine method.
    onRegister (registerHaskellService [".lhs"] 
		  clsidLiterateHaskellService litHaskellServiceName) $
    withComponentName litHaskellServiceName $
    withProgID "LiterateHaskellBabelService.1" $
    withVerIndepProgID "LiterateHaskellBabelService" $
    HaskellServiceProxy.litComponentInfo
  ]

-- ----------------------------------------------------------------------------
-- Registering the package

regSetValueResID :: RegistryKey -> Maybe String -> Int -> IO () 
regSetValueResID key nm id = regSetValueString key nm ('#':show id)

registerHaskellPackage
	:: ComponentInfo
	-> FilePath
	-> Bool			-- True <=> register, False <=> unregister
	-> IO ()
registerHaskellPackage info dll_path is_reg = do
	let package_root = vs_root ++ "Packages\\" ++ show clsidHaskellPackage
	
	    project_root = vs_root ++ "Projects\\" ++ show clsidHaskellProject
	    project_add_items_root = project_root ++ "\\AddItemTemplates\\TemplateDirs\\"++show clsidHaskellPackage++"\\1"
	    project_filters_root   = project_root ++ "\\Filters\\/1"
	    
	    project_add_misc_items_root = vs_root ++ "Projects\\{A2FE74E1-B743-11d0-AE1A-00A0C90FFFC3}\\AddItemTemplates\\TemplateDirs\\"++show clsidHaskellPackage++"\\/1"
	    
	    new_projects_root = vs_root++"NewProjectTemplates\\TemplateDirs\\"++show clsidHaskellPackage++"\\1"
	    
	    templates_dir       = vshaskellRoot `joinFileName` "Templates"
	    proj_templates_dir  = templates_dir `joinFileName` "Projects"
	    items_templates_dir = templates_dir `joinFileName` "ProjectItems"
	    misc_items_templates_dir = templates_dir `joinFileName` "MiscItems"
	    
	    project_doc_type = "VisualStudio"++haskellProjExtension++"."++vs_version
	    
	    inst_products_path = vs_root++"InstalledProducts"
	    
	    menus_root = vs_root ++ "Menus"
	    
	if is_reg 
		then do
			vstudioPath <- withRegKey HKEY_LOCAL_MACHINE vs_root $ \k -> do
				          regQueryValueString k (Just "InstallDir")
			withRegKey HKEY_LOCAL_MACHINE package_root $ \k -> do
				regSetValueString k Nothing "visual haskell"
				regSetValueDWORD k (Just "ID") IDS_PACKAGE_LOAD_KEY
				regSetValueString k (Just "InprocServer32") dll_path
				regSetValueString k (Just "ProductName") "visual haskell"
				regSetValueString k (Just "ProductVersion") "1.0"
				regSetValueString k (Just "CompanyName") "Microsoft"
				regSetValueString k (Just "MinEdition") "standard"
			withRegKey HKEY_LOCAL_MACHINE (package_root++"\\SatelliteDll") $ \k -> do
				regSetValueString k (Just "DllName") "vs_haskell_ui.dll"
				regSetValueString k (Just "Path") (vshaskellRoot `joinFileName` "bin")
			withRegKey HKEY_CLASSES_ROOT haskellProjExtension $ \k -> do
				regSetValueString k Nothing project_doc_type
				regSetValueString k (Just "Content Type") "text/plain"
			withRegKey HKEY_CLASSES_ROOT project_doc_type $ \k -> do
				regSetValueString k Nothing "Visual Haskell Project"
			withRegKey HKEY_CLASSES_ROOT (project_doc_type++"\\DefaultIcon") $ \k -> do
				regSetValueString k Nothing (vshaskellRoot `joinFileName` "HaskellProject.ico")
			withRegKey HKEY_CLASSES_ROOT (project_doc_type++"\\shell\\open\\command") $ \k -> do
				regSetValueString k Nothing ("\"" ++ vstudioPath ++ "\\devenv.exe\" \"%1\"")
			withRegKey HKEY_LOCAL_MACHINE project_root $ \k -> do
				regSetValueString k Nothing "Haskell Projects"
  				regSetValueResID  k (Just "DisplayName") IDS_HASKELL_PROJECTS_DISP_NAME
  				regSetValueString k (Just "DefaultProjectExtension") haskellProjExtension
  				regSetValueResID  k (Just "DisplayProjectFileExtensions") IDS_HASKELL_PROJECTS_FILTER
  				regSetValueString k (Just "ItemTemplatesDir") items_templates_dir
  				regSetValueString k (Just "Package") (show clsidHaskellPackage)
  				regSetValueString k (Just "PossibleProjectExtensions") (tail haskellProjExtension++";description")
  				regSetValueString k (Just "ProjectTemplatesDir") proj_templates_dir
			withRegKey HKEY_LOCAL_MACHINE project_add_items_root $ \k -> do
				regSetValueResID  k Nothing IDS_HASKELL_PROJECTS_TITLE
  				regSetValueString k (Just "TemplatesDir") items_templates_dir
  				regSetValueDWORD  k (Just "SortPriority") 64
  			withRegKey HKEY_LOCAL_MACHINE project_add_misc_items_root $ \k -> do
				regSetValueResID  k Nothing IDS_HASKELL_ITEMS_TITLE
			  	regSetValueString k (Just "TemplatesDir") misc_items_templates_dir
  				regSetValueDWORD  k (Just "SortPriority") 64
			withRegKey HKEY_LOCAL_MACHINE project_filters_root $ \k -> do
				regSetValueResID  k Nothing 3
				regSetValueDWORD  k (Just "CommonOpenFilesFilter") 0
				regSetValueDWORD  k (Just "CommonFindFilesFilter") 0
				regSetValueDWORD  k (Just "FindInFilesFilter") 0
				regSetValueDWORD  k (Just "NotOpenFileFilter") 0
				regSetValueDWORD  k (Just "NotAddExistingItemFilter") 0
			withRegKey HKEY_LOCAL_MACHINE new_projects_root $ \k -> do
				regSetValueResID k Nothing 7
				regSetValueDWORD  k (Just "NewProjectDialogOnly") 0
				regSetValueDWORD  k (Just "SortPriority") 41
				regSetValueString k (Just "TemplatesDir") proj_templates_dir
			withRegKey HKEY_LOCAL_MACHINE (inst_products_path++"\\Visual Haskell") $ \k -> do
				regSetValueString k (Just "Package") (show clsidHaskellPackage)
				regSetValueDWORD  k (Just "UseInterface") 1
			withRegKey HKEY_LOCAL_MACHINE menus_root $ \k -> do
				regSetValueString k (Just (show clsidHaskellPackage)) ",1000,1"

			-- register HaskellProject.tlb
			iTypeLib <- loadTypeLibEx (vshaskellRoot `joinFileName` "HaskellProject.tlb") True
			release iTypeLib
			return ()
		else do
			regDeleteKey HKEY_LOCAL_MACHINE (package_root++"\\SatelliteDll")
			regDeleteKey HKEY_LOCAL_MACHINE (package_root)
			regDeleteKey HKEY_LOCAL_MACHINE (project_root ++ "\\AddItemTemplates\\TemplateDirs\\"++show clsidHaskellPackage++"\\1")
			regDeleteKey HKEY_LOCAL_MACHINE (project_root ++ "\\AddItemTemplates\\TemplateDirs\\"++show clsidHaskellPackage)
			regDeleteKey HKEY_LOCAL_MACHINE (project_root ++ "\\AddItemTemplates\\TemplateDirs")
			regDeleteKey HKEY_LOCAL_MACHINE (project_root ++ "\\AddItemTemplates")
			regDeleteKey HKEY_LOCAL_MACHINE (project_root ++ "\\Filters\\/1")
			regDeleteKey HKEY_LOCAL_MACHINE (project_root ++ "\\Filters")
			regDeleteKey HKEY_LOCAL_MACHINE (project_root)
			regDeleteKey HKEY_LOCAL_MACHINE project_add_misc_items_root 
			regDeleteKey HKEY_CLASSES_ROOT haskellProjExtension
			regDeleteKey HKEY_CLASSES_ROOT (project_doc_type++"\\DefaultIcon")
			regDeleteKey HKEY_CLASSES_ROOT (project_doc_type++"\\shell\\open\\command")
			regDeleteKey HKEY_CLASSES_ROOT (project_doc_type)
			regDeleteKey HKEY_LOCAL_MACHINE (vs_root++"NewProjectTemplates\\TemplateDirs\\"++show clsidHaskellPackage++"\\1")
			regDeleteKey HKEY_LOCAL_MACHINE (vs_root++"NewProjectTemplates\\TemplateDirs\\"++show clsidHaskellPackage)
			regDeleteKey HKEY_LOCAL_MACHINE (inst_products_path++"\\Visual Haskell")

-- ----------------------------------------------------------------------------
-- Registering the language service

registerHaskellService
	:: [String]		-- file suffix(es)
	-> CLSID		-- CLSID of language service
	-> String		-- Language Service name
	-> ComponentInfo
	-> FilePath
	-> Bool			-- True <=> register, False <=> unregister
	-> IO ()
registerHaskellService extensions clsid serviceName info dll_path is_reg = do
  let 
	lang_clsid = show clsid
  --
  -- HKEY_LOCAL_MACHINE/Software/Microsoft/VisualStudio/7.0Exp/
  --    Services/
  --       <languageCLSID>/
  --    	<packageCLSID>
  --    	Name = "Haskell"
  let
	services        = vs_root ++ "Services"
	babel_clsid     = show clsidBabelPackage
	serv_lang_clsid = services ++ '\\':lang_clsid
  --
  if is_reg 
    then
    withRegKey HKEY_LOCAL_MACHINE serv_lang_clsid $ \k -> do
	regSetValueString k Nothing babel_clsid
  	regSetValueString k (Just "Name") serviceName

    else
    regDeleteKey HKEY_LOCAL_MACHINE serv_lang_clsid

  --    Languages/
  --       File Extensions/
  --    	.hs/
  --    		<languageCLSID>
  --    		Name = "Haskell"
  --    	.lhs/
  --    		<languageCLSID>
  --    		Name = "Haskell"
  let
      languages = vs_root ++ "Languages"
      fileextns = languages ++ "\\File Extensions"

      regExtension ext
	  | is_reg = do
	  withRegKey HKEY_LOCAL_MACHINE (fileextns++'\\':ext) $ \k -> do
		regSetValueString k Nothing lang_clsid
		regSetValueString k (Just "Name") serviceName
	  | otherwise =
	  regDeleteKey HKEY_LOCAL_MACHINE (fileextns++'\\':ext)

  mapM regExtension extensions

  --       Language Services/
  --    	Haskell/
  --    		<languageCLSID>
  --    		Extensions = ".hs;.lhs;"
  --    		Package = <packageCLSID>
  --    		... others ....
  let
	ls_haskell = languages ++ "\\Language Services" ++ '\\':serviceName
  --
  if is_reg 
    then
      withRegKey HKEY_LOCAL_MACHINE ls_haskell $ \k -> do
    	regSetValueString k Nothing lang_clsid
    	regSetValueString k (Just "Extensions")
    	    (concat (map (++";") extensions))
    	regSetValueString k (Just "Package") babel_clsid
    	regSetValueDWORD k (Just "LangResId") 0
    	-- which features we implement:
    	regSetValueDWORD k (Just "RequestStockColors") 1
    	regSetValueDWORD k (Just "ShowCompletion")     1
    	regSetValueDWORD k (Just "QuickInfo")          1
    	regSetValueDWORD k (Just "SortMemberList")     0
    	regSetValueDWORD k (Just "CodeSense")          1
    	regSetValueDWORD k (Just "CodeSenseDelay")     1000
    	regSetValueDWORD k (Just "MaxErrorMessages")   8
    	regSetValueDWORD k (Just "MatchBraces")        0
    	regSetValueDWORD k (Just "ShowMatchingBrace")  0
    	regSetValueDWORD k (Just "MatchBracesAtCaret") 0

	-- The babel example code has this, but it isn't in the documentation:
    	regSetValueDWORD k (Just "ThreadModel") 1

    else -- unregister
	regDeleteKey HKEY_LOCAL_MACHINE ls_haskell