{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE RecordWildCards #-}

module Server.Frontend.SpaceTime (getSpaceTimeDiagramR) where

import Server.Frontend.Routes

import           Data.Functor           ((<&>))
import qualified Data.Map               as M
import           Data.Text              (Text)
import qualified Data.Vector            as V
import qualified GTFS
import           Text.Blaze.Html        (Html)
import qualified Data.Text as T
import           Yesod
import Text.Read (readMaybe)
import Data.Time (getCurrentTime, UTCTime (..))
import Persist
import Data.Function ((&), on)
import Data.List
import Data.Coerce (coerce)
import Control.Monad (when, forM)
import GHC.Float (int2Double)
import Fmt ((|+), (+|))
import Data.Maybe (catMaybes, mapMaybe)
import GTFS (Seconds(unSeconds))

getSpaceTimeDiagramR :: Handler Html
getSpaceTimeDiagramR = do

  req <- getRequest

  day <- case lookup "day" (reqGetParams req) >>= (readMaybe . T.unpack) of
    Just day -> pure  day
    Nothing  -> liftIO $ getCurrentTime <&> utctDay

  tickets <- runDB $ selectList [ TicketDay ==. day ] [] >>= mapM (\ticket -> do
    stops <- selectList [StopTicket ==. entityKey ticket] []
    pure (ticket, stops))


  -- TODO: this should be a nicer error message
  when (null tickets)
    notFound

  -- we take the longest trip of the day. This will lead to unreasonable results
  -- if there's more than one shape (this whole route should probably take a shape id tbh)
  stations <- runDB $ fmap snd tickets
        & maximumBy (compare `on` length)
        & fmap entityVal
        & sortOn stopSequence
        & mapM (\stop -> do
              s <- getJust (stopStation stop)
              pure (stopStation stop, s, stop))

  let maxSequence = stopSequence ((\(_,_,stop) -> stop) (last stations))
  let scaleSequence a = int2Double a * 100 / int2Double maxSequence

  let (minY, maxY) = tickets
       <&> snd
       & concat
       <&> (timeToPos . stopDeparture . entityVal)
       & (\ys -> (minimum ys - 20, maximum ys + 20))

  defaultLayout $ do
    [whamlet|
       <h1>_{MsgSpaceTimeDiagram}

       <section><svg viewBox="-2 #{minY} 106 #{maxY - minY}" width="100%">
         $forall (_, station, Stop{..}) <- stations
           <path
             style="fill:none;stroke:#79797a;stroke-width:0.3"
             d="M #{scaleSequence stopSequence},#{minY} #{scaleSequence stopSequence},#{maxY}"
             >
           <text style="font-size:2pt;" transform="rotate(90)">
             <tspan
               x="#{minY + 3}"
               y="#{0 - (scaleSequence stopSequence + 0.5)}"
               >#{stationName station}
         $forall (ticket, stops) <- tickets
           <path
             style="fill:none;stroke:blueviolet;stroke-width:0.3"
             d="M #{mkStopsline scaleSequence stations stops}"
             >

    |]

mkStopsline :: (Int -> Double) -> [(StationId, Station, Stop)] -> [Entity Stop] -> Text
mkStopsline scaleSequence stations stops = stops
  <&> (mkStop . entityVal)
  & T.concat
  where mkStop stop = " "+|scaleSequence s|+","+|timeToPos (stopArrival stop)|+" "
                             +|scaleSequence s|+","+|timeToPos (stopDeparture stop)|+""
          where s = mapMaybe
                  (\(stationId, _, res) ->
                      if stationId == stopStation stop then Just res else Nothing) stations
                  & head
                  & stopSequence

-- TODO: ignores time zones!
timeToPos = (\a -> a / 500) . int2Double . GTFS.timeSeconds
-- timeToPos time = unSeconds $ GTFS.toSeconds time _ _