Makefile

@@ -1,7 +0,0 @@
-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,122 +1,27 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeFamilies #-}
-
 module Main where
 
-import Data.ByteString.Lazy as BS
+import Track(parseFile)
 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
 
-staticFiles "frontend" -- this param appears to be a pathname
+data HelloWorld = HelloWorld
 
-data Souplesse = Souplesse
+mkYesod "HelloWorld" [parseRoutes|
-  { getStatic :: Static
+/ HomeR GET
-  }
-
--- 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 Souplesse
+instance Yesod HelloWorld
 
-getCalendarR :: Handler Html
+getHomeR :: Handler Html
-getCalendarR = do
+getHomeR = defaultLayout [whamlet|Hello World!|]
-  (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"
-  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 HelloWorld
-  warp 3000 $ Souplesse static'

lib/Track.hs

@@ -11,18 +11,17 @@ 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
@@ -120,7 +119,3 @@ 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,11 +71,7 @@ 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