-- | An integer list editor
module GUI.MLens.Gtk.Demos.IntListEditor where

import GUI.MLens.Gtk

import Control.Monad
import qualified Control.Arrow as Arrow
import Data.List
import Data.Function (on)
import Prelude hiding ((.), id)

---------------

intListEditor
    :: (Functor m, ExtRef m)
    => Ref m String         -- ^ state reference
    -> Ref m String         -- ^ settings reference
    -> I m
intListEditor state settings = Action $ do
    list <- extRef state showLens []
    (undo, redo)  <- undoTr ((==) `on` map fst) list
    range <- extRef settings showLens True
    let safe = lens id (const . take maxi)
        len = joinML $ \_ -> readRef range >>= \r -> return $ lens length $ extendList r . min maxi
        sel = liftM (filter snd) $ readRef list
    return $ Notebook
        [ (,) "Editor" $ vcat
            [ hcat
                [ Entry $ showLens . len . list
                , smartButton (return "+1") (modL len (+1))      list
                , smartButton (return "-1") (modL len (+(-1)))   list
                , smartButton (toFree $ liftM (("DeleteAll " ++) . show) $ readRef $ len . list) (modL len $ const 0) list
                , Button (return "undo") $ toFree undo
                , Button (return "redo") $ toFree redo
                ]
            , hcat
                [ sbutton (return "+1")         (map $ mapFst (+1))           list
                , sbutton (return "-1")         (map $ mapFst (+(-1)))        list
                , sbutton (return "sort")       (sortBy (compare `on` fst))   list
                , sbutton (return "SelectAll")  (map $ mapSnd $ const True)   list
                , sbutton (return "SelectPos")  (map $ \(a,_) -> (a, a>0))    list
                , sbutton (return "SelectEven") (map $ \(a,_) -> (a, even a)) list
                , sbutton (return "InvertSel")  (map $ mapSnd not)            list
                , sbutton (toFree $ liftM (("DelSel " ++) . show . length) sel) (filter $ not . snd) list
                , smartButton (return "CopySel") (modL safe $ concatMap $ \(x,b) -> (x,b): [(x,False) | b]) list
                , sbutton (return "+1 Sel")     (map $ mapSel (+1))           list
                , sbutton (return "-1 Sel")     (map $ mapSel (+(-1)))        list
                ]
            , Label $ toFree $ liftM (("Sum: " ++) . show . sum . map fst) sel
            , Action $ listEditor def (itemEditor list) list
            ]
        , (,) "Settings" $ hcat
            [ Label $ return "Create range"
            , Checkbox range
            ]
        ]
 where
    itemEditor list i r = return $ hcat
        [ Label $ return $ show (i+1) ++ "."
        , Entry $ showLens . fstLens . r
        , Checkbox $ sndLens . r
        , Button (return "Del")  $ return $ Just $ modRef list (\xs -> take i xs ++ drop (i+1) xs)
        , Button (return "Copy") $ return $ Just $ modRef list (\xs -> take (i+1) xs ++ drop i xs) ]

    extendList r n xs = take n $ (reverse . drop 1 . reverse) xs ++
        (uncurry zip . ((if r then enumFrom else repeat) Arrow.*** repeat)) (head $ reverse xs ++ [def])

    def = (0, True)
    maxi = 15

    sbutton s f k = smartButton s (return . f) k

    mapFst f (x, y) = (f x, y)
    mapSnd f (x, y) = (x, f y)
    mapSel f (x, y) = (if y then f x else x, y)


listEditor :: ExtRef m => a -> (Int -> Ref m a -> m (I m)) -> Ref m [a] -> m (I m)
listEditor def ed = editor 0 where
  editor i r = liftM Action $ memoRead $ do
    q <- extRef r listLens (False, (def, []))
    t1 <- ed i $ fstLens . sndLens . q
    t2 <- editor (i+1) $ sndLens . sndLens . q
    return $ Cell True (liftM fst (readRef q)) $ \b -> vcat $ if b then [t1, t2] else []