add start and duration params to json endpoint

This commit is contained in:
Daniel Barlow 2024-11-06 22:00:51 +00:00
parent e111a323f7
commit 04797427fc
3 changed files with 26 additions and 9 deletions

View File

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

View File

@ -17,7 +17,7 @@ module Store (save, fetch, migrateAll) where
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Reader (ReaderT) 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
import Database.Persist.Class import Database.Persist.Class
import Database.Persist.Postgresql import Database.Persist.Postgresql
@ -30,6 +30,7 @@ import Database.Persist.Postgresql
runSqlPool, runSqlPool,
) )
import Database.Persist.TH import Database.Persist.TH
import Text.Read (readMaybe)
import Track (Point (..), Pos (..)) import Track (Point (..), Pos (..))
import Track as T import Track as T
@ -67,7 +68,8 @@ toPoint entity =
save p = do insert $ fromPoint p save p = do insert $ fromPoint p
fetch :: (MonadIO m) => ReaderT SqlBackend m [Point] fetch :: (MonadIO m) => UTCTime -> NominalDiffTime -> ReaderT SqlBackend m [Point]
fetch = do fetch start duration = do
trkpts <- selectList [TrkptLat <=. 360] [] -- Asc TrkptTime] let finish = addUTCTime duration start
trkpts <- selectList [TrkptTime >. start, TrkptTime <. finish] []
return $ map toPoint trkpts return $ map toPoint trkpts

View File

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