{-# LANGUAGE CPP #-} {-# LANGUAGE JavaScriptFFI #-} module View.Statistics.Chart ( view , In(..) , Dataset(..) ) where import qualified Control.Concurrent as Concurrent import Control.Monad (void) import Control.Monad.IO.Class (liftIO) import Data.Aeson ((.=)) import qualified Data.Aeson as AE import qualified Data.Map as M import Data.Text (Text) import Language.Javascript.JSaddle (JSString, JSVal) import qualified Language.Javascript.JSaddle.Value as JSValue import Reflex.Dom (MonadWidget) import qualified Reflex.Dom as R -- import GHCJS.Foreign.Callback #ifdef __GHCJS__ foreign import javascript unsafe "new Chart(document.getElementById($1), $2);" drawChart :: JSString -> JSVal -> IO () #else drawChart = error "drawChart: only available from JavaScript" #endif data In = In { _in_title :: Text , _in_labels :: [Text] , _in_datasets :: [Dataset] } data Dataset = Dataset { _dataset_label :: Text , _dataset_data :: [Int] , _dataset_color :: Text } view :: forall t m. MonadWidget t m => In -> m () view input = do R.divClass "g-Chart" $ R.elAttr "canvas" (M.singleton "id" "chart") $ R.blank liftIO $ Concurrent.forkIO $ do Concurrent.threadDelay 500000 config <- JSValue.valMakeJSON (configToJson input) drawChart "chart" config return () configToJson (In title labels datasets) = AE.object [ "type" .= AE.String "line" , "data" .= AE.object [ "labels" .= labels , "datasets" .= map datasetToJson datasets ] , "options" .= AE.object [ "responsive" .= True , "title" .= AE.object [ "display" .= True , "text" .= title ] , "tooltips" .= AE.object [ "mode" .= AE.String "nearest" , "intersect" .= False ] , "hover" .= AE.object [ "mode" .= AE.String "nearest" , "intersect" .= True ] , "scales" .= AE.object [ "yAxes" .= [ [ AE.object [ "ticks" .= AE.object [ "beginAtZero" .= True ] ] ] ] ] ] ] datasetToJson (Dataset label data_ color) = AE.object [ "label" .= label , "data" .= data_ , "fill" .= False , "backgroundColor" .= color , "borderColor" .= color ]