{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Serve a chart web page with a web socket in it, that accepts 'ChartOptions'.
module Prettychart.Server
  ( startChartServer,
    startChartServerWith,
    printChart,
    chartSocketPage,
  )
where

import Box
import Chart
import Control.Concurrent.Async
import Control.Monad (when)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack)
import Data.Text.Encoding
import MarkupParse
import Optics.Core hiding (element)
import Prettychart.Any
import Web.Rep

-- | 'Page' containing a web socket and javascript needed to run it.
chartSocketPage :: Maybe ByteString -> Page
chartSocketPage :: Maybe ByteString -> Page
chartSocketPage Maybe ByteString
title =
  Page
bootstrapPage
    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
      [ Js
webSocket,
        Js
runScriptJs,
        Js
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
.~ ByteString -> [Attr] -> Markup -> Markup
element ByteString
"div" [ByteString -> ByteString -> Attr
Attr ByteString
"class" ByteString
"container"] (ByteString -> [Attr] -> Markup -> Markup
element ByteString
"row" [ByteString -> ByteString -> Attr
Attr ByteString
"class" ByteString
"col"] (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (ByteString -> [Attr] -> ByteString -> Markup
elementc ByteString
"h4" []) Maybe ByteString
title) forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup
element_ ByteString
"div" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Attr
Attr ByteString
"id" ByteString
"prettychart"))
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "cssBody" a => a
#cssBody
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Css
cssColorScheme

-- | Print a chart supplying a 'ChartOptions' consumer, and a showable thing that may be chartable. The first argument flags whether to also print the item to stdout.
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)

-- | Start the chart server. Returns the chart consumer, and a server quit signal effect.
--
-- An iconic ghci session transcript:
--
-- >> import Chart.Examples
-- >> (sendChart, quitChartServer) <- startChartServer (Just "prettychart")
-- >> sendChart unitExample
--
-- ... point browser to localhost:9160 ...
--
-- >> quitChartServer
startChartServer :: Maybe String -> IO (ChartOptions -> IO Bool, IO ())
startChartServer :: Maybe String -> IO (ChartOptions -> IO Bool, IO ())
startChartServer Maybe String
title = SocketConfig -> Page -> IO (ChartOptions -> IO Bool, IO ())
startChartServerWith SocketConfig
defaultSocketConfig (Maybe ByteString -> Page
chartSocketPage forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
title)

-- | Start the chart server protocol with bespoke 'SocketConfig' and 'Page' configurations.
--
-- > startChartServerWith (defaultSocketConfig & #port .~ 4567) (defaultSocketPage & #htmlBody %~ divClass_ "row" "bespoke footnote")
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 (ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
replace ByteString
"prettychart" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> ByteString
encodeChartOptions 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)