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

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

handleTree :: MonadIO m => MetaHandler p m c o
handleTree :: forall (m :: * -> *) p c o.
MonadIO m =>
String -> Explorer p m c o -> m (Explorer p m c o)
handleTree String
input Explorer p m c o
ex = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> String
drawTree forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall p (m :: * -> *) c o. Explorer p m c o -> Tree (Ref, c)
toTree Explorer p m c o
ex)
  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 :: forall (m :: * -> *) p c o.
MonadIO m =>
[(String, String -> Explorer p m c o -> m (Explorer p m c o))]
metaTable = [
  (String
"jump", forall (m :: * -> *) p c o.
MonadIO m =>
String -> Explorer p m c o -> m (Explorer p m c o)
handleJump),
  (String
"revert", forall (m :: * -> *) p c o.
MonadIO m =>
String -> Explorer p m c o -> m (Explorer p m c o)
handleRevert),
  (String
"tree", 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 :: forall (m :: * -> *) p c o.
MonadIO m =>
String
-> [(String, String -> Explorer p m c o -> m (Explorer p m c o))]
constructMetaTable String
prefix = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String
prefix forall a. [a] -> [a] -> [a]
++ )) 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 :: forall p o (m :: * -> *) c.
(Eq p, Eq o, Monoid o, MonadIO m, MonadMask m) =>
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 =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
Hl.runInputT 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 <- forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Hl.getInputLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prompt p m c o
prompt forall a b. (a -> b) -> a -> b
$ Explorer p m c o
ex
      case Maybe String
minput of
        (Just String
input) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (if String
metaPrefix 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) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Explorer p m c o -> InputT m ()
loop
        Maybe String
Nothing -> 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
input in
            case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String
cmd, MetaHandler p m c o
_) -> (String
metaPrefix forall a. [a] -> [a] -> [a]
++ String
cmd) 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 (forall programs (m :: * -> *) configs output.
Explorer programs m configs output -> configs
config Explorer p m c o
ex) of
            (Just p
program) -> 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 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
newEx
            Maybe p
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Explorer p m c o
ex