Compare commits

..

No commits in common. "f5811078691e3d3a0c43e985bc641a4f48d237f2" and "12f1de6e58c5c2176bb0267a5f49a244b6d66067" have entirely different histories.

4 changed files with 15 additions and 126 deletions

View File

@ -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=$@ $<

View File

@ -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 module Main where
import Data.ByteString.Lazy as BS import Track(parseFile)
import Data.List as List 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 :: IO ()
main = do main = do
points <- Track.parseFile "track.gpx" 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'

View File

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

View File

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