tabloid-0.44: DataProcController.hs

module DataProcController 
    ( new
    , view
    , Controller
    , onUpdate
    , Haskell.Env
    ) where

import Graphics.UI.Gtk
import Control.Monad
import Control.Applicative

import qualified DataProcView as View
import qualified ShellCmdInputController as Shell
import qualified HaskellCmdInputController as Haskell
import qualified LineSplitterController as RxDef
import qualified TableController as Table
import qualified Data.Map as M

import qualified Data.ByteString.Lazy.Char8 as L
import SimpleRegex
import Data.Maybe
import WindowedApp
import Component

type Controller = Ref C

view = View.mainWidget . gui

new :: IO Haskell.Env -> IO Controller
new env = do
  s <- Shell.new
  r <- RxDef.new
  t <- Table.new
  h <- Haskell.new env
  sv <- (s.>Shell.view) 
  rv <- (r.>RxDef.view) 
  tv <- (t.>Table.view)
  hv <- (h.>Haskell.view)
  g@(View.V _ _ _ _ useShellRB useHaskellRB) <- View.new sv rv tv hv
  toggleButtonSetActive useShellRB True
  toggleButtonSetActive useHaskellRB False
  this <- newRef $ C g s r t RxDef.defaultFilter Nothing
  onToggled useHaskellRB (this .<< switchViews)
  s .< Shell.onUpdate 
        (Just (\lines -> this .>> showData lines))
  r .< RxDef.onUpdate 
        (Just (\filt -> do
                   this .< (\stat -> stat {filterFun = filt})
                   postGUIAsync $ s .<< Shell.runText))
  h .< Haskell.onUpdate (Just (\lines ->
                                   Table.push t ((map L.pack) <$> lines)))
  return this

onUpdate :: (Maybe ([[String]] -> IO ())) -> C -> C
onUpdate f state = state {updateCB = f}

-- internal

switchViews :: C -> IO C
switchViews state = do
  useHaskell <- toggleButtonGetActive $ View.useShellRB (gui state)
  let cont = View.shellOrHaskellContainer (gui state)
  let hs = View.shellView (gui state)
  let sh = View.haskellView (gui state)
  [c] <- containerGetChildren cont
  containerRemove cont c
  boxPackStart cont (if useHaskell then hs else sh) PackGrow 2
  widgetShowAll cont
  return state

showData :: L.ByteString -> C -> IO ()
showData x state = do
  content <- (filterFun state x) 
  when (isJust (updateCB state)) 
           ((fromJust (updateCB state)) (((map L.unpack) <$>) content))
  Table.push (table state) content

data C = C {
      gui :: View.ViewState
    , shell :: Shell.Controller
    , rxdef :: RxDef.Controller
    , table :: Table.Controller
    , filterFun :: RxDef.Filter
    , updateCB :: Maybe ([[String]] -> IO ()) 
    }

-- tests
test = windowedApp "DataProcController test" $ do
         t <- new (return M.empty) :: IO Controller
         t .> view