module LineSplitterController ( new , test , onUpdate , view , Controller , Filter , OnUpdate , defaultFilter ) where import Graphics.UI.Gtk import Control.Monad import Control.Applicative import Data.Maybe import WindowedApp import Component import SimpleRegex import qualified LineSplitterView as View import qualified RegexDefinitionController as RxDef import qualified Data.ByteString.Lazy.Char8 as L import SimpleRegex type Controller = Ref C type Filter = L.ByteString -> IO [[L.ByteString]] type OnUpdate = Filter -> IO () view = View.mainWidget . gui new :: IO Controller new = do rx <- RxDef.new rxv <- rx .> RxDef.view v@(View.V mw dis sm ls ) <- View.new rxv this <- newRef (C v Nothing defaultFilter rxv Nothing) onToggled dis $ do disA <- toggleButtonGetActive dis unless disA $ widgetSetSensitivity rxv True when disA (this .<< updateState) rx .< RxDef.onUpdate (Just (\ s -> updateStateRx this s >> (this .<< updateState))) this .<< updateState return this onUpdate :: Maybe OnUpdate -> C -> C onUpdate u c = c { updateCB = u } -- internal functions defaultFilter :: Filter defaultFilter s = do putStrLn "defaultFilter" return (map (:[]) (L.lines s)) updateStateRx :: Ref C -> Maybe (Regex,String) -> IO () updateStateRx this rx = do putStrLn $ "got new regex: " ++ maybe "Nothing" snd rx this .< (\c -> c {regex = rx}) this .<< updateState updateState :: C -> IO C updateState state = do di <- toggleButtonGetActive (View.disableRB (gui state)) sp <- toggleButtonGetActive (View.linesplitModeRB (gui state)) sm <- toggleButtonGetActive (View.submatchModeRB (gui state)) newFilter <- case (di, sp, sm) of (_, True, _) -> do postGUIAsync $ widgetSetSensitivity (regexDefView state) True makeRegexFilterFieldSep state (_, _, True) -> do postGUIAsync $ widgetSetSensitivity (regexDefView state) True makeRegexFilterSubMatches state _ -> do postGUIAsync $ widgetSetSensitivity (regexDefView state) False return defaultFilter let newstate = (state {filterFun = newFilter}) notifyUpdateCallback newstate return newstate withMaybeRegex :: Maybe a -> (a -> Filter) -> Filter withMaybeRegex Nothing _ = defaultFilter withMaybeRegex (Just rx) f = f rx makeRegexFilterSubMatches :: C -> IO Filter makeRegexFilterSubMatches state = do return $ withMaybeRegex (regex state) (\(rx,src) indat -> do putStrLn $ "makeRegexFilterSubMatches" ++ src let sms = catSubmatches rx $ L.lines indat res = map (\ (ss, s) -> case ss of [] -> [s] _ -> ss) sms return res) makeRegexFilterFieldSep :: C -> IO Filter makeRegexFilterFieldSep state = return $ withMaybeRegex (regex state) (\(rx,src) d -> do putStrLn ("makeRegexFilterFieldSep " ++ src) let res = map (regexSplit rx) (L.lines d) return res) notifyUpdateCallback :: C -> IO () notifyUpdateCallback state = case updateCB state of Nothing -> do return () Just updateCB' -> do updateCB' (filterFun state) data C = C { gui :: View.ViewState , updateCB :: Maybe OnUpdate , filterFun :: Filter , regexDefView :: Widget , regex :: Maybe (Regex, String) } test = windowedApp "RegexDefinitionController test" $ do clut <- new mw <- View.mainWidget <$> (clut .> gui) clut .< onUpdate (Just tryNewFilter) return mw testdata = L.unlines $ L.pack <$> [concat (map ((++ ";") . show) [x * 10 .. 9 + x * 10]) | x <- [1..10]] tryNewFilter f = do res <- (f testdata) putStrLn (take 100 (show res))