{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Point
  ( Pos (..),
    Point (..),
    save,
    fetch,
    migration,
  )
where

import Control.Exception
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as L
import Data.Either
import Data.Functor ((<&>))
import Data.List as List
import Data.List qualified
import Data.Map as Map
import Data.Maybe (isJust)
import Data.Text qualified
import Data.Text.Lazy as T
import Data.Time
import Data.Time.Clock (DiffTime, NominalDiffTime, UTCTime, addUTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Data.Time.ISO8601 qualified
import Database.Persist
import Database.Persist.Class
import Database.Persist.Postgresql
  ( ConnectionString,
    SqlBackend,
    createPostgresqlPool,
    pgConnStr,
    pgPoolSize,
    rawExecute,
    runMigration,
    runSqlPool,
  )
import Database.Persist.TH
import Debug.Trace (trace, traceShow)
import Session qualified
import Text.Read (readMaybe)
import Text.XML
import Text.XML.Cursor as Cursor

-- import Track (Point (..), Pos (..))
-- import Track as T

data Pos = Pos Double Double (Maybe Double) deriving (Show, Eq)

type Power = Maybe Int

type Cadence = Maybe Int

type HeartRate = Maybe Int

data Point = Point
  { pos :: Pos,
    time :: UTCTime,
    cadence :: Cadence,
    power :: Power,
    heartRate :: HeartRate
  }
  deriving (Show)

instance ToJSON Pos where
  toJSON (Pos lat lon ele) =
    case ele of
      Just e -> object ["lat" .= lat, "lon" .= lon, "ele" .= e]
      Nothing -> object ["lat" .= lat, "lon" .= lon, "ele" .= Null]

instance ToJSON Point where
  toJSON Point {..} =
    object
      [ "pos" .= pos,
        "time" .= utcTimeToPOSIXSeconds time,
        "cadence" .= cadence,
        "power" .= power,
        "heartRate" .= heartRate
      ]

share
  [mkPersist sqlSettings, mkMigrate "migration"]
  [persistLowerCase|
Trkpt
    lat Double
    lon Double
    ele Double Maybe
    time UTCTime
    cadence Int Maybe
    power Int Maybe
    heartRate  Int Maybe
|]

fromPoint :: Point -> Trkpt
fromPoint p =
  let Pos lat lon ele = pos p
   in Trkpt lat lon ele (time p) (cadence p) (power p) (heartRate p)

toPoint :: Entity Trkpt -> Point
toPoint entity =
  let tkp = (\(Entity _ tkp) -> tkp) entity
      pos = Pos (trkptLat tkp) (trkptLon tkp) (trkptEle tkp)
   in Point
        pos
        (trkptTime tkp)
        (trkptCadence tkp)
        (trkptPower tkp)
        (trkptHeartRate tkp)

data OverlapExists = OverlapExists String deriving (Show)

instance Exception OverlapExists

fetch :: (MonadIO m) => UTCTime -> NominalDiffTime -> ReaderT SqlBackend m [Point]
fetch start duration = do
  let finish = addUTCTime duration start
  trkpts <- selectList [TrkptTime >. start, TrkptTime <. finish] []
  return $ List.map toPoint trkpts

-- any :: (MonadIO m) => UTCTime -> NominalDiffTime -> ReaderT SqlBackend m Bool
any start duration = do
  let finish = addUTCTime duration start
  exists <- selectFirst [TrkptTime >. start, TrkptTime <. finish] []
  return $ isJust exists

startTime :: [Point] -> UTCTime
startTime (p : ps) = List.foldr (\a b -> min b (time a)) (time p) ps

duration :: [Point] -> NominalDiffTime
duration track =
  case track of
    [] -> 0
    (p : ps) ->
      let start = startTime track
          finish = List.foldr (\a b -> max b (time a)) (time p) ps
       in diffUTCTime finish start

save :: (MonadIO m) => [Point] -> ReaderT SqlBackend m (Either OverlapExists [Point])
save track = do
  let start = startTime track
  priors <- Point.any start (duration track)
  if priors
    then return $ Left (OverlapExists "track overlaps with existing data")
    else do
      mapM_ (Database.Persist.Class.insert . fromPoint) track
      Session.refreshDrafts
      return $ Right track