{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module ProductMixAuction.Graphics.Types
  ( GraphicsOptions(..)
  , defaultDotsize

  , Env(..)
  , GoodEnv(..)
  , mkEnv

  -- * Plotly
  , axis
  , line2d
  , line3d
  , linePlot3D
  , meshPlot3D
  , surface3d
  , quadrilateral3d
  , uiLabel
  , addFooter
  , T2
  , T3
  , T4

  -- * Utilities
  , (?|)
  , (?!)

  -- * Colours
  , lightgreen
  , lightred
  , lightblue
  , lightbrown
  , red
  , orange
  , darkgreen

  -- * Lenses
  , go_file
  , go_dotsize
  , go_show_bids_q
  , go_simple_colors
  , env_goods
  , env_options
  , env_prices
  , env_scale
  , env_x_good
  , env_y_good
  , env_z_good
  , ge_good
  , ge_price
  , ge_max_price
  , ge_min_price
  ) where

import Control.Lens
import Data.Aeson (toJSON)
import Data.ByteString.Lens
import Data.Csv (ToField, toField)
import Data.Default.Class
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Text as T
import Data.Text.Lens hiding (text)
import Graphics.Plotly.Base hiding (x,y,z,i,j,k)
import qualified Graphics.Plotly.Base as P
import Graphics.Plotly.Simple

import ProductMixAuction.LP
import ProductMixAuction.LP.Bid
import ProductMixAuction.Types

data GraphicsOptions = GraphicsOptions
  { _go_file          :: FilePath
  , _go_dotsize       :: Double
  , _go_show_bids_q   :: Bool
  , _go_simple_colors :: Bool
  }

defaultDotsize :: Double
defaultDotsize = 20

instance Default GraphicsOptions where
  def = GraphicsOptions "graphs.html" defaultDotsize True False

data Env = Env
  { _env_goods   :: [GoodEnv]       -- ^ List of goods with their metadata
  , _env_prices  :: Map Good Price  -- ^ Auction price for each good
  , _env_options :: GraphicsOptions -- ^ Graphics options
  , _env_scale   :: ScaleFactor     -- ^ Scale factor for the auction
  }

data GoodEnv = GoodEnv
  { _ge_good      :: Good   -- ^ Label for this good
  , _ge_price     :: Price  -- ^ Auction price
  , _ge_min_price :: Price  -- ^ Minimum price relevant for this good
  , _ge_max_price :: Price  -- ^ Maximum price relevant for this good
  }

$(makeLenses ''GraphicsOptions)
$(makeLenses ''Env)
$(makeLenses ''GoodEnv)

env_x_good :: Traversal' Env GoodEnv
env_x_good = env_goods . ix 0

env_y_good :: Traversal' Env GoodEnv
env_y_good = env_goods . ix 1

env_z_good :: Traversal' Env GoodEnv
env_z_good = env_goods . ix 2



lightgreen, lightred, lightblue, lightbrown, red, orange, darkgreen :: Color
lightgreen = ColRGB 200 255 150
lightred   = ColRGB 255 100 150
lightblue  = ColRGB 100 150 255
lightbrown = ColRGB 210 105 30
red        = ColRGB 255 0   0
orange     = ColRGB 255 105 0
darkgreen  = ColRGB 0   150 0

axis :: T.Text -> Axis
axis l = defAxis & axistitle ?~ l

type T2 a = (a, a)
type T3 a = (a, a, a)
type T4 a = (a, a, a, a)

line2d :: [T2 Double] -> Trace
line2d xys =
  linePlot xys
    & line ?~ (defLine & linecolor ?~ ColRGB 0 0 0)
    & traceshowlegend ?~ False

linePlot3D :: [T3 Double] -> Trace
linePlot3D xyzs = scatter3d & P.x ?~ (xyzs ^.. each . _1 . to toJSON)
                            & P.y ?~ (xyzs ^.. each . _2 . to toJSON)
                            & P.z ?~ (xyzs ^.. each . _3 . to toJSON)
                            & mode ?~ [Lines]

line3d :: [T3 Double] -> Trace
line3d ps =
  linePlot3D ps
    & line ?~ (defLine & linecolor ?~ ColRGB 0 0 0)
    & traceshowlegend ?~ False

meshPlot3D :: [T3 Double] -> [T3 Int] -> Trace
meshPlot3D xyzs ijks =
  mesh3d & P.x ?~ (xyzs ^.. each . _1 . to toJSON)
         & P.y ?~ (xyzs ^.. each . _2 . to toJSON)
         & P.z ?~ (xyzs ^.. each . _3 . to toJSON)
         & P.i ?~ (ijks ^.. each . _1)
         & P.j ?~ (ijks ^.. each . _2)
         & P.k ?~ (ijks ^.. each . _3)
         & mode ?~ [Lines]

surface3d :: [T3 Double] -> [T3 Int] -> Color -> Trace
surface3d ps qs c =
  meshPlot3D ps qs
    & tracecolor ?~ c
    & traceshowlegend ?~ False
    & traceopacity ?~ 0.2
    & hoverinfo ?~ HoverNone

quadrilateral3d :: T4 (T3 Double) -> Color -> Trace
quadrilateral3d (p, q, r, s) = surface3d [p, q, r, s] [(0, 1, 2), (0, 2, 3)]

mkEnv :: GraphicsOptions -> AuctionInput bid -> AuctionOutput bid -> Env
mkEnv go i o =
    Env { _env_goods   = goods
        , _env_prices  = prices
        , _env_options = go
        , _env_scale    = i ^. ac_scale
        }
  where
    prices = _ao_prices o
    goods = map toGoodEnv $ Map.toList prices

    toGoodEnv (good, p) = GoodEnv { _ge_good      = good
                                  , _ge_price     = p
                                  , _ge_min_price = min p (fromMaybe 0 (minimumOf price_l i))
                                  , _ge_max_price = max p (fromMaybe 0 (maximumOf price_l i))
                                  }
      where
        price_l = ac_bidders . each . bidder_bids . each . to (flip bidValue good) . to round


uiLabel :: (ToField a, IsText t) => a -> t
uiLabel a = _Text . packedChars # toField a

infixr 4 ?|

-- Reverse infix form of "fromMaybe"
(?|) :: Maybe a -> a -> a
(?|) = flip fromMaybe

infixr 4 ?!

-- Reverse infix form of "fromJust" with a custom error message
(?!) :: Maybe a -> String -> a
(?!) ma msg = ma ?| error msg


-- | Set a text annotation for a footer.  The text must have manual
-- line breaks.  This increases the bottom margin by a fixed amount to
-- make space, and increases the height to match.
addFooter :: T.Text -> Layout -> Layout
addFooter t l = l & annotations ?~ [footerAnnotation t]
                  & margin ?~ Margin 80 80 130 80 0
                  & height ?~ 500

footerAnnotation :: T.Text -> Annotation
footerAnnotation t = defAnnotation & annotationtext      ?~ t
                                   & annotationshowarrow ?~ False
                                   & annotationalign     ?~ AlignLeft
                                   & annotationx         ?~ toJSON (0 :: Int)
                                   & annotationxref      ?~ "paper"
                                   & annotationxshift    ?~ -50
                                   & annotationy         ?~ toJSON (0 :: Int)
                                   & annotationyref      ?~ "paper"
                                   & annotationyshift    ?~ -105