packages feed

lhae-0.0.3: src/Controller/Menu/File/Import/Csv.hs

module Controller.Menu.File.Import.Csv (eventHandler) 
    where

import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Control.Monad.Trans (liftIO)
import Controller (Controller,onView,getFromConfig,setOnConfig)
import Controller.Menu.File.Import.CsvParameters (Parameters(..))
import Controller.Dialog (openFileDialog)
import qualified Controller.Grid as Grid
import Controller.Canonical (addRowInput)
import Config (csvImportParameters)
import Util (justWhen,breakAt,maybeRead)
import qualified Util
import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..)
                           ,showSimpleDialog,cancelButton)
import I18n (__)

eventHandler :: Controller ()
eventHandler = getFromConfig csvImportParameters >>= eventHandlerWith

eventHandlerWith :: Parameters -> Controller ()
eventHandlerWith storedParams = do
  action <- onView $ showSimpleDialog (__ "Import") dialog storedParams
  justWhen action $ \params -> 
      do setOnConfig $ \c -> c {csvImportParameters = params}
         importFile <- openFileDialog (__ "Import") []
         case importFile of
           Nothing -> eventHandlerWith params
           Just file -> importCsvFile params file 

dialog :: Layout Parameters ()
dialog =
    let setColDelimiter p = maybe p (\d -> p {columnDelimiter = d}) . maybeRead
        setRowDelimiter p = maybe p (\d -> p {rowDelimiter = d}) . maybeRead
        setFirstCol p b = p {firstColumnContainsLabels = b}
        setFirstRow p b = p {firstRowContainsLabels = b}
        setStripWhitespace p b = p {stripWhitespace = b}
    in
      Modifier Margin $ Column
        [ Grid [[ Label $ __ "Column delimiter"
                , Widget $ TextEntry (show . columnDelimiter) setColDelimiter]
               ,[ Label $ __ "Row delimiter"
                , Widget $ TextEntry (show . rowDelimiter) setRowDelimiter]
               ,[ Label $ __ "First column contains labels"
                , Widget $ CheckBox "" firstColumnContainsLabels setFirstCol]
               ,[ Label $ __ "First row contains labels"
                , Widget $ CheckBox "" firstRowContainsLabels setFirstRow]
               ,[ Label $ __ "Strip whitespace"
                , Widget $ CheckBox "" stripWhitespace setStripWhitespace]]
        , Modifier Center $ Row 
                       [ Widget $ DefaultButton (__ "&Import ...") ()
                       , cancelButton]]

importCsvFile :: Parameters -> FilePath -> Controller ()
importCsvFile params filePath = do
  Grid.new
  Grid.batched $ do
    rows <- breakAt (rowDelimiter params) <$> (liftIO $ readFile filePath)
    if firstRowContainsLabels params 
     then let labels = 
                  let values = breakAt (columnDelimiter params) $ head rows
                  in
                    map (mayStripWhitespace params) values
          in do
            forM_ (tail rows) $ importRow params
            Grid.updateColumnLabels labels
     else forM_ rows $ importRow params
          
importRow :: Parameters -> String -> Controller ()
importRow params row = 
    let csvValues = breakAt (columnDelimiter params) row
        label = if firstColumnContainsLabels params
                then Just $ mayStripWhitespace params $ head csvValues
                else Nothing
        rowData = if firstColumnContainsLabels params
                  then map (mayStripWhitespace params) $ tail csvValues
                  else map (mayStripWhitespace params) csvValues
    in 
      addRowInput label rowData

mayStripWhitespace :: Parameters -> String -> String
mayStripWhitespace params = if stripWhitespace params 
                            then Util.stripWhitespace else id