README.md

@@ -73,7 +73,3 @@ _Do not look below this line_
 * frontend can get data from backend
 * for DX, backend can serve the js files needed by frontend
 * we only have yesod-core, may need other parts as well
-```
-docker run -p 5432:5432 --name souplesse-postgres -e POSTGRES_USER=souplesse  -e POSTGRES_PASSWORD=secret -d postgres
-nix-shell -p postgresql --run "psql -h localhost -U souplesse   -p 5432"
-```

app/Main.hs

@@ -6,13 +6,13 @@
 
 module Main where
 
-import Control.Monad.Logger (runStderrLoggingT)
 import Data.ByteString.Lazy as BS
 import Data.List as List
-import Database.Persist.Postgresql (ConnectionString, runMigration, runSqlPersistMPool, withPostgresqlPool)
+import Data.Text as T
 import Debug.Trace (traceShow)
-import Store (migrateAll, save)
 import Track (parseBS, parseFile)
+-- import Import
+
 import Yesod.Core
 import Yesod.Form.Fields
 import Yesod.Form.Functions
@@ -41,7 +41,7 @@ instance Yesod Souplesse
 
 getCalendarR :: Handler Html
 getCalendarR = do
-  (formWidget, _) <- generateFormPost uploadForm
+  (formWidget, formEnctype) <- generateFormPost uploadForm
   defaultLayout
     [whamlet|
 <h1>Calendar
@@ -92,14 +92,14 @@ instance RenderMessage Souplesse FormMessage where
 
 postUploadR :: Handler Html
 postUploadR = do
-  ((result, _), _) <- runFormPost uploadForm
+  ((result, widget), enctype) <- runFormPost uploadForm
   case result of
     FormSuccess upload -> do
       bs <- fileSourceByteString $ fileInfo upload
       case Track.parseBS (fromStrict bs) of
         Right points ->
           defaultLayout [whamlet|<p>#{List.length points} points - thanks!|]
-        Left _ ->
+        Left e ->
           defaultLayout
             [whamlet|<p>parse error ]
     FormMissing ->
@@ -114,16 +114,9 @@ postUploadR = do
 
             |]
 
-connStr :: ConnectionString
-connStr = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret"
-
 main :: IO ()
-main = runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do
+main = do
-  flip runSqlPersistMPool pool $ do
+  points <- Track.parseFile "track.gpx"
-    runMigration migrateAll
-
-    p1 : _ <- liftIO $ Track.parseFile "track.gpx"
-    Store.save p1
   static'@(Static settings) <- static "frontend"
-  -- putStrLn ("loaded " ++ show (List.length points) ++ " points from GPX")
+  putStrLn ("loaded " ++ show (List.length points) ++ " points from GPX")
   warp 3000 $ Souplesse static'

lib/Store.hs

@@ -1,55 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Store (save, migrateAll) where
-
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Reader (ReaderT)
-import Data.Time.Clock (UTCTime)
-import Database.Persist
-import Database.Persist.Postgresql
-  ( ConnectionString,
-    SqlBackend,
-    createPostgresqlPool,
-    pgConnStr,
-    pgPoolSize,
-    runMigration,
-    runSqlPool,
-  )
-import Database.Persist.TH
-import Track as T
-
-connString :: ConnectionString
-connString = "host=127.0.0.1 port=5432 user=souplesse dbname=souplesse password=secret"
-
-share
-  [mkPersist sqlSettings, mkMigrate "migrateAll"]
-  [persistLowerCase|
-Trkpt
-    lat Double
-    lon Double
-    ele Double Maybe
-    time UTCTime
-    cadence Int Maybe
-    power Int Maybe
-    heartRate  Int Maybe
-|]
-
-fromPoint :: Point -> Trkpt
-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)
-
-save p = do insert $ fromPoint p

lib/Track.hs

@@ -4,7 +4,6 @@ module Track
   ( Track,
     Pos (..),
     BadFile,
-    Point,
     pos,
     cadence,
     power,
@@ -33,7 +32,7 @@ import Text.Read (readMaybe)
 import Text.XML
 import Text.XML.Cursor as Cursor
 
-data Pos = Pos Double Double (Maybe Double) deriving (Show, Eq)
+data Pos = Pos Float Float (Maybe Float) deriving (Show, Eq)
 
 type Power = Maybe Int
 
@@ -65,12 +64,12 @@ instance Exception BadFile
 
 elToPoint :: Cursor -> Either SomeException Point
 elToPoint c =
-  let lat = listToMaybe (attribute "lat" c) >>= asDouble
+  let lat = listToMaybe (attribute "lat" c) >>= asFloat
-      lon = listToMaybe (attribute "lon" c) >>= asDouble
+      lon = listToMaybe (attribute "lon" c) >>= asFloat
       ts =
         listToMaybe (child c >>= element (gpxNS "time") >>= child >>= content)
           >>= (Data.Time.ISO8601.parseISO8601 . Data.Text.unpack)
-      ele = listToMaybe (child c >>= element (gpxNS "ele") >>= child >>= content) >>= asDouble
+      ele = listToMaybe (child c >>= element (gpxNS "ele") >>= child >>= content) >>= asFloat
       gpxtpx =
         child c
           >>= element (gpxNS "extensions")
@@ -94,7 +93,7 @@ elToPoint c =
               (listToMaybe hr >>= asInt)
         else Left (toException (BadFile "missing a required attribute"))
   where
-    asDouble v = (readMaybe :: String -> Maybe Double) (Data.Text.unpack v)
+    asFloat v = (readMaybe :: String -> Maybe Float) (Data.Text.unpack v)
     asInt v = (readMaybe :: String -> Maybe Int) (Data.Text.unpack v)
 
 getPoints :: Cursor -> Either SomeException [Point]

souplesse.cabal

@@ -73,9 +73,6 @@ executable souplesse
       , souplesse-lib
       , text
       , bytestring
-      , persistent
-      , persistent-postgresql
-      , monad-logger
       , yesod-core == 1.6.25.1
       , yesod-static
       , yesod-form
@@ -92,7 +89,6 @@ executable souplesse
 library souplesse-lib
     exposed-modules:
         Track
-        Store
     hs-source-dirs:
         lib
     build-depends:
@@ -101,9 +97,6 @@ library souplesse-lib
       , time
       , containers
       , text
-      , transformers
-      , persistent
-      , persistent-postgresql
       , iso8601-time
     default-language: GHC2021