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


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

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



newtype Token = Token UUID
  deriving newtype (Show, ToJSON, Eq, Ord, FromHttpApiData, ToJSONKey)
instance ToSchema Token where
  declareNamedSchema _ = declareNamedSchema (Proxy @String)
instance ToParamSchema Token where
  toParamSchema _ = toParamSchema (Proxy @String)

-- 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")
instance ToSchema TrainPing where
  declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "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 :> Post '[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])
type CompleteAPI = "debug" :> "openapi" :> Get '[JSON] Swagger
  :<|> API





server :: GTFS -> KnownTrips -> Server CompleteAPI
server gtfs@GTFS{..} knownTrains = handleDebugAPI :<|> 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
        handleDebugAPI = pure $ toSwagger (Proxy @API)

application :: GTFS -> IO Application
application gtfs = do
  knownTrips <- newTVarIO mempty
  pure $ serve (Proxy @CompleteAPI) $ 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?

-}