{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE QuasiQuotes         #-}
{-# LANGUAGE ViewPatterns #-}

module Server.ControlRoom (ControlRoom(..)) where

import           Control.Monad               (unless, when)
import           Control.Monad.IO.Class      (MonadIO (liftIO))
import qualified Data.ByteString.Char8       as C8
import qualified Data.Map                    as M
import           Data.Swagger                (ToSchema (..))
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import           Web.FormUrlEncoded          (ToForm)
import           Web.Internal.FormUrlEncoded (Form)

import           Control.Monad               (forM_)
import           Control.Monad.Extra         (maybeM, whenM)
import           Data.Functor                ((<&>))
import           Data.Map                    (Map)
import           Data.Pool                   (Pool)
import           Data.Time                   (getCurrentTime, utctDay)
import           Data.Time.Calendar          (Day)
import           Data.Time.Format.ISO8601    (iso8601Show)
import           Data.UUID                   (UUID)
import qualified Data.UUID                   as UUID
import           Database.Persist            (Entity (..), delete, entityVal,
                                              get, insert, selectList, (==.))
import           Database.Persist.Sql        (SqlBackend, PersistFieldSql,
                                              runSqlPool)
import           GHC.Generics                (Generic)
import           Persist                     (AmendmentStatus,
                                              Announcement (..),
                                              EntityField (..), Key (..),
                                              ScheduleAmendment (ScheduleAmendment),
                                              runSql)
import           Server.Util                 (Service, redirect)
import           Text.ProtocolBuffers        (Default (defaultValue))
import           Web.FormUrlEncoded          (FromForm)
import           Fmt                         ((+|), (|+))
import Yesod
import Data.List (lookup)
import Text.Read (readMaybe)
import Text.Blaze.Html (ToMarkup(..))
import qualified Data.Vector as V

import           GTFS


data ControlRoom = ControlRoom
  { getBaseurl :: Text
  , getGtfs :: GTFS
  , getPool :: Pool SqlBackend
  }

mkYesod "ControlRoom" [parseRoutes|
/main MainR GET
/train/#TripID/#Day TrainViewR GET
|]

instance Yesod ControlRoom where
  approot = ApprootMaster (\cr -> getBaseurl cr)

-- which backend we're using and how to run an action.
instance YesodPersist ControlRoom where
  type YesodPersistBackend ControlRoom = SqlBackend

  runDB action = do
    pool <- getYesod <&> getPool
    runSqlPool action pool

getMainR :: Handler Html
getMainR = do
  req <- getRequest
  let maybeDay = lookup "day" (reqGetParams req) >>= (readMaybe . T.unpack)

  day <- liftIO $ maybeM (getCurrentTime <&> utctDay) pure (pure maybeDay)
  gtfs <- getYesod <&> getGtfs
  let trips = tripsOnDay gtfs day
  defaultLayout [whamlet|
<h1>Trips on #{iso8601Show day}
<ol>
  $forall Trip{..} <- trips
    <li><a href="@{TrainViewR tripTripID day}">#{tripTripID}</a>
        : #{stopDeparture (V.head tripStops)} #{stationName (stopStation (V.head tripStops))}
|] -- TODO: display stuff

getTrainViewR :: TripID -> Day -> Handler Html
getTrainViewR trip day = do
  GTFS{..} <- getYesod <&> getGtfs
  case M.lookup trip trips of
    Nothing -> notFound
    Just res@Trip{..} -> do
      anns <- runDB $ selectList [ AnnouncementTrip ==. trip, AnnouncementDay ==. day ] []
      defaultLayout [whamlet|
<h1>#{tripTripID} on #{iso8601Show day}
<h2>Announcements
<ul>
  $forall Entity (AnnouncementKey uuid) Announcement{..} <- anns
    <li><em>#{announcementHeader}: #{announcementMessage}</em> <a href="">delete</a>
  $if null anns
    <li><em>(none)</em>
  <li><a href="">Add Announcement</a>
<h2>Stops
<ol>
  $forall Stop{..} <- tripStops
    <div>(#{stopSequence}) #{stopArrival} #{stationName stopStation}

<h2>Vehicle Position
<div> Todo!
|]



instance ToMarkup Time where
  toMarkup time =
    toMarkup (show time)

-- type ControlRoomAPI =
--   "main" :> QueryParam "day" Day :> Get '[HTML] (Day, Map TripID (Trip Deep Deep))
--   :<|> "train" :> Capture "tripID" TripID :> Capture "day" Day :> Get '[HTML] TrainView
--   :<|> "trips" :> Get '[HTML] (Map TripID (Trip Deep Deep))
--   :<|> "trip" :> Capture "tripId" TripID :> Get '[HTML] (Trip Deep Deep)
--   :<|> ControlRoomCranks

-- -- | train infra seems to involve turning lots of cranks, so here have some!
-- type ControlRoomCranks =
--   "train" :> "cancel" :> ReqBody '[FormUrlEncoded] Form :> Post '[PlainText] NoContent
--   :<|> "train" :> "del-announce" :> Capture "uuid" UUID :> Get '[PlainText] NoContent
--   :<|> "train" :> "announce" :> Capture "tripId" TripID :> Capture "day" Day :> ReqBody '[FormUrlEncoded] TrainAnnounceF :> Post '[PlainText] NoContent
--   :<|> "train" :> "date" :> Capture "tripId" TripID :> ReqBody '[FormUrlEncoded] TrainDateF :> Post '[PlainText] NoContent
--   :<|> "train" :> "date" :> Capture "tripId" TripID :> QueryParam' '[Required] "" TrainDateF :> Post '[PlainText] NoContent
--   :<|> "train" :> "delay" :> ReqBody '[FormUrlEncoded] Form :> Post '[PlainText] NoContent
--   :<|> "train" :> "metainfo" :> ReqBody '[FormUrlEncoded] Form :> EmptyAPI
--   :<|> "trip" :> "new" :> ReqBody '[FormUrlEncoded] Form :> EmptyAPI

-- data TrainAnnounceF = TrainAnnounceF
--   { taHeader  :: Text
--   , taMsg     :: Text
--   , taLogTime :: Maybe Bool
--   } deriving (Generic, ToHtmlForm, FromForm)

-- -- | TODO: can also be "normal"?
-- data TrainDateF = TrainDateF
--   { tdDay    :: Day
--   , tdStatus :: AmendmentStatus
--   } deriving (Generic, ToHtmlForm, FromForm)


-- controlRoomServer :: GTFS -> Pool SqlBackend -> Service ControlRoomAPI
-- controlRoomServer gtfs@GTFS{..} dbpool = handleTimetable :<|> handleTrain :<|> handleTrips :<|> handleTrip
--   :<|> controlRoomCranks dbpool
--   where handleTrain trip day = case M.lookup trip trips of
--           Just res -> do
--             as <- runSql dbpool
--               $ selectList [ AnnouncementTrip ==. trip, AnnouncementDay ==. day ] []
--             pure (TrainView day res as True) -- TODO: can't just assume it runs that day …
--           Nothing  -> throwError err404
--         handleTimetable maybeDay = do
--           -- TODO: resolve "overlay" trips (perhaps just additional CalendarDates?)
--           day <- liftIO $ maybeM (getCurrentTime <&> utctDay) pure (pure maybeDay)
--           pure $ (day, tripsOnDay gtfs day)
--         handleTrips = pure trips
--         handleTrip tripId = case M.lookup tripId trips of
--           Just trip -> pure trip
--           Nothing   -> throwError err404

-- controlRoomCranks :: Pool SqlBackend -> Service ControlRoomCranks
-- controlRoomCranks dbpool = undefined :<|> handleAnnounceDel :<|> handleAnnounce :<|> handleDate :<|> handleDate :<|> undefined
--   where handleAnnounce tripID day TrainAnnounceF{..} = do
--           now <- liftIO $ getCurrentTime
--           AnnouncementKey uuid <- runSql dbpool $ insert $ Announcement
--             { announcementTrip = tripID
--             , announcementMessage = taMsg
--             , announcementHeader = taHeader
--             , announcementDay = day
--             , announcementUrl = Nothing
--             , announcementAnnouncedAt =
--               fmap (const now) taLogTime
--             }
--           redirect ("/cr/train/"<>C8.pack (T.unpack tripID)<>"/"<>C8.pack (iso8601Show day))
--         handleAnnounceDel uuid = do
--           ann <- runSql dbpool $ do
--             a <- get (AnnouncementKey uuid)
--             delete (AnnouncementKey uuid)
--             pure a
--           case ann of
--             Nothing -> throwError err404
--             Just Announcement{..} ->
--               redirect ("/cr/train/"+|announcementTrip|+"/"+| iso8601Show announcementDay|+"")
--         handleDate tripId TrainDateF{..} = do
--           -- TODO: check that tripId exists
--           runSql dbpool $ insert $ ScheduleAmendment tripId tdDay tdStatus
--           redirect ("/cr/train/"+|tripId|+"/"+| iso8601Show tdDay|+"")


-- instance ToHtmlFormInput CalendarExceptionType
-- instance ToHtmlForm CalendarDate


-- instance ToHtml TrainView  where
--   toHtml (TrainView day Trip{..} as running) = crPage tripTripID $ do
--     unless running $ do
--       div_ [class_ "warning"] "Warning: Trip not running on this day!"

--     h2_ "Announcements"
--     ul_ $ do
--       unless (null as) $ forM_ as $ \(Entity (AnnouncementKey uuid) Announcement{..}) -> do
--         li_ $ do
--           em_ (toHtml announcementHeader); ": "; toHtml announcementMessage
--           " "; a_ [href_ $ "/cr/train/del-announce/"<>UUID.toText uuid] "delete"
--       li_ $ do
--         "Add Announcement:"
--         toHtmlForm (defaultValue {formAction = Just ("/cr/train/announce/"<>tripTripID<>"/"<>(T.pack . iso8601Show) day) })
--           (Proxy @TrainAnnounceF)

--     h2_ "Stops"
--     ol_ $ forM_ tripStops $ \Stop{..} -> do
--       div_ (toHtml (stationName stopStation))

--     h2_ "Vehicle Position"
--     div_ "todo!"

--     h2_ "Cancellation Status"
--     a_ [href_ ("/cr/train/date/"+|tripTripID|+"?tdDate="+|iso8601Show day|+"&tdStatus=Cancelled")] "Cancel"


-- instance ToHtml (Day, Map TripID (Trip Deep Deep)) where
--   toHtml (day, trips) = crPage ("trips on " <> shownDay) $ do
--     ol_ $ forM_ trips $ \Trip{..} -> li_ $ do
--       a_ [href_ ("/cr/train/"<>tripTripID<>"/"<>shownDay)] (toHtml tripTripID)
--     when (null trips) $ do
--       em_ "(none)"
--     where shownDay = T.pack (iso8601Show day)

-- -- | control room page
-- crPage :: Monad m => Text -> HtmlT m () -> HtmlT m ()
-- crPage title content = do
--   h1_ (toHtml title)
--   main_ content