{-
    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, lookup)
import Data.Maybe (fromJust)
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, label, usevbox, textvuf, savebutton, quitbutton)
	    <- useFlagsWindow
	-- Take each of the useflags into the proper radio buttons panel.
	radiolist <- takeFlagsToRadio usevbox 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 :: [(String, VBox)] -> [String] -> IO [RadioFlag]
takeFlagsToRadio usevbox flags =
    do
      let useflags = ltouseflag flags
      mapM (\ x@(UseFlag flag _ ) ->
                case flag of
                  name | f 'a' name -> radio (lookupkey "a" usevbox) x
                       | f 'b' name -> radio (lookupkey "b" usevbox) x
                       | f 'c' name -> radio (lookupkey "c" usevbox) x
                       | f 'd' name -> radio (lookupkey "d" usevbox) x
                       | f 'e' name -> radio (lookupkey "e" usevbox) x
                       | f 'f' name -> radio (lookupkey "f" usevbox) x
                       | f 'g' name -> radio (lookupkey "g" usevbox) x
                       | f 'h' name -> radio (lookupkey "h" usevbox) x
                       | f 'i' name -> radio (lookupkey "i" usevbox) x
                       | f 'j' name -> radio (lookupkey "j" usevbox) x
                       | f 'k' name -> radio (lookupkey "k" usevbox) x
                       | f 'l' name -> radio (lookupkey "l" usevbox) x
                       | f 'm' name -> radio (lookupkey "m" usevbox) x
                       | f 'n' name -> radio (lookupkey "n" usevbox) x
                       | f 'o' name -> radio (lookupkey "o" usevbox) x
                       | f 'p' name -> radio (lookupkey "p" usevbox) x
                       | f 'q' name -> radio (lookupkey "q" usevbox) x
                       | f 'r' name -> radio (lookupkey "r" usevbox) x
                       | f 's' name -> radio (lookupkey "s" usevbox) x
                       | f 't' name -> radio (lookupkey "t" usevbox) x
                       | f 'u' name -> radio (lookupkey "u" usevbox) x
                       | f 'v' name -> radio (lookupkey "v" usevbox) x
                       | f 'w' name -> radio (lookupkey "w" usevbox) x
                       | f 'x' name -> radio (lookupkey "x" usevbox) x
                       | f 'y' name -> radio (lookupkey "y" usevbox) x
                       | f 'z' name -> radio (lookupkey "z" usevbox) x
                       | otherwise -> radio (lookupkey "S" usevbox) x) useflags
        where
          f = (flip (.) head) . (==)
          ltouseflag = nub . map toUseFlag . filter (not . null) . sort
          lookupkey k = fromJust . lookup k

useFlagsWindow :: IO (Window, Label, [(String, VBox)], 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
    -- 
    -- These are the different vboxes containing each of
    -- the use flags inside notebook panels sorted by the
    -- first letter alphabetically.
    --
    vboxA <- vBoxNew False 0
    scrollA <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollA vboxA

    vboxB <- vBoxNew False 0
    scrollB <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollB vboxB

    vboxC <- vBoxNew False 0
    scrollC <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollC vboxC

    vboxD <- vBoxNew False 0
    scrollD <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollD vboxD

    vboxE <- vBoxNew False 0
    scrollE <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollE vboxE

    vboxF <- vBoxNew False 0
    scrollF <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollF vboxF

    vboxG <- vBoxNew False 0
    scrollG <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollG vboxG

    vboxH <- vBoxNew False 0
    scrollH <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollH vboxH

    vboxI <- vBoxNew False 0
    scrollI <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollI vboxI

    vboxJ <- vBoxNew False 0
    scrollJ <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollJ vboxJ

    vboxK <- vBoxNew False 0
    scrollK <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollK vboxK

    vboxL <- vBoxNew False 0
    scrollL <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollL vboxL

    vboxM <- vBoxNew False 0
    scrollM <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollM vboxM

    vboxN <- vBoxNew False 0
    scrollN <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollN vboxN

    vboxO <- vBoxNew False 0
    scrollO <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollO vboxO

    vboxP <- vBoxNew False 0
    scrollP <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollP vboxP

    vboxQ <- vBoxNew False 0
    scrollQ <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollQ vboxQ

    vboxR <- vBoxNew False 0
    scrollR <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollR vboxR

    vboxS <- vBoxNew False 0
    scrollS <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollS vboxS

    vboxT <- vBoxNew False 0
    scrollT <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollT vboxT

    vboxU <- vBoxNew False 0
    scrollU <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollU vboxU

    vboxV <- vBoxNew False 0
    scrollV <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollV vboxV

    vboxW <- vBoxNew False 0
    scrollW <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollW vboxW

    vboxX <- vBoxNew False 0
    scrollX <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollX vboxX

    vboxY <- vBoxNew False 0
    scrollY <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollY vboxY

    vboxZ <- vBoxNew False 0
    scrollZ <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollZ vboxZ

    vboxSpecial <- vBoxNew False 0
    scrollSpecial <- scrolledWindowNew Nothing Nothing
    scrolledWindowAddWithViewport scrollSpecial vboxSpecial
    -- Use Flags panels assoc list.
    let usevbox = [("a", vboxA), ("b", vboxB), ("c", vboxC)
                  , ("d", vboxD), ("e", vboxE), ("f", vboxF)
                  , ("g", vboxG), ("h", vboxH), ("i", vboxI)
                  , ("j", vboxJ), ("k", vboxK), ("l", vboxL)
                  , ("m", vboxM), ("n", vboxN), ("o", vboxO)
                  , ("p", vboxP), ("q", vboxQ), ("r", vboxR)
                  , ("s", vboxS), ("t", vboxT), ("u", vboxU)
                  , ("v", vboxV), ("w", vboxW), ("x", vboxX)
                  , ("y", vboxY), ("z", vboxZ), ("S", vboxSpecial)]
    -- Add each use flag box to the respective panel.
    mapM_ (\ (a, b) -> notebookAppendPage notebook a b)
          [ (scrollA, "A"), (scrollB, "B"), (scrollC, "C")
          , (scrollD, "D"), (scrollE, "E"), (scrollF, "F")
          , (scrollG, "G"), (scrollH, "H"), (scrollI, "I")
          , (scrollJ, "J"), (scrollK, "K"), (scrollL, "L")
          , (scrollM, "M"), (scrollN, "N"), (scrollO, "O")
          , (scrollP, "P"), (scrollQ, "Q"), (scrollR, "R")
          , (scrollS, "S"), (scrollT, "T"), (scrollU, "U")
          , (scrollV, "V"), (scrollW, "W"), (scrollX, "X")
          , (scrollY, "Y"), (scrollZ, "Z"), (scrollSpecial, "Special") ]
    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, label, usevbox, 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)