{-# LANGUAGE NoImplicitPrelude #-}

module Data.Aviation.Stratux.Websockets(
  WSConnectionIO
, decodeWith
, decode
, decode'
, stratuxApp
, trafficAppWith
, trafficApp
, trafficApp'
) where

import Control.Category(Category((.)))
import Data.Aeson(FromJSON)
import qualified Data.Aeson as A(eitherDecode, eitherDecode')
import Control.Concurrent(forkIO)
import Control.Monad(Monad((>>=), (>>)), forever, unless)
import Control.Monad.Trans.Reader(ReaderT(ReaderT))
import Control.Monad.Trans.Except(ExceptT(ExceptT))
import Data.Aviation.Stratux.Types(Traffic)
import Data.Either(Either)
import Data.Function(($))
import Data.Functor(Functor(fmap))
import Data.Int(Int)
import Data.String(String)
import qualified Data.Text as T(null)
import qualified Data.Text.IO as T(getLine)
import Network.Socket (withSocketsDo)
import qualified Network.WebSockets as WS(Connection, WebSocketsData, ClientApp, receiveData, sendClose, sendTextData, runClient)
import System.IO(IO)

type WSConnectionIO f a =
  ReaderT WS.Connection (f IO) a

-- | Decode from JSON anything received on the websocket.
decodeWith ::
  WS.WebSocketsData a =>
  (a -> b)
  -> (IO b -> m c)
  -> ReaderT WS.Connection m c
decodeWith d k =
  ReaderT (k . fmap d . WS.receiveData)

-- | Decode from JSON anything received on the websocket.
-- Parses immediately, but defers conversion.
decode ::
  FromJSON a =>
  WSConnectionIO (ExceptT String) a
decode =
  decodeWith A.eitherDecode ExceptT

-- | Decode from JSON anything received on the websocket.
-- Parses and performs conversion immediately.
decode' ::
  FromJSON a =>
  WSConnectionIO (ExceptT String) a
decode' =
  decodeWith A.eitherDecode' ExceptT

-- | A stratux websockets application. Loops receiving data and waits for input
-- from stdin. An empty line to stdin terminates the program loop.
stratuxApp ::
  (WS.WebSocketsData t, WS.WebSocketsData u) =>
  (t -> IO b) -- ^ The function to run on each receive of data on the websocket.
  -> u -- ^ The connection close traffic.
  -> WS.ClientApp ()
stratuxApp k s c = do
  _ <- forkIO . forever $ WS.receiveData c >>= k
  let loop = do  line <- T.getLine
                 unless (T.null line) $ WS.sendTextData c line >> loop
  loop
  WS.sendClose c s

-- | Decodes JSON to stratux traffic.
trafficAppWith ::
  (WS.WebSocketsData t, WS.WebSocketsData u) =>
  (t -> Either String Traffic) -- ^ Data to traffic.
  -> String -- ^ host.
  -> Int -- ^ port.
  -> (Either String Traffic -> IO b) -- ^ For each traffic message.
  -> u -- ^ The connection close traffic.
  -> IO ()
trafficAppWith q host port k s =
  withSocketsDo $ WS.runClient host port "/traffic" (stratuxApp (k . q) s)

-- | Decodes JSON to stratux traffic.
-- Parses immediately, but defers conversion.
trafficApp ::
  WS.WebSocketsData u =>
  String -- ^ host.
  -> Int -- ^ port.
  -> (Either String Traffic -> IO b) -- ^ For each traffic message.
  -> u -- ^ The connection close traffic.
  -> IO ()
trafficApp =
  trafficAppWith A.eitherDecode

-- | Decodes JSON to stratux traffic.
-- Parses and performs conversion immediately.
trafficApp' ::
  WS.WebSocketsData u =>
  String -- ^ host.
  -> Int -- ^ port.
  -> (Either String Traffic -> IO b) -- ^ For each traffic message.
  -> u -- ^ The connection close traffic.
  -> IO ()
trafficApp' =
  trafficAppWith A.eitherDecode'