{-# LANGUAGE TypeSynonymInstances, NoMonomorphismRestriction #-} {-# OPTIONS_HADDOCK hide #-} module Graphics.GChart.ChartItems ( ChartM, ChartItem, set, ChartDataEncodable, getChartDataFromChartM, addDataToChart, addColorToChart, addFillToChart, addAxisToChart, getParams ) where import Graphics.GChart.Types import Graphics.GChart.DataEncoding import Control.Monad.State import Data.List import Data.Maybe -- Monad type ChartM a = State Chart a -- Typeclass abstracting all the fields in a chart class ChartItem c where -- set the field set :: c -> ChartM () -- encode the field into string params encode :: c -> [(String,String)] -- Setting/Encoding Chart Data updateChart u = do chart <- get put $ u chart asList a = [a] getChartDataFromChartM m = execState m defaultChart -- size instance ChartItem ChartSize where set size = updateChart $ \chart -> chart { chartSize = size } encode size = asList ("chs", show width ++ "x" ++ show height) where Size width height = size -- type instance ChartItem ChartType where set cType = updateChart $ \chart -> chart { chartType = cType } encode cType = asList ("cht",t) where t = case cType of Line -> "lc" LineXY -> "lxy" Sparklines -> "ls" Pie -> "p" Pie3D -> "p3" PieConcentric -> "pc" BarHorizontalStacked -> "bhs" BarVerticalStacked -> "bvs" BarHorizontalGrouped -> "bhg" BarVerticalGrouped -> "bvg" Venn -> "v" ScatterPlot -> "s" Radar -> "r" GoogleOMeter -> "gom" -- title instance ChartItem ChartTitle where set title = updateChart $ \chart -> chart { chartTitle = Just title } encode title = asList ("chtt", title) -- data -- FIXME just a placeholder for now instance ChartItem ChartData where set cData = updateChart $ \chart -> chart { chartData = cData } encode datas = asList ("chd", encodeData datas) where encodeData (Simple d) = encodeSimple d encodeData (Text d) = encodeText d encodeData (Extended d) = encodeExtended d class Num a => ChartDataEncodable a where addEncodedChartData :: [a] -> ChartData -> ChartData instance ChartDataEncodable Int where addEncodedChartData d cd@(Simple old) = Simple $ old ++ [d] addEncodedChartData d cd@(Extended old) = Extended $ old ++ [d] addEncodedChartData d _ = error "Invalid type for specified encoding. Use float data" instance ChartDataEncodable Float where addEncodedChartData d cd@(Text old) = Text $ old ++ [d] addEncodedChartData d _ = error "Invalid type for specified encoding. Use int data" addDataToChart d = do c <- get let old = chartData c set $ addEncodedChartData d old -- color instance ChartItem ChartColors where set colors = updateChart $ \chart -> chart { chartColors = Just colors } encode (ChartColors colors) = asList ("chco", intercalate "," colors) addColorToChart color = do chart <- get let (ChartColors old) = fromMaybe (ChartColors []) $ chartColors chart new = ChartColors $ old ++ [color] set new -- fill instance ChartItem ChartFills where set fills = updateChart $ \chart -> chart { chartFills = Just fills } encode fills = asList ("chf",intercalate "|" $ map encodeFill fills) encodeFill (Fill kind fType) = case kind of Solid color -> intercalate "," [fillType,"s",color] LinearGradient angle offsets -> intercalate "," [fillType, "lg", show angle, intercalate "," $ map (\(c,o) -> c ++ "," ++ show o ) offsets] LinearStripes angle widths -> intercalate "," [fillType, "ls", show angle, intercalate "," $ map (\(c,w) -> c ++ "," ++ show w) widths] where fillType = case fType of Background -> "bg" Area -> "c" Transparent -> "a" addFillToChart fill = do chart <- get let fills = fromMaybe [] $ chartFills chart newFills = fills ++ asList fill set newFills -- legend instance ChartItem ChartLegend where set legend = updateChart $ \chart -> chart { chartLegend = Just legend } encode (Legend labels position) = encodeTitle : encodePosition position where encodeTitle = ("chdl", intercalate "|" labels) encodePosition Nothing = [] encodePosition (Just p) = let pos = case p of LegendBottom -> "b" LegendTop -> "t" LegendVBottom -> "bv" LegendVTop -> "tv" LegendRight -> "r" LegendLeft -> "l" in asList ("chdlp",pos) -- AXIS instance ChartItem ChartAxes where set axes = updateChart $ \chart -> chart { chartAxes = Just axes } encode axes = filter (/= ("","")) $ map (\f -> f axes) [encodeAxesTypes, encodeAxesLabels, encodeAxesPositions, encodeAxesRanges, encodeAxesStyles] addAxisToChart axis = do chart <- get let old = fromMaybe [] $ chartAxes chart new = old ++ [axis] set new convertFieldToString encoder field = intercalate "|" . map encoder . filter (\(_,maybeField) -> maybeField /= Nothing) . indexed . map field indexed = zip [0..] encodeFieldToParams fieldParam fieldStr | fieldStr == "" = ("","") | otherwise = (fieldParam, fieldStr) encodeAxesTypes axes = ("chxt",a) where a = intercalate "," $ map toParam axes toParam axes = case axisType axes of AxisBottom -> "x" AxisTop -> "t" AxisLeft -> "y" AxisRight -> "r" -- axis labels strAxisLabels (idx,Just labels) = show idx ++ ":|" ++ intercalate "|" labels strAxesLabels = convertFieldToString strAxisLabels axisLabels encodeAxesLabels = encodeFieldToParams "chxl" . strAxesLabels -- axis positions strAxisPositions (idx, Just positions) = show idx ++ "," ++ intercalate "," (map show positions) strAxesPositions = convertFieldToString strAxisPositions axisPositions encodeAxesPositions = encodeFieldToParams "chxp" . strAxesPositions -- axis ranges strAxisRange (idx, Just range) = show idx ++ "," ++ intercalate "," (encodeRange range) where encodeRange (Range (start,end) interval) | interval == Nothing = [show start, show end] | otherwise = [show start, show end, show (fromJust interval)] strAxesRanges = convertFieldToString strAxisRange axisRange encodeAxesRanges = encodeFieldToParams "chxr" . strAxesRanges -- axis style strAxisStyle (idx, Just style) = show idx ++ "," ++ intercalate "," (catMaybes (encodeStyle style)) where encodeStyle (Style a b c d e) = [Just a, liftM show b, liftM encodeAlign c, liftM encodeDrawingControl d, liftM id e] encodeAlign c = case c of AxisStyleLeft -> "-1" AxisStyleCenter -> "0" AxisStyleRight -> "1" encodeDrawingControl d = case d of DrawLines -> "l" DrawTicks -> "t" DrawLinesTicks -> "lt" strAxesStyles = convertFieldToString strAxisStyle axisStyle encodeAxesStyles = encodeFieldToParams "chxs" . strAxesStyles -- GRID instance ChartItem ChartGrid where set grid = updateChart $ \chart -> chart { chartGrid = Just grid } encode grid = asList ("chg", encodeGrid grid) where encodeGrid (ChartGrid a b c d e f)= intercalate "," $ catMaybes [Just (show a), Just (show b), liftM show c, liftM show d, liftM show e, liftM show f] -- LABELS (Pie Chart, Google-O-Meter instance ChartItem ChartLabels where set labels = updateChart $ \chart -> chart { chartLabels = Just labels } encode (ChartLabels labels) = asList ("chl", intercalate "|" labels) -- URL Conversion -- FIXME : too much boilerplate. Can it be reduced? encodeMaybe Nothing = [("","")] encodeMaybe (Just x) = encode x getParams chart = filter (/= ("","")) $ concat [encode $ chartType chart, encode $ chartSize chart, encode $ chartData chart, encodeMaybe $ chartTitle chart, encodeMaybe $ chartColors chart, encodeMaybe $ chartFills chart, encodeMaybe $ chartLegend chart, encodeMaybe $ chartAxes chart, encodeMaybe $ chartGrid chart, encodeMaybe $ chartLabels chart]