module Main where

import Prelude

import Data.Array as Array
import Data.Either (Either(..))
import Data.Int as Int
import Data.Foldable as Foldable
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Number.Format (toString)
import Data.Set as Set
import Data.Tuple as Tup
import Effect (Effect)
import Effect.Console (log)
import Effect.Class (liftEffect)
import Effect.Exception (throw)
import TernaryGraph (Dimension, svgTextID, ternaryGraph, ternaryGraphSvg, TextStyle, tickLabelStrings)
import Web.DOM.Document (contentType
  , createElement
  , Document
  , getElementsByClassName
  , importNode
  , toNode
  , toNonElementParentNode
  , toParentNode
  , url
  )
import Web.DOM.DOMParser (makeDOMParser, parseSVGFromString)
import Web.DOM.Element as Element -- (Element, setAttribute, toEventTarget, toNode) as Element
import Web.DOM.Node (appendChild, childNodes, Node, nodeName, removeChild, setTextContent)
import Web.DOM.NodeList as NodeList
import Web.DOM.NonElementParentNode (getElementById)
import Web.DOM.ParentNode (firstElementChild)
import Web.Event.Event (Event, EventType(..))
import Web.Event.EventTarget (addEventListener, eventListener)
import Web.HTML (window)
import Web.HTML.HTMLElement as HTMLElement
import Web.HTML.HTMLInputElement as HTMLInput
import Web.HTML.HTMLDocument as HTMLDoc
import Web.HTML.Window (document)

myGetElementById :: Document -> String -> Effect Element.Element
myGetElementById doc id = do
  elementMay <- getElementById id $ toNonElementParentNode doc
  case elementMay of
    Nothing -> throw $ "Unable to find element with ID '" <> id <> "'"
    Just e -> pure e

getNodeById :: Document -> String -> Effect Node
getNodeById doc id = do
  elementMay <- getElementById id $ toNonElementParentNode doc
  case elementMay of
    Nothing -> throw $ "Unable to find element with ID '" <> id <> "'"
    Just e -> pure $ Element.toNode e

getAllTextDimensions :: forall f. Foldable.Foldable f => Document -> Node -> f (Tup.Tuple String TextStyle) -> Effect (Map.Map (Tup.Tuple String TextStyle) Dimension)
getAllTextDimensions document svgContainer strings = do
  myDomParser <- makeDOMParser

  -- Create svg fragments
  let textID = \i -> "text-" <> (show i)
  let (Tup.Tuple idMap _) = Foldable.foldr (\strTup (Tup.Tuple map i) -> Tup.Tuple (Map.insert (textID i) strTup map) (i + 1)) (Tup.Tuple Map.empty 0) strings
  let frag = \str style i -> svgTextID (Just (textID i)) str { x: 0.0, y: 0.0 } 0.0 style { widthPx: 0.0, heightPx: 0.0 }
  let fragments = Foldable.foldr (\(Tup.Tuple str style) arr -> Array.cons (frag str style (Array.length arr)) arr) [] strings

  -- create svg string
  let svg = ternaryGraphSvg fragments

  -- add to container
  svgDocMay <- parseSVGFromString svg myDomParser
  svgDoc <- case svgDocMay of
    Left error -> throw error
    Right doc -> pure doc

  elMay <- firstElementChild $ toParentNode svgDoc
  svgNode <- case elMay of
    Nothing -> throw "no child in svg doc"
    Just el -> pure $ Element.toNode el

  newNode <- importNode svgNode true document
  appendChild newNode svgContainer

  -- get dimensions for all text elements
  myMap <- Foldable.foldM (\map i -> do
    let id = textID i
    textElement <- myGetElementById document id
    boundingRect <- Element.getBoundingClientRect textElement
    
    let textNFontMay = Map.lookup id idMap
    textNFont <- case textNFontMay of
      Nothing -> throw $ "Missing '" <> id <> "' from map"
      Just x -> pure x
    
    log $ id <> ": " <> (toString boundingRect.width) <> ", " <> (toString boundingRect.height)
    
    pure $ Map.insert textNFont { widthPx: boundingRect.width, heightPx: boundingRect.height } map
  ) Map.empty (Array.range 0 ((Array.length fragments) - 1))

  -- remove the svg
  containerKids <- (childNodes svgContainer) >>= NodeList.toArray
  Foldable.for_ containerKids \kid -> do
    removeChild kid svgContainer

  pure myMap

update :: Event -> Effect Unit
update e = do
  w <- window
  d <- document w
  let document = HTMLDoc.toDocument d
  domParser <- makeDOMParser

  log "update"
  inputElement <- myGetElementById document "ticks"
  inputHTMLElement <- case HTMLInput.fromElement inputElement of
    Nothing -> throw "'ticks' element is not an input tag"
    Just e -> pure e
  ticks <- (liftM1 Int.round) $ HTMLInput.valueAsNumber inputHTMLElement

  svgContainer <- getNodeById document "svg-container"

  let graphDef = { axis1Label: "axis 1"
  , axis2Label: "axis 2"
  , axis3Label: "axis 3"
  , axis1Start: 0
  , axis2Start: 1
  , axis3Start: 20
  , numTicks: ticks
  , tickTextStyle: { sizePx: 12.0
    , typeface: "Liberation Sans"
    }
  , axisTitleTextStyle: { sizePx: 16.0
    , typeface: "Liberation Mono"
    }
  }

  let tickText = tickLabelStrings graphDef

  let tickTextStyles = Foldable.foldr (\text textStyleArray -> Array.cons (Tup.Tuple text graphDef.tickTextStyle) textStyleArray) [] tickText 
  let textStyles = tickTextStyles <> [ (Tup.Tuple graphDef.axis1Label graphDef.axisTitleTextStyle)
    , (Tup.Tuple graphDef.axis2Label graphDef.axisTitleTextStyle)
    , (Tup.Tuple graphDef.axis3Label graphDef.axisTitleTextStyle)
  ]
  textDimensions <- getAllTextDimensions document svgContainer textStyles

  log $ case Map.lookup (Tup.Tuple "axis 1" graphDef.axisTitleTextStyle) textDimensions of
    Nothing -> "Not found"
    Just { widthPx: width, heightPx: height} -> (toString width) <> ", " <> (toString height)

  let mySVGErr = ternaryGraph 100.0 50.0 50.0 graphDef textDimensions
  mySVG <- case mySVGErr of
    Left error -> throw error
    Right svg -> pure svg
  
  svgDocMay <- parseSVGFromString mySVG domParser
  svgDoc <- case svgDocMay of
    Left error -> throw error
    Right doc -> pure doc

  elMay <- firstElementChild $ toParentNode svgDoc
  svgNode <- case elMay of
    Nothing -> throw "no child in svg doc"
    Just el -> pure $ Element.toNode el

  containerKids <- (childNodes svgContainer) >>= NodeList.toArray
  Foldable.for_ containerKids \kid -> do
    removeChild kid svgContainer

  newNode <- importNode svgNode true document
  appendChild newNode svgContainer

main :: Effect Unit
main = do
  w <- window
  d <- document w
  let dd = HTMLDoc.toDocument d
  domParser <- makeDOMParser

  svgContainer <- getNodeById dd "svg-container"

  let graphDef = { axis1Label: "axis 1"
  , axis2Label: "axis 2"
  , axis3Label: "axis 3"
  , axis1Start: 0
  , axis2Start: 1
  , axis3Start: 20
  , numTicks: 10
  , tickTextStyle: { sizePx: 12.0
    , typeface: "Liberation Sans"
    }
  , axisTitleTextStyle: { sizePx: 16.0
    , typeface: "Liberation Mono"
    }
  }

  let tickText = tickLabelStrings graphDef

  log $ Array.intercalate ",\n" (Set.toUnfoldable tickText)

  let tickTextStyles = Foldable.foldr (\text textStyleArray -> Array.cons (Tup.Tuple text graphDef.tickTextStyle) textStyleArray) [] tickText 
  let textStyles = tickTextStyles <> [ (Tup.Tuple graphDef.axis1Label graphDef.axisTitleTextStyle)
    , (Tup.Tuple graphDef.axis2Label graphDef.axisTitleTextStyle)
    , (Tup.Tuple graphDef.axis3Label graphDef.axisTitleTextStyle)
  ]
  textDimensions <- getAllTextDimensions dd svgContainer textStyles

  log $ Foldable.foldr (\dim str -> str <> "\n" <> (toString dim.widthPx) <> ", " <> (toString dim.heightPx)) "" $ Map.values textDimensions

  let textDimensions2 = Map.mapMaybe (\dim -> Just {widthPx: 0.0, heightPx: 0.0}) textDimensions

  let mySVGErr = ternaryGraph 100.0 50.0 50.0 graphDef textDimensions2
  mySVG <- case mySVGErr of
    Left error -> throw error
    Right svg -> pure svg
  
  svgDocMay <- parseSVGFromString mySVG domParser
  svgDoc <- case svgDocMay of
    Left error -> throw error
    Right doc -> pure doc

  elMay <- firstElementChild $ toParentNode svgDoc
  svgNode <- case elMay of
    Nothing -> throw "no child in svg doc"
    Just el -> pure $ Element.toNode el
  
  newNode <- importNode svgNode true dd
  appendChild newNode svgContainer

  listener <- eventListener update

  inputElement <- myGetElementById dd "ticks"
  addEventListener (EventType "input") listener true (Element.toEventTarget inputElement)
  log "20250727T183907"
  --inputMay <- getElementById "ticks" $ toNonElementParentNode dd
  --inputNode <- case inputMay of
    --Nothing -> throw $ "Unable to find " <> containerID 
    --Just e -> pure $ Element.toNode e