Compare commits

...

2 Commits

4 changed files with 33 additions and 13 deletions

View File

@ -10,16 +10,21 @@ import Control.Monad.Logger (runStderrLoggingT)
import Control.Monad.Trans.Resource (runResourceT)
import Data.ByteString.Lazy as BS
import Data.List as List
import Data.Text (Text, unpack)
-- https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Static-file-subsite-Hello-World.md
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Database.Persist.Postgresql (ConnectionPool, ConnectionString, SqlBackend, runMigration, runSqlPool, withPostgresqlPool)
import Debug.Trace (traceShow)
import Store (fetch, migrateAll, save)
import Text.Read (readMaybe)
import Track (parseBS)
import Yesod.Core
import Yesod.Form.Fields
import Yesod.Form.Functions
import Yesod.Form.Input
import Yesod.Form.Types
import Yesod.Persist
-- https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Static-file-subsite-Hello-World.md
import Yesod.Static
staticFiles "frontend" -- this param appears to be a pathname
@ -88,17 +93,26 @@ var app = Elm.Main.init({
<p>Copyright &copy; 2024 Daniel Barlow
|]
type Form x = Html -> MForm (HandlerFor Souplesse) (FormResult x, Widget)
data Timerange = Timerange {start :: Int, duration :: Int} deriving (Show)
getPointsR :: Handler Value
getPointsR = do
points <- runDB Store.fetch
returnJson points
tr <-
runInputGet $
Timerange
<$> ireq intField "start"
<*> ireq intField "duration"
let start' = posixSecondsToUTCTime $ fromInteger $ toInteger $ start tr
duration' = fromInteger $ toInteger $ duration tr
points <- runDB $ Store.fetch start' duration'
returnJson (traceShow tr points)
data FileForm = FileForm
{ fileInfo :: FileInfo
}
type Form x = Html -> MForm (HandlerFor Souplesse) (FormResult x, Widget)
uploadForm :: Form FileForm
uploadForm =
renderDivs $

View File

@ -17,7 +17,7 @@ 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 Data.Time.Clock (DiffTime, NominalDiffTime, UTCTime, addUTCTime)
import Database.Persist
import Database.Persist.Class
import Database.Persist.Postgresql
@ -30,6 +30,7 @@ import Database.Persist.Postgresql
runSqlPool,
)
import Database.Persist.TH
import Text.Read (readMaybe)
import Track (Point (..), Pos (..))
import Track as T
@ -61,13 +62,14 @@ toPoint entity =
in Point
pos
(trkptTime tkp)
Nothing
Nothing
Nothing
(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]
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

View File

@ -58,7 +58,10 @@ instance ToJSON Point where
toJSON Point {..} =
object
[ "pos" .= pos,
"time" .= time
"time" .= time,
"cadence" .= cadence,
"power" .= power,
"heartRate" .= heartRate
]
-- TODO do we even need this type?

View File

@ -78,6 +78,7 @@ executable souplesse
, persistent-postgresql
, resourcet
, monad-logger
, time
, yesod-core == 1.6.25.1
, yesod-static
, yesod-form