packages feed

apelsin-1.0: src/FilterBar.hs

module FilterBar (newFilterBar, smartFilter) where

import Graphics.UI.Gtk
import Data.IORef
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Char8 (ByteString)
import Data.Char
import Network.Tremulous.ByteStringUtils as B

import Constants


newFilterBar :: (TreeModelClass self, TreeModelFilterClass self) => self -> Label -> String
	-> IO (HBox, IORef ByteString)
newFilterBar filtered stat initial  = do
	current <- newIORef ""
	
	-- Filterbar
	ent <- entryNew
	set ent [ widgetHasFocus	:= True
		, widgetIsFocus		:= True
		, widgetCanDefault	:= True
		, entryText		:= initial ]
	lbl <- labelNewWithMnemonic "_Filter:"
	set lbl [ labelMnemonicWidget := ent ]
	
	findbar <- hBoxNew False spacing
	boxPackStart findbar lbl PackNatural 0
	boxPackStart findbar ent PackGrow 0
	
	let f = do
		rawstr <- entryGetText ent
		let str = B.pack $ map toLower rawstr
		writeIORef current str
		treeModelFilterRefilter filtered
		n <- treeModelIterNChildren filtered Nothing
		set stat [ labelText := show n ]
		return True
	f 
	onKeyRelease ent (const f) 
		
	return (findbar, current)

	
data Expr = Is !ByteString | Not !ByteString

mkExpr :: ByteString -> Expr
mkExpr ss = case (B.head ss, B.tail ss) of
	('-', xs) | B.length xs > 0	-> Not (B.tail ss)
                  | otherwise		-> Is xs                 
	_				-> Is ss

matchExpr :: Expr -> [ByteString] -> Bool
matchExpr (Is xs)  = any (xs `B.isInfixOf`)
matchExpr (Not xs) = all (not . (xs `B.isInfixOf`))

smartFilter :: ByteString -> [ByteString] -> Bool
smartFilter raw xs = all (`matchExpr` xs) search 
	where
	search	= map mkExpr (B.splitfilter ' ' raw)