packages feed

lhae-0.0.2: src/Controller/Menu/File/Open.hs

module Controller.Menu.File.Open (eventHandler)
    where

import Control.Monad (forM_)
import Control.Monad.Trans (liftIO)
import qualified Graphics.UI.WXCore as WXC
import Controller (Controller,onGridView,onGridModel)
import qualified Controller.Grid as Grid
import Controller.Menu.Table.Add (addRow,addColumn)
import Controller.Canonical (writeRowData)
import Controller.Dialog (openFileDialog,warning)
import Model.Grid (resizeTo)
import Util (justWhen)
import Util.Sexp (Sexp(..),ValidSexp(..),parseFile,validate)
import I18n (__)

eventHandler :: Controller ()
eventHandler = do
  result <- openFileDialog (__ "Open") [(__ "Tables",["*.table"])]
  justWhen result openFile

validTableSexp :: ValidSexp
validTableSexp = 
    ValidList [ ValidListOf ValidAtom
              , ValidListOf ValidAtom
              , ValidListOf $ ValidListOf ValidAtom
              ]

invalidFile :: FilePath -> String -> Controller ()
invalidFile filePath msg =
    warning $ unwords [__ "Invalid file",filePath ++ ":",msg]

openFile :: FilePath -> Controller ()
openFile filePath = do
  content <- liftIO $ parseFile filePath
  case content of
    Left error -> invalidFile filePath error 
    Right sexp -> if validate validTableSexp sexp == True
                  then loadTable filePath sexp
                  else invalidFile filePath $ __ "Invalid s-expression"

loadTable :: FilePath -> Sexp -> Controller ()
loadTable filePath (List [List rows,List cols,List cells]) = do
  Grid.new $ Just filePath
  onGridView WXC.gridBeginBatch
  onGridModel $ resizeTo (length rows,length cols)

  forM_ rows $ \(Atom a) -> addRow $ Just a
  forM_ cols $ \(Atom a) -> addColumn $ Just a
  loadCells cells
      
  onGridView WXC.gridEndBatch
  Grid.markAsSaved
  
loadCells :: [Sexp] -> Controller ()
loadCells rows = do
  forM_ (zip [0..] rows) $ \(r,List row) ->
      writeRowData r $ map (\(Atom value) -> value) row