-- | Build REPL apps
module TinyApp.Repl where

import Control.Exception
import Control.Monad
import System.IO

-- | Signals whether the application should continue asking 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 a REPL application that is not allowed to perform arbitrary IO while executing.
data Sandbox state = Sandbox
  { -- | Initial state
    forall state. Sandbox state -> state
initialize :: state,
    -- | The prompt to show. It can depend on the state
    forall state. Sandbox state -> state -> String
prompt :: state -> String,
    -- | Process the user input given the current state
    -- Returns the next state, the output and whether to continue or not the program
    forall state.
Sandbox state -> String -> state -> (state, String, ContinueExit)
update :: String -> state -> (state, String, ContinueExit)
  }

-- | Executes the REPL application.
runRepl :: Sandbox s -> IO ()
runRepl :: forall s. Sandbox s -> IO ()
runRepl = 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
runRepl'

-- | Executes the REPL application returning its final state.
runRepl' :: forall s. Sandbox s -> IO s
runRepl' :: forall s. Sandbox s -> IO s
runRepl' Sandbox s
config =
  let go :: s -> IO s
      go :: s -> IO s
go s
state = do
        String -> IO ()
System.IO.putStr (Sandbox s
config.prompt s
state)
        -- Since the prompt does not finish in a newline we force a flush right after
        Handle -> IO ()
hFlush Handle
stdout
        -- When Control-D an exception is thrown
        Maybe String
input <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch @IOException (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
System.IO.getLine) (\IOException
_ -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing)
        case Maybe String
input of
          Maybe String
Nothing -> s -> IO s
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
state
          Just String
input' -> do
            let (s
state', String
output, ContinueExit
continue) = Sandbox s
config.update String
input' s
state
            String -> IO ()
System.IO.putStrLn String
output
            case ContinueExit
continue of
              ContinueExit
Continue ->
                s -> IO s
go s
state'
              ContinueExit
Exit ->
                s -> IO s
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
state'
   in do
        s -> IO s
go Sandbox s
config.initialize