{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.TUI where

import Hydra.Prelude hiding (Down, State, padLeft)

import Brick
import Hydra.Cardano.Api

import Brick.BChan (newBChan, writeBChan)
import Graphics.Vty (
  Vty,
  defaultConfig,
 )
import Graphics.Vty.Platform.Unix (mkVty)
import Hydra.Chain.CardanoClient (mkCardanoClient)
import Hydra.Chain.Direct.State ()
import Hydra.Client (HydraEvent (..), withClient)
import Hydra.TUI.Drawing
import Hydra.TUI.Handlers
import Hydra.TUI.Logging.Types
import Hydra.TUI.Model
import Hydra.TUI.Options (Options (..))
import Hydra.TUI.Style

runWithVty :: IO Vty -> Options -> IO RootState
runWithVty :: IO Vty -> Options -> IO RootState
runWithVty IO Vty
buildVty options :: Options
options@Options{Host
hydraNodeHost :: Host
hydraNodeHost :: Options -> Host
hydraNodeHost, NetworkId
cardanoNetworkId :: NetworkId
cardanoNetworkId :: Options -> NetworkId
cardanoNetworkId, SocketPath
cardanoNodeSocket :: SocketPath
cardanoNodeSocket :: Options -> SocketPath
cardanoNodeSocket} = do
  BChan (HydraEvent Tx)
eventChan <- Int -> IO (BChan (HydraEvent Tx))
forall a. Int -> IO (BChan a)
newBChan Int
10
  IO Any -> (Async IO Any -> IO RootState) -> IO RootState
forall a b. IO a -> (Async IO a -> IO b) -> IO b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync (BChan (HydraEvent Tx) -> IO Any
forall {tx} {b}. BChan (HydraEvent tx) -> IO b
timer BChan (HydraEvent Tx)
eventChan) ((Async IO Any -> IO RootState) -> IO RootState)
-> (Async IO Any -> IO RootState) -> IO RootState
forall a b. (a -> b) -> a -> b
$ \Async IO Any
_ ->
    -- REVIEW(SN): what happens if callback blocks?
    forall tx a.
(ToJSON (ClientInput tx), FromJSON (TimedServerOutput tx)) =>
Options -> ClientComponent tx IO a
withClient @Tx Options
options (BChan (HydraEvent Tx) -> HydraEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (HydraEvent Tx)
eventChan) ((Client Tx IO -> IO RootState) -> IO RootState)
-> (Client Tx IO -> IO RootState) -> IO RootState
forall a b. (a -> b) -> a -> b
$ \Client Tx IO
hydraClient -> do
      Vty
initialVty <- IO Vty
buildVty
      UTCTime
now <- IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
      Vty
-> IO Vty
-> Maybe (BChan (HydraEvent Tx))
-> App RootState (HydraEvent Tx) Name
-> RootState
-> IO RootState
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
initialVty IO Vty
buildVty (BChan (HydraEvent Tx) -> Maybe (BChan (HydraEvent Tx))
forall a. a -> Maybe a
Just BChan (HydraEvent Tx)
eventChan) (Client Tx IO -> App RootState (HydraEvent Tx) Name
app Client Tx IO
hydraClient) (UTCTime -> RootState
initialState UTCTime
now)
 where
  app :: Client Tx IO -> App RootState (HydraEvent Tx) Name
app Client Tx IO
hydraClient =
    App
      { appDraw :: RootState -> [Widget Name]
appDraw = CardanoClient -> Client Tx IO -> RootState -> [Widget Name]
draw CardanoClient
cardanoClient Client Tx IO
hydraClient
      , appChooseCursor :: RootState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = RootState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor
      , appHandleEvent :: BrickEvent Name (HydraEvent Tx) -> EventM Name RootState ()
appHandleEvent = CardanoClient
-> Client Tx IO
-> BrickEvent Name (HydraEvent Tx)
-> EventM Name RootState ()
handleEvent CardanoClient
cardanoClient Client Tx IO
hydraClient
      , appStartEvent :: EventM Name RootState ()
appStartEvent = () -> EventM Name RootState ()
forall a. a -> EventM Name RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      , appAttrMap :: RootState -> AttrMap
appAttrMap = RootState -> AttrMap
forall s. s -> AttrMap
Hydra.TUI.Style.style
      }
  initialState :: UTCTime -> RootState
initialState UTCTime
now =
    RootState
      { $sel:nodeHost:RootState :: Host
nodeHost = Host
hydraNodeHost
      , UTCTime
now :: UTCTime
$sel:now:RootState :: UTCTime
now
      , $sel:connectedState:RootState :: ConnectedState
connectedState = ConnectedState
Disconnected
      , $sel:logState:RootState :: LogState
logState = LogState{logMessages :: [LogMessage]
logMessages = [], logVerbosity :: LogVerbosity
logVerbosity = LogVerbosity
Short}
      }

  cardanoClient :: CardanoClient
cardanoClient = NetworkId -> SocketPath -> CardanoClient
mkCardanoClient NetworkId
cardanoNetworkId SocketPath
cardanoNodeSocket

  timer :: BChan (HydraEvent tx) -> IO b
timer BChan (HydraEvent tx)
chan = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
now <- IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
    BChan (HydraEvent tx) -> HydraEvent tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (HydraEvent tx)
chan (HydraEvent tx -> IO ()) -> HydraEvent tx -> IO ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> HydraEvent tx
forall tx. UTCTime -> HydraEvent tx
Tick UTCTime
now
    DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

run :: Options -> IO RootState
run :: Options -> IO RootState
run = IO Vty -> Options -> IO RootState
runWithVty (VtyUserConfig -> IO Vty
mkVty VtyUserConfig
defaultConfig)