--  --                                                          ; {{{1
--
--  File        : Koneko/Repl.hs
--  Maintainer  : Felix C. Stegerman <flx@obfusk.net>
--  Date        : 2022-02-12
--
--  Copyright   : Copyright (C) 2022  Felix C. Stegerman
--  Version     : v0.0.1
--  License     : GPLv3+
--
--  --                                                          ; }}}1

{-# LANGUAGE OverloadedStrings #-}

module Koneko.Repl (repl, repl', promptText, errorText) where

import Control.Monad (unless)
import Data.String (IsString)
import Data.Text (Text)
import System.IO (hPutStrLn, stderr)

import qualified Data.Text as T
import qualified Data.Text.IO as T

import Koneko.Data (Context, Stack)
import Koneko.Eval (evalText, tryK)
import Koneko.Misc (prompt)
import Koneko.Prim (replDef)

-- TODO: readline? or just rlwrap?

repl :: Context -> Stack -> IO ()
repl :: Context -> Stack -> IO ()
repl Context
c Stack
s = () () -> IO Stack -> IO ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Text -> Context -> Stack -> IO Stack
repl' Bool
False Text
forall s. IsString s => s
promptText Context
c Stack
s

-- | NB: when an exception is caught during the evaluation of a line,
-- the exeption is printed and the repl continues with the stack reset
-- to what it was before that line; however, any definitions that were
-- added to a module before the exception occurred will have taken
-- effect.
repl' :: Bool -> Text -> Context -> Stack -> IO Stack
repl' :: Bool -> Text -> Context -> Stack -> IO Stack
repl' Bool
breakOnError Text
pr Context
ctx Stack
st = Context -> IO ()
replDef Context
ctx IO () -> IO Stack -> IO Stack
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Context -> Stack -> IO Stack
loop Context
ctx Stack
st
  where
    loop :: Context -> Stack -> IO Stack
    loop :: Context -> Stack -> IO Stack
loop Context
c Stack
s = Maybe Text -> IO (Maybe Text)
prompt (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pr) IO (Maybe Text) -> (Maybe Text -> IO Stack) -> IO Stack
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Stack -> (Text -> IO Stack) -> Maybe Text -> IO Stack
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Stack
s Stack -> IO () -> IO Stack
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> IO ()
T.putStrLn Text
"") Text -> IO Stack
f
      where
        f :: Text -> IO Stack
f Text
line = if Text -> Bool
T.null Text
line then Context -> Stack -> IO Stack
loop Context
c Stack
s else do
          Either KException Stack
r <- IO Stack -> IO (Either KException Stack)
forall a. IO a -> IO (Either KException a)
tryK (IO Stack -> IO (Either KException Stack))
-> IO Stack -> IO (Either KException Stack)
forall a b. (a -> b) -> a -> b
$ Text -> Context -> Stack -> IO Stack
et Text
line Context
c Stack
s IO Stack -> (Stack -> IO Stack) -> IO Stack
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> Text -> Stack -> IO Stack
showTop Context
c Text
line
          let err :: a -> IO Stack
err a
e = do  Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
forall s. IsString s => s
errorText String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e
                          if Bool
breakOnError then Stack -> IO Stack
forall (m :: * -> *) a. Monad m => a -> m a
return Stack
s else Context -> Stack -> IO Stack
loop Context
c Stack
s
          (KException -> IO Stack)
-> (Stack -> IO Stack) -> Either KException Stack -> IO Stack
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either KException -> IO Stack
forall a. Show a => a -> IO Stack
err (Context -> Stack -> IO Stack
loop Context
c) Either KException Stack
r
    showTop :: Context -> Text -> Stack -> IO Stack
showTop Context
c Text
line Stack
s = Stack
s Stack -> IO () -> IO Stack
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Stack -> Text -> Bool
shouldSkip Stack
s Text
line)
      (() () -> IO Stack -> IO ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Context -> Stack -> IO Stack
et Text
"__prld__.show __prld__.say!" Context
c (Int -> Stack -> Stack
forall a. Int -> [a] -> [a]
take Int
1 Stack
s))   --  TODO
    et :: Text -> Context -> Stack -> IO Stack
et = String -> Text -> Context -> Stack -> IO Stack
evalText String
"(repl)"

shouldSkip :: Stack -> Text -> Bool
shouldSkip :: Stack -> Text -> Bool
shouldSkip Stack
s Text
line = Stack -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Stack
s Bool -> Bool -> Bool
|| Text -> Char
T.head Text
line Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',',Char
';']    -- safe!

promptText, errorText :: IsString s => s
promptText :: s
promptText  = s
">>> "
errorText :: s
errorText   = s
"*** ERROR: "

-- vim: set tw=70 sw=2 sts=2 et fdm=marker :