module Graphics.Google.Chart (
Chart,
chartURL,
setSize, setTitle, setTitleOpts, setData,
ChartData, encodeDataSimple, encodeDataText, encodeDataExtended,
setDataColors,
LegendChart, setLegend,
AxisLabelChart, setAxisTypes, AxisType(..), setAxisLabels,
setAxisLabelPositions, setAxisRanges, AxisAlignment(..), setAxisStyles,
LineChart, newLineChart,
PieChart, newPieChart, PieStyle(..), setLabels,
BarChart, newBarChart, Orientation(..), BarStyle(..),
VennDiagram, newVennDiagram
) where
import Data.Char (chr, ord)
import Data.List (intercalate)
import Numeric (showHex)
urlEnc str = concatMap enc str where
enc c | c >= 'A' && c <= 'Z' = [c]
| c >= 'a' && c <= 'z' = [c]
| c >= '0' && c <= '9' = [c]
| c `elem` safe = [c]
| c == ' ' = "+"
| otherwise = '%':(showHex (ord c) "")
safe = "$-_.!*'(),|:"
type Params = [(String,String)]
class Chart c where
params :: c -> Params
fromParams :: Params -> c
setParam :: (Chart c) => String -> String -> c -> c
setParam key val c = fromParams $ (key,val) : filter ((/= key) . fst) (params c)
setSize :: (Chart c) => Int -> Int -> c -> c
setSize width height = setParam "chs" (show width ++ "x" ++ show height)
setTitle :: (Chart c) => String -> c -> c
setTitle title = setParam "chtt" title
setTitleOpts :: (Chart c) => String
-> Int
-> c -> c
setTitleOpts color size = setParam "chts" (color ++ "," ++ show size)
setData :: (Chart c) => ChartData -> c -> c
setData (ChartData str) = setParam "chd" str
chartURL :: (Chart c) => c -> String
chartURL chart = baseURL ++ intercalate "&" urlparams where
baseURL = "http://chart.apis.google.com/chart?"
urlparams = [urlEnc a ++ "=" ++ urlEnc b | (a,b) <- params chart]
newtype ChartData = ChartData String deriving Show
encodeDataSimple :: [[Int]] -> ChartData
encodeDataSimple datas =
ChartData $ "s:" ++ intercalate "," (map (map enc) datas) where
enc i | i >= 0 && i <= 25 = chr (ord 'A' + i)
| i >= 26 && i <= 51 = chr (ord 'a' + (i 26))
| i >= 52 && i <= 61 = chr (ord '0' + (i 52))
| otherwise = '_'
encodeDataText :: RealFrac a => [[a]] -> ChartData
encodeDataText datas =
ChartData $ "t:" ++ intercalate "|" (map encData datas) where
encData = intercalate "," . map encDatum
encDatum i | i >= 0 && i <= 100 = showDecimal i
| otherwise = "-1"
showDecimal :: RealFrac a => a -> String
showDecimal i = show (fromIntegral (round (i * 10.0)) / 10.0)
encodeDataExtended :: [[Int]] -> ChartData
encodeDataExtended datas =
ChartData $ "e:" ++ intercalate "," (map (concatMap encDatum) datas) where
encDatum i | i >= 0 && i < 4096 = let (a, b) = i `quotRem` 64 in
[encChar a, encChar b]
| otherwise = "__"
encChar i | i >= 0 && i <= 25 = chr (ord 'A' + i)
| i >= 26 && i <= 51 = chr (ord 'a' + (i 26))
| i >= 52 && i <= 61 = chr (ord '0' + (i 52))
| i == 62 = '-'
| i == 63 = '.'
setDataColors :: Chart c => [String] -> c -> c
setDataColors colors = setParam "chco" (intercalate "," colors)
class Chart c => LegendChart c
setLegend :: LegendChart c => [String] -> c -> c
setLegend strs = setParam "chdl" (intercalate "|" strs)
class Chart c => AxisLabelChart c
data AxisType = AxisBottom | AxisTop | AxisLeft | AxisRight
setAxisTypes :: AxisLabelChart c => [AxisType] -> c -> c
setAxisTypes axes = setParam "chxt" (intercalate "," (map axisChar axes)) where
axisChar AxisBottom = "x"
axisChar AxisTop = "t"
axisChar AxisLeft = "y"
axisChar AxisRight = "r"
setAxisLabels :: AxisLabelChart c => [[String]] -> c -> c
setAxisLabels axislabels =
setParam "chxl" (intercalate "|" (zipWith axisLabel [0..] axislabels)) where
axisLabel :: Int -> [String] -> String
axisLabel _ [] = ""
axisLabel index labels = show index ++ ":|" ++ intercalate "|" labels
setAxisLabelPositions :: AxisLabelChart c => [[Int]] -> c -> c
setAxisLabelPositions positions =
setParam "chxp" (intercalate "|" (zipWith axisPosn [0..] positions)) where
axisPosn _ [] = ""
axisPosn index xs = intercalate "," (map show (index:xs))
setAxisRanges :: AxisLabelChart c => [(Int,Int)] -> c -> c
setAxisRanges ranges =
setParam "chxr" (intercalate "|" (zipWith axisRange [0..] ranges)) where
axisRange index (min,max) = intercalate "," (map show [index,min,max])
data AxisAlignment = AlignLeft | AlignCenter | AlignRight
setAxisStyles :: AxisLabelChart c => [(String,Int,AxisAlignment)] -> c -> c
setAxisStyles styles =
setParam "chxs" (intercalate "|" (zipWith axisStyle [0..] styles)) where
axisStyle index (color, size, align) =
intercalate "," [show index, color, show size, alignString align]
alignString AlignLeft = "-1"
alignString AlignCenter = "0"
alignString AlignRight = "1"
newtype LineChart = LineChart Params
instance Chart LineChart where
params (LineChart p) = p
fromParams = LineChart
instance LegendChart LineChart
instance AxisLabelChart LineChart
newLineChart :: LineChart
newLineChart = fromParams [("cht","lc")]
newtype PieChart = PieChart Params
instance Chart PieChart where
params (PieChart p) = p
fromParams = PieChart
data PieStyle = Pie2D | Pie3D
newPieChart :: PieStyle -> PieChart
newPieChart Pie2D = fromParams [("cht","p")]
newPieChart Pie3D = fromParams [("cht","p3")]
setLabels :: [String] -> PieChart -> PieChart
setLabels labels = setParam "chl" $ intercalate "|" labels
newtype BarChart = BarChart Params
instance Chart BarChart where
params (BarChart p) = p
fromParams = BarChart
instance LegendChart BarChart
instance AxisLabelChart BarChart
data Orientation = Horizontal | Vertical
data BarStyle = Stacked | Grouped
newBarChart :: Orientation -> BarStyle -> BarChart
newBarChart orient style =
fromParams [("cht",'b':oLetter orient:sLetter style:[])] where
oLetter Horizontal = 'h'
oLetter Vertical = 'v'
sLetter Stacked = 's'
sLetter Grouped = 'g'
newtype VennDiagram = VennDiagram Params
instance Chart VennDiagram where
params (VennDiagram p) = p
fromParams = VennDiagram
instance LegendChart VennDiagram
newVennDiagram :: VennDiagram
newVennDiagram = fromParams [("cht", "v")]