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

module Store (save, fetch, sessions, sessionStartTime, sessionDuration, migrateAll) where

import Control.Exception
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Maybe (isJust)
import Data.Time.Clock (DiffTime, NominalDiffTime, UTCTime, addUTCTime)
import Database.Persist
import Database.Persist.Class
import Database.Persist.Postgresql
  ( ConnectionString,
    SqlBackend,
    createPostgresqlPool,
    pgConnStr,
    pgPoolSize,
    runMigration,
    runSqlPool,
    rawExecute,
    PgInterval
  )
import Database.Persist.TH
import Text.Read (readMaybe)
import Track (Point (..), Pos (..))
import Track as T
import Text.RawString.QQ (r)

connString :: ConnectionString
connString = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret"

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

Session
    startTime UTCTime
    duration PgInterval
    draft Bool default=True
    notes String Maybe
|]

fromPoint :: Point -> Trkpt
fromPoint p =
  let Pos lat lon ele = T.pos p
   in Trkpt lat lon ele (T.time p) (T.cadence p) (T.power p) (T.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)

updateSessions = [r|
-- delete existing drafts as new data may extend one of them
delete from session where draft;
-- find all potential start points in the new data
insert into session(start_time, duration, draft) (select time as start_time, make_interval(0) as duration, true as draft from trkpt as p where not exists (select id from session where start_time <= p.time and (start_time + duration) > p.time) and not exists(select * from trkpt as p1 where time > p.time - '600 seconds'::interval and time < p.time));
-- reset durations
 update session s1
 set duration =
    coalesce(
    (select max(time) from trkpt t1
     where t1.time < coalesce((select min(start_time) from session s2 where s2.start_time > s1.start_time), now())) - s1.start_time
     , make_interval())
where draft;
|]

data OverlapExists = OverlapExists String deriving (Show)

instance Exception OverlapExists

sessions :: (MonadIO m) =>  ReaderT SqlBackend m [Session]
sessions = do
  s <- selectList [SessionDraft !=. True] [Desc SessionStartTime, LimitTo 10]
  return $ map (\(Entity _ x) -> x) s


save :: (MonadIO m) => Track -> ReaderT SqlBackend m (Either OverlapExists Track)
save track = do
  let start = startTime track
      finish = addUTCTime (duration track) (startTime track)
  priors <- selectFirst [TrkptTime >. start, TrkptTime <. finish] []
  if isJust priors
    then return $ Left (OverlapExists "track overlaps with existing data")
    else do
      mapM_ (insert . fromPoint) track
      rawExecute updateSessions []
      return $ Right track

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 $ map toPoint trkpts