{-# LANGUAGE OverloadedStrings #-}
module Charts.Internal.Server where


import Charts.Internal.Chart
import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types.Status
import Data.Aeson
import Paths_charter
import Control.Concurrent.Async
import System.Process
import Control.Monad
import Control.Concurrent.MVar

-- | Serve a chart, updating along with the MVar
chartApp :: MVar Chart -> FilePath -> Application
chartApp :: MVar Chart -> FilePath -> Application
chartApp MVar Chart
chartVar FilePath
indexFile Request
req Response -> IO ResponseReceived
handler
      | Request -> [Text]
pathInfo Request
req [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"data"] = do
          Chart
chart <- MVar Chart -> IO Chart
forall a. MVar a -> IO a
readMVar MVar Chart
chartVar
          Response -> IO ResponseReceived
handler (Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
ok200 [(HeaderName
"Content-Type", ByteString
"application/json")] (Chart -> ByteString
forall a. ToJSON a => a -> ByteString
encode Chart
chart))
      | Bool
otherwise = do
          Response -> IO ResponseReceived
handler (Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
responseFile Status
ok200 ResponseHeaders
forall a. Monoid a => a
mempty FilePath
indexFile Maybe FilePart
forall a. Maybe a
Nothing)

-- | Serve a single static chart on the given port
serveChart :: Port ->  Chart -> IO ()
serveChart :: Port -> Chart -> IO ()
serveChart Port
port Chart
chart = do
    Port -> ((Chart -> IO ()) -> IO ()) -> IO ()
serveDynamicChart Port
port (\Chart -> IO ()
handler -> Chart -> IO ()
handler (Chart
chart{dynamic :: Bool
dynamic=Bool
False}))

-- | Serve a chart on the given port.
-- The application can update the chart using the given handler.
serveDynamicChart :: Port -> ((Chart -> IO ()) -> IO ()) -> IO ()
serveDynamicChart :: Port -> ((Chart -> IO ()) -> IO ()) -> IO ()
serveDynamicChart Port
port (Chart -> IO ()) -> IO ()
handler = do
    FilePath
indexHtml <- FilePath -> IO FilePath
getDataFileName FilePath
"templates/index.html"
    MVar Chart
chartVar <- IO (MVar Chart)
forall a. IO (MVar a)
newEmptyMVar
    let runServer :: IO ()
runServer = Port -> Application -> IO ()
run Port
port (MVar Chart -> FilePath -> Application
chartApp MVar Chart
chartVar FilePath
indexHtml)
    let runHandler :: IO ()
runHandler = (Chart -> IO ()) -> IO ()
handler (MVar Chart -> Chart -> IO ()
updateChart MVar Chart
chartVar)
    IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
concurrently_ IO ()
runServer IO ()
runHandler) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
procHandle -> do
        IO ProcessHandle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessHandle -> IO ()) -> IO ProcessHandle -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ProcessHandle
spawnProcess FilePath
"open" [(FilePath
"http://localhost:" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Port -> FilePath
forall a. Show a => a -> FilePath
show Port
port)]
        Async () -> IO ()
forall a. Async a -> IO a
wait Async ()
procHandle
  where
    updateChart :: MVar Chart -> Chart -> IO ()
    updateChart :: MVar Chart -> Chart -> IO ()
updateChart MVar Chart
var Chart
c = IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Bool
isEmpty <- MVar Chart -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar Chart
var
      if Bool
isEmpty then MVar Chart -> Chart -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Chart
var Chart
c
                 else IO Chart -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Chart -> IO ()) -> IO Chart -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar Chart -> Chart -> IO Chart
forall a. MVar a -> a -> IO a
swapMVar MVar Chart
var Chart
c