souplesse/lib/Store.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 Store (save, fetch, migrateAll) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Time.Clock (UTCTime)
import Database.Persist
import Database.Persist.Class
import Database.Persist.Postgresql
  ( ConnectionString,
    SqlBackend,
    createPostgresqlPool,
    pgConnStr,
    pgPoolSize,
    runMigration,
    runSqlPool,
  )
import Database.Persist.TH
import Track (Point (..), Pos (..))
import Track as T

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
|]

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)

save p = do insert $ fromPoint p

fetch :: (MonadIO m) => ReaderT SqlBackend m [Point]
fetch = do
  trkpts <- selectList [TrkptLat <=. 360] [] -- Asc TrkptTime]
  return $ map toPoint trkpts