-- {-# LANGUAGE CPP #-}

module Agda.Interaction.Highlighting.Vim where

import Control.Monad.Trans
import Data.Function ( on )
import System.FilePath

import qualified Data.List as List
import qualified Data.Map as Map

import Agda.Syntax.Scope.Base
import Agda.Syntax.Concrete.Name as CName

import Agda.TypeChecking.Monad

import qualified Agda.Utils.IO.UTF8 as UTF8
import Agda.Utils.Tuple

-- defined in Data.Function
-- on f g x y = f (g x) (g y)

vimFile :: FilePath -> FilePath
vimFile file =
    case splitFileName file of
	(path, name) -> path </> "" <.> name <.> "vim"

escape :: String -> String
escape = concatMap esc
    where
	escchars = "$\\^.*~[]"
	esc c	| c `elem` escchars = ['\\',c]
		| otherwise	    = [c]

wordBounded :: String -> String
wordBounded s0 = concat ["\\<", s0, "\\>"]

keyword :: String -> [String] -> String
keyword _ [] = ""
keyword cat ws	= "syn keyword " ++ unwords (cat : ws)

match :: String -> [String] -> String
match _ [] = ""
match cat ws	= "syn match " ++ cat ++ " \"" ++
		    concat (List.intersperse "\\|" $ map (wordBounded . escape) ws) ++ "\""

matches :: [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String]
matches cons icons defs idefs flds iflds =
    map snd
    $ List.sortBy (compare `on` fst)
    $ cons' ++ defs' ++ icons' ++ idefs'
    where
	cons'  = foo "agdaConstructor"	    $ classify length cons
	icons' = foo "agdaInfixConstructor" $ classify length icons
	defs'  = foo "agdaFunction"	    $ classify length defs
	idefs' = foo "agdaInfixFunction"    $ classify length idefs
	flds'  = foo "agdaProjection"	    $ classify length flds
	iflds' = foo "agdaInfixProjection"  $ classify length iflds

	classify f = List.groupBy ((==) `on` f)
		     . List.sortBy (compare `on` f)

	foo :: String -> [[String]] -> [(Int, String)]
	foo cat = map (length . head /\ match cat)

toVim :: NamesInScope -> String
toVim ns = unlines $ matches mcons micons mdefs midefs mflds miflds
    where
	cons = [ x | (x, def:_) <- Map.toList ns, anameKind def == ConName ]
	defs = [ x | (x, def:_) <- Map.toList ns, anameKind def == DefName ]
	flds = [ x | (x, fld:_) <- Map.toList ns, anameKind fld == FldName ]

	mcons = map show cons
	mdefs = map show defs
	mflds = map show flds

	micons = concatMap parts cons
	midefs = concatMap parts defs
	miflds = concatMap parts flds

	parts (NoName _ _) = []
	parts (Name _ [_]) = []
	parts (Name _ ps)  = [ x | Id x <- ps ]

generateVimFile :: FilePath -> TCM ()
generateVimFile file = do
    scope <- getScope
    liftIO $ UTF8.writeFile (vimFile file) $ toVim $ names scope
    where
	names = nsNames . everythingInScope