-- |Exports an instance for 'WxGen' [a]. It handles [Char] instances specially.
module Graphics.UI.WxGeneric.GenericList
    ( 
    )
where

import Graphics.UI.SybWidget.MySYB(gToString)
import Graphics.UI.SybWidget.InstanceCreator

import Graphics.UI.WxGeneric.GenericClass
import Graphics.UI.WxGeneric.GenericWidget

import Graphics.UI.WX as Wx
import Graphics.UI.XTC

import Data.Maybe
import Control.Monad
import Data.List(partition)

instance (WxGen a, Show a) => WxGen [a] where
    mkWid xs = (mkListOuter `extOuter` mkStringOuter) xs

mkStringOuter :: String -> Outer String
mkStringOuter x = toOuter helper where
    helper p = do te <- textEntry p [ text := x ]
                  return $ mkSingleObservable te (get te text) (\val -> set te [ text := val ])

mkListOuter :: (WxGen a, Show a) => [a] -> Outer [a]
mkListOuter xs = toOuter (valuedCompose helper) where
    helper p =
        do let shortenLongLines ys = if length ys > maxListWidth
                                     then take (maxListWidth - 4) ys ++ " ..."
                                     else ys
               maxListWidth = 20
           changeVar <- varCreate (return ())
           ls <- mkMultiListViewEx p (shortenLongLines . gToString) [ typedItems := xs ]
           up     <- button p [ text := "&Up" ]
           down   <- button p [ text := "&Down" ]
           remove <- button p [ text := "&Remove" ]
           edit   <- button p [ text := "&Edit" ]
           add    <- button p [ text := "&Add" ]
           let lay = column 10 [ fill $ widget ls
                               , row 5 $ map widget [up, down, remove, edit, add]
                               ]
               whenOne [y] f = f y
               whenOne _ _   = False
               updateEnabledness =
                   do selected <- get ls selections
                      ys       <- get ls typedItems
                      set up     [ enabled := whenOne selected (> 0) ]
                      set down   [ enabled := whenOne selected (< (length ys - 1)) ]
                      set remove [ enabled := (length selected > 0) ]
                      set edit   [ enabled := (length selected == 1) ]
               setCmd wid f = set wid [ on command := 
                                           do selected <- get ls selections
                                              items'   <- get ls typedItems
                                              res <- f selected items'
                                              case res of
                                                Nothing -> return ()
                                                Just (newItems, newSel) ->
                                                    do set ls [ typedItems := newItems
                                                              , selections := newSel
                                                              ]
                                                       updateEnabledness
                                                       join (varGet changeVar)
                                      ]
           let upCmd [i] items' | i > 0  = return $ Just (swapItems i (i-1) items', [i-1])
               upCmd _ _ = return Nothing
           setCmd up upCmd

           let downCmd [i] items' | i < (length items' - 1)
                   = return $ Just (swapItems  i (i+1) items', [i+1])
               downCmd _ _ = return Nothing
           setCmd down downCmd
           
           let removeCmd selected items' =
                   return $ Just ( snd $ splitWithIndices selected items', [])
           setCmd remove removeCmd

           let addCmd Nothing  = errorDialog p "Internal error" "Could not create base instance"
               addCmd (Just x) = do y <- modalValuedDialog p "Adding element" "&Add" x
                                    case y of
                                      Nothing -> return ()
                                      Just y' -> do set ls [ typedItems :~ (++ [y'])
                                                           , selections := []
                                                           ]
                                                    updateEnabledness
                                                    join (varGet changeVar)
           set add [ on command := addCmd (createInstance' wxGenCtx (head xs)) ]

           let editCmd [s] items' =
                   do x <- modalValuedDialog p "Editng element" "&Ok" (items' !! s)
                      case x of
                        Nothing -> return Nothing
                        Just x' -> return $ Just (replace x' s items', [s])
               editCmd _ _ = return Nothing
           setCmd edit editCmd
           
           set ls [ on select := updateEnabledness >> propagateEvent ]
           updateEnabledness
           return ( lay, get ls typedItems, \ys -> set ls [typedItems := ys]
                  , varGet changeVar, varSet changeVar)

-- |Splits a list in two parts, according to the indices
-- parameter. The first is the indices, the second are the rest of
-- list.
splitWithIndices :: [Int] -> [a] -> ([a], [a])
splitWithIndices indices xs = 
    let (toTake, toLeave) = partition move $ zip [0..] xs
        move (x, _) = elem x indices
    in (map snd toTake, map snd toLeave)
                            

-- |Replaces an item in a list. 
replace :: a       -- ^ The new item. 
        -> Int     -- ^ Index (starting at 0) to replace. Must be less than the lists length.
        -> [a] -> [a]
replace x index xs = take index xs ++ [x] ++ drop (index + 1) xs

-- |Replaces an item in a list. 
swapItems :: Int     -- ^ First index (starting at 0) to swap. Must be less than the lists length.
          -> Int     -- ^ Second index (starting at 0) to replace. Must be less than the lists length.
          -> [a] -> [a]
swapItems first second xs =
    replace (xs !! second) first $ replace (xs !! first) second xs