BarChart.hs

module Controller.Menu.File.Export.Diagram.BarChart (eventHandler)
    where

import Control.Applicative ((<$>))
import Control.Monad (when)
import Text.Printf (printf)
import Data.List (transpose)
import Controller (Controller,getFromConfig,onView
                  ,onGridView,setOnConfig)
import Controller.Menu.File.Export.Diagram.BarChartParameters 
    (Parameters(..),gnuplotLegend,legendFromInt,intFromLegend,legendList)
import qualified Controller.Menu.File.Export.Diagram.Common as Common
import Controller.Dialog (nonNumericDataWarningText
                         ,noColumnsSelectedText,saveFileDialog)
import Config (barChartExportParameters)
import View.Component.Grid (getRowLabels,getColumnLabels)
import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..)
                           ,showDialog,cancelButton)
import Util.FileType (justPngWildcard)
import I18n (__)

data Action = Preview | Export

eventHandler :: Controller ()
eventHandler = getFromConfig barChartExportParameters 
               >>= \params -> eventHandlerWith $ params {columns = []}

eventHandlerWith :: Parameters -> Controller ()
eventHandlerWith initParams = do
  result <- do d <- dialog <$> onGridView getColumnLabels
               onView $ showDialog (__ "Export") d initParams
  case result of
    Nothing -> return ()
    Just (params,Export) ->         
        do saveFile <- saveFileDialog (__ "Export") justPngWildcard
           setOnConfig $ \c -> c {barChartExportParameters = params}
           case saveFile of
             Nothing -> eventHandlerWith params
             Just imageFilePath -> 
                 do success <- Common.plot (gpFileContent params) 
                               (dataFileContent params) imageFilePath
                    when (not success) $ eventHandlerWith params

    Just (params,Preview) ->
        do setOnConfig $ \c -> c {barChartExportParameters = params}
           _ <- Common.showPreview (gpFileContent params) 
                                   (dataFileContent params)
           eventHandlerWith params

dialog :: [String] -> Layout Parameters Action
dialog columnLabels =
    let setCols p cols = p {columns = cols}
        setBarWidth p w = p {barWidth = w}
        setGaps p g = p {gaps = g}
        setLegend p i = p {legend = legendFromInt i}
    in
      Modifier Margin $ Column 
       [ Row [ Grid [[ Label $ __ "Bar width"
                     , Widget $ NumberEntry barWidth setBarWidth]
                    ,[ Label $ __ "Gaps"
                     , Widget $ Spinner 0 maxBound gaps setGaps]
                    ,[ Label $ __ "Legend"
                     , Widget $ Choice legendList 
                                  (intFromLegend . legend) setLegend]
                    ]
             , Modifier Center $ Modifier (Boxed $ __ "Columns") 
                 $ Widget $ MultiListBox columnLabels columns setCols
             ]
       , Modifier Center $ Row 
                      [ Widget $ DefaultButton (__ "&Export ...") Export
                      , Widget $ Button (__ "&Preview ...") Preview
                      , cancelButton]]

dataFileContent :: Parameters -> Controller (Either String String)
dataFileContent (Parameters {columns = []}) = return $ Left noColumnsSelectedText
dataFileContent (Parameters {columns = cols}) = do
  numericColumns <- Common.getNumericColumns cols
  case numericColumns of
    Left nonNumeric -> return $ Left $ nonNumericDataWarningText nonNumeric
    Right columns -> 
        do rowLabels <- onGridView getRowLabels
           let firstLine = "\"\"" : rowLabels
               columnToLine (label,values) = label:(map show values)
               dataLines = map columnToLine columns
               lines = transpose $ firstLine : dataLines
           return $ Right $ unlines $ map unwords lines

gpFileContent :: Parameters -> FilePath -> String
gpFileContent params dataFilePath = 
    printf (unlines
      [ "set key %s top"
      , "set style data histogram"
      , "set style histogram clustered gap %d"
      , "set boxwidth %f"
      , "set style fill solid"
      , "plot for [COL=2:%d] \"%s\" using COL:xtic(1) title columnhead"
      ])
    (gnuplotLegend $ legend params) (gaps params) (barWidth params)
    (1 + (length $ columns params)) dataFilePath