packages feed

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

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

import Control.Monad (forM_)
import Control.Monad.Trans (liftIO)
import Controller (Controller,onGridModel)
import qualified Controller.Grid as Grid
import Controller.Cell (showSelectedContent)
import Controller.Canonical (writeRowInput)
import Controller.Dialog (openFileDialog,warning)
import Model.Grid (resizeTo,save)
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 do loadTable filePath sexp
                          showSelectedContent
                  else invalidFile filePath $ __ "Invalid s-expression"

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

    Grid.addRows $ map (\(Atom a) -> a) rows
    Grid.addColumns $ map (\(Atom a) -> a) cols
    loadCells cells
      
  onGridModel $ save filePath
  
loadCells :: [Sexp] -> Controller ()
loadCells rows = do
  forM_ (zip [0..] rows) $ \(r,List row) ->
      writeRowInput r $ map (\(Atom value) -> value) row