70 lines
2.0 KiB
Haskell
70 lines
2.0 KiB
Haskell
{-# 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
|
|
, updateSessions
|
|
, migrateSession
|
|
) where
|
|
|
|
import Data.Text
|
|
import Text.RawString.QQ (r)
|
|
import Data.Time.Clock (
|
|
UTCTime,
|
|
)
|
|
|
|
import Database.Persist
|
|
-- import Database.Persist.Class
|
|
import Database.Persist.TH
|
|
import Database.Persist.Postgresql
|
|
( SqlBackend,
|
|
PgInterval
|
|
)
|
|
import Control.Monad.IO.Class (MonadIO)
|
|
import Control.Monad.Trans.Reader (ReaderT)
|
|
|
|
|
|
share
|
|
[mkPersist sqlSettings, mkMigrate "migrateSession"]
|
|
[persistLowerCase|
|
|
Session
|
|
startTime UTCTime
|
|
duration PgInterval
|
|
draft Bool default=True
|
|
notes String Maybe
|
|
|]
|
|
|
|
updateSessions :: Text
|
|
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;
|
|
|]
|
|
|
|
recents :: (MonadIO m) => ReaderT SqlBackend m [Session]
|
|
recents = do
|
|
s <- selectList [SessionDraft !=. True] [Desc SessionStartTime, LimitTo 10]
|
|
return $ Prelude.map (\(Entity _ x) -> x) s
|