module TableController ( Controller , test , new , view , push ) where import qualified Data.ByteString.Lazy.Char8 as L import qualified Graphics.UI.Gtk.ModelView as MV import qualified LoadSaveController as LSC import qualified TableView as View import Graphics.UI.Gtk import Data.Maybe import Data.List import SimpleRegex import Control.Monad import Control.Applicative import WindowedApp import Component type Controller = Ref C type StringList = MV.ListStore [L.ByteString] view :: C -> Widget view = View.mainWidget . gui new :: IO Controller new = do lsc <- LSC.new (Just "jira") lsv <- (lsc .> LSC.view) l <- MV.listStoreNew [] v <- View.new l lsv lsc .< (LSC.onSave (Just (Just <$> toJira l))) onClicked (View.searchPB v) (searchTableBackward (View.searchE v) l (View.treeView v)) onClicked (View.searchNB v) (searchTableForward (View.searchE v) l (View.treeView v)) View.add_col (View.treeView v) l (L.unpack . (!! 0)) "Line" 0 this <- newRef (C v l 1 Nothing) onToggled (View.groupB v) (this .<< updateGrouping) onValueSpinned (View.groupE v) (this .<< updateGrouping) return this push this rows = this .<< \s -> case groupCol s of Nothing -> pushRaw (zipWith (:) (map (L.pack . show) [1..]) rows) s Just (c, _) -> pushRaw (zipWith (:) (map (L.pack . show) [1..]) rows) (s {groupCol = Just (c, rows)}) -- internal functions groupRows [] _ = [] groupRows (row:rows) col = row : sameGroup ++ groupRows rest col where cell = row !! col (sameGroup, rest) = partition ((== cell) . (!! col)) rows updateGrouping state@(C g listM mc gCol) = do col <- spinButtonGetValueAsInt (View.groupE g) grouping <- toggleButtonGetActive (View.groupB g) if grouping then do rows <- MV.listStoreToList listM case gCol of Nothing -> pushRaw rows (state { groupCol = Just (col, rows)}) Just (ccol, crows) -> pushRaw crows (state { groupCol = Just (col, crows)}) else case gCol of Nothing -> return (state { groupCol = Nothing }) Just (ccols, crows) -> pushRaw crows (state { groupCol = Nothing}) searchTableBackward entry liststore treeview = do selI <- getSelectedRow treeview rows' <- MV.listStoreToList liststore let rows = reverse $ zip [0..] (take selI rows') searchRowRange rows entry treeview searchTableForward entry liststore treeview = do selI <- getSelectedRow treeview rows' <- MV.listStoreToList liststore let rows = zip [(selI + 1) ..] (drop (selI + 1) rows') searchRowRange rows entry treeview searchRowRange rows entry treeview = do searchTerm <- entryGetText entry let sI = filter (any (isInfixOf searchTerm) . (map L.unpack) . snd) rows case sI of ((nexti, _):_) -> do MV.treeViewSetCursor treeview [nexti] Nothing _ -> beep getSelectedRow treeV = do tsel <- MV.treeViewGetSelection treeV sel <- MV.treeSelectionGetSelectedRows tsel return $ case sel of ((fst_sel:_):_) -> fst_sel _ -> 0 toCsv liststore = withRows liststore (formatLine [('"', L.pack "\"\"")] (L.pack "\"") (L.pack ";")) toJira liststore = withRows liststore (((pipeSym `L.append`) . (`L.append` pipeSym)) . (formatLine [] L.empty pipeSym)) where pipeSym = L.pack "|" withRows :: StringList -> ([L.ByteString] -> L.ByteString) -> IO L.ByteString withRows liststore action = do cont <- MV.listStoreToList liststore return (L.unlines (action <$> cont)) formatLine repl quot sep = (intercal sep) . (map $ embedString quot) . (map $ replaceChars repl) embedString :: L.ByteString -> L.ByteString -> L.ByteString embedString es = (es `L.append`) . (`L.append` es) intercal :: L.ByteString -> [L.ByteString] -> L.ByteString intercal = (L.concat .) . intersperse replaceChars :: [(Char,L.ByteString)] -> L.ByteString -> L.ByteString replaceChars tab = L.foldl' (\s c -> s `L.append` fromJust (lookup c tab `mplus` Just (L.pack [c]))) L.empty pushRaw :: [[L.ByteString]] -> C -> IO C pushRaw rows c@(C g listM mc groupCol) = let addRows n [] = return n addRows n (r:rs) = do let r' = length r when (r' > n) $ forM_ [n .. r' - 1] (\i -> View.add_col (View.treeView g) listM (at i) ("$" ++ show i) i) (MV.listStoreAppend listM) r addRows (max n r') rs at :: Int -> [L.ByteString] -> String at i xs | (length xs) <= i = "" | otherwise = L.unpack $ xs !! i in do (MV.listStoreClear listM) rowcount <- spinButtonGetValueAsInt (View.maxLines g) let groupedRows = maybe selRows (groupRows selRows . fst) groupCol selRows = (take rowcount rows) cs <- addRows mc groupedRows spinButtonSetRange (View.groupE g) 0 (fromIntegral (cs - 1)) return (c { cols = cs }) data C = C { gui :: View.ViewState , listModel :: StringList , cols :: Int , groupCol :: Maybe (Int, [[L.ByteString]]) } -- tests test = windowedApp "TableController test" $ do t <- new :: IO Controller t `push` [[(L.pack . show) (c `rem` 3)| c <- [r .. r + 10]] | r <- [0 .. 9]] t .> view