{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

module Main (main) where

import qualified Graphics.UI.Threepenny       as UI
import qualified Graphics.UI.Threepenny.Core  as TP (Config)
import           Graphics.UI.Threepenny.Core        hiding (Config)

import           Thermoprint.Client
import           Network.WebSockets
import           Network.Socket (withSocketsDo)
import           Network.URI

import qualified Options.Applicative as Opt
import           System.Environment

import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as CBS

import           Data.Text (Text)
import qualified Data.Text as T

import           Control.Concurrent
import           Control.Exception
import           Control.Monad.Catch

import           Control.Applicative
import           Control.Monad
import           Data.Maybe
import           Data.Monoid
import           Text.Read

data Config = Config
  { tpConfig :: TP.Config
  , server   :: BaseUrl
  }

main :: IO ()
main = withSocketsDo $ config >>= Opt.execParser . opts >>= (\c -> startGUI (tpConfig c) $ (withWebSocket setup) c)
  where
    opts config = Opt.info (Opt.helper <*> config)
      ( Opt.fullDesc
        <> Opt.progDesc "Run a webgui to Thermoprint.Client"
      )

config :: IO (Opt.Parser Config)
config = do
  p <- fromMaybe 8023 . (readMaybe =<<) <$> lookupEnv portEnv
  a <- fromMaybe "localhost" <$> lookupEnv hostEnv
  return $ Config <$> ((\port addr -> defaultConfig { jsPort = port, jsAddr = addr }) <$> optional (Opt.option Opt.auto $ port p) <*> optional (fmap CBS.pack $ Opt.strOption $ addr a))
    <*> (BaseUrl Http
         <$> Opt.strOption (Opt.long "target-addr" <> Opt.short 'A' <> Opt.metavar "HOST" <> Opt.help "Host to connect to" <> Opt.value "localhost" <> Opt.showDefault)
         <*> Opt.option Opt.auto (Opt.long "target-port" <> Opt.short 'P' <> Opt.metavar "PORT" <> Opt.help "Port to connect to" <> Opt.value 3000 <> Opt.showDefault)
        )
  where
    port def = Opt.long "port"
      <> Opt.short 'p'
      <> Opt.metavar "PORT"
      <> Opt.help ("Port to bind to; default read from $" <> portEnv) 
      <> Opt.value def
      <> Opt.showDefault
    addr def = Opt.long "addr"
      <> Opt.short 'a'
      <> Opt.metavar "HOST"
      <> Opt.help ("Host to listen on; default read from $" <> hostEnv)
      <> Opt.value def
      <> Opt.showDefault
    hostEnv = "ADDR"
    portEnv = "PORT"

setup :: Config -> Window -> Event (Either WebSocketException URI) -> UI ()
setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
  onEvent socketErr handleSocketErr

  return window # set UI.title "Thermoprint"

  title <- UI.input
    # set UI.id_ "title"
  content <- UI.textarea
    # set UI.id_ "content"
  draftTable <- UI.table

  saveBtn <- UI.button #+ [string "Save"]
  discBtn <- UI.button #+ [string "Discard"]
  prntBtn <- UI.button #+ [string "Print"]

  getBody window #+ [ row [ column [ UI.h1 #+ [string "Current draft"]
                                   , row [UI.label # set text "Title" # set UI.for "title", element title # set style [("width", "100%")]]
                                   , element content # set style [("width", "100%")]
                                   , row [ element saveBtn # set style [("width", "100%")]
                                         , element prntBtn # set style [("width", "100%")]
                                         , element discBtn # set style [("width", "100%")]
                                         ]
                                   ]
                          , column [ UI.h1 #+ [string "Saved drafts"]
                                   , element draftTable
                                   ]
                          ]
                    ]
  
  where
    handleSocketErr InvalidMessage = debug "Received unparseable message from websocket"
    handleSocketErr e@(UnknownException e') = void $ do
      getBody window #+ [UI.p # set text (show e') # set UI.id_ "error"]
      liftIO $ throwIO e

data WebSocketException = InvalidMessage | UnknownException SomeException
  deriving (Show)

instance Exception WebSocketException

withWebSocket :: (Config -> Window -> Event (Either WebSocketException URI) -> UI void) -> Config -> Window -> UI ()
withWebSocket setup c@(Config{..}) w = do
  (dataUpdate, triggerData) <- liftIO newEvent
  let
    rcvEvents = runClient (baseUrlHost server) (baseUrlPort server) "" $ forever . (triggerData . maybe (Left InvalidMessage) Right . parseURI . T.unpack <=< receiveData)
  liftIO . forkIO $ rcvEvents `catchAll` (triggerData . Left . UnknownException)
  void $ setup c w dataUpdate