-- | Build interactice apps that reacts to each keystroke and renders text
-- Requires `ghc-options: -threaded`
module TinyApp.Interactive
  ( Event (..),
    Key (..),
    Modifier (..),
    Sandbox (..),
    ContinueExit (..),
    runInteractive,
    runInteractive',
  )
where

import Brick qualified as B
import Brick.Main qualified as BM
import Brick.Types qualified as BT
import Brick.Widgets.Core qualified as BWC
import Control.Monad
import Control.Monad.State
import Graphics.Vty qualified as V
import Graphics.Vty.Input.Events qualified as VE

-- | Representes keys that can be pressed
data Key
  = KEsc
  | KChar Char
  | KBS
  | KEnter
  | KLeft
  | KRight
  | KUp
  | KDown
  | KUpLeft
  | KUpRight
  | KDownLeft
  | KDownRight
  | KCenter
  | KFun Int
  | KBackTab
  | KPrtScr
  | KPause
  | KIns
  | KHome
  | KPageUp
  | KDel
  | KEnd
  | KPageDown
  | KBegin
  | KMenu
  deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Key
readsPrec :: Int -> ReadS Key
$creadList :: ReadS [Key]
readList :: ReadS [Key]
$creadPrec :: ReadPrec Key
readPrec :: ReadPrec Key
$creadListPrec :: ReadPrec [Key]
readListPrec :: ReadPrec [Key]
Read, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord)

fromVKey :: V.Key -> Key
fromVKey :: Key -> Key
fromVKey Key
V.KEsc = Key
KEsc
fromVKey (V.KChar Char
char) = Char -> Key
KChar Char
char
fromVKey Key
V.KBS = Key
KBS
fromVKey Key
V.KEnter = Key
KEnter
fromVKey Key
V.KLeft = Key
KLeft
fromVKey Key
V.KRight = Key
KRight
fromVKey Key
V.KUp = Key
KUp
fromVKey Key
V.KDown = Key
KDown
fromVKey Key
V.KUpLeft = Key
KUpLeft
fromVKey Key
V.KUpRight = Key
KUpRight
fromVKey Key
V.KDownLeft = Key
KDownLeft
fromVKey Key
V.KDownRight = Key
KDownRight
fromVKey Key
V.KCenter = Key
KCenter
fromVKey (V.KFun Int
int) = Int -> Key
KFun Int
int
fromVKey Key
V.KBackTab = Key
KBackTab
fromVKey Key
V.KPrtScr = Key
KPrtScr
fromVKey Key
V.KPause = Key
KPause
fromVKey Key
V.KIns = Key
KIns
fromVKey Key
V.KHome = Key
KHome
fromVKey Key
V.KPageUp = Key
KPageUp
fromVKey Key
V.KDel = Key
KDel
fromVKey Key
V.KEnd = Key
KEnd
fromVKey Key
V.KPageDown = Key
KPageDown
fromVKey Key
V.KBegin = Key
KBegin
fromVKey Key
V.KMenu = Key
KMenu

-- | Modifiers keys
data Modifier = MShift | MCtrl | MMeta | MAlt
  deriving (Modifier -> Modifier -> Bool
(Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool) -> Eq Modifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Modifier -> Modifier -> Bool
== :: Modifier -> Modifier -> Bool
$c/= :: Modifier -> Modifier -> Bool
/= :: Modifier -> Modifier -> Bool
Eq, Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
(Int -> Modifier -> ShowS)
-> (Modifier -> String) -> ([Modifier] -> ShowS) -> Show Modifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Modifier -> ShowS
showsPrec :: Int -> Modifier -> ShowS
$cshow :: Modifier -> String
show :: Modifier -> String
$cshowList :: [Modifier] -> ShowS
showList :: [Modifier] -> ShowS
Show, ReadPrec [Modifier]
ReadPrec Modifier
Int -> ReadS Modifier
ReadS [Modifier]
(Int -> ReadS Modifier)
-> ReadS [Modifier]
-> ReadPrec Modifier
-> ReadPrec [Modifier]
-> Read Modifier
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Modifier
readsPrec :: Int -> ReadS Modifier
$creadList :: ReadS [Modifier]
readList :: ReadS [Modifier]
$creadPrec :: ReadPrec Modifier
readPrec :: ReadPrec Modifier
$creadListPrec :: ReadPrec [Modifier]
readListPrec :: ReadPrec [Modifier]
Read, Eq Modifier
Eq Modifier
-> (Modifier -> Modifier -> Ordering)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Modifier)
-> (Modifier -> Modifier -> Modifier)
-> Ord Modifier
Modifier -> Modifier -> Bool
Modifier -> Modifier -> Ordering
Modifier -> Modifier -> Modifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Modifier -> Modifier -> Ordering
compare :: Modifier -> Modifier -> Ordering
$c< :: Modifier -> Modifier -> Bool
< :: Modifier -> Modifier -> Bool
$c<= :: Modifier -> Modifier -> Bool
<= :: Modifier -> Modifier -> Bool
$c> :: Modifier -> Modifier -> Bool
> :: Modifier -> Modifier -> Bool
$c>= :: Modifier -> Modifier -> Bool
>= :: Modifier -> Modifier -> Bool
$cmax :: Modifier -> Modifier -> Modifier
max :: Modifier -> Modifier -> Modifier
$cmin :: Modifier -> Modifier -> Modifier
min :: Modifier -> Modifier -> Modifier
Ord)

fromVModifier :: V.Modifier -> Modifier
fromVModifier :: Modifier -> Modifier
fromVModifier Modifier
V.MShift = Modifier
MShift
fromVModifier Modifier
V.MCtrl = Modifier
MCtrl
fromVModifier Modifier
V.MMeta = Modifier
MMeta
fromVModifier Modifier
V.MAlt = Modifier
MAlt

-- | Event the application can receive
data Event = Key Key [Modifier]

-- | Signals whether the application should continue waiting input from the user or exit.
data ContinueExit = Continue | Exit
  deriving (ContinueExit -> ContinueExit -> Bool
(ContinueExit -> ContinueExit -> Bool)
-> (ContinueExit -> ContinueExit -> Bool) -> Eq ContinueExit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContinueExit -> ContinueExit -> Bool
== :: ContinueExit -> ContinueExit -> Bool
$c/= :: ContinueExit -> ContinueExit -> Bool
/= :: ContinueExit -> ContinueExit -> Bool
Eq, Int -> ContinueExit -> ShowS
[ContinueExit] -> ShowS
ContinueExit -> String
(Int -> ContinueExit -> ShowS)
-> (ContinueExit -> String)
-> ([ContinueExit] -> ShowS)
-> Show ContinueExit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContinueExit -> ShowS
showsPrec :: Int -> ContinueExit -> ShowS
$cshow :: ContinueExit -> String
show :: ContinueExit -> String
$cshowList :: [ContinueExit] -> ShowS
showList :: [ContinueExit] -> ShowS
Show)

-- | Defines an interactive application that is not allowed to perform arbitrary IO while executing.
data Sandbox state = Sandbox
  { -- | Initial state
    forall state. Sandbox state -> state
initialize :: state,
    -- | What to draw based on the current state.
    -- The screen is cleared between render calls. Usually use '\n' or *Prelude.unlines* to render multiple lines.
    forall state. Sandbox state -> state -> String
render :: state -> String,
    -- | Process the event given the current state
    -- Returns the next state and whether to continue or not the program
    forall state.
Sandbox state -> Event -> state -> (state, ContinueExit)
update :: Event -> state -> (state, ContinueExit)
  }

-- | Executes the application.
runInteractive :: Sandbox s -> IO ()
runInteractive :: forall s. Sandbox s -> IO ()
runInteractive = IO s -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Control.Monad.void (IO s -> IO ()) -> (Sandbox s -> IO s) -> Sandbox s -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sandbox s -> IO s
forall s. Sandbox s -> IO s
runInteractive'

-- | Executes the application returning its final state.
runInteractive' :: forall s. Sandbox s -> IO s
runInteractive' :: forall s. Sandbox s -> IO s
runInteractive' Sandbox s
config =
  let app :: BM.App s e ()
      app :: forall e. App s e ()
app =
        BM.App
          { appDraw :: s -> [Widget ()]
BM.appDraw = \s
s -> [String -> Widget ()
forall n. String -> Widget n
BWC.str (Sandbox s
config.render s
s)],
            appChooseCursor :: s -> [CursorLocation ()] -> Maybe (CursorLocation ())
BM.appChooseCursor = \s
_ [CursorLocation ()]
_ -> Maybe (CursorLocation ())
forall a. Maybe a
Nothing,
            appHandleEvent :: BrickEvent () e -> EventM () s ()
BM.appHandleEvent = \BrickEvent () e
e -> do
              s
s <- EventM () s s
forall s (m :: * -> *). MonadState s m => m s
get
              case BrickEvent () e
e of
                BT.VtyEvent (VE.EvKey Key
k [Modifier]
ms) ->
                  case Sandbox s
config.update (Key -> [Modifier] -> Event
Key (Key -> Key
fromVKey Key
k) ((Modifier -> Modifier) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> [a] -> [b]
map Modifier -> Modifier
fromVModifier [Modifier]
ms)) s
s of
                    (s
s', ContinueExit
Continue) -> do
                      s -> EventM () s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s'
                    (s
s', ContinueExit
Exit) -> do
                      s -> EventM () s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s'
                      EventM () s ()
forall n s. EventM n s ()
BM.halt
                BrickEvent () e
_ ->
                  () -> EventM () s ()
forall a. a -> EventM () s a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
            appStartEvent :: EventM () s ()
BM.appStartEvent = () -> EventM () s ()
forall a. a -> EventM () s a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
            appAttrMap :: s -> AttrMap
BM.appAttrMap = \s
_ -> Attr -> [(AttrName, Attr)] -> AttrMap
B.attrMap Attr
V.defAttr []
          }
   in App s Any () -> s -> IO s
forall n s e. Ord n => App s e n -> s -> IO s
BM.defaultMain App s Any ()
forall e. App s e ()
app Sandbox s
config.initialize