-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Property
-- 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
--
-- Construct custom properties on DOM elements
--
-- > div_ [ prop "id" "foo" ] [ ]
--
----------------------------------------------------------------------------
module Miso.Property
  ( -- *** Smart constructors
    textProp
  , stringProp
  , boolProp
  , intProp
  , integerProp
  , doubleProp
  , prop
  ) where
-----------------------------------------------------------------------------
import           Data.Aeson (ToJSON(..))
-----------------------------------------------------------------------------
import           Miso.Types
import           Miso.String (MisoString)
-----------------------------------------------------------------------------
-- | @prop k v@ is an attribute that will set the attribute @k@ of the DOM 
-- node associated with the vnode to @v@.
prop :: ToJSON a => MisoString -> a -> Attribute action
prop :: forall a action. ToJSON a => MisoString -> a -> Attribute action
prop MisoString
k a
v = MisoString -> Value -> Attribute action
forall action. MisoString -> Value -> Attribute action
Property MisoString
k (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v)
-----------------------------------------------------------------------------
-- | Set field to `Bool` value
boolProp :: MisoString -> Bool -> Attribute action
boolProp :: forall action. MisoString -> Bool -> Attribute action
boolProp = MisoString -> Bool -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop
-----------------------------------------------------------------------------
-- | Set field to `String` value
stringProp ::  MisoString -> String -> Attribute action
stringProp :: forall action. MisoString -> String -> Attribute action
stringProp = MisoString -> String -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop
-----------------------------------------------------------------------------
-- | Set field to `Text` value
textProp ::  MisoString -> MisoString -> Attribute action
textProp :: forall action. MisoString -> MisoString -> Attribute action
textProp = MisoString -> MisoString -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop
-----------------------------------------------------------------------------
-- | Set field to `Int` value
intProp ::  MisoString -> Int -> Attribute action
intProp :: forall action. MisoString -> Int -> Attribute action
intProp = MisoString -> Int -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop
-----------------------------------------------------------------------------
-- | Set field to `Integer` value
integerProp ::  MisoString -> Integer -> Attribute action
integerProp :: forall action. MisoString -> Integer -> Attribute action
integerProp = MisoString -> Integer -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop
-----------------------------------------------------------------------------
-- | Set field to `Double` value
doubleProp ::  MisoString -> Double -> Attribute action
doubleProp :: forall action. MisoString -> Double -> Attribute action
doubleProp = MisoString -> Double -> Attribute action
forall a action. ToJSON a => MisoString -> a -> Attribute action
prop
-----------------------------------------------------------------------------