delete commented code

Makefile

@@ -0,0 +1,7 @@
+default: frontend/frontend.js dist-newstyle/build/x86_64-linux/ghc-9.6.5/souplesse-0.1.0.0/x/souplesse/build/souplesse/souplesse
+
+dist-newstyle/build/x86_64-linux/ghc-9.6.5/souplesse-0.1.0.0/x/souplesse/build/souplesse/souplesse: app/*.hs lib/*.hs
+	cabal build
+
+frontend/frontend.js: frontend/src/Main.elm
+	elm make --output=$@ $<

app/Main.hs

@@ -1,27 +1,122 @@
-{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
 module Main where
 
-import Track(parseFile)
+import Data.ByteString.Lazy as BS
 import Data.List as List
+import Data.Text as T
+import Debug.Trace (traceShow)
+import Track (parseBS, parseFile)
+-- import Import
 
-import           Yesod.Core
+import Yesod.Core
+import Yesod.Form.Fields
+import Yesod.Form.Functions
+import Yesod.Form.Types
+-- https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Static-file-subsite-Hello-World.md
+import Yesod.Static
 
-data HelloWorld = HelloWorld
+staticFiles "frontend" -- this param appears to be a pathname
 
-mkYesod "HelloWorld" [parseRoutes|
+data Souplesse = Souplesse
-/ HomeR GET
+  { getStatic :: Static
+  }
+
+-- ref https://www.yesodweb.com/book/routing-and-handlers
+-- for adding params (start/end) to the timeline route
+mkYesod
+  "Souplesse"
+  [parseRoutes|
+/ CalendarR GET
+/timeline TimelineR GET
+/upload UploadR POST
+/static StaticR Static getStatic
 |]
 
-instance Yesod HelloWorld
+instance Yesod Souplesse
 
-getHomeR :: Handler Html
+getCalendarR :: Handler Html
-getHomeR = defaultLayout [whamlet|Hello World!|]
+getCalendarR = do
+  (formWidget, formEnctype) <- generateFormPost uploadForm
+  defaultLayout
+    [whamlet|
+<h1>Calendar
+
+<p>A calendar view goes here
+
+<form action="/upload" method=post enctype="multipart/form-data">
+    ^{formWidget}
+    <input type="submit" name="send" value="send">
+
+<a href="/timeline">timeline
+&copy; 2024 Daniel Barlow
+|]
+
+getTimelineR :: Handler Html
+-- what's this about? <img src=@{StaticR image_png}/>|]
+getTimelineR = defaultLayout $ do
+  setTitle "timeline"
+  addScriptRemote "/static/frontend.js"
+  toWidgetBody
+    [julius|
+window.addEventListener("load", function(){
+var app = Elm.Main.init({
+  node: document.getElementById("elm")
+});
+})
+|]
+  toWidget
+    [hamlet|
+<pre id="elm">
+<p>Copyright &copy; 2024 Daniel Barlow
+|]
+
+data FileForm = FileForm
+  { fileInfo :: FileInfo
+  }
+
+type Form x = Html -> MForm (HandlerFor Souplesse) (FormResult x, Widget)
+
+uploadForm :: Form FileForm
+uploadForm =
+  renderDivs $
+    FileForm
+      <$> fileAFormReq "choose file"
+
+instance RenderMessage Souplesse FormMessage where
+  renderMessage _ _ = defaultFormMessage
+
+postUploadR :: Handler Html
+postUploadR = do
+  ((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 e ->
+          defaultLayout
+            [whamlet|<p>parse error ]
+    FormMissing ->
+        defaultLayout [whamlet|<p>FormMissing  (?)|]
+    FormFailure errors ->
+      defaultLayout
+        [whamlet|
+                 <h1>Error uploading
+                 <ul>
+                     $forall err <- errors
+                         <li>#{err}
+
+            |]
 
 main :: IO ()
 main = do
   points <- Track.parseFile "track.gpx"
-  putStrLn ("loaded " ++ (show (List.length points)) ++ " points from GPX")
+  static'@(Static settings) <- static "frontend"
-  warp 3000 HelloWorld
+  putStrLn ("loaded " ++ show (List.length points) ++ " points from GPX")
+  warp 3000 $ Souplesse static'

lib/Track.hs

@@ -11,17 +11,18 @@ module Track
     time,
     parse,
     parseFile,
+    parseBS,
     Track.length,
   )
 where
 
 import Control.Exception
+import Data.Either
 import Data.Functor ((<&>))
 import Data.List as List
 import Data.List qualified
 import Data.Map as Map
 import Data.Maybe
-import Data.Either
 import Data.Text qualified
 import Data.Text.Lazy as T
 import Data.Time
@@ -119,3 +120,7 @@ parseFile name = do
   return $ case getPoints (fromDocument gpx) of
     Left err -> []
     Right points -> points
+
+parseBS bs = do
+  gpx <- parseLBS def bs
+  getPoints (fromDocument gpx)

souplesse.cabal

@@ -71,7 +71,11 @@ executable souplesse
     build-depends:
         base ^>=4.18.2.1
       , souplesse-lib
+      , text
+      , bytestring
       , yesod-core == 1.6.25.1
+      , yesod-static
+      , yesod-form
 
     -- Directories containing source files.
     hs-source-dirs:   app