{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# LANGUAGE UndecidableInstances       #-}

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           Database.Persist
import           Database.Persist.TH
import           GHC.Foreign            (withCStringsLen)
import           GHC.Generics           (Generic)
import           GTFS
import           PersistOrphans
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)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
TripToken sql=tt_tracker_token
  Id UUID default=uuid_generate_v4()
  issued UTCTime
  blocked Bool
  tripNumber Text
  deriving Eq Show Generic

TripPing json sql=tt_trip_ping
  token UUID
  latitude Double
  longitude Double
  delay Double
  timestamp UTCTime
  deriving Show Generic Eq

|]


instance ToSchema TripPing where
  declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "ping")

type KnownTrips = TVar (Map Token [TripPing])

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] TripPing :> Post '[JSON] ()
  -- debug things
  :<|> "debug" :> "state" :> Get '[JSON] (Map Token [TripPing])
type CompleteAPI = "debug" :> "openapi" :> Get '[JSON] Swagger
  :<|> API





server :: GTFS -> KnownTrips -> Server CompleteAPI
server gtfs@GTFS{..} knownTrains = handleDebugAPI :<|> handleStations :<|> handleTimetable :<|> handleTrip
  :<|> handleRegister :<|> handleTripPing :<|> 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
        handleTripPing 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?

-}