{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE KindSignatures    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeOperators     #-}


module Shpadoinkle.Run (
  -- * Agnostic Run
  runJSorWarp
  -- * Live Reloads
  , Env(..), Port
  , liveWithBackend
  , liveWithStatic
  , live
  -- ** Convenience Variants
  , fullPage
  , fullPageJSM
  , simple
  , entrypoint
  ) where


import           Data.Text                              (Text)
import           GHCJS.DOM.Types                        (JSM)
import           Shpadoinkle                            (Backend, Html, RawNode,
                                                         TVar, newTVarIO,
                                                         shpadoinkle, type (~>))


#ifndef ghcjs_HOST_OS


import           Language.Javascript.JSaddle.Warp       (run)
import           Language.Javascript.JSaddle.WebSockets (debug, debugOr)
import           Network.Wai                            (Application)
import           Network.Wai.Application.Static         (defaultFileServerSettings,
                                                         staticApp)


-- | Serve a web server and a jsaddle warp frontend at the same time.
-- This is useful for live reloads for development purposes.
-- For example:
-- @
--   ghcid -c "cabal repl dev" -W -T "Main.main"
-- @
liveWithBackend
  :: Port
  -- ^ Port to server the live server
  -> JSM ()
  -- ^ Frontend application
  -> IO Application
  -- ^ Server API
  -> IO ()
liveWithBackend :: Port -> JSM () -> IO Application -> IO ()
liveWithBackend Port
port JSM ()
frontend IO Application
server = Port -> JSM () -> Application -> IO ()
debugOr Port
port JSM ()
frontend (Application -> IO ()) -> IO Application -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Application
server


-- | Serve jsaddle warp frontend.
-- This is useful for live reloads for development purposes.
-- For example:
-- @
--   ghcid -c "cabal repl" -W -T "Main.dev"
-- @
live
  :: Port
  -- ^ Port to server the live server
  -> JSM ()
  -- ^ Frontend application
  -> IO ()
live :: Port -> JSM () -> IO ()
live = Port -> JSM () -> IO ()
debug


-- | Serve jsaddle warp frontend with a static file server.
liveWithStatic
  :: Port
  -- ^ Port to serve the live server
  -> JSM ()
  -- ^ Frontend application
  -> FilePath
  -- ^ Path to static files
  -> IO ()
liveWithStatic :: Port -> JSM () -> FilePath -> IO ()
liveWithStatic Port
port JSM ()
frontend =
  Port -> JSM () -> IO Application -> IO ()
liveWithBackend Port
port JSM ()
frontend (IO Application -> IO ())
-> (FilePath -> IO Application) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> IO Application
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application -> IO Application)
-> (FilePath -> Application) -> FilePath -> IO Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticSettings -> Application
staticApp (StaticSettings -> Application)
-> (FilePath -> StaticSettings) -> FilePath -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StaticSettings
defaultFileServerSettings


#else


data Application


live :: Port -> JSM () -> IO ()
live = error "Live reloads require GHC"


liveWithStatic :: Port -> JSM () -> FilePath -> IO ()
liveWithStatic = error "Live reloads require GHC"


liveWithBackend :: Port -> JSM () -> IO Application -> IO ()
liveWithBackend = error "Live reloads require GHC"


#endif


data Env = Dev | Prod


type Port = Int


-- | Wrapper around 'shpadoinkle' for full page apps
-- that do not need outside control of the territory
fullPage
  :: Backend b m a => Monad (b m) => Eq a
  => (m ~> JSM)
  -- ^ How do we get to JSM?
  -> (TVar a -> b m ~> m)
  -- ^ What backend are we running?
  -> a
  -- ^ What is the initial state?
  -> (a -> Html (b m) a)
  -- ^ How should the html look?
  -> b m RawNode
  -- ^ Where do we render?
  -> JSM ()
fullPage :: (m ~> JSM)
-> (TVar a -> b m ~> m)
-> a
-> (a -> Html (b m) a)
-> b m RawNode
-> JSM ()
fullPage m ~> JSM
g TVar a -> b m ~> m
f a
i a -> Html (b m) a
view b m RawNode
getStage = do
  TVar a
model <- a -> JSM (TVar a)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO a
i
  (m ~> JSM)
-> (TVar a -> b m ~> m)
-> TVar a
-> (a -> Html (b m) a)
-> b m RawNode
-> JSM ()
forall (b :: (* -> *) -> * -> *) (m :: * -> *) a.
(Backend b m a, Monad (b m), Eq a) =>
(m ~> JSM)
-> (TVar a -> b m ~> m)
-> TVar a
-> (a -> Html (b m) a)
-> b m RawNode
-> JSM ()
shpadoinkle m ~> JSM
g TVar a -> b m ~> m
f TVar a
model a -> Html (b m) a
view b m RawNode
getStage
{-# INLINE fullPage #-}


-- | 'fullPageJSM' is a wrapper around 'shpadoinkle'
-- for full page apps that do not need outside control
-- of the territory, where actions are performed directly in JSM.
--
-- This set of assumptions is extremely common when starting
-- a new project.
fullPageJSM
  :: Backend b JSM a => Monad (b JSM) => Eq a
  => (TVar a -> b JSM ~> JSM)
  -- ^ What backend are we running?
  -> a
  -- ^ What is the initial state?
  -> (a -> Html (b JSM) a)
  -- ^ How should the html look?
  -> b JSM RawNode
  -- ^ Where do we render?
  -> JSM ()
fullPageJSM :: (TVar a -> b JSM ~> JSM)
-> a -> (a -> Html (b JSM) a) -> b JSM RawNode -> JSM ()
fullPageJSM = (JSM ~> JSM)
-> (TVar a -> b JSM ~> JSM)
-> a
-> (a -> Html (b JSM) a)
-> b JSM RawNode
-> JSM ()
forall (b :: (* -> *) -> * -> *) (m :: * -> *) a.
(Backend b m a, Monad (b m), Eq a) =>
(m ~> JSM)
-> (TVar a -> b m ~> m)
-> a
-> (a -> Html (b m) a)
-> b m RawNode
-> JSM ()
fullPage forall a. a -> a
JSM ~> JSM
id
{-# INLINE fullPageJSM #-}


-- | Start the program!
--
-- This function works in GHC and GHCjs. I saved you from using C preprocessor directly. You're welcome.
runJSorWarp :: Int -> JSM () -> IO ()
#ifdef ghcjs_HOST_OS
runJSorWarp _ = id
{-# INLINE runJSorWarp #-}
#else
runJSorWarp :: Port -> JSM () -> IO ()
runJSorWarp = Port -> JSM () -> IO ()
run
{-# INLINE runJSorWarp #-}
#endif


-- | Simple app
--
-- (a good starting place)
simple
  :: Backend b JSM a => Monad (b JSM) => Eq a
  => (TVar a -> b JSM ~> JSM)
  -- ^ What backend are we running?
  -> a
  -- ^ what is the initial state?
  -> (a -> Html (b JSM) a)
  -- ^ how should the html look?
  -> b JSM RawNode
  -- ^ where do we render?
  -> JSM ()
simple :: (TVar a -> b JSM ~> JSM)
-> a -> (a -> Html (b JSM) a) -> b JSM RawNode -> JSM ()
simple = (TVar a -> b JSM ~> JSM)
-> a -> (a -> Html (b JSM) a) -> b JSM RawNode -> JSM ()
forall (b :: (* -> *) -> * -> *) a.
(Backend b JSM a, Monad (b JSM), Eq a) =>
(TVar a -> b JSM ~> JSM)
-> a -> (a -> Html (b JSM) a) -> b JSM RawNode -> JSM ()
fullPageJSM
{-# INLINE simple #-}


entrypoint :: Env -> Text
entrypoint :: Env -> Text
entrypoint Env
Dev  = Text
"/jsaddle.js"
entrypoint Env
Prod = Text
"/all.min.js"