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

-- | Data types that are or might yet be saved in the database, and possibly
-- also a few little convenience functions for using persistent.
module Persist where

import           Data.Aeson                  (FromJSON, ToJSON, ToJSONKey)
import           Data.Swagger                (ToParamSchema (..), ToSchema (..),
                                              genericDeclareNamedSchema)
import           Data.Text                   (Text)
import           Data.UUID                   (UUID)
import           Database.Persist
import           Database.Persist.Sql        (PersistFieldSql,
                                              runSqlPersistMPool)
import           Database.Persist.TH
import           GTFS
import           PersistOrphans
import           Servant                     (FromHttpApiData (..),
                                              ToHttpApiData)

import           Conduit                     (ResourceT)
import           Control.Monad.IO.Class      (MonadIO (liftIO))
import           Control.Monad.Logger        (NoLoggingT)
import           Control.Monad.Reader        (ReaderT)
import           Data.Data                   (Proxy (..))
import           Data.Pool                   (Pool)
import           Data.Time                   (NominalDiffTime, TimeOfDay,
                                              UTCTime (utctDay), addUTCTime,
                                              dayOfWeek, diffUTCTime,
                                              getCurrentTime, nominalDay)
import           Data.Time.Calendar          (Day, DayOfWeek (..))
import           Data.Vector                 (Vector)
import           Database.Persist.Postgresql (SqlBackend)
import           GHC.Generics                (Generic)
import           Web.PathPieces              (PathPiece)
import Fmt


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

deriving newtype instance PersistField Seconds
deriving newtype instance PersistFieldSql Seconds
-- deriving newtype instance PathPiece Seconds
-- deriving newtype instance ToParamSchema Seconds

data AmendmentStatus = Cancelled | Added | PartiallyCancelled Int Int
  deriving (ToJSON, FromJSON, Generic, Show, Read, Eq)
derivePersistField "AmendmentStatus"

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-- | tokens which have been issued
Running sql=tt_tracker_token
  Id Token default=uuid_generate_v4()
  expires UTCTime
  blocked Bool
  trip Text
  day Day
  vehicle Text Maybe
  agent Text
  deriving Eq Show Generic

-- raw frames as received from OBUs
TrainPing json sql=tt_trip_ping
  token RunningId
  lat Double
  long Double
  timestamp UTCTime
  deriving Show Generic Eq ToSchema

-- status of a train somewhen in time (may be in the future),
-- inferred from trainpings / entered via controlRoom
TrainAnchor json sql=tt_trip_anchor
  trip TripID
  day Day
  created UTCTime
  when Seconds
  delay Seconds Maybe
  msg Text Maybe
  deriving Show Generic Eq ToSchema

-- TODO: multi-language support?
Announcement json sql=tt_announcements
  Id UUID default=uuid_generate_v4()
  trip TripID
  header Text
  message Text
  day Day
  url Text Maybe
  announcedAt UTCTime Maybe
  deriving Generic ToSchema Show

-- | this table works as calendar_dates.txt in GTFS
ScheduleAmendment json sql=tt_schedule_amendement
  trip TripID
  day Day
  status AmendmentStatus
  -- only one special rule per TripID and Day (else incoherent)
  TripAndDay trip day
|]

instance ToSchema RunningId where
  declareNamedSchema _ = declareNamedSchema (Proxy @UUID)

runSql :: MonadIO m => Pool SqlBackend -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> m a
runSql pool = liftIO . flip runSqlPersistMPool pool