{-# LANGUAGE OverloadedStrings #-}
module ProductMixAuction.Graphics
( charts
, renderGraphicsFile
) where
import Control.Lens
import Data.Aeson (encode)
import Data.ByteString.Lazy (ByteString, toStrict)
import Data.Csv (ToField)
import Data.Maybe
import Data.Monoid hiding (All)
import Data.Text.Encoding (decodeUtf8)
import Graphics.Plotly.Base (Plotly(Plotly))
import Lucid.Base
import Lucid.Html5
import ProductMixAuction.Graphics.Scatter
import ProductMixAuction.Graphics.SupplyDemand
import ProductMixAuction.Graphics.TQSSDemand
import ProductMixAuction.Graphics.Types
import ProductMixAuction.LP
charts :: (ToField bid, Ord bid) =>
GraphicsOptions -> AuctionInput bid -> AuctionOutput bid -> [Plotly]
charts go i o =
maybeToList (scatterBidsChart env (i ^. ac_bidders) (o ^. ao_bid_allocations))
++ [stackedBidsChart env (i ^. ac_bidders) (o ^. ao_bid_allocations)]
++ supplyDemandLineCharts i o
++ tqssDemandChart i o
where
env = mkEnv go i o
renderGraphicsFile :: (ToField bid, Ord bid)
=> GraphicsOptions -> AuctionInput bid -> AuctionOutput bid -> ByteString
renderGraphicsFile go i o =
renderBS . doctypehtml_ $ head_ (plotlyCDNVersion <> s) <>
body_ (mconcat . map chartToHtml $ charts go i o)
where
s = style_ $ "g.pointtext text { visibility: hidden } "
<> "#pma-scatter-bids-3d { height: 1000px }"
plotlyCDNVersion :: Monad m => HtmlT m ()
plotlyCDNVersion = script_ [src_ "https://cdn.plot.ly/plotly-1.33.0.min.js"] ("" :: ByteString)
chartToHtml :: Monad m => Plotly -> HtmlT m ()
chartToHtml (Plotly divId trs lay) = do
div_ [id_ divId] ""
script_ ("Plotly.newPlot('" <> divId <> "', " <> trs' <> "," <> lay'
<> ", {displaylogo:false, modeBarButtonsToRemove:['hoverClosestCartesian','hoverCompareCartesian', 'hoverClosest3d', 'toggleSpikelines', 'toggleHover']});")
where
trs' = decodeUtf8 $ toStrict $ encode trs
lay' = decodeUtf8 $ toStrict $ encode lay