souplesse/lib/Session.hs

{-# 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 Session
  ( Session (..),
    recents,
    refreshDrafts,
    migrateSession,
  )
where

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Text
import Data.Time.Clock
  ( UTCTime,
  )
import Database.Persist
import Database.Persist.Postgresql
  ( PgInterval,
    SqlBackend,
    rawExecute
  )
import Database.Persist.TH
import Text.RawString.QQ (r)

share
  [mkPersist sqlSettings, mkMigrate "migrateSession"]
  [persistLowerCase|
Session
    startTime UTCTime
    duration PgInterval
    draft Bool default=True
    notes String Maybe
|]

updateSql :: Text
updateSql =
  [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;
|]

refreshDrafts :: (MonadIO m) => ReaderT SqlBackend m ()
refreshDrafts =
  rawExecute updateSql []

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