{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}

module Examples where

import Lucid.Svg

import Control.Monad (unless)
import Data.Foldable (for_)
import Data.Function ((&))
import Data.String (IsString(..))
import Geomancy.Layout.Alignment qualified as Alignment
import Geomancy.Layout.Box (Box(..))
import Geomancy.Layout.Box qualified as Box
import Geomancy.Layout.View (LayoutView(..), View(..), ViewSize(..), layout)
import Geomancy.Layout.View qualified as ViewSize
import Geomancy.Vec2 (Vec2, vec2, pattern WithVec2)
import Lucid.Svg qualified as SVG

toSVGfile :: forall stuff . (LayoutView stuff, Show (Placed stuff), SVGStuff (Placed stuff)) => FilePath -> View () stuff -> IO ()
toSVGfile path =
  SVG.renderToFile path . toSVG @stuff . layout exampleScreenBox

class SVGStuff stuff where
  svgStuff :: stuff -> String

instance SVGStuff String where
  svgStuff = id

instance SVGStuff Dynamic where
  svgStuff = \case
    Label s -> s
    Icon s -> s

toSVG :: (LayoutView stuff, SVGStuff (Placed stuff)) => View Box (Placed stuff) -> Svg ()
toSVG = svg . go
  where
    go = \case
      View{ann, stuff} -> g_ [class_ "view"] $ contents ann "red" (svgStuff  stuff)
      Spacer{ann} -> g_ [class_ "spacer"] $ contents ann "#acf" ""
      HStack{ann, children} -> g_ [class_ "hstack"] $ contents ann "#afa" "" <> for_ children go
      VStack{ann, children} -> g_ [class_ "vstack"] $ contents ann "#aaf" "" <> for_ children go
      ZStack{ann, children} -> g_ [class_ "zstack"] $ contents ann "#faa" "" <> for_ children go
      Overlay{primary, secondary} -> g_ [class_ "overlay"] $ go primary <> go secondary
      Frame{ann, inner} -> g_ [class_ "frame"] $ contents ann "#faf" "" <> go inner
      FlexibleFrame{ann, inner} -> g_ [class_ "flex"] $ contents ann "#ffa" "" <> go inner
      Padding{inner} -> g_ [class_ "padding"] $ go inner -- dashed rect?
      Offset{inner} -> g_ [class_ "offset"] $ go inner -- dashed rect?
      AspectRatio{ann, inner} -> g_ [class_ "aspect"] $ contents ann "#aff" "" <> go inner

    svg :: Svg () -> Svg ()
    svg content = do
      doctype_
      with
        (svg11_ $ rect_ [width_ "100%", height_ "100%", fill_ "#ddd"] <> content
        )
        [ version_ "1.1"
        , width_ "800"
        , height_ "600"
        ]

    -- contents :: SVG.Svg ()

    contents box color ss = do
      let (WithVec2 x y, _br) = Box.toCorners box
      -- let WithVec2 x y = position - size * 0.5
      let WithVec2 w h = box.size
      rect_
        [ x_ (fromString $ show x)
        , y_ (fromString $ show y)
        , width_ (fromString $ show w)
        , height_ (fromString $ show h)
        , fill_ color
        , fill_opacity_ "0.5"
        , stroke_ "black"
        , stroke_width_ "1"
        , rx_ "12"
        ]
      unless (null ss) $ text_
        [ x_ (fromString $ show $ x + w / 2)
        , y_ (fromString $ show $ y + (h + 10) / 2)
        , font_size_ "16"
        , text_anchor_ "middle"
        , text_ "middle"
        , fill_ "black"
        ]
        (fromString ss)
        -- (fromString . show $ (position, size))

newtype Static = Static String
  deriving newtype (Eq, Ord, Show, IsString)

instance LayoutView Static where
  type ReportedCache Static = String
  type Placed Static = String
  viewFlexibility _ = ViewSize.infinite_{minWidth=Just 20, minHeight=Just 20}
  proposeView proposed (Static s) = (proposed, s)
  placeView _box = id

data Dynamic
  = Label String -- ^ Trims content to fit
  | Icon String -- ^ Fixed size/content
  deriving (Eq, Ord, Show)

instance LayoutView Dynamic where
  type ReportedCache Dynamic = (Int, Dynamic)
  viewFlexibility = \case
    Label s ->
      -- The way SwiftUI does it (allegedly)
      ViewSize.range_
        (fst . proposeView 0 $ Label s)
        (fst . proposeView (1/0) $ Label s)
    Icon{} -> ViewSize.fixed_ 32
  proposeView (WithVec2 w _h) e = case e of
    Label s -> (vec2 maxWidth 32, (len, e'))
      where
        charWidth = 10
        maxChars = floor (w / charWidth)
        trimmed =
          if maxChars > 0 && maxChars < length s then
            take maxChars s
          else
            s
        len = length trimmed
        maxWidth = fromIntegral len * charWidth
        e' = Label trimmed
    Icon _ -> (32, (2, e))
  placeView _parent (_len, e) = e

-- | Set up screen box with the top-left corner at 0,0 and origin at 400,300
exampleScreenBox :: Box
exampleScreenBox = Box
  { position = exampleScreenSize / 2 -- use 0,0 origin to match SVG
  , size = exampleScreenSize
  }

exampleScreenSize :: Vec2
exampleScreenSize = vec2 800 600

{- | 2 flexible views split parent in equal halves

@
HStack
  {ann =
     Box
       {position = Vec2 400.0 300.0,
        size = Vec2 800.0 600.0},
   children =
     [View
        {ann =
           Box
             {position = Vec2 200.0 300.0,
              size = Vec2 400.0 600.0},
         stuff = "400x600"},
      View
        {ann =
           Box
             {position = Vec2 600.0 300.0,
              size = Vec2 400.0 600.0},
         stuff = "400x600"}]}
@
-}
exampleHalves :: View () Static
exampleHalves =
  HStack ()
    [ View () "400x600"
    , View () "400x600"
    ]

{- | Mixing fixed and flexible views

@
HStack
  {ann =
     Box
       {position = Vec2 400.0 300.0,
        size = Vec2 800.0 600.0},
   children =
     [Frame
        {ann =
           Box
             {position = Vec2 50.0 300.0, size = Vec2 100.0 50.0},
         size = Vec2 100.0 50.0,
         align = Alignment (Vec2 0.5 0.5),
         inner =
           View
             {ann =
                Box
                  {position = Vec2 50.0 300.0, size = Vec2 100.0 50.0},
              stuff = "Fixed 100x50"}},
      Spacer
        {ann =
           Box
             {position = Vec2 255.0 300.0,
              size = Vec2 310.0 600.0}},
      View
        {ann =
           Box
             {position = Vec2 565.0 300.0,
              size = Vec2 310.0 600.0},
         stuff = "Flexible 310x600"},
      Frame
        {ann =
           Box
             {position = Vec2 760.0 40.0, size = Vec2 80.0 80.0},
         size = Vec2 80.0 80.0,
         align = Alignment (Vec2 0.0 0.0),
         inner =
           View
             {ann =
                Box
                  {position = Vec2 760.0 40.0, size = Vec2 80.0 80.0},
              stuff = "Fixed 80x80"}}]}
@
-}
exampleTree :: View () Static
exampleTree =
  HStack ()
    [ Frame () (vec2 100 50) Alignment.centerBottom $ -- Fixed size
        View () "Fixed 100x50" -- Inherited
    , Spacer () -- Flexible (Infinite)
    , View () "Flexible 310x600" -- Flexible (Infinite)
    , Frame () (vec2 80 80) Alignment.leftTop $ -- Fixed size
        View () "Fixed 80x80" -- Inherited
    ]

{- | Smoke test for frames asserting the view sizes

@
Frame
  {ann =
     Box
       {position = Vec2 400.0 300.0,
        size = Vec2 800.0 600.0},
   size = Vec2 800.0 600.0,
   align = Alignment (Vec2 0.5 0.5),
   inner =
     HStack
       {ann =
          Box
            {position = Vec2 400.0 300.0,
             size = Vec2 800.0 600.0},
        children =
          [Frame
             {ann =
                Box
                  {position = Vec2 200.0 300.0,
                   size = Vec2 400.0 600.0},
              size = Vec2 400.0 600.0,
              align = Alignment (Vec2 0.5 0.5),
              inner =
                View
                  {ann =
                     Box
                       {position = Vec2 200.0 300.0,
                        size = Vec2 400.0 600.0},
                   stuff = "400x600"}},
           Frame
             {ann =
                Box
                  {position = Vec2 600.0 300.0,
                   size = Vec2 400.0 600.0},
              size = Vec2 400.0 600.0,
              align = Alignment (Vec2 0.5 0.5),
              inner =
                View
                  {ann =
                     Box
                       {position = Vec2 600.0 300.0,
                        size = Vec2 400.0 600.0},
                   stuff = "400x600"}}]}}
@
-}
exampleFramed :: View () Static
exampleFramed =
  Frame () exampleScreenBox.size Alignment.center $ -- XXX: no-op
    HStack ()
      [ Frame () (vec2 400 600) Alignment.center $ View () "400x600"
      , Frame () (vec2 400 600) Alignment.center $ View () "400x600"
      ]

{- | Smoke test for nesting HStacks

@
HStack
  {ann =
     Box
       {position = Vec2 400.0 300.0,
        size = Vec2 800.0 600.0},
   children =
     [HStack
        {ann =
           Box
             {position = Vec2 400.0 300.0,
              size = Vec2 800.0 600.0},
         children =
           [HStack
              {ann =
                 Box
                   {position = Vec2 200.0 300.0,
                    size = Vec2 400.0 600.0},
               children =
                 [View
                    {ann =
                       Box
                         {position = Vec2 200.0 300.0,
                          size = Vec2 400.0 600.0},
                     stuff = "400x600"}]},
            HStack
              {ann =
                 Box
                   {position = Vec2 600.0 300.0,
                    size = Vec2 400.0 600.0},
               children =
                 [View
                    {ann =
                       Box
                         {position = Vec2 600.0 300.0,
                          size = Vec2 400.0 600.0},
                     stuff = "400x600"}]}]}]}
@
-}
exampleNested :: View () Static
exampleNested =
  HStack () . pure $ -- XXX: no-op
    HStack ()
      [ HStack () [View () "400x600"] -- XXX: no-op wrapped halves
      , HStack () [View () "400x600"]
      ]

{- | The stack conents is larger than the screen size.

@
HStack
  {ann =
     Box
       {position = Vec2 550.0 300.0,
        size = Vec2 1100.0 600.0},
   children =
     [Frame
        {ann =
           Box
             {position = Vec2 250.0 300.0,
              size = Vec2 500.0 600.0},
         size = Vec2 500.0 600.0,
         align = Alignment (Vec2 0.5 0.5),
         inner =
           View
             {ann =
                Box
                  {position = Vec2 250.0 300.0,
                   size = Vec2 500.0 600.0},
              stuff = "500x600"}},
      Frame
        {ann =
           Box
             {position = Vec2 800.0 300.0,
              size = Vec2 600.0 600.0},
         size = Vec2 600.0 600.0,
         align = Alignment (Vec2 0.5 0.5),
         inner =
           View
             {ann =
                Box
                  {position = Vec2 800.0 300.0,
                   size = Vec2 600.0 600.0},
              stuff = "600x600"}}]}
@
-}
exampleOverflow :: View () Static
exampleOverflow =
  HStack ()
    [ Frame () (vec2 500 600) Alignment.center $ View () "500x600"
    , Frame () (vec2 600 600) Alignment.center $ View () "600x600"
    ]

{- | The views report their flex and real size.

Icons should be flush with their labels.
The pair-hstack should hug its elements.
The spacer between them should push the pairs away from the center.
-}
exampleDynamic :: View () Dynamic
exampleDynamic =
  Padding () (Box.TRBL 32) $
  Offset () (vec2 0 32) $
  AspectRatio () 1 Alignment.center $
  HStack ()
    [ HStack ()
        [ View () $ Label "very large"
        , View () $ Icon "💅"
        ]
    , Spacer ()
    , FlexibleFrame () (ViewSize.range_ 60 100 & ViewSize.parentHeight) Alignment.centerTop $
        HStack ()
          [ View () $ Label "very large"
          , View () $ Icon "💅"
          ]
    ]

exampleDynamicVert :: View () Dynamic
exampleDynamicVert =
  Padding () (Box.TRBL 32) $
  ZStack () . (FlexibleFrame () ViewSize.parent_ Alignment.rightBottom (View () $ Icon "✋") :) . pure $ -- this is getting out of hand...
  Offset () (vec2 0 32) $
  AspectRatio () 1 Alignment.center $
  VStack ()
    [ HStack ()
        [ View () $ Label "very large"
        , View () $ Icon "💅"
        ]
    , Spacer ()
        & Overlay () (Frame () 128 Alignment.rightTop . Offset () (vec2 16 (-16)) $ View () $ Icon "🌈")
    , FlexibleFrame () (ViewSize.range_ 60 100 & ViewSize.parentWidth) Alignment.leftMiddle $
        HStack ()
          [ View () $ Label "very large"
          , View () $ Icon "💅"
          ]
    ]