{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Termbox.Banana
  ( -- * Introduction
    -- $intro

    -- * Core API
    TermboxEvent,
    run,

    -- * Re-exports from @termbox@
    Termbox.black,
    Termbox.blue,
    Termbox.bold,
    Termbox.cyan,
    Termbox.green,
    Termbox.magenta,
    Termbox.red,
    Termbox.reverse,
    Termbox.underline,
    Termbox.white,
    Termbox.yellow,
    Termbox.set,
    Termbox.Attr,
    Termbox.Cell (..),
    Termbox.Cells,
    Termbox.Cursor (..),
    Termbox.Event (..),
    Termbox.InitError (..),
    Termbox.Key (..),
    pattern Termbox.KeyCtrl2,
    pattern Termbox.KeyCtrl3,
    pattern Termbox.KeyCtrl4,
    pattern Termbox.KeyCtrl5,
    pattern Termbox.KeyCtrl7,
    pattern Termbox.KeyCtrlH,
    pattern Termbox.KeyCtrlI,
    pattern Termbox.KeyCtrlLsqBracket,
    pattern Termbox.KeyCtrlM,
    pattern Termbox.KeyCtrlUnderscore,
    Termbox.Mouse (..),
    Termbox.PollError (..),
  )
where

import Control.Concurrent.MVar
import Data.Function (fix)
import Reactive.Banana
import Reactive.Banana.Frameworks
import qualified Termbox

-- $intro
--
-- This module is intended to be imported qualified:
--
-- @
-- import qualified Termbox.Banana as Termbox
-- @
--
-- ==== __👉 Quick start example__
--
-- This is a program that displays the last key pressed, and quits on @Esc@:
--
-- @
-- {-\# LANGUAGE LambdaCase          \#-}
-- {-\# LANGUAGE ScopedTypeVariables \#-}
--
-- module Main where
--
-- import Reactive.Banana
-- import Reactive.Banana.Frameworks
--
-- import qualified Termbox.Banana as Termbox
--
-- main :: IO ()
-- main =
--   Termbox.'run' moment
--
-- moment
--   :: Event Termbox.'Termbox.Event'
--   -> Behavior (Int, Int)
--   -> MomentIO (Behavior (Termbox.'Termbox.Cells', Termbox.'Termbox.Cursor'), Event ())
-- moment eEvent _bSize = do
--   let
--     eQuit :: Event ()
--     eQuit =
--       () <$ filterE isKeyEsc eEvent
--
--   bLatestEvent :: Behavior (Maybe Termbox.'Termbox.Event') <-
--     stepper
--       Nothing
--       (Just \<$\> eEvent)
--
--   let
--     bCells :: Behavior Termbox.'Termbox.Cells'
--     bCells =
--       maybe mempty renderEvent \<$\> bLatestEvent
--
--   let
--     bScene :: Behavior (Termbox.'Termbox.Cells', Termbox.'Termbox.Cursor')
--     bScene =
--       (,)
--         \<$\> bCells
--         \<*\> pure Termbox.'Termbox.NoCursor'
--
--   pure (bScene, eQuit)
--
-- renderEvent :: Termbox.'Termbox.Event' -> Termbox.'Termbox.Cells'
-- renderEvent =
--   foldMap (\\(i, c) -> Termbox.set i 0 (Termbox.'Termbox.Cell' c mempty mempty))
--     . zip [0..]
--     . show
--
-- isKeyEsc :: Termbox.'Termbox.Event' -> Bool
-- isKeyEsc = \\case
--   Termbox.'Termbox.EventKey' Termbox.'Termbox.KeyEsc' -> True
--   _ -> False
-- @

-- | A @termbox@ event. This type alias exists only for Haddock readability;
-- in code, you are encouraged to use
--
-- * @Event@ for @reactive-banana@ events
-- * @Termbox.Event@ for @termbox@ events
type TermboxEvent =
  Termbox.Event

type EventSource a =
  (AddHandler a, a -> IO ())

-- | Run a @termbox@ program with the specified input and output modes.
--
-- Given
--
-- * the terminal event stream
-- * the time-varying terminal size (width, then height)
--
-- return
--
-- * a time-varying scene to render
-- * an event stream of arbitrary values, only the first of which is relevant,
--   which ends the @termbox@ program and returns from the @main@ action.
run ::
  ( Event TermboxEvent ->
    Behavior (Int, Int) ->
    MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event a)
  ) ->
  IO a
run :: forall a.
(Event TermboxEvent
 -> Behavior (Int, Int)
 -> MomentIO (Behavior (Cells, Cursor), Event a))
-> IO a
run Event TermboxEvent
-> Behavior (Int, Int)
-> MomentIO (Behavior (Cells, Cursor), Event a)
program =
  (Int
 -> Int -> (Cells -> Cursor -> IO ()) -> IO TermboxEvent -> IO a)
-> IO a
forall a.
(Int
 -> Int -> (Cells -> Cursor -> IO ()) -> IO TermboxEvent -> IO a)
-> IO a
Termbox.run ((Int
  -> Int -> (Cells -> Cursor -> IO ()) -> IO TermboxEvent -> IO a)
 -> IO a)
-> (Int
    -> Int -> (Cells -> Cursor -> IO ()) -> IO TermboxEvent -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \Int
width Int
height Cells -> Cursor -> IO ()
render IO TermboxEvent
poll -> do
    MVar a
doneVar :: MVar a <-
      IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar

    (AddHandler TermboxEvent
eventAddHandler, TermboxEvent -> IO ()
fireEvent) :: EventSource TermboxEvent <-
      IO (EventSource TermboxEvent)
forall a. IO (AddHandler a, Handler a)
newAddHandler

    EventNetwork
network :: EventNetwork <-
      MomentIO () -> IO EventNetwork
compile (MomentIO () -> IO EventNetwork) -> MomentIO () -> IO EventNetwork
forall a b. (a -> b) -> a -> b
$ do
        Event TermboxEvent
eEvent :: Event TermboxEvent <-
          AddHandler TermboxEvent -> MomentIO (Event TermboxEvent)
forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler AddHandler TermboxEvent
eventAddHandler

        let eResize :: Event (Int, Int)
            eResize :: Event (Int, Int)
eResize =
              Event (Maybe (Int, Int)) -> Event (Int, Int)
forall a. Event (Maybe a) -> Event a
filterJust
                ( ( \case
                      Termbox.EventResize Int
w Int
h -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
w, Int
h)
                      TermboxEvent
_ -> Maybe (Int, Int)
forall a. Maybe a
Nothing
                  )
                    (TermboxEvent -> Maybe (Int, Int))
-> Event TermboxEvent -> Event (Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event TermboxEvent
eEvent
                )

        Behavior (Int, Int)
bSize :: Behavior (Int, Int) <-
          ((Int, Int) -> Event (Int, Int) -> MomentIO (Behavior (Int, Int)))
-> Event (Int, Int) -> (Int, Int) -> MomentIO (Behavior (Int, Int))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, Int) -> Event (Int, Int) -> MomentIO (Behavior (Int, Int))
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper Event (Int, Int)
eResize (Int
width, Int
height)

        ((Cells, Cursor) -> IO ())
-> (Event TermboxEvent
    -> Behavior (Int, Int)
    -> MomentIO (Behavior (Cells, Cursor), Event a))
-> Event TermboxEvent
-> Behavior (Int, Int)
-> (a -> IO ())
-> MomentIO ()
forall a.
((Cells, Cursor) -> IO ())
-> (Event TermboxEvent
    -> Behavior (Int, Int)
    -> MomentIO (Behavior (Cells, Cursor), Event a))
-> Event TermboxEvent
-> Behavior (Int, Int)
-> (a -> IO ())
-> MomentIO ()
moment ((Cells -> Cursor -> IO ()) -> (Cells, Cursor) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Cells -> Cursor -> IO ()
render) Event TermboxEvent
-> Behavior (Int, Int)
-> MomentIO (Behavior (Cells, Cursor), Event a)
program Event TermboxEvent
eEvent Behavior (Int, Int)
bSize (MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
doneVar)

    EventNetwork -> IO ()
actuate EventNetwork
network

    (IO a -> IO a) -> IO a
forall a. (a -> a) -> a
fix ((IO a -> IO a) -> IO a) -> (IO a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IO a
loop -> do
      IO TermboxEvent
poll IO TermboxEvent -> (TermboxEvent -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TermboxEvent -> IO ()
fireEvent
      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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO a
loop a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

moment ::
  ((Termbox.Cells, Termbox.Cursor) -> IO ()) ->
  ( Event TermboxEvent ->
    Behavior (Int, Int) ->
    MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event a)
  ) ->
  Event TermboxEvent ->
  Behavior (Int, Int) ->
  (a -> IO ()) ->
  MomentIO ()
moment :: forall a.
((Cells, Cursor) -> IO ())
-> (Event TermboxEvent
    -> Behavior (Int, Int)
    -> MomentIO (Behavior (Cells, Cursor), Event a))
-> Event TermboxEvent
-> Behavior (Int, Int)
-> (a -> IO ())
-> MomentIO ()
moment (Cells, Cursor) -> IO ()
render Event TermboxEvent
-> Behavior (Int, Int)
-> MomentIO (Behavior (Cells, Cursor), Event a)
program Event TermboxEvent
eEvent Behavior (Int, Int)
bSize a -> IO ()
abort = do
  (Behavior (Cells, Cursor)
bScene, Event a
eDone) :: (Behavior (Termbox.Cells, Termbox.Cursor), Event a) <-
    Event TermboxEvent
-> Behavior (Int, Int)
-> MomentIO (Behavior (Cells, Cursor), Event a)
program Event TermboxEvent
eEvent Behavior (Int, Int)
bSize

  Event (Future (Cells, Cursor))
eScene :: Event (Future (Termbox.Cells, Termbox.Cursor)) <-
    Behavior (Cells, Cursor)
-> MomentIO (Event (Future (Cells, Cursor)))
forall a. Behavior a -> MomentIO (Event (Future a))
changes Behavior (Cells, Cursor)
bScene

  IO () -> MomentIO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MomentIO ())
-> ((Cells, Cursor) -> IO ()) -> (Cells, Cursor) -> MomentIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cells, Cursor) -> IO ()
render ((Cells, Cursor) -> MomentIO ())
-> MomentIO (Cells, Cursor) -> MomentIO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior (Cells, Cursor) -> MomentIO (Cells, Cursor)
forall (m :: * -> *) a. MonadMoment m => Behavior a -> m a
valueB Behavior (Cells, Cursor)
bScene
  Event (IO ()) -> MomentIO ()
reactimate (a -> IO ()
abort (a -> IO ()) -> Event a -> Event (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event a
eDone)
  Event (Future (IO ())) -> MomentIO ()
reactimate' (((Future (Cells, Cursor) -> Future (IO ()))
-> Event (Future (Cells, Cursor)) -> Event (Future (IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Future (Cells, Cursor) -> Future (IO ()))
 -> Event (Future (Cells, Cursor)) -> Event (Future (IO ())))
-> (((Cells, Cursor) -> IO ())
    -> Future (Cells, Cursor) -> Future (IO ()))
-> ((Cells, Cursor) -> IO ())
-> Event (Future (Cells, Cursor))
-> Event (Future (IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Cells, Cursor) -> IO ())
-> Future (Cells, Cursor) -> Future (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Cells, Cursor) -> IO ()
render Event (Future (Cells, Cursor))
eScene)