module TernaryGraph where

import Prelude (discard, class Monoid, class Semigroup, Unit, (==), ($), (<), (<=), (<<<), (<>), (*), (+), (-), (/), (&&))

--import Data.Array ((!!), concat, cons, mapWithIndex, range)
import Data.Array as Array
import Data.Either as Either
import Data.Functor (map)
import Data.Int as Int
import Data.List (fold)
import Data.Map as Map
import Data.Maybe as Maybe
import Data.Number (cos, pi, sin)
import Data.Number.Format (toString)
import Data.Ord ((<))
import Data.Ring (negate)
import Data.Set as Set
import Data.Tuple as Tup
import Data.Tuple.Nested (Tuple3, tuple3, get1, get2, get3)

-- A spatial value (position, size) in pixels
-- TODO: Apply this across all spatial values
newtype Pixels = Pixels Number

unpixel :: Pixels -> Number
unpixel (Pixels value) = value

type Dimension =
  { widthPx :: Number
  , heightPx :: Number
  }

type TextStyle =
  {  typeface :: String
  ,  sizePx :: Number
  }

type Point =
  { x :: Number
  , y :: Number
  }

type GraphDefinition =
  { axis1Label :: String
  , axis2Label :: String
  , axis3Label :: String
  , axis1Start :: Int
  , axis2Start :: Int
  , axis3Start :: Int
  , numTicks :: Int
  , tickTextStyle :: TextStyle
  , tickSize :: Pixels
  , axisTitleTextStyle :: TextStyle
  }

type Line =
  { start :: Point
  , end :: Point
  }

rotate :: Number -> Point -> Point
rotate angle { x: x, y: y} = {
  x: x * (cos angle) - y * (sin angle),
  y: x * (sin angle) + y * (cos angle)
}

transform :: Number -> Number -> Number -> Point -> Point
transform scale xOffset yOffset { x: x, y: y} = {
  x: scale * x + xOffset,
  y: scale * y + yOffset
}

rotateLine :: Number -> Line -> Line
rotateLine angle { start: p1, end: p2} = {
  start: rotate angle p1,
  end: rotate angle p2
}

transformLine :: Number -> Number -> Number -> Line -> Line
transformLine scale xOffset yOffset { start: start, end: end } = {
start : t start,
end : t end
}
  where t = transform scale xOffset yOffset

newtype XMLFragment = XMLFragment String

derive newtype instance xmlFragmentSemiGroup :: Semigroup XMLFragment
derive newtype instance xmlFragmentMonoid :: Monoid XMLFragment

-- TODO: Add style configuration
svgLine :: Line -> XMLFragment
svgLine { start: {x: x1, y: y1}, end: {x: x2, y: y2} } =
  XMLFragment $ """<path style="fill:none;stroke:#000000;stroke-width:0.5;stroke-linecap:butt;stroke-linejoin:miter;stroke-dasharray:none;stroke-opacity:1"
  """ <> "d=\"M " <> (toString x1) <> "," <> (toString y1) <> " " <> (toString x2) <> "," <> (toString y2) <> "\"/>"

svgText :: String -> Point -> Number -> TextStyle -> Dimension -> XMLFragment
svgText = svgTextID Maybe.Nothing

svgTextID :: Maybe.Maybe String -> String -> Point -> Number -> TextStyle -> Dimension -> XMLFragment
svgTextID idMaybe text { x: x, y: y } angle style dimension =
  XMLFragment $ "<text " <> idText <> " xml:space=\"preserve\" style=\"font-size:" <> (toString style.sizePx) <> "px;line-height:131%;font-family:'" <> style.typeface <> "';fill:#000000;stroke:#000000;stroke-width:0.0999998;stroke-linecap:round;stop-color:#000000;fill-opacity:1\" "
  <> "transform=\"translate(" <> (toString centerX) <> ", " <> (toString centerY) <> ") rotate(" <> (toString (angle * 180.0 / pi)) <> ")\">" <> text <> "</text>"
  where
    offset = rotate angle {x: dimension.widthPx / 4.0, y: -dimension.heightPx / 8.0}
    centerX = x - offset.x
    centerY = y - offset.y
    idText = case idMaybe of
      Maybe.Nothing -> ""
      Maybe.Just id -> "id=\"" <> id <> "\""

getTick :: Number -> Int -> Pixels -> Int -> Line
getTick scale numTicks tickSize tickI =
  {start: {x: x, y: -(0.5 + (unpixel tickSize) / scale)}, end: {x: x, y: y}}
  where
    -- For even number of ticks, the ticks don't intersect in the required pattern, so offset them
    x = if (Int.rem numTicks 2) == 0 
          then 2.0 * (sin (pi / 3.0)) * (Int.toNumber tickI) / (Int.toNumber numTicks) - (sin (pi / 3.0))
          else 2.0 * (sin (pi / 3.0)) * ((Int.toNumber tickI) + 1.0) / ((Int.toNumber numTicks) + 0.5) - (sin (pi / 3.0)) - ((9.5 / 6.0) / ((Int.toNumber numTicks) + 0.5))
    y = if x < 0.0
          then 1.0 + x * 1.5 / (sin (pi / 3.0))
          else 1.0 - x * 1.5 / (sin (pi / 3.0))

getTicks :: Number -> Number -> Pixels -> Int -> Tuple3 (Array Line) (Array Line) (Array Line)
getTicks scale angle tickSize numTicks =
  tuple3 axis1Lines axis2Lines axis3Lines
  where
    foo = map (getTick scale (numTicks - 1) tickSize) (Array.range 0 (numTicks - 1))
    axis1Lines = map (rotateLine angle) foo
    axis2Lines = map (rotateLine (2.0 * pi / 3.0)) axis1Lines
    axis3Lines = map (rotateLine (2.0 * pi / 3.0)) axis2Lines

-- There's probably a better way to do this
unfragment :: XMLFragment -> String
unfragment (XMLFragment frag) = frag

ternaryGraphSvg :: Array XMLFragment -> String
ternaryGraphSvg fragments = """<?xml version="1.0" encoding="UTF-8"?>
  <svg
    width="110mm"
    height="80mm"
    viewBox="-75 -50 250 220"
    version="1.1"
    xmlns="http://www.w3.org/2000/svg"
    xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
    xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
    xmlns:svg="http://www.w3.org/2000/svg">
""" <> unfragment (fold fragments) <> "</svg>"

axesPoints :: Number -> Tuple3 Point Point Point
axesPoints angle = tuple3 
  (rotate angle { x: 0.0, y: 1.0 })
  (rotate angle { x: -(sin (2.0 * pi / 3.0)), y : -0.5 })
  (rotate angle { x: (sin (2.0 * pi / 3.0)), y: -0.5 })

axesPath :: Point -> Point -> Point -> XMLFragment
axesPath p1 p2 p3 = XMLFragment $ """<path style="fill:none;stroke:#000000;stroke-width:1;stroke-linecap:bevel;stroke-linejoin:bevel;stroke-dasharray:none;stroke-opacity:1"
""" <> "d=\"M " <> (toString p1.x) <> "," <> (toString p1.y) <> " " <> (toString p2.x) <> "," <> (toString p2.y) <> " " <> (toString p3.x) <> "," <> (toString p3.y) <> " Z\"/>"

tickLabelStrings :: GraphDefinition -> Set.Set String
tickLabelStrings def =
  Set.map (\x -> "E" <> (toString (Int.toNumber x))) axisTicks
  where
    axis1Ticks = Set.fromFoldable (Array.range def.axis1Start (def.axis1Start + def.numTicks))
    axis2Ticks = Set.fromFoldable (Array.range def.axis2Start (def.axis2Start + def.numTicks))
    axis3Ticks = Set.fromFoldable (Array.range def.axis3Start (def.axis3Start + def.numTicks))
    axisTicks = Set.union (Set.union axis1Ticks axis2Ticks) axis3Ticks

ternaryGraph :: Number -> Number -> Number -> GraphDefinition -> Map.Map (Tup.Tuple String TextStyle) Dimension -> Either.Either String String
ternaryGraph scale xOffset yOffset definition textDimensions = result
  where
    axisTickLines = getTicks scale pi definition.tickSize definition.numTicks
    axis1TickLines = map (transformLine scale xOffset yOffset) (get1 axisTickLines)
    axis2TickLines = map (transformLine scale xOffset yOffset) (get2 axisTickLines)
    axis3TickLines = map (transformLine scale xOffset yOffset) (get3 axisTickLines)
    tickLines = Array.concat [axis1TickLines, axis2TickLines, axis3TickLines]
    tickLinesSvg = fold $ map svgLine tickLines

    axesPointsPi = axesPoints pi
    axisPoint1 = transform scale xOffset yOffset (get1 axesPointsPi)
    axisPoint2 = transform scale xOffset yOffset (get2 axesPointsPi)
    axisPoint3 = transform scale xOffset yOffset (get3 axesPointsPi)
    axesPathSvg = axesPath axisPoint1 axisPoint2 axisPoint3

    axis1TitleDim = Map.lookup (Tup.Tuple definition.axis1Label definition.axisTitleTextStyle) textDimensions
    axis2TitleDim = Map.lookup (Tup.Tuple definition.axis2Label definition.axisTitleTextStyle) textDimensions
    axis3TitleDim = Map.lookup (Tup.Tuple definition.axis3Label definition.axisTitleTextStyle) textDimensions

    axis1TitlePos = {x: 0.0, y: 0.9}
    axis2TitlePos = rotate (2.0 * pi / 3.0) axis1TitlePos
    axis3TitlePos = rotate (-2.0 * pi / 3.0) axis1TitlePos

    axisTitleSize = definition.axisTitleTextStyle.sizePx
    axisTitlesSvg :: Array (Either.Either String XMLFragment)
    axisTitlesSvg = [
      case axis1TitleDim of
        Maybe.Nothing -> Either.Left ("Failed to find '" <> definition.axis1Label <> "' in dimensions map") 
        Maybe.Just dim -> Either.Right $ svgText definition.axis1Label (transform scale xOffset yOffset axis1TitlePos) 0.0 definition.axisTitleTextStyle dim,
      case axis2TitleDim of
        Maybe.Nothing -> Either.Left ("Failed to find '" <> definition.axis2Label <> "' in dimensions map") 
        Maybe.Just dim -> Either.Right $ svgText definition.axis2Label (transform scale xOffset yOffset axis2TitlePos) (-pi / 3.0) definition.axisTitleTextStyle dim,
      case axis3TitleDim of
        Maybe.Nothing -> Either.Left ("Failed to find '" <> definition.axis3Label <> "' in dimensions map") 
        Maybe.Just dim -> Either.Right $ svgText definition.axis3Label (transform scale xOffset yOffset axis3TitlePos) (pi / 3.0) definition.axisTitleTextStyle dim
    ]
 
    tickLength = 5.0
    -- TODO: Base this off of label dimensions / orientation
    labelSpacing = 5.0
    axis1Offset = {x: 0.0, y: tickLength + labelSpacing}
    axis2Offset = rotate (2.0 * pi / 3.0) axis1Offset
    axis3Offset = rotate (-2.0 * pi / 3.0) axis1Offset
    axis1TickStarts = map (\line -> line.start + axis1Offset)
    axis2TickStarts = map (\line -> line.start + axis2Offset)
    axis3TickStarts = map (\line -> line.start + axis3Offset)
    
    axisTickLabels = \rotation startI -> Array.mapWithIndex (\i point -> 
      let text = ("E" <> (toString (Int.toNumber (i + startI))))
          angle = 0.0
          labelText = case Map.lookup (Tup.Tuple text definition.tickTextStyle) textDimensions of
            Maybe.Nothing -> Either.Left ("Failed to find '" <> text <> "' in dimensions map") 
            Maybe.Just dimension -> Either.Right $ svgText text point angle definition.tickTextStyle dimension
      in labelText
    )

    axis1TickLabels :: Array (Either.Either String XMLFragment)
    axis1TickLabels = axisTickLabels 0.0 definition.axis1Start $ axis1TickStarts axis1TickLines
    axis2TickLabels = axisTickLabels 0.0 definition.axis2Start $ axis2TickStarts axis2TickLines
    axis3TickLabels = axisTickLabels 0.0 definition.axis3Start $ axis3TickStarts axis3TickLines

    labelFragmentsErr = Array.concat [axisTitlesSvg, axis1TickLabels, axis2TickLabels, axis3TickLabels]

    labelFragments = Array.foldr (\labelFragmentErr soFar -> case labelFragmentErr of
      Either.Left _ -> soFar
      Either.Right labelFragment -> Array.cons labelFragment soFar) [] labelFragmentsErr

    errors = Array.foldr (\labelFragmentErr soFar -> case labelFragmentErr of
      Either.Left labelFragment -> Array.cons labelFragment soFar
      Either.Right _ -> soFar) [] labelFragmentsErr

    fragments = Array.concat [[tickLinesSvg, axesPathSvg], labelFragments]
    result = if Array.all (\x -> Either.isRight x) labelFragmentsErr then
      Either.Right $ ternaryGraphSvg fragments
      else
      -- TODO: Include specific labels
      Either.Left $ Array.intercalate "\n" errors