module Language.Explorer.Tools.REPL where

import Control.Monad.IO.Class (MonadIO(..))
import Language.Explorer.Monadic
    (Explorer(config), execute, revert, jump, toTree)
import qualified System.Console.Haskeline as Hl
import Data.Tree (drawTree)
import Data.Maybe (fromJust, isNothing)
import Data.Char (isSpace)
import Data.List (find, isPrefixOf)
import Text.Read (readMaybe)
import Control.Arrow (Arrow(first))
import Control.Monad.Trans
import Control.Monad.Catch


type MetaTable p m c o = [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
type RParser p c = String -> c -> Maybe p
type Prompt p m c o = Explorer p m c o -> String
type MetaHandler p m c o = String -> Explorer p m c o -> m (Explorer p m c o)
type OutputHandler m o = o -> m ()
type Repl p m c o = Prompt p m c o -> RParser p c -> String -> MetaTable p m c o -> MetaHandler p m c o -> OutputHandler m o -> Explorer p m c o -> m ()


handleJump :: MonadIO m => String -> Explorer p m c o -> m (Explorer p m c o)
handleJump :: String -> Explorer p m c o -> m (Explorer p m c o)
handleJump String
input Explorer p m c o
ex = case String -> Maybe Ref
forall a. Read a => String -> Maybe a
readMaybe ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
input) of
  (Just Ref
ref_id) -> case Ref -> Explorer p m c o -> Maybe (Explorer p m c o)
forall p (m :: * -> *) c o.
Ref -> Explorer p m c o -> Maybe (Explorer p m c o)
jump Ref
ref_id Explorer p m c o
ex of
    (Just Explorer p m c o
ex') -> Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex'
    Maybe (Explorer p m c o)
Nothing -> IO (Explorer p m c o) -> m (Explorer p m c o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Explorer p m c o) -> m (Explorer p m c o))
-> IO (Explorer p m c o) -> m (Explorer p m c o)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Given reference is not in the exploration tree." IO () -> IO (Explorer p m c o) -> IO (Explorer p m c o)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Explorer p m c o -> IO (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex
  Maybe Ref
Nothing -> IO (Explorer p m c o) -> m (Explorer p m c o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Explorer p m c o) -> m (Explorer p m c o))
-> IO (Explorer p m c o) -> m (Explorer p m c o)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"the jump command requires an integer argument." IO () -> IO (Explorer p m c o) -> IO (Explorer p m c o)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Explorer p m c o -> IO (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex

handleRevert :: MonadIO m => MetaHandler p m c o
handleRevert :: MetaHandler p m c o
handleRevert String
input Explorer p m c o
ex = case String -> Maybe Ref
forall a. Read a => String -> Maybe a
readMaybe ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
input) of
  (Just Ref
ref_id) -> case Ref -> Explorer p m c o -> Maybe (Explorer p m c o)
forall p (m :: * -> *) c o.
Ref -> Explorer p m c o -> Maybe (Explorer p m c o)
revert Ref
ref_id Explorer p m c o
ex of
    (Just Explorer p m c o
ex') -> do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"reverting"
      Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex'
    Maybe (Explorer p m c o)
Nothing -> IO (Explorer p m c o) -> m (Explorer p m c o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Explorer p m c o) -> m (Explorer p m c o))
-> IO (Explorer p m c o) -> m (Explorer p m c o)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Given reference is not valid for reverting." IO () -> IO (Explorer p m c o) -> IO (Explorer p m c o)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Explorer p m c o -> IO (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex
  Maybe Ref
Nothing -> IO (Explorer p m c o) -> m (Explorer p m c o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Explorer p m c o) -> m (Explorer p m c o))
-> IO (Explorer p m c o) -> m (Explorer p m c o)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"the jump command requires an integer argument." IO () -> IO (Explorer p m c o) -> IO (Explorer p m c o)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Explorer p m c o -> IO (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex

handleTree :: MonadIO m => MetaHandler p m c o
handleTree :: MetaHandler p m c o
handleTree String
input Explorer p m c o
ex = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ())
-> (Tree String -> String) -> Tree String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> String
drawTree (Tree String -> IO ()) -> Tree String -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Ref, c) -> String) -> Tree (Ref, c) -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ref -> String
forall a. Show a => a -> String
show (Ref -> String) -> ((Ref, c) -> Ref) -> (Ref, c) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ref, c) -> Ref
forall a b. (a, b) -> a
fst) (Explorer p m c o -> Tree (Ref, c)
forall p (m :: * -> *) c o. Explorer p m c o -> Tree (Ref, c)
toTree Explorer p m c o
ex)
  Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex

metaTable :: MonadIO m => [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
metaTable :: [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
metaTable = [
  (String
"jump", String -> Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) p c o.
MonadIO m =>
String -> Explorer p m c o -> m (Explorer p m c o)
handleJump),
  (String
"revert", String -> Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) p c o.
MonadIO m =>
String -> Explorer p m c o -> m (Explorer p m c o)
handleRevert),
  (String
"tree", String -> Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) p c o.
MonadIO m =>
String -> Explorer p m c o -> m (Explorer p m c o)
handleTree)]

constructMetaTable :: MonadIO m => String -> [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
constructMetaTable :: String
-> [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
constructMetaTable String
prefix = ((String, String -> Explorer p m c o -> m (Explorer p m c o))
 -> (String, String -> Explorer p m c o -> m (Explorer p m c o)))
-> [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
-> [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String)
-> (String, String -> Explorer p m c o -> m (Explorer p m c o))
-> (String, String -> Explorer p m c o -> m (Explorer p m c o))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ )) [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
forall (m :: * -> *) p c o.
MonadIO m =>
[(String, String -> Explorer p m c o -> m (Explorer p m c o))]
metaTable

repl :: (Eq p, Eq o, Monoid o, MonadIO m, MonadMask m) => Repl p m c o
repl :: Repl p m c o
repl Prompt p m c o
prompt RParser p c
parser String
metaPrefix MetaTable p m c o
metaTable MetaHandler p m c o
metaHandler OutputHandler m o
outputHandler Explorer p m c o
ex =
  Settings m -> InputT m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
Hl.runInputT Settings m
forall (m :: * -> *). MonadIO m => Settings m
Hl.defaultSettings (Explorer p m c o -> InputT m ()
loop Explorer p m c o
ex)
    where
    loop :: Explorer p m c o -> InputT m ()
loop Explorer p m c o
ex = do
      Maybe String
minput <- String -> InputT m (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Hl.getInputLine (String -> InputT m (Maybe String))
-> Prompt p m c o -> Explorer p m c o -> InputT m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prompt p m c o
prompt (Explorer p m c o -> InputT m (Maybe String))
-> Explorer p m c o -> InputT m (Maybe String)
forall a b. (a -> b) -> a -> b
$ Explorer p m c o
ex
      case Maybe String
minput of
        (Just String
input) -> m (Explorer p m c o) -> InputT m (Explorer p m c o)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (if String
metaPrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
input then String -> m (Explorer p m c o)
runMeta String
input else String -> m (Explorer p m c o)
runExec String
input) InputT m (Explorer p m c o)
-> (Explorer p m c o -> InputT m ()) -> InputT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Explorer p m c o -> InputT m ()
loop
        Maybe String
Nothing -> () -> InputT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      where
        runMeta :: String -> m (Explorer p m c o)
runMeta String
input =
          let (String
pcmd, String
args) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
input in
            case ((String, MetaHandler p m c o) -> Bool)
-> MetaTable p m c o -> Maybe (String, MetaHandler p m c o)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String
cmd, MetaHandler p m c o
_) -> (String
metaPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pcmd) MetaTable p m c o
metaTable of
              Just (String
_, MetaHandler p m c o
f) -> MetaHandler p m c o
f String
args Explorer p m c o
ex
              Maybe (String, MetaHandler p m c o)
Nothing -> MetaHandler p m c o
metaHandler String
input Explorer p m c o
ex
        runExec :: String -> m (Explorer p m c o)
runExec String
input =
          case RParser p c
parser String
input (Explorer p m c o -> c
forall programs (m :: * -> *) configs output.
Explorer programs m configs output -> configs
config Explorer p m c o
ex) of
            (Just p
program) -> p -> Explorer p m c o -> m (Explorer p m c o, o)
forall p (m :: * -> *) c o.
Language p m c o =>
p -> Explorer p m c o -> m (Explorer p m c o, o)
execute p
program Explorer p m c o
ex m (Explorer p m c o, o)
-> ((Explorer p m c o, o) -> m (Explorer p m c o))
-> m (Explorer p m c o)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Explorer p m c o
newEx, o
out) -> OutputHandler m o
outputHandler o
out m () -> m (Explorer p m c o) -> m (Explorer p m c o)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
newEx
            Maybe p
Nothing -> Explorer p m c o -> m (Explorer p m c o)
forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex