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

module Main where

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.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 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
/upload UploadR POST
/static StaticR Static getStatic
|]

instance Yesod Souplesse

getCalendarR :: Handler Html
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 File = File

data FileForm = FileForm
  { fileInfo :: FileInfo
  --    , fileDescription :: Text
  }

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>error ]
        FormMissing  ->
          traceShow "missing" $
          defaultLayout [whamlet|<p>missing|]
    FormFailure x ->
      traceShow x $
        defaultLayout
          [whamlet|
                <p>Nope, sorry
            |]

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'