module RegexDefinitionController ( test , Controller , new , onUpdate , view ) where import qualified Graphics.UI.Gtk.ModelView as MV import qualified RegexDefinitionView as View import qualified Data.ByteString.Lazy.Char8 as L import SimpleRegex import Component import Graphics.UI.Gtk import Data.IORef import Data.Maybe import Data.List import Control.Monad import Control.Applicative import Control.Concurrent import WindowedApp import qualified LoadSaveController as LSC type Controller = Ref C view = View.mainWidget . gui new = do lsc <- LSC.new (Just "regex") lscv <- (lsc .> LSC.view) v <- View.new lscv this <- newRef $ C Nothing v Nothing lsc .< (LSC.onLoad (Just (\cont -> (this .<< (\state -> do entrySetText (View.regexE (gui state)) (L.unpack cont) onCh state))))) lsc .< (LSC.onSave (Just (this .>> (\state -> Just <$> L.pack <$> (entryGetText $ View.regexE (gui state)))))) (View.regexE v) `onEntryActivate` (this .>> onAct) (View.regexE v) `onEditableChanged` (do lsc .>> LSC.clearLabel this .<< onCh) (View.applyB v) `onClicked` (this .>> onAct) (View.applyB v) `widgetSetSensitivity` False return this onUpdate :: Maybe ((Maybe (Regex,String)) -> IO ()) -> C -> C onUpdate ma c = c { regexUpdateCB = ma } -- internal main state record data C = C { regexUpdateCB :: Maybe (Maybe (Regex, String) -> IO ()) , gui :: View.ViewState , currentRegex :: Maybe (Regex, String) } -- internal callbacks and functions onAct :: C -> IO () onAct c = do case regexUpdateCB c of Just uf -> uf (currentRegex c) _ -> return () onCh :: C -> IO C onCh c = do str <- entryGetText $ View.regexE (gui c) res <- compileWithError str let v = gui c c' <- case res of Right r -> do labelSetText (View.errorL (gui c)) "" (View.applyB v) `widgetSetSensitivity` (str /= "") return (c {currentRegex = Just (r, str)}) Left err -> do labelSetText (View.errorL (gui c)) err (View.applyB v) `widgetSetSensitivity` False return (c {currentRegex = Nothing}) return c' -- tests test = windowedApp "RegexDefinitionController test" $ do clut <- new clut .< onUpdate $ Just (\r -> case r of Nothing -> putStrLn "not ok" Just (_,str) -> putStrLn $ "ok" ++ str) mw <- View.mainWidget <$> (clut .> gui) return mw