{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
module Prettychart.Server
( startChartServer,
startChartServerWith,
printChart,
chartSocketPage,
)
where
import Box
import Chart
import Control.Concurrent.Async
import Control.Monad (when)
import Lucid as L
import Optics.Core
import Prettychart.Any
import Web.Rep
chartSocketPage :: Page
chartSocketPage :: Page
chartSocketPage =
Page
bootstrap5Page
forall a b. a -> (a -> b) -> b
& forall a. IsLabel "jsOnLoad" a => a
#jsOnLoad
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Monoid a => [a] -> a
mconcat
[ RepJs
webSocket,
RepJs
runScriptJs,
RepJs
refreshJsbJs
]
forall a b. a -> (a -> b) -> b
& forall a. IsLabel "htmlBody" a => a
#htmlBody
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> Html () -> Html ()
divClass_
Text
"container"
( forall a. Monoid a => [a] -> a
mconcat
[ Text -> Html () -> Html ()
divClass_ Text
"row" forall a b. (a -> b) -> a -> b
$ Text -> Html () -> Html ()
divClass_ Text
"col" (forall arg result. Term arg result => arg -> result
h4_ Html ()
"prettychart" forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
L.with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
id_ Text
"prettychart"] forall a. Monoid a => a
mempty)
]
)
printChart :: (Show a) => Bool -> (ChartOptions -> IO Bool) -> a -> IO ()
printChart :: forall a. Show a => Bool -> (ChartOptions -> IO Bool) -> a -> IO ()
printChart Bool
reprint ChartOptions -> IO Bool
send a
s = case String -> Either String ChartOptions
anyChart (forall a. Show a => a -> String
show a
s) of
Left String
_ -> forall a. Show a => a -> IO ()
print a
s
Right ChartOptions
co -> do
Bool
b <- ChartOptions -> IO Bool
send ChartOptions
co
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b Bool -> Bool -> Bool
|| Bool
reprint) (forall a. Show a => a -> IO ()
print a
s)
startChartServer :: IO (ChartOptions -> IO Bool, IO ())
startChartServer :: IO (ChartOptions -> IO Bool, IO ())
startChartServer = SocketConfig -> Page -> IO (ChartOptions -> IO Bool, IO ())
startChartServerWith SocketConfig
defaultSocketConfig Page
chartSocketPage
startChartServerWith :: SocketConfig -> Page -> IO (ChartOptions -> IO Bool, IO ())
startChartServerWith :: SocketConfig -> Page -> IO (ChartOptions -> IO Bool, IO ())
startChartServerWith SocketConfig
scfg Page
page = do
(Box Committer IO ChartOptions
c Emitter IO ChartOptions
e, IO ()
q) <- forall a. Queue a -> IO (Box IO a a, IO ())
toBoxM forall a. Queue a
Single
Async ()
x <- forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ SocketConfig -> Page -> Box IO Text Text -> IO ()
serveSocketBox SocketConfig
scfg Page
page (forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO Text
toStdout (Text -> Text -> Text
replace Text
"prettychart" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> Text
renderChartOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emitter IO ChartOptions
e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) a. Committer m a -> a -> m Bool
commit Committer IO ChartOptions
c, forall a. Async a -> IO ()
cancel Async ()
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
q)