tabloid-0.3: LineSplitterController.hs

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))