-- |
-- This module provides an Elm Architecture 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-banana termbox-banana>@, a @reactive-banana@ FRP interface.
--
-- ==== __👉 Quick start example__
--
-- This @termbox@ program displays the number of keys pressed.
--
-- @
-- {-\# LANGUAGE BlockArguments \#-}
-- {-\# LANGUAGE DerivingStrategies \#-}
-- {-\# LANGUAGE DuplicateRecordFields \#-}
-- {-\# LANGUAGE ImportQualifiedPost \#-}
-- {-\# LANGUAGE LambdaCase \#-}
-- {-\# LANGUAGE NamedFieldPuns \#-}
-- {-\# LANGUAGE OverloadedRecordDot \#-}
--
-- import Data.Foldable (fold)
-- import Data.Function ((&))
-- import Data.Void (Void)
-- import Termbox.Tea qualified as Termbox
--
-- main :: IO ()
-- main = do
--   result \<-
--     Termbox.'run'
--       Termbox.'Program'
--         { initialize,
--           pollEvent,
--           handleEvent,
--           render,
--           finished
--         }
--   putStrLn case result of
--     Left err -\> \"Termbox program failed to initialize: \" ++ show err
--     Right state -\> \"Final state: \" ++ show state
--
-- data MyState = MyState
--   { keysPressed :: !Int,
--     pressedEsc :: !Bool
--   }
--   deriving stock (Show)
--
-- initialize :: Termbox.'Size' -\> MyState
-- initialize _size =
--   MyState
--     { keysPressed = 0,
--       pressedEsc = False
--     }
--
-- pollEvent :: Maybe (IO Void)
-- pollEvent =
--   Nothing
--
-- handleEvent :: MyState -\> Termbox.'Event' Void -\> IO MyState
-- handleEvent state = \\case
--   Termbox.'EventKey' key -\>
--     pure
--       MyState
--         { keysPressed = state.keysPressed + 1,
--           pressedEsc =
--             case key of
--               Termbox.'KeyEsc' -\> True
--               _ -\> False
--         }
--   _ -\> pure state
--
-- render :: MyState -\> Termbox.'Scene'
-- render state =
--   fold
--     [ string (\"Number of keys pressed: \" ++ show state.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'
--
-- finished :: MyState -\> Bool
-- finished state =
--   state.pressedEsc
--
-- string :: [Char] -\> Termbox.'Image'
-- string chars =
--   zip [0 ..] chars & foldMap \\(i, char) -\>
--     Termbox.char char & Termbox.atCol i
-- @
module Termbox.Tea
  ( -- * Main
    Program (..),
    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
    Event (..),
    Key (..),
    Mouse (..),
    MouseButton (..),

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

import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import Control.Monad (forever)
import qualified Ki
import Termbox
  ( Color,
    Event (..),
    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 (render, run)

-- | A @termbox@ program, parameterized by state __@s@__.
data Program s = forall e.
  Program
  { -- | The initial state, given the initial terminal size.
    forall s. Program s -> Size -> s
initialize :: Size -> s,
    -- | Poll for a user event. Every value that this @IO@ action returns is provided to @handleEvent@.
    ()
pollEvent :: Maybe (IO e),
    -- | Handle an event.
    ()
handleEvent :: s -> Event e -> IO s,
    -- | Render the current state.
    forall s. Program s -> s -> Scene
render :: s -> Scene,
    -- | Is the current state finished?
    forall s. Program s -> s -> Bool
finished :: s -> Bool
  }

-- | Run a @termbox@ program.
--
-- @run@ either:
--
--   * Returns immediately with an @InitError@.
--   * Returns the final state, once it's @finished@.
run :: Program s -> IO (Either InitError s)
run :: forall s. Program s -> IO (Either InitError s)
run Program s
program =
  IO s -> IO (Either InitError s)
forall a. IO a -> IO (Either InitError a)
Termbox.run (Program s -> IO s
forall s. Program s -> IO s
run_ Program s
program)

run_ :: Program s -> IO s
run_ :: forall s. Program s -> IO s
run_ Program {Size -> s
$sel:initialize:Program :: forall s. Program s -> Size -> s
initialize :: Size -> s
initialize, Maybe (IO e)
$sel:pollEvent:Program :: ()
pollEvent :: Maybe (IO e)
pollEvent, s -> Event e -> IO s
$sel:handleEvent:Program :: ()
handleEvent :: s -> Event e -> IO s
handleEvent, s -> Scene
$sel:render:Program :: forall s. Program s -> s -> Scene
render :: s -> Scene
render, s -> Bool
$sel:finished:Program :: forall s. Program s -> s -> Bool
finished :: s -> Bool
finished} = do
  s
state0 <- Size -> s
initialize (Size -> s) -> IO Size -> IO s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Size
getSize

  let loop0 :: IO (Event e) -> s -> IO s
loop0 IO (Event e)
doPoll =
        let loop :: s -> IO s
loop s
s0 =
              if s -> Bool
finished s
s0
                then s -> IO s
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s0
                else do
                  Scene -> IO ()
Termbox.render (s -> Scene
render s
s0)
                  Event e
event <- IO (Event e)
doPoll
                  s
s1 <- s -> Event e -> IO s
handleEvent s
s0 Event e
event
                  s -> IO s
loop s
s1
         in s -> IO s
loop

  case Maybe (IO e)
pollEvent of
    Maybe (IO e)
Nothing -> IO (Event e) -> s -> IO s
loop0 IO (Event e)
forall e. IO (Event e)
poll s
state0
    Just IO e
pollEvent1 -> do
      MVar (Event e)
eventVar <- IO (MVar (Event e))
forall a. IO (MVar a)
newEmptyMVar

      (Scope -> IO s) -> IO s
forall a. (Scope -> IO a) -> IO a
Ki.scoped \Scope
scope -> do
        Scope -> IO Void -> IO ()
Ki.fork_ Scope
scope do
          IO () -> IO Void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
            e
event <- IO e
pollEvent1
            MVar (Event e) -> Event e -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Event e)
eventVar (e -> Event e
forall e. e -> Event e
EventUser e
event)

        Scope -> IO Void -> IO ()
Ki.fork_ Scope
scope do
          IO () -> IO Void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
            Event e
event <- IO (Event e)
forall e. IO (Event e)
Termbox.poll
            MVar (Event e) -> Event e -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Event e)
eventVar Event e
event

        IO (Event e) -> s -> IO s
loop0 (MVar (Event e) -> IO (Event e)
forall a. MVar a -> IO a
takeMVar MVar (Event e)
eventVar) s
state0