91 lines
2.5 KiB
Haskell
91 lines
2.5 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,
|
|
refreshDrafts,
|
|
migration,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.IO.Class (MonadIO)
|
|
import Control.Monad.Trans.Reader (ReaderT)
|
|
import Data.Text
|
|
import Data.Time.Clock
|
|
( NominalDiffTime,
|
|
UTCTime,
|
|
)
|
|
import Database.Persist
|
|
import Database.Persist.Postgresql
|
|
( PgInterval,
|
|
SqlBackend,
|
|
getPgInterval,
|
|
rawExecute,
|
|
)
|
|
import Database.Persist.TH
|
|
import Text.RawString.QQ (r)
|
|
|
|
share
|
|
[mkPersist sqlSettings, mkMigrate "migration"]
|
|
[persistLowerCase|
|
|
SessionRow sql=session
|
|
startTime UTCTime
|
|
duration PgInterval
|
|
draft Bool default=True
|
|
notes String Maybe
|
|
|]
|
|
|
|
data Session = Session
|
|
{ startTime :: UTCTime,
|
|
duration :: NominalDiffTime,
|
|
draft :: Bool,
|
|
notes :: Maybe String
|
|
}
|
|
|
|
fromEntity :: Entity SessionRow -> Session
|
|
fromEntity (Entity _ row) =
|
|
Session
|
|
(sessionRowStartTime row)
|
|
(getPgInterval (sessionRowDuration row))
|
|
(sessionRowDraft row)
|
|
(sessionRowNotes row)
|
|
|
|
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 [SessionRowDraft !=. True] [Desc SessionRowStartTime, LimitTo 10]
|
|
return $ Prelude.map fromEntity s
|