{-
    Functions to work around the USE flags.
    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-}

module UseFlag where

import Graphics.UI.Gtk
import Util
import Data.List (sort, nub, groupBy)
import Data.Char (isSpace)

type Variable = String
type Value = String
type AddType = String -> [RadioFlag] -> [EnvValues] -> IO String

data UseFlag = UseFlag String String
data RadioFlag = Radio String [RadioButton]
data EnvValues = EnvValue Variable Value | Comment String
                 deriving Show

instance Eq UseFlag where
    UseFlag use _ == UseFlag use' _ = use == use'

useflagpath, localuseflagpath :: FilePath
useflaglabel :: String
useflagpath = "/usr/portage/profiles/use.desc"
localuseflagpath = "/usr/portage/profiles/use.local.desc"
useflaglabel = "Use Flags Enabled/Disabled:\n"

allUseFlags :: IO [String]
allUseFlags = 
    do
    flags <- readGlobalFlagFile useflagpath
    localflags <- readLocalFlagFile localuseflagpath
    return (flags ++ localflags)

globalUseFlags :: IO () 
globalUseFlags = allUseFlags >>= 
		 mapM (return . parseLocalUSE) >>=
		 useFlag makeconfpath addAtConf "USE"

parseLocalUSE :: String -> String
{- Test for local use flags and parse from <cat/pkg>:<use> <desc> to 
   <use> <desc>. -}
parseLocalUSE use = 
    let (_, t) = break (== ':') $ takeWhile (/= ' ') use
	in
	case t of
	   [] -> use
	   _ -> tail $ dropWhile(/= ':') use

pkgUseFlags :: String -> [String] -> IO ()
pkgUseFlags = useFlag packageuse addAtPkgUse

useFlag :: FilePath -> AddType 
	-> (String -> [String] -> IO ())
{- | Setup the USE flag window with the variable information. -}
useFlag usefile addfunc = usef
    where
    usef token [] =
	popSelectWindow msg (allUseFlags >>= useFlag usefile addfunc token)
	    where
	    msg = "No ebuild use flag information.\nOpen the global use\
		  \ flag editor for this package?."
    usef token useflags =
	do
	(window, notebook, label, textvuf, savebutton, quitbutton)
	    <- useFlagsWindow
	-- Take each of the useflags into the proper radio buttons panel.
	radiolist <- takeFlagsToRadio notebook useflags
        -- Read the make.conf or package.use flag, depending
	-- if we are using the global use flag editor or the
	-- package specific use flag editor.
	b <- readFileIfExist usefile
	case b of
          [] -> popErrorWindow (usefile ++ " error reading file.")
	  xs -> do
	       let char = (if token == "USE" then '=' else ' ')
	       -- Parse the configuration files.
               let usefileparsed = parseConf $ map (dropWhile isSpace) $ lines xs
	       envvalues <- mkEnvValues char usefileparsed
	       updateTextBuffer textvuf $ getcurrentflags envvalues
	       -- activate use flags.
	       mapM_ (activateUseFlags token (words $ getEnvValue token envvalues)) radiolist
	       labelSetMarkup label ("<i>Listing " ++ (show (length radiolist))
				   ++ " flags for " ++ token ++ "</i>")
	       savebutton `onClicked`
			  popSelectWindow "Do you want to save this USE flags setup?"
                                          (do
					   addfunc token radiolist envvalues >>= 
					       writeFileIfExist usefile
					   ys <- readFileIfExist usefile
					   (if null b
					       then mkEnvValues char usefileparsed
					       else mkEnvValues char (lines ys)) >>=
					       updateTextBuffer textvuf . getcurrentflags)
	       quitbutton `onClicked` widgetDestroy window >> return ()
	       {- Main creation call routine for hUFE -}
               widgetShowAll window
		   where
		   -- Current USE flags setup. Add a newline for pretty printing.
		   getcurrentflags = unwords . map (++ "\n") . words . getEnvValue token

toUseFlag :: String -> UseFlag
toUseFlag xs = let (use, (_:desc)) = break (== ' ') xs
		   in UseFlag use desc

activateUseFlags :: String -> [String] -> RadioFlag -> IO ()
{- Activate the radioflags for each USE flags enabled or disabled.
   Consider local use flags of the form: category/package:useflag to test for validity. -}
activateUseFlags _ [] (Radio _ (_:_:r:[])) = toggleButtonSetActive r True
activateUseFlags varpkg (('-':use):ufxs) radion@(Radio uf (_:n:_:[]))
    | (use == uf) || (use == ((last . splitStr ':') uf)) && (findSubstring ((head . splitStr ':') uf) varpkg) = toggleButtonSetActive n True
    | otherwise = activateUseFlags varpkg ufxs radion
activateUseFlags varpkg (use:ufxs) radiop@(Radio uf (p:_:_:[]))
    | (use == uf) || (use == ((last . splitStr ':') uf)) && (findSubstring ((head . splitStr ':') uf) varpkg)= toggleButtonSetActive p True
    | otherwise = activateUseFlags varpkg ufxs radiop
activateUseFlags _ _ _ = popErrorWindow "Error activating use flag buttons."

checkUseFlags :: RadioFlag -> IO String
checkUseFlags (Radio uf (p:n:_:[])) =
    do
    let f = last $ splitStr ':' uf
    b <- toggleButtonGetActive p
    if b 
       then return f
       else do
	    tb <- toggleButtonGetActive n
	    if tb then return ('-':f) else return []
checkUseFlags _ = return []

mkEnvValues :: Char -> [String] -> IO [EnvValues]
mkEnvValues sep = 
    mapM (\ xs -> if null xs || head xs == '#' || checkifknown xs
	             then return (Comment xs)
	             else do
	                  let (var, (_:val)) = break (== sep) xs
	                  return (EnvValue var val))
	where
	-- Check if the token is a valid make.conf command,
	-- so we parse correct values between make.conf and package.use
	checkifknown = flip any knowncmd . (==) . head . words
	knowncmd = ["source"]

insertVariable :: EnvValues -> [EnvValues] -> [EnvValues]
insertVariable env [] = env : []
insertVariable ins@(EnvValue var _) (out@(EnvValue var' _):exs)
    | var == var' = ins : exs
    | otherwise = out : insertVariable ins exs
insertVariable env (envvalues:xs) = envvalues : insertVariable env xs

envValuetoString :: String -> EnvValues -> String
envValuetoString _ (EnvValue _ []) = []
envValuetoString s (EnvValue var val) = var ++ s ++ val
envValuetoString _ (Comment xs) = xs

radio :: VBox -> UseFlag -> IO RadioFlag
radio vbox (UseFlag useflag desc) = 
    do
    hbox <- hBoxNew False 0
    radio1 <- radioButtonNewWithLabel "+"
    radio2 <- radioButtonNewWithLabel "-"
    radio3 <- radioButtonNewWithLabel (useflag ++ desc)
    radioButtonSetGroup radio1 radio3
    radioButtonSetGroup radio2 radio3
    toggleButtonSetActive radio3 True
    boxPackStart hbox radio1 PackNatural 0
    boxPackStart hbox radio2 PackNatural 0
    boxPackStart hbox radio3 PackNatural 0
    boxPackStartDefaults vbox hbox
    return (Radio useflag [radio1, radio2, radio3])

readGlobalFlagFile, readLocalFlagFile :: FilePath -> IO [String] 
readGlobalFlagFile = readFlagFile
readLocalFlagFile = readFlagFile

readFlagFile :: FilePath -> IO [String]
readFlagFile = (=<<) (return . filter (/= []) .
		      map (\ xs -> case xs of 
			              { [] -> [] ; ('#':_) -> [] ; ys -> ys }) .
		      lines) . readFile

parseConf :: [String] -> [String]
-- This functions takes care of properly parsing the USE flag
-- enviroment variable from the configuration files.
-- make.conf might have '\' newline separators, so fix that.
parseConf [] = []
parseConf y@(x:xs) | (not . null) x && last x == '\\' = 
		       let (a, b) = f y [] in a : parseConf b
		   | otherwise = x : parseConf xs
    where
    f [] str = (str, [])
    f (z:zs) str | last z == '\\' = f zs (str ++ init z)
		 | otherwise = (str ++ z, zs)

takeFlagsToRadio :: Notebook -> [String] -> IO [RadioFlag]
takeFlagsToRadio notebook flags =
    do
      let useflags = ltouseflag flags
      radiolist <- mapM (\ groupflags ->
                             do
                               let (UseFlag flag _) = head groupflags
                               vbox <- createFlagBox [ head flag]
                               mapM (radio vbox) groupflags) (groupFlags useflags)
      return $ concat radiolist
        where
          groupFlags = groupBy (\ (UseFlag a _) (UseFlag b _) -> (head a) == (head b))
          createFlagBox name =
              do
                vbox <- vBoxNew False 0
                scroll <- scrolledWindowNew Nothing Nothing
                scrolledWindowAddWithViewport scroll vbox
                notebookAppendPage notebook scroll name
                return vbox
          ltouseflag = nub . map toUseFlag . filter (not . null) . sort

useFlagsWindow :: IO (Window, Notebook, Label, TextView, Button, Button)
{- | Create USE Flag Window. -}
useFlagsWindow =
    do
    window <- windowNew
    mainbox <- vBoxNew False 5
    mainvbox <- vBoxNew False 9
    mainpaned <- hPanedNew
    cflagbox <- vBoxNew False 5
    (statscroll, statview) <- makeView False
    -- Add logo.
    image <- imageNewFromFile windowlogo
    boxPackStart mainbox image PackNatural 0
    -- List the current setup of USE flags.
    currentflagsvbox <- vBoxNew False 9
    boxPackStart currentflagsvbox statscroll PackGrow 0
    -- Pack the current USE flags inside a box.
    cflag <- labelNew $ Just "Current Flags Setup"
    hsep <- hSeparatorNew
    boxPackStart cflagbox cflag PackNatural 0
    boxPackStart cflagbox hsep PackNatural 0
    cframe <- frameNew
    containerAdd cframe currentflagsvbox
    boxPackStart cflagbox cframe PackGrow 3
    panedAdd1 mainpaned cflagbox
    -- The main radiobutton widget listing all
    -- the USE flags.
    notebook <- notebookNew
    notebookSetPopup notebook True
    panedAdd2 mainpaned notebook
    boxPackStart mainvbox mainpaned PackGrow 5
    -- Make main frame.
    mainframe <- makeFrame "USE Flags" 0.50 0.50
    containerSetBorderWidth mainvbox 9
    containerAdd mainframe mainvbox
    -- Add the main frame to the mainbox.
    boxPackStart mainbox mainframe PackGrow 0
    -- Usage explanation.
    label <- labelNew Nothing
    usagelabel <- labelNew $ Just "[+] Enable | [-] Disable"
    boxPackStart mainbox label PackNatural 0
    boxPackStart mainbox usagelabel PackNatural 0
    -- Create the button box: save, close.
    buttonbox <- hBoxNew False 0
    savebutton <- buttonNewFromStock stockSave
    quitbutton <- buttonNewFromStock stockClose
    -- pack the 'Save' and 'Quit' button.
    boxPackStart buttonbox savebutton PackNatural 0
    boxPackStart buttonbox quitbutton PackNatural 0
    boxPackStart mainbox buttonbox PackNatural 0
    containerAdd window mainbox
    set window [ windowTitle := "Himerge USE Flags Editor"
	       , windowDefaultWidth := 700
	       , windowDefaultHeight := 400
	       , containerBorderWidth := 5 ]
    return (window, notebook, label, statview, savebutton, quitbutton)

getEnvValue :: String -> [EnvValues] -> String
getEnvValue _ [] = []
getEnvValue pkgname ((EnvValue pkg value):xs)
    | pkgname == pkg = filter (/= '"') value
    | otherwise = getEnvValue pkgname xs
getEnvValue pkgname (_:xs) = getEnvValue pkgname xs

addAtConf, addAtPkgUse :: AddType
addAtConf = addAt "=" show id
addAtPkgUse = addAt " " id (sort . filter (/= []))

addAt :: String -> (String -> String)
      -> ([String] -> [String]) -> AddType
addAt sep func funcord = af
    where
    af value radiolist envlist =
	mapM checkUseFlags radiolist >>=
	return . unlines . funcord . map (envValuetoString sep) . 
	flip insertVariable envlist . EnvValue value . func . unwords .
	nub . filter (not . null)