serve JSON fron db at /points

app/Main.hs

@@ -12,7 +12,7 @@ import Data.ByteString.Lazy as BS
 import Data.List as List
 import Database.Persist.Postgresql (ConnectionPool, ConnectionString, SqlBackend, runMigration, runSqlPool, withPostgresqlPool)
 import Debug.Trace (traceShow)
-import Store (migrateAll, save)
+import Store (fetch, migrateAll, save)
 import Track (parseBS)
 import Yesod.Core
 import Yesod.Form.Fields
@@ -35,6 +35,7 @@ mkYesod
 /timeline TimelineR GET
 /upload UploadR POST
 /static StaticR Static getStatic
+/points PointsR GET
 |]
 
 getStatic :: Souplesse -> Static
@@ -87,6 +88,11 @@ var app = Elm.Main.init({
 <p>Copyright &copy; 2024 Daniel Barlow
 |]
 
+getPointsR :: Handler Value
+getPointsR = do
+  points <- runDB Store.fetch
+  returnJson points
+
 data FileForm = FileForm
   { fileInfo :: FileInfo
   }

lib/Store.hs

@@ -13,12 +13,13 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Store (save, migrateAll) where
+module Store (save, fetch, migrateAll) where
 
-import Control.Monad.IO.Class (liftIO)
+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,
@@ -29,6 +30,7 @@ import Database.Persist.Postgresql
     runSqlPool,
   )
 import Database.Persist.TH
+import Track (Point (..), Pos (..))
 import Track as T
 
 connString :: ConnectionString
@@ -52,4 +54,20 @@ 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)
+        Nothing
+        Nothing
+        Nothing
+
 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

lib/Track.hs

@@ -1,15 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Track
   ( Track,
     Pos (..),
     BadFile,
-    Point,
-    pos,
-    cadence,
-    power,
-    heartRate,
-    time,
+    Point (..),
     parse,
     parseFile,
     parseBS,
@@ -18,6 +14,8 @@ module Track
 where
 
 import Control.Exception
+import Data.Aeson
+import Data.ByteString.Lazy.Char8 qualified as L
 import Data.Either
 import Data.Functor ((<&>))
 import Data.List as List
@@ -50,6 +48,19 @@ data Point = Point
   }
   deriving (Show)
 
+instance ToJSON Pos where
+  toJSON (Pos lat lon ele) =
+    case ele of
+      Just e -> object ["lat" .= lat, "lon" .= lon, "ele" .= e]
+      Nothing -> object ["lat" .= lat, "lon" .= lon, "ele" .= Null]
+
+instance ToJSON Point where
+  toJSON Point {..} =
+    object
+      [ "pos" .= pos,
+        "time" .= time
+      ]
+
 -- TODO do we even need this type?
 type Track = [Point]
 

souplesse.cabal

@@ -70,6 +70,7 @@ executable souplesse
     -- Other library packages from which modules are imported.
     build-depends:
         base ^>=4.18.2.1
+      , aeson
       , souplesse-lib
       , text
       , bytestring
@@ -99,6 +100,8 @@ library souplesse-lib
         lib
     build-depends:
         base >=4.7 && <5
+      , aeson
+      , bytestring
       , xml-conduit
       , time
       , containers