-- |
-- This module provides a @reactive-banana@ FRP interface to @termbox@, a simple C library for writing text-based user
-- interfaces: <https://github.com/termbox/termbox>
--
-- See also:
--
-- * @<https://hackage.haskell.org/package/termbox-tea termbox-tea>@, an Elm Architecture interface.
--
-- ==== __👉 Quick start example__
--
-- This @termbox@ program displays the number of keys pressed.
--
-- @
-- {-\# LANGUAGE BlockArguments \#-}
-- {-\# LANGUAGE DuplicateRecordFields \#-}
-- {-\# LANGUAGE ImportQualifiedPost \#-}
-- {-\# LANGUAGE LambdaCase \#-}
-- {-\# LANGUAGE OverloadedRecordDot \#-}
--
-- module Main (main) where
--
-- import Data.Foldable (fold)
-- import Data.Function ((&))
-- import Reactive.Banana ((\<\@\>))
-- import Reactive.Banana qualified as Banana
-- import Termbox.Banana qualified as Termbox
--
-- main :: IO ()
-- main = do
--   result \<- Termbox.'run' network
--   putStrLn case result of
--     Left err -\> \"Termbox program failed to initialize: \" ++ show err
--     Right state -\> \"Final state: \" ++ show state
--
-- network :: (Banana.MonadMoment m) =\> Termbox.'Inputs' -\> m (Termbox.'Outputs' Int)
-- network inputs = do
--   keysPressed \<- Banana.accumB 0 ((+ 1) \<$ inputs.keys)
--   pure
--     Termbox.'Outputs'
--       { scene = render \<$\> keysPressed,
--         done = Banana.filterJust (isDone \<$\> keysPressed \<\@\> inputs.keys)
--       }
--   where
--     isDone :: Int -\> Termbox.'Key' -\> Maybe Int
--     isDone n = \\case
--       Termbox.'KeyEsc' -\> Just n
--       _ -\> Nothing
--
-- render :: Int -\> Termbox.'Scene'
-- render keysPressed =
--   fold
--     [ string (\"Number of keys pressed: \" ++ show keysPressed),
--       fold
--         [ string \"Press\",
--           string \"Esc\" & Termbox.'bold' & Termbox.'atCol' 6,
--           string \"to quit.\" & Termbox.'atCol' 10
--         ]
--         & Termbox.'atRow' 2
--     ]
--     & Termbox.'at' Termbox.'Pos' {row = 2, col = 4}
--     & Termbox.'image'
--
-- string :: [Char] -\> Termbox.'Image'
-- string chars =
--   zip [0 ..] chars & foldMap \\(i, char) -\>
--     Termbox.'char' char & Termbox.'atCol' i
-- @
module Termbox.Banana
  ( -- * Main
    Inputs (..),
    Outputs (..),
    run,
    InitError (..),

    -- * Terminal contents

    -- ** Scene
    Scene,
    image,
    fill,
    cursor,

    -- ** Image
    Image,
    char,

    -- *** Color
    fg,
    bg,

    -- *** Style
    bold,
    underline,
    blink,

    -- *** Translation
    at,
    atRow,
    atCol,

    -- ** Colors
    Color,

    -- *** Basic colors
    defaultColor,
    red,
    green,
    yellow,
    blue,
    magenta,
    cyan,
    white,
    bright,

    -- *** 216 miscellaneous colors
    color,

    -- *** 24 monochrome colors
    gray,

    -- * Event handling
    Key (..),
    Mouse (..),
    MouseButton (..),

    -- * Miscellaneous types
    Pos (..),
    posUp,
    posDown,
    posLeft,
    posRight,
    Size (..),
  )
where

import Control.Concurrent.MVar
import Control.Monad.IO.Class (liftIO)
import Data.Void (Void)
import qualified Reactive.Banana as Banana
import qualified Reactive.Banana.Frameworks as Banana
import Termbox
  ( Color,
    Image,
    InitError (..),
    Key (..),
    Mouse (..),
    MouseButton (..),
    Pos (..),
    Scene,
    Size (..),
    at,
    atCol,
    atRow,
    bg,
    blink,
    blue,
    bold,
    bright,
    char,
    color,
    cursor,
    cyan,
    defaultColor,
    fg,
    fill,
    getSize,
    gray,
    green,
    image,
    magenta,
    poll,
    posDown,
    posLeft,
    posRight,
    posUp,
    red,
    underline,
    white,
    yellow,
  )
import qualified Termbox (Event (..), render, run)

-- | The inputs to a @termbox@ FRP network.
data Inputs = Inputs
  { -- | The initial terminal size.
    Inputs -> Size
initialSize :: !Size,
    -- | Key events.
    Inputs -> Event Key
keys :: !(Banana.Event Key),
    -- | Resize events.
    Inputs -> Event Size
resizes :: !(Banana.Event Size),
    -- | Mouse events.
    Inputs -> Event Mouse
mouses :: !(Banana.Event Mouse)
  }

-- | The outputs from a @termbox@ FRP network.
data Outputs a = Outputs
  { -- | The scene to render.
    forall a. Outputs a -> Behavior Scene
scene :: !(Banana.Behavior Scene),
    -- | The events of arbitrary values, on the first of which is relevant, which causes 'run' to return.
    --
    -- /Note/: Wrapping this event in 'Banana.once' is not necessary, as this library does so internally.
    forall a. Outputs a -> Event a
done :: !(Banana.Event a)
  }

-- | Run a @termbox@ FRP network.
--
-- @run@ either:
--
--   * Returns immediately with an 'InitError'.
--   * Returns the first value emitted by @done@.
run ::
  -- | The FRP network.
  (Inputs -> Banana.MomentIO (Outputs a)) ->
  -- | The result of the FRP network.
  IO (Either InitError a)
run :: forall a.
(Inputs -> MomentIO (Outputs a)) -> IO (Either InitError a)
run Inputs -> MomentIO (Outputs a)
program =
  IO a -> IO (Either InitError a)
forall a. IO a -> IO (Either InitError a)
Termbox.run ((Inputs -> MomentIO (Outputs a)) -> IO a
forall a. (Inputs -> MomentIO (Outputs a)) -> IO a
run_ Inputs -> MomentIO (Outputs a)
program)

run_ :: (Inputs -> Banana.MomentIO (Outputs a)) -> IO a
run_ :: forall a. (Inputs -> MomentIO (Outputs a)) -> IO a
run_ Inputs -> MomentIO (Outputs a)
program = do
  Size
initialSize <- IO Size
getSize

  MVar a
doneVar <- IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  (AddHandler Key
keysAddHandler, Handler Key
fireKey) <- IO (AddHandler Key, Handler Key)
forall a. IO (AddHandler a, Handler a)
Banana.newAddHandler
  (AddHandler Size
resizesAddHandler, Handler Size
fireResize) <- IO (AddHandler Size, Handler Size)
forall a. IO (AddHandler a, Handler a)
Banana.newAddHandler
  (AddHandler Mouse
mousesAddHandler, Handler Mouse
fireMouse) <- IO (AddHandler Mouse, Handler Mouse)
forall a. IO (AddHandler a, Handler a)
Banana.newAddHandler

  EventNetwork
network <-
    MomentIO () -> IO EventNetwork
Banana.compile do
      Event Key
keys <- AddHandler Key -> MomentIO (Event Key)
forall a. AddHandler a -> MomentIO (Event a)
Banana.fromAddHandler AddHandler Key
keysAddHandler
      Event Size
resizes <- AddHandler Size -> MomentIO (Event Size)
forall a. AddHandler a -> MomentIO (Event a)
Banana.fromAddHandler AddHandler Size
resizesAddHandler
      Event Mouse
mouses <- AddHandler Mouse -> MomentIO (Event Mouse)
forall a. AddHandler a -> MomentIO (Event a)
Banana.fromAddHandler AddHandler Mouse
mousesAddHandler

      Outputs {Behavior Scene
scene :: forall a. Outputs a -> Behavior Scene
scene :: Behavior Scene
scene, Event a
done :: forall a. Outputs a -> Event a
done :: Event a
done} <- Inputs -> MomentIO (Outputs a)
program Inputs {Size
initialSize :: Size
initialSize :: Size
initialSize, Event Key
keys :: Event Key
keys :: Event Key
keys, Event Size
resizes :: Event Size
resizes :: Event Size
resizes, Event Mouse
mouses :: Event Mouse
mouses :: Event Mouse
mouses}
      let render :: Behavior (IO ())
render = Scene -> IO ()
Termbox.render (Scene -> IO ()) -> Behavior Scene -> Behavior (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior Scene
scene

      -- Render the first scene, and again every time it changes.
      IO () -> MomentIO ()
forall a. IO a -> MomentIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MomentIO ()) -> MomentIO (IO ()) -> MomentIO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior (IO ()) -> MomentIO (IO ())
forall (m :: * -> *) a. MonadMoment m => Behavior a -> m a
Banana.valueB Behavior (IO ())
render
      Event (Future (IO ())) -> MomentIO ()
Banana.reactimate' (Event (Future (IO ())) -> MomentIO ())
-> MomentIO (Event (Future (IO ()))) -> MomentIO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior (IO ()) -> MomentIO (Event (Future (IO ())))
forall a. Behavior a -> MomentIO (Event (Future a))
Banana.changes Behavior (IO ())
render

      -- Smuggle `done` values out via `doneVar` (only the first matters)
      Event a
done1 <- Event a -> MomentIO (Event a)
forall (m :: * -> *) a. MonadMoment m => Event a -> m (Event a)
Banana.once Event a
done
      Event (IO ()) -> MomentIO ()
Banana.reactimate (MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
doneVar (a -> IO ()) -> Event a -> Event (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event a
done1)

  EventNetwork -> IO ()
Banana.actuate EventNetwork
network

  let loop :: IO a
loop = do
        forall e. IO (Event e)
poll @Void IO (Event Void) -> (Event Void -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Termbox.EventKey Key
key -> Handler Key
fireKey Key
key
          Termbox.EventResize Size
size -> Handler Size
fireResize Size
size
          Termbox.EventMouse Mouse
mouse -> Handler Mouse
fireMouse Mouse
mouse
        MVar a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar a
doneVar IO (Maybe a) -> (Maybe a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe a
Nothing -> IO a
loop
          Just a
result -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

  IO a
loop