-----------------------------------------------------------------------------
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lynx.Element
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Lynx.Element
  ( -- ** Smart constructor for lynx elements
    lynx_
    -- ** Page
  , page_
    -- ** View
  , view_
    -- ** Scroll View
  , scrollView_
    -- ** Image
  , image_
    -- ** List
  , list_
  , listItem_
    -- * Text
  , text_
  ) where
-----------------------------------------------------------------------------
import           Data.Aeson (toJSON)
-----------------------------------------------------------------------------
import           Miso.String (MisoString)
import           Miso.Types (View, Attribute, node, NS(HTML))
import           Miso.Property (textProp, prop)
import           Miso.Lynx.Element.List (ListOptions(..))
-----------------------------------------------------------------------------
-- | Smart constructor for constructing a built-in lynx element.
--
lynx_ :: MisoString -> [Attribute action] -> [View model action] -> View model action
lynx_ :: forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ = NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
forall action model.
NS
-> MisoString
-> [Attribute action]
-> [View model action]
-> View model action
node NS
HTML
-----------------------------------------------------------------------------
-- | <https://lynxjs.org/api/elements/built-in/page.html>
--
-- <page> element is the root node, only one <page> element is allowed per page.
-- You can omit the explicit <page> wrapper, as the frontend framework will
-- generate the root node by default.
--
-- You shouldn't use this, we already generate the 'page' for you when
-- the initial 'renderPage' callback is invoked by PrimJS, and there can
-- only be one 'page' present at at time. We include it here for completeness,
-- and because 'page' functionality might change in the future.
--
page_ :: [Attribute action] -> [View model action] -> View model action
page_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
page_ = MisoString
-> [Attribute action] -> [View model action] -> View model action
forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ MisoString
"page"
-----------------------------------------------------------------------------
-- | <https://lynxjs.org/api/elements/built-in/scroll-view.html>
--
-- Basic element, used to contain other elements. <view> is the foundation
-- for all other elements; its attributes, events, and methods can be
-- used in other elements.
--
scrollView_ :: [Attribute action] -> [View model action] -> View model action
scrollView_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
scrollView_ = MisoString
-> [Attribute action] -> [View model action] -> View model action
forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ MisoString
"scroll-view"
-----------------------------------------------------------------------------
-- | <https://lynxjs.org/api/elements/built-in/view.html>
--
-- Basic element, used to contain other elements. <view> is the foundation
-- for all other elements; its attributes, events, and methods can be
-- used in other elements.
--
view_ :: [Attribute action] -> [View model action] -> View model action
view_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
view_ = MisoString
-> [Attribute action] -> [View model action] -> View model action
forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ MisoString
"view"
-----------------------------------------------------------------------------
-- | <https://lynxjs.org/api/elements/built-in/image.html>
--
-- Used to display different types of images, including web images,
-- static resources, and locally stored images.
--
-- <https://lynxjs.org/api/elements/built-in/image.html>
--
-- 'image_' does not support children.
--
-- <https://lynxjs.org/api/elements/built-in/image.html#required-src>
--
-- *Required*
--
-- 'image_' takes a required *src* parameter (as 'MisoString') by default.
--
-- The supported image formats are: *png*, *jpg*, *jpeg*, *bmp*, *gif*, and *webp*.
--
-- > image_ "https://url.com/image.png" []
--
image_ :: MisoString -> [Attribute action] -> View model action
image_ :: forall action model.
MisoString -> [Attribute action] -> View model action
image_ MisoString
url [Attribute action]
attrs = MisoString
-> [Attribute action] -> [View model action] -> View model action
forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ MisoString
"image" (MisoString -> MisoString -> Attribute action
forall action. MisoString -> MisoString -> Attribute action
textProp MisoString
"src" MisoString
url Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs) []
-----------------------------------------------------------------------------
-- | <https://lynxjs.org/api/elements/built-in/list.html>
--
listItem_ :: [Attribute action] -> [View model action] -> View model action
listItem_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
listItem_ = MisoString
-> [Attribute action] -> [View model action] -> View model action
forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ MisoString
"list-item"
-----------------------------------------------------------------------------
-- | <https://lynxjs.org/api/elements/built-in/list.html>
--
list_ :: ListOptions -> [Attribute action] -> [View model action] -> View model action
list_ :: forall action model.
ListOptions
-> [Attribute action] -> [View model action] -> View model action
list_ ListOptions {Int
ListType
ScrollOrientation
listType_ :: ListType
spanCount_ :: Int
scrollOrientation_ :: ScrollOrientation
scrollOrientation_ :: ListOptions -> ScrollOrientation
spanCount_ :: ListOptions -> Int
listType_ :: ListOptions -> ListType
..} [Attribute action]
attrs = MisoString
-> [Attribute action] -> [View model action] -> View model action
forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ MisoString
"list" ([Attribute action]
forall {action}. [Attribute action]
defaults [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
attrs)
  where
    defaults :: [Attribute action]
defaults =
      [ MisoString -> Value -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop MisoString
"list-type" (ListType -> Value
forall a. ToJSON a => a -> Value
toJSON ListType
listType_)
      , MisoString -> Value -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop MisoString
"span-count" (Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
spanCount_)
      , MisoString -> Value -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop MisoString
"scroll-orientation" (ScrollOrientation -> Value
forall a. ToJSON a => a -> Value
toJSON ScrollOrientation
scrollOrientation_)
      ]
-----------------------------------------------------------------------------
-- | <https://lynxjs.org/api/elements/built-in/text.html>
--
-- <text> is a built-in component in Lynx used to display text content.
-- It supports specifying text style, binding click event callbacks, and can
-- nest <text>, <image>, and <view> components to achieve relatively complex
-- text and image content presentation.
--
text_ :: [Attribute action] -> [View model action] -> View model action
text_ :: forall action model.
[Attribute action] -> [View model action] -> View model action
text_ = MisoString
-> [Attribute action] -> [View model action] -> View model action
forall action model.
MisoString
-> [Attribute action] -> [View model action] -> View model action
lynx_ MisoString
"text"
-----------------------------------------------------------------------------