From 04797427fc3dad1af1ff081ffdf441f3ba37a2cf Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Wed, 6 Nov 2024 22:00:51 +0000 Subject: [PATCH] add start and duration params to json endpoint --- app/Main.hs | 24 +++++++++++++++++++----- lib/Store.hs | 10 ++++++---- souplesse.cabal | 1 + 3 files changed, 26 insertions(+), 9 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index e7b7dfa..cc1db6e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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({

Copyright © 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 $ diff --git a/lib/Store.hs b/lib/Store.hs index fa67872..ec6d3d8 100644 --- a/lib/Store.hs +++ b/lib/Store.hs @@ -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 @@ -67,7 +68,8 @@ toPoint entity = 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 diff --git a/souplesse.cabal b/souplesse.cabal index cb202e0..c0625d3 100644 --- a/souplesse.cabal +++ b/souplesse.cabal @@ -78,6 +78,7 @@ executable souplesse , persistent-postgresql , resourcet , monad-logger + , time , yesod-core == 1.6.25.1 , yesod-static , yesod-form