-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lynx
-- 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
--
-- Example usage:
--
-- @
-- import Miso
-- import Miso.Lynx
--
-- view :: Model -> View Model Action
-- view m =
--   view_
--   []
--   [ view_ [ onTap Increment ] [ text_ [] [ "+" ] ]
--   , text_ [] [ text $ ms (show m) ]
--   , view_ [ onTap Decrement ] [ text_ [] [ "-" ] ]
--   ]
-- @
--
-- More information on how to use miso is available on GitHub
--
-- <http://github.com/dmjio/miso-lynx>
--
----------------------------------------------------------------------------
module Miso.Lynx
   ( -- * Entrypoint
     lynx
     -- * Element
   , module Miso.Lynx.Element
     -- * FFI
   , module Miso.Lynx.FFI
     -- * Event
   , module Miso.Lynx.Event
   ) where
-----------------------------------------------------------------------------
import Miso (renderApp, App)
import Miso.Lynx.Element
import Miso.Lynx.FFI
import Miso.Lynx.Event
-----------------------------------------------------------------------------
import Control.Monad (void)
import Language.Javascript.JSaddle (JSM)
#ifndef GHCJS_BOTH
import Data.FileEmbed (embedStringFile)
import Language.Javascript.JSaddle (eval)
import Miso.String (MisoString)
#endif
-----------------------------------------------------------------------------
lynx :: Eq model => App model action -> JSM ()
lynx :: forall model action. Eq model => App model action -> JSM ()
lynx App model action
vcomp = JSM () -> JSM ()
forall a. JSM a -> JSM ()
withJS (MisoString -> App model action -> JSM ()
forall model action.
Eq model =>
MisoString -> App model action -> JSM ()
renderApp MisoString
"native" App model action
vcomp)
-----------------------------------------------------------------------------
-- | Used when compiling with jsaddle to make miso's JavaScript present in
-- the execution context.
withJS :: JSM a -> JSM ()
withJS :: forall a. JSM a -> JSM ()
withJS JSM a
action = JSM a -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM a -> JSM ()) -> JSM a -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
#ifndef GHCJS_BOTH
  _ <- MisoString -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval ($(embedStringFile "js/miso-lynx.js") :: MisoString)
#endif
  action
-----------------------------------------------------------------------------