{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}


module Server where
import Servant (type (:>), Server, serve, err404, throwError, FromHttpApiData (parseUrlPiece), Application)
import Servant.API (Capture, Get, JSON, type (:<|>) ((:<|>)), FromHttpApiData, ReqBody, Post)

import qualified Data.Map as M
import Data.Map (Map)
import Data.Functor ((<&>))
import Data.Time (getCurrentTime, UTCTime (utctDay), dayOfWeek)
import GTFS
import Data.Proxy (Proxy(Proxy))
import Data.Vector (Vector)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Data.Text (Text)
import qualified Data.UUID.V4 as UUID
import qualified Data.UUID as UUID
import Data.UUID (UUID)
import Control.Concurrent.STM
import Data.Aeson (ToJSON (toJSON), FromJSON (parseJSON), ToJSONKey, genericToJSON, genericParseJSON)
import Servant.Server (Handler)
import GHC.Generics (Generic)
import GHC.Foreign (withCStringsLen)

newtype Token = Token UUID
  deriving newtype (Show, ToJSON, Eq, Ord, FromHttpApiData, ToJSONKey)

-- TODO: perhaps wrap into server-side struct to add network delay stats?
data TrainPing = TrainPing
  { pingLat :: Float
  , pingLong :: Float
  , pingDelay :: Int
  , pingTimestamp :: Time
  } deriving (Generic)

instance FromJSON TrainPing where
  parseJSON = genericParseJSON (aesonOptions "ping")
instance ToJSON TrainPing where
  toJSON = genericToJSON (aesonOptions "ping")


type KnownTrips = TVar (Map Token [TrainPing])

type API = "stations" :> Get '[JSON] (Map StationID Station)
  :<|> "timetable" :> Capture "Station ID" StationID :> Get '[JSON] (Map TripID (Trip Deep))
  :<|> "trip" :> Capture "Trip ID" TripID :> Get '[JSON] (Trip Deep)
  -- ingress API (put this behind BasicAuth?)
  -- TODO: perhaps require a first ping for registration?
  :<|> "trainregister" :> Capture "Trip ID" TripID :> Get '[JSON] Token
  -- TODO: perhaps a websocket instead?
  :<|> "trainping" :> Capture "Train Token" Token :> ReqBody '[JSON] TrainPing :> Post '[JSON] ()
  -- debug things
  :<|> "debug" :> "state" :> Get '[JSON] (Map Token [TrainPing])

server :: GTFS -> KnownTrips -> Server API
server gtfs@GTFS{..} knownTrains = handleStations :<|> handleTimetable :<|> handleTrip
  :<|> handleRegister :<|> handleTrainPing :<|> handleDebugState
  where handleStations = pure stations
        handleTimetable station = do
          today <- liftIO getCurrentTime <&> utctDay
          pure $ tripsOnDay gtfs today
        handleTrip trip = case M.lookup trip trips of
          Just res -> pure res
          Nothing -> throwError err404
        handleRegister tripID = liftIO $ do
          token <- UUID.nextRandom <&> Token
          atomically $ modifyTVar knownTrains (M.insert token [])
          pure token
        handleTrainPing token ping = liftIO $ atomically $ do
            modifyTVar knownTrains (M.update (\history -> Just (ping : history)) token)
            pure ()
        handleDebugState = liftIO $ readTVarIO knownTrains

application :: GTFS -> IO Application
application gtfs = do
  knownTrips <- newTVarIO mempty
  pure $ serve (Proxy @API) $ server gtfs knownTrips

{-
TODO:
there should be a basic API allowing the questions:
 - what are the next trips leaving from $station? (or $geolocation?)
 - all stops of a given tripID

then the "ingress" API:
 - train ping (location, estimated delay, etc.)
 - cancel trip
 - add trip?

-}