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 (addRow)
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}
        setParseNumbers p b = p {tryParsingNumbers = 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]
               ,[ Label $ __ "Try parsing numbers"
                , Widget $ CheckBox "" tryParsingNumbers setParseNumbers]]
        , Modifier Center $ Row 
                       [ Widget $ DefaultButton (__ "&Import") ()
                       , cancelButton]]

importCsvFile :: Parameters -> FilePath -> Controller ()
importCsvFile params filePath = do
  Grid.new Nothing
  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 (getCellInput params) $ tail csvValues
                  else map (getCellInput params) csvValues
    in 
      addRow (label,rowData)            

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

getCellInput :: Parameters -> String -> String
getCellInput params =
    let mayParseNumber x = 
            if tryParsingNumbers params
            then case maybeRead x :: Maybe Double of
                   Just number -> show number
                   Nothing -> show x
            else show x
    in
      mayParseNumber . mayStripWhitespace params