souplesse

commit 04797427fc3dad1af1ff081ffdf441f3ba37a2cf
parent e111a323f7e2568b269439e3fa72b1391468c822
Author: Daniel Barlow <dan@telent.net>
Date:   Wed,  6 Nov 2024 22:00:51 +0000

add start and duration params to json endpoint

Diffstat:
M
app/Main.hs
 | 
24
+++++++++++++++++++-----
M
lib/Store.hs
 | 
10
++++++----
M
souplesse.cabal
 | 
1
+

3 files changed, 26 insertions(+), 9 deletions(-)
diff --git 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({
 <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 $
diff --git 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
@@ -78,6 +78,7 @@ executable souplesse
       , persistent-postgresql
       , resourcet
       , monad-logger
+      , time
       , yesod-core == 1.6.25.1
       , yesod-static
       , yesod-form