{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}

module Main where

import Track(parseFile)
import Data.List as List

import           Yesod.Core

-- 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 Souplesse = Souplesse
  { 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
/static StaticR Static getStatic
|]

instance Yesod Souplesse

getCalendarR :: Handler Html
getCalendarR = defaultLayout [whamlet|
<h1>Calendar</h1>

<p>A calendar view goes here

<a href="/timeline">timeline</a>
&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
|]


main :: IO ()
main = do
  points <- Track.parseFile "track.gpx"
  static'@(Static settings) <- static "frontend"
  putStrLn ("loaded " ++ show (List.length points) ++ " points from GPX")
  warp 3000 $ Souplesse static'