{-# LANGUAGE CPP, ScopedTypeVariables, FlexibleInstances #-}
-- | GF interactive mode
module GF.Interactive (mainGFI,mainRunGFI,mainServerGFI) where

import Prelude hiding (putStrLn,print)
import qualified Prelude as P(putStrLn)
import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine)
import GF.Command.Commands(PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands)
import GF.Command.CommonCommands(commonCommands,extend)
import GF.Command.SourceCommands
import GF.Command.CommandInfo
import GF.Command.Help(helpCommand)
import GF.Command.Abstract
import GF.Command.Parse(readCommandLine,pCommand)
import GF.Data.Operations (Err(..))
import GF.Data.Utilities(whenM,repeatM)
import GF.Grammar hiding (Ident,isPrefixOf)
import GF.Infra.UseIO(ioErrorText,putStrLnE)
import GF.Infra.SIO
import GF.Infra.Option
import qualified System.Console.Haskeline as Haskeline

import PGF
import PGF.Internal(abstract,funs,lookStartCat,emptyPGF)

import Data.Char
import Data.List(isPrefixOf)
import qualified Data.Map as Map
import qualified Text.ParserCombinators.ReadP as RP
--import System.IO(utf8)
--import System.CPUTime(getCPUTime)
import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
import Control.Exception(SomeException,fromException,evaluate,try)
import Control.Monad.State hiding (void)
import qualified GF.System.Signal as IO(runInterruptibly)
#ifdef SERVER_MODE
import GF.Server(server)
#endif

import GF.Command.Messages(welcome)
-- Provides an orphan instance of MonadFail for StateT in ghc versions < 8
import Control.Monad.Trans.Instances ()

-- | Run the GF Shell in quiet mode (@gf -run@).
mainRunGFI :: Options -> [FilePath] -> IO ()
mainRunGFI :: Options -> [FilePath] -> IO ()
mainRunGFI Options
opts [FilePath]
files = Options -> [FilePath] -> IO ()
shell (Options -> Options
beQuiet Options
opts) [FilePath]
files

beQuiet :: Options -> Options
beQuiet = Options -> Options -> Options
addOptions ((Flags -> Flags) -> Options
modifyFlags (\Flags
f -> Flags
f{optVerbosity :: Verbosity
optVerbosity=Verbosity
Quiet}))

-- | Run the interactive GF Shell
mainGFI :: Options -> [FilePath] -> IO ()
mainGFI :: Options -> [FilePath] -> IO ()
mainGFI Options
opts [FilePath]
files = do
  FilePath -> IO ()
P.putStrLn FilePath
welcome
  Options -> [FilePath] -> IO ()
shell Options
opts [FilePath]
files

shell :: Options -> [FilePath] -> IO ()
shell Options
opts [FilePath]
files = (StateT GFEnv IO () -> GFEnv -> IO ())
-> GFEnv -> StateT GFEnv IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT GFEnv IO () -> GFEnv -> IO ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Options -> GFEnv
emptyGFEnv Options
opts) (StateT GFEnv IO () -> IO ()) -> StateT GFEnv IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   do (SIO ((), GFEnv) -> IO ((), GFEnv))
-> StateT GFEnv SIO () -> StateT GFEnv IO ()
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT SIO ((), GFEnv) -> IO ((), GFEnv)
forall a. SIO a -> IO a
runSIO (StateT GFEnv SIO () -> StateT GFEnv IO ())
-> StateT GFEnv SIO () -> StateT GFEnv IO ()
forall a b. (a -> b) -> a -> b
$ Options -> [FilePath] -> StateT GFEnv SIO ()
importInEnv Options
opts [FilePath]
files
                      (GFEnv -> GFEnv) -> StateT GFEnv IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GFEnv -> GFEnv) -> StateT GFEnv IO ())
-> (GFEnv -> GFEnv) -> StateT GFEnv IO ()
forall a b. (a -> b) -> a -> b
$ \ GFEnv
gfenv0 -> GFEnv
gfenv0 {history :: [FilePath]
history = [[FilePath] -> FilePath
unwords (FilePath
"i"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
files)]}
                      StateT GFEnv IO ()
loop

#ifdef SERVER_MODE
-- | Run the GF Server (@gf -server@).
-- The 'Int' argument is the port number for the HTTP service.
mainServerGFI :: Options -> Int -> [FilePath] -> IO ()
mainServerGFI Options
opts0 Int
port [FilePath]
files =
    Maybe Int
-> Int
-> Maybe FilePath
-> (GFEnv -> FilePath -> SIO (Maybe GFEnv))
-> GFEnv
-> IO ()
forall p a.
p
-> Int
-> Maybe FilePath
-> (a -> FilePath -> SIO (Maybe a))
-> a
-> IO ()
server Maybe Int
jobs Int
port Maybe FilePath
root GFEnv -> FilePath -> SIO (Maybe GFEnv)
execute1' (GFEnv -> IO ()) -> (((), GFEnv) -> GFEnv) -> ((), GFEnv) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), GFEnv) -> GFEnv
forall a b. (a, b) -> b
snd
      (((), GFEnv) -> IO ()) -> IO ((), GFEnv) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SIO ((), GFEnv) -> IO ((), GFEnv)
forall a. SIO a -> IO a
runSIO (StateT GFEnv SIO () -> GFEnv -> SIO ((), GFEnv)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Options -> [FilePath] -> StateT GFEnv SIO ()
importInEnv Options
opts [FilePath]
files) (Options -> GFEnv
emptyGFEnv Options
opts))
  where
    root :: Maybe FilePath
root = (Flags -> Maybe FilePath) -> Options -> Maybe FilePath
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe FilePath
optDocumentRoot Options
opts
    opts :: Options
opts = Options -> Options
beQuiet Options
opts0
    jobs :: Maybe Int
jobs = Maybe (Maybe Int) -> Maybe Int
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((Flags -> Maybe (Maybe Int)) -> Options -> Maybe (Maybe Int)
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe (Maybe Int)
optJobs Options
opts)

    execute1' :: GFEnv -> FilePath -> SIO (Maybe GFEnv)
execute1' GFEnv
gfenv0 FilePath
cmd =
       do (Bool
continue,GFEnv
gfenv) <- StateT GFEnv SIO Bool -> GFEnv -> SIO (Bool, GFEnv)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (FilePath -> StateT GFEnv SIO Bool
execute1 FilePath
cmd) GFEnv
gfenv0
          Maybe GFEnv -> SIO (Maybe GFEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GFEnv -> SIO (Maybe GFEnv))
-> Maybe GFEnv -> SIO (Maybe GFEnv)
forall a b. (a -> b) -> a -> b
$ if Bool
continue then GFEnv -> Maybe GFEnv
forall a. a -> Maybe a
Just GFEnv
gfenv else Maybe GFEnv
forall a. Maybe a
Nothing
#else
mainServerGFI opts port files =
  error "GF has not been compiled with server mode support"
#endif

-- | Read end execute commands until it is time to quit
loop :: StateT GFEnv IO ()
loop :: StateT GFEnv IO ()
loop = StateT GFEnv IO Bool -> StateT GFEnv IO ()
forall (m :: * -> *). Monad m => m Bool -> m ()
repeatM StateT GFEnv IO Bool
readAndExecute1

-- | Read and execute one command, returning 'True' to continue execution,
-- | 'False' when it is time to quit
readAndExecute1 :: StateT GFEnv IO Bool
readAndExecute1 :: StateT GFEnv IO Bool
readAndExecute1 = (SIO (Bool, GFEnv) -> IO (Bool, GFEnv))
-> StateT GFEnv SIO Bool -> StateT GFEnv IO Bool
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT SIO (Bool, GFEnv) -> IO (Bool, GFEnv)
forall a. SIO a -> IO a
runSIO (StateT GFEnv SIO Bool -> StateT GFEnv IO Bool)
-> (FilePath -> StateT GFEnv SIO Bool)
-> FilePath
-> StateT GFEnv IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StateT GFEnv SIO Bool
execute1 (FilePath -> StateT GFEnv IO Bool)
-> StateT GFEnv IO FilePath -> StateT GFEnv IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT GFEnv IO FilePath
readCommand

-- | Read a command
readCommand :: StateT GFEnv IO String
readCommand :: StateT GFEnv IO FilePath
readCommand =
  do Options
opts <- (GFEnv -> Options) -> StateT GFEnv IO Options
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GFEnv -> Options
startOpts
     case (Flags -> Mode) -> Options -> Mode
forall a. (Flags -> a) -> Options -> a
flag Flags -> Mode
optMode Options
opts of
       Mode
ModeRun -> IO FilePath -> StateT GFEnv IO FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO FilePath
tryGetLine
       Mode
_       -> IO FilePath -> StateT GFEnv IO FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FilePath -> StateT GFEnv IO FilePath)
-> (GFEnv -> IO FilePath) -> GFEnv -> StateT GFEnv IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GFEnv -> IO FilePath
fetchCommand (GFEnv -> StateT GFEnv IO FilePath)
-> StateT GFEnv IO GFEnv -> StateT GFEnv IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT GFEnv IO GFEnv
forall s (m :: * -> *). MonadState s m => m s
get

timeIt :: m b -> m (Integer, b)
timeIt m b
act =
  do Integer
t1 <- SIO Integer -> m Integer
forall (m :: * -> *) a. MonadSIO m => SIO a -> m a
liftSIO (SIO Integer -> m Integer) -> SIO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ SIO Integer
getCPUTime
     b
a <-  m b
act
     Integer
t2 <- SIO Integer -> m Integer
forall (m :: * -> *) a. MonadSIO m => SIO a -> m a
liftSIO (SIO Integer -> m Integer) -> SIO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ SIO Integer
getCPUTime
     (Integer, b) -> m (Integer, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
t2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
t1,b
a)

-- | Optionally show how much CPU time was used to run an IO action
optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
optionallyShowCPUTime :: Options -> m a -> m a
optionallyShowCPUTime Options
opts m a
act
  | Bool -> Bool
not (Options -> Verbosity -> Bool
verbAtLeast Options
opts Verbosity
Normal) = m a
act
  | Bool
otherwise = do (Integer
dt,a
r) <- m a -> m (Integer, a)
forall (m :: * -> *) b.
(Monad m, MonadSIO m) =>
m b -> m (Integer, b)
timeIt m a
act
                   SIO () -> m ()
forall (m :: * -> *) a. MonadSIO m => SIO a -> m a
liftSIO (SIO () -> m ()) -> SIO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> SIO ()
putStrLnFlush (FilePath -> SIO ()) -> FilePath -> SIO ()
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer
dt Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000000) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" msec"
                   a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r


type ShellM = StateT GFEnv SIO

-- | Execute a given command line, returning 'True' to continue execution,
-- | 'False' when it is time to quit
execute1, execute1' :: String -> ShellM Bool
execute1 :: FilePath -> StateT GFEnv SIO Bool
execute1 FilePath
s0 =
  do (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GFEnv -> GFEnv) -> StateT GFEnv SIO ())
-> (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ \ GFEnv
gfenv0 -> GFEnv
gfenv0 {history :: [FilePath]
history = FilePath
s0 FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: GFEnv -> [FilePath]
history GFEnv
gfenv0}
     FilePath -> StateT GFEnv SIO Bool
execute1' FilePath
s0

-- | Execute a given command line, without adding it to the history
execute1' :: FilePath -> StateT GFEnv SIO Bool
execute1' FilePath
s0 =
  do Options
opts <- (GFEnv -> Options) -> StateT GFEnv SIO Options
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GFEnv -> Options
startOpts
     StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
interruptible (StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool)
-> StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
forall a b. (a -> b) -> a -> b
$ Options -> StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
forall (m :: * -> *) a.
(Monad m, MonadSIO m) =>
Options -> m a -> m a
optionallyShowCPUTime Options
opts (StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool)
-> StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
forall a b. (a -> b) -> a -> b
$
       case FilePath -> [FilePath]
pwords FilePath
s0 of
      -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands
      -- special commands
         FilePath
"q" :[FilePath]
_   -> StateT GFEnv SIO Bool
quit
         FilePath
"!" :[FilePath]
ws  -> [FilePath] -> StateT GFEnv SIO Bool
system_command [FilePath]
ws
         FilePath
"eh":[FilePath]
ws  -> [FilePath] -> StateT GFEnv SIO Bool
execute_history [FilePath]
ws
         FilePath
"i" :[FilePath]
ws  -> do [FilePath] -> StateT GFEnv SIO ()
import_ [FilePath]
ws; StateT GFEnv SIO Bool
continue
      -- other special commands, working on GFEnv
         FilePath
"dc":[FilePath]
ws  -> [FilePath] -> StateT GFEnv SIO Bool
define_command [FilePath]
ws
         FilePath
"dt":[FilePath]
ws  -> [FilePath] -> StateT GFEnv SIO Bool
define_tree [FilePath]
ws
      -- ordinary commands
         [FilePath]
_        -> do CommandEnv ShellM
env <- (GFEnv -> CommandEnv ShellM)
-> StateT GFEnv SIO (CommandEnv ShellM)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GFEnv -> CommandEnv ShellM
commandenv
                        CommandEnv ShellM -> FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *).
(MonadFail m, Output m, TypeCheckArg m) =>
CommandEnv m -> FilePath -> m ()
interpretCommandLine CommandEnv ShellM
env FilePath
s0
                        StateT GFEnv SIO Bool
continue
  where
    continue,stop :: ShellM Bool
    continue :: StateT GFEnv SIO Bool
continue = Bool -> StateT GFEnv SIO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    stop :: StateT GFEnv SIO Bool
stop = Bool -> StateT GFEnv SIO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    interruptible :: ShellM Bool -> ShellM Bool
    interruptible :: StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
interruptible StateT GFEnv SIO Bool
act =
      do GFEnv
gfenv <- StateT GFEnv SIO GFEnv
forall s (m :: * -> *). MonadState s m => m s
get
         (SIO (Bool, GFEnv) -> SIO (Bool, GFEnv))
-> StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (
           (SomeException -> SIO (Bool, GFEnv))
-> ((Bool, GFEnv) -> SIO (Bool, GFEnv))
-> Either SomeException (Bool, GFEnv)
-> SIO (Bool, GFEnv)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\SomeException
e -> SomeException -> SIO ()
printException SomeException
e SIO () -> SIO (Bool, GFEnv) -> SIO (Bool, GFEnv)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, GFEnv) -> SIO (Bool, GFEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True,GFEnv
gfenv)) (Bool, GFEnv) -> SIO (Bool, GFEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return
             (Either SomeException (Bool, GFEnv) -> SIO (Bool, GFEnv))
-> (SIO (Bool, GFEnv) -> SIO (Either SomeException (Bool, GFEnv)))
-> SIO (Bool, GFEnv)
-> SIO (Bool, GFEnv)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< SIO (Bool, GFEnv) -> SIO (Either SomeException (Bool, GFEnv))
forall a. SIO a -> SIO (Either SomeException a)
runInterruptibly) StateT GFEnv SIO Bool
act

  -- Special commands:

    quit :: StateT GFEnv SIO Bool
quit = do Options
opts <- (GFEnv -> Options) -> StateT GFEnv SIO Options
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GFEnv -> Options
startOpts
              Bool -> StateT GFEnv SIO () -> StateT GFEnv SIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Verbosity -> Bool
verbAtLeast Options
opts Verbosity
Normal) (StateT GFEnv SIO () -> StateT GFEnv SIO ())
-> StateT GFEnv SIO () -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *). Output m => FilePath -> m ()
putStrLnE FilePath
"See you."
              StateT GFEnv SIO Bool
stop

    system_command :: [FilePath] -> StateT GFEnv SIO Bool
system_command [FilePath]
ws = do SIO ExitCode -> StateT GFEnv SIO ExitCode
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SIO ExitCode -> StateT GFEnv SIO ExitCode)
-> SIO ExitCode -> StateT GFEnv SIO ExitCode
forall a b. (a -> b) -> a -> b
$ FilePath -> SIO ExitCode
restrictedSystem (FilePath -> SIO ExitCode) -> FilePath -> SIO ExitCode
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath]
ws ; StateT GFEnv SIO Bool
continue


       {-"eh":w:_ -> do
                  cs <- readFile w >>= return . map words . lines
                  gfenv' <- foldM (flip (process False benv)) gfenv cs
                  loopNewCPU gfenv' -}
    execute_history :: [FilePath] -> StateT GFEnv SIO Bool
execute_history [FilePath
w] =
      do [FilePath] -> StateT GFEnv SIO ()
execute ([FilePath] -> StateT GFEnv SIO ())
-> (FilePath -> [FilePath]) -> FilePath -> StateT GFEnv SIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> StateT GFEnv SIO ())
-> StateT GFEnv SIO FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SIO FilePath -> StateT GFEnv SIO FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FilePath -> SIO FilePath
forall a. IO a -> SIO a
restricted (FilePath -> IO FilePath
readFile FilePath
w))
         StateT GFEnv SIO Bool
continue
      where
        execute :: [FilePath] -> StateT GFEnv SIO ()
execute []           = () -> StateT GFEnv SIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        execute (FilePath
line:[FilePath]
lines) = StateT GFEnv SIO Bool -> StateT GFEnv SIO () -> StateT GFEnv SIO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> StateT GFEnv SIO Bool
execute1' FilePath
line) ([FilePath] -> StateT GFEnv SIO ()
execute [FilePath]
lines)

    execute_history [FilePath]
_   =
       do FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *). Output m => FilePath -> m ()
putStrLnE FilePath
"eh command not parsed"
          StateT GFEnv SIO Bool
continue

    define_command :: [FilePath] -> StateT GFEnv SIO Bool
define_command (FilePath
f:[FilePath]
ws) =
        case FilePath -> Maybe CommandLine
readCommandLine ([FilePath] -> FilePath
unwords [FilePath]
ws) of
           Just CommandLine
comm ->
             do (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GFEnv -> GFEnv) -> StateT GFEnv SIO ())
-> (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$
                  \ GFEnv
gfenv ->
                    let env :: CommandEnv ShellM
env = GFEnv -> CommandEnv ShellM
commandenv GFEnv
gfenv
                    in GFEnv
gfenv {
                         commandenv :: CommandEnv ShellM
commandenv = CommandEnv ShellM
env {
                           commandmacros :: Map FilePath CommandLine
commandmacros = FilePath
-> CommandLine
-> Map FilePath CommandLine
-> Map FilePath CommandLine
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
f CommandLine
comm (CommandEnv ShellM -> Map FilePath CommandLine
forall (m :: * -> *). CommandEnv m -> Map FilePath CommandLine
commandmacros CommandEnv ShellM
env)
                         }
                       }
                StateT GFEnv SIO Bool
continue
           Maybe CommandLine
_ -> StateT GFEnv SIO Bool
dc_not_parsed
    define_command [FilePath]
_ = StateT GFEnv SIO Bool
dc_not_parsed

    dc_not_parsed :: StateT GFEnv SIO Bool
dc_not_parsed = FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *). Output m => FilePath -> m ()
putStrLnE FilePath
"command definition not parsed" StateT GFEnv SIO ()
-> StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT GFEnv SIO Bool
continue

    define_tree :: [FilePath] -> StateT GFEnv SIO Bool
define_tree (FilePath
f:[FilePath]
ws) =
        case FilePath -> Maybe Expr
readExpr ([FilePath] -> FilePath
unwords [FilePath]
ws) of
          Just Expr
exp ->
           do (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GFEnv -> GFEnv) -> StateT GFEnv SIO ())
-> (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$
                \ GFEnv
gfenv ->
                  let env :: CommandEnv ShellM
env = GFEnv -> CommandEnv ShellM
commandenv GFEnv
gfenv
                  in GFEnv
gfenv { commandenv :: CommandEnv ShellM
commandenv = CommandEnv ShellM
env {
                               expmacros :: Map FilePath Expr
expmacros = FilePath -> Expr -> Map FilePath Expr -> Map FilePath Expr
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
f Expr
exp (CommandEnv ShellM -> Map FilePath Expr
forall (m :: * -> *). CommandEnv m -> Map FilePath Expr
expmacros CommandEnv ShellM
env) } }
              StateT GFEnv SIO Bool
continue
          Maybe Expr
_ -> StateT GFEnv SIO Bool
dt_not_parsed
    define_tree [FilePath]
_ = StateT GFEnv SIO Bool
dt_not_parsed

    dt_not_parsed :: StateT GFEnv SIO Bool
dt_not_parsed = FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *). Output m => FilePath -> m ()
putStrLnE FilePath
"value definition not parsed" StateT GFEnv SIO ()
-> StateT GFEnv SIO Bool -> StateT GFEnv SIO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT GFEnv SIO Bool
continue

pwords :: FilePath -> [FilePath]
pwords FilePath
s = case FilePath -> [FilePath]
words FilePath
s of
             FilePath
w:[FilePath]
ws -> FilePath -> FilePath
getCommandOp FilePath
w FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ws
             [FilePath]
ws -> [FilePath]
ws

import_ :: [FilePath] -> StateT GFEnv SIO ()
import_ [FilePath]
args =
  do case [FilePath] -> Err (Options, [FilePath])
forall (err :: * -> *).
ErrorMonad err =>
[FilePath] -> err (Options, [FilePath])
parseOptions [FilePath]
args of
       Ok (Options
opts',[FilePath]
files) -> do
         Options
opts <- (GFEnv -> Options) -> StateT GFEnv SIO Options
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GFEnv -> Options
startOpts
         FilePath
curr_dir <- SIO FilePath -> StateT GFEnv SIO FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift SIO FilePath
getCurrentDirectory
         [FilePath]
lib_dir  <- SIO [FilePath] -> StateT GFEnv SIO [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SIO [FilePath] -> StateT GFEnv SIO [FilePath])
-> SIO [FilePath] -> StateT GFEnv SIO [FilePath]
forall a b. (a -> b) -> a -> b
$ Options -> SIO [FilePath]
getLibraryDirectory (Options -> Options -> Options
addOptions Options
opts Options
opts')
         Options -> [FilePath] -> StateT GFEnv SIO ()
importInEnv (Options -> Options -> Options
addOptions Options
opts (FilePath -> [FilePath] -> Options -> Options
fixRelativeLibPaths FilePath
curr_dir [FilePath]
lib_dir Options
opts')) [FilePath]
files
       Bad FilePath
err -> FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *). Output m => FilePath -> m ()
putStrLnE (FilePath -> StateT GFEnv SIO ())
-> FilePath -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Command parse error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err

-- | Commands that work on 'GFEnv'
moreCommands :: [(FilePath, CommandInfo ShellM)]
moreCommands = [
  (FilePath
"e",  CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: FilePath
longname = FilePath
"empty",
     synopsis :: FilePath
synopsis = FilePath
"empty the environment (except the command history)",
     exec :: [Option] -> CommandArguments -> StateT GFEnv SIO CommandOutput
exec = \ [Option]
_ CommandArguments
_ ->
            do (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GFEnv -> GFEnv) -> StateT GFEnv SIO ())
-> (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ \ GFEnv
gfenv -> (Options -> GFEnv
emptyGFEnv (GFEnv -> Options
startOpts GFEnv
gfenv))
                                     { history :: [FilePath]
history=GFEnv -> [FilePath]
history GFEnv
gfenv }
               CommandOutput -> StateT GFEnv SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
     }),
  (FilePath
"ph", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: FilePath
longname = FilePath
"print_history",
     synopsis :: FilePath
synopsis = FilePath
"print command history",
     explanation :: FilePath
explanation = [FilePath] -> FilePath
unlines [
       FilePath
"Prints the commands issued during the GF session.",
       FilePath
"The result is readable by the eh command.",
       FilePath
"The result can be used as a script when starting GF."
       ],
     examples :: [(FilePath, FilePath)]
examples = [
      FilePath -> (FilePath, FilePath)
mkEx FilePath
"ph | wf -file=foo.gfs  -- save the history into a file"
      ],
     exec :: [Option] -> CommandArguments -> StateT GFEnv SIO CommandOutput
exec = \ [Option]
_ CommandArguments
_ ->
            (GFEnv -> CommandOutput)
-> StateT GFEnv SIO GFEnv -> StateT GFEnv SIO CommandOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> CommandOutput
fromString (FilePath -> CommandOutput)
-> (GFEnv -> FilePath) -> GFEnv -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (GFEnv -> [FilePath]) -> GFEnv -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (GFEnv -> [FilePath]) -> GFEnv -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
1 ([FilePath] -> [FilePath])
-> (GFEnv -> [FilePath]) -> GFEnv -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GFEnv -> [FilePath]
history) StateT GFEnv SIO GFEnv
forall s (m :: * -> *). MonadState s m => m s
get
     }),
  (FilePath
"r",  CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: FilePath
longname = FilePath
"reload",
     synopsis :: FilePath
synopsis = FilePath
"repeat the latest import command",
     exec :: [Option] -> CommandArguments -> StateT GFEnv SIO CommandOutput
exec = \ [Option]
_ CommandArguments
_ ->
       do GFEnv
gfenv0 <- StateT GFEnv SIO GFEnv
forall s (m :: * -> *). MonadState s m => m s
get
          let imports :: [(FilePath, [FilePath])]
imports = [(FilePath
s,[FilePath]
ws) | FilePath
s <- GFEnv -> [FilePath]
history GFEnv
gfenv0, (FilePath
"i":[FilePath]
ws) <- [FilePath -> [FilePath]
pwords FilePath
s]]
          case [(FilePath, [FilePath])]
imports of
            (FilePath
s,[FilePath]
ws):[(FilePath, [FilePath])]
_ -> do
              FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *). Output m => FilePath -> m ()
putStrLnE (FilePath -> StateT GFEnv SIO ())
-> FilePath -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"repeating latest import: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
              [FilePath] -> StateT GFEnv SIO ()
import_ [FilePath]
ws
              CommandOutput -> StateT GFEnv SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
            [(FilePath, [FilePath])]
_ -> do FilePath -> StateT GFEnv SIO ()
forall (m :: * -> *). Output m => FilePath -> m ()
putStrLnE (FilePath -> StateT GFEnv SIO ())
-> FilePath -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"no import in history"
                    CommandOutput -> StateT GFEnv SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
     })
  ]


printException :: SomeException -> SIO ()
printException SomeException
e = SIO () -> (IOError -> SIO ()) -> Maybe IOError -> SIO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SomeException -> SIO ()
forall a. Show a => a -> SIO ()
print SomeException
e) (FilePath -> SIO ()
putStrLn (FilePath -> SIO ()) -> (IOError -> FilePath) -> IOError -> SIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> FilePath
ioErrorText) (SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e)

fetchCommand :: GFEnv -> IO String
fetchCommand :: GFEnv -> IO FilePath
fetchCommand GFEnv
gfenv = do
  FilePath
path <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"gf_history"
  let settings :: Settings IO
settings =
        Settings :: forall (m :: * -> *).
CompletionFunc m -> Maybe FilePath -> Bool -> Settings m
Haskeline.Settings {
          complete :: CompletionFunc IO
Haskeline.complete = GFEnv -> CompletionFunc IO
wordCompletion GFEnv
gfenv,
          historyFile :: Maybe FilePath
Haskeline.historyFile = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path,
          autoAddHistory :: Bool
Haskeline.autoAddHistory = Bool
True
        }
  Either SomeException (Maybe FilePath)
res <- IO (Maybe FilePath) -> IO (Either SomeException (Maybe FilePath))
forall a. IO a -> IO (Either SomeException a)
IO.runInterruptibly (IO (Maybe FilePath) -> IO (Either SomeException (Maybe FilePath)))
-> IO (Maybe FilePath)
-> IO (Either SomeException (Maybe FilePath))
forall a b. (a -> b) -> a -> b
$ Settings IO -> InputT IO (Maybe FilePath) -> IO (Maybe FilePath)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
Haskeline.runInputT Settings IO
settings (FilePath -> InputT IO (Maybe FilePath)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> InputT m (Maybe FilePath)
Haskeline.getInputLine (GFEnv -> FilePath
prompt GFEnv
gfenv))
  case Either SomeException (Maybe FilePath)
res of
    Left  SomeException
_        -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
    Right Maybe FilePath
Nothing  -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"q"
    Right (Just FilePath
s) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s

importInEnv :: Options -> [FilePath] -> ShellM ()
importInEnv :: Options -> [FilePath] -> StateT GFEnv SIO ()
importInEnv Options
opts [FilePath]
files =
  do PGF
pgf0 <- (GFEnv -> PGF) -> StateT GFEnv SIO PGF
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GFEnv -> PGF
multigrammar
     if (Flags -> Bool) -> Options -> Bool
forall a. (Flags -> a) -> Options -> a
flag Flags -> Bool
optRetainResource Options
opts
      then do SourceGrammar
src <- SIO SourceGrammar -> StateT GFEnv SIO SourceGrammar
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SIO SourceGrammar -> StateT GFEnv SIO SourceGrammar)
-> SIO SourceGrammar -> StateT GFEnv SIO SourceGrammar
forall a b. (a -> b) -> a -> b
$ Options -> [FilePath] -> SIO SourceGrammar
importSource Options
opts [FilePath]
files
              PGF
pgf <- SIO PGF -> StateT GFEnv SIO PGF
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SIO PGF -> StateT GFEnv SIO PGF)
-> (SIO PGF -> SIO PGF) -> SIO PGF -> StateT GFEnv SIO PGF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SIO PGF -> SIO PGF
forall a. SIO a -> SIO a
lazySIO (SIO PGF -> StateT GFEnv SIO PGF)
-> SIO PGF -> StateT GFEnv SIO PGF
forall a b. (a -> b) -> a -> b
$ PGF -> SIO PGF
importPGF PGF
pgf0 -- duplicates some work, better to link src
              (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GFEnv -> GFEnv) -> StateT GFEnv SIO ())
-> (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ \ GFEnv
gfenv -> GFEnv
gfenv {retain :: Bool
retain=Bool
True, pgfenv :: CmdEnv
pgfenv = (SourceGrammar
src,PGF -> PGFEnv
pgfEnv PGF
pgf)}
      else do PGF
pgf1 <- SIO PGF -> StateT GFEnv SIO PGF
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SIO PGF -> StateT GFEnv SIO PGF)
-> SIO PGF -> StateT GFEnv SIO PGF
forall a b. (a -> b) -> a -> b
$ PGF -> SIO PGF
importPGF PGF
pgf0
              (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GFEnv -> GFEnv) -> StateT GFEnv SIO ())
-> (GFEnv -> GFEnv) -> StateT GFEnv SIO ()
forall a b. (a -> b) -> a -> b
$ \ GFEnv
gfenv->GFEnv
gfenv { retain :: Bool
retain=Bool
False,
                                        pgfenv :: CmdEnv
pgfenv = (SourceGrammar
emptyGrammar,PGF -> PGFEnv
pgfEnv PGF
pgf1) }
  where
    importPGF :: PGF -> SIO PGF
importPGF PGF
pgf0 =
      do let opts' :: Options
opts' = Options -> Options -> Options
addOptions (Optimization -> Bool -> Options
setOptimization Optimization
OptCSE Bool
False) Options
opts
         PGF
pgf1 <- PGF -> Options -> [FilePath] -> SIO PGF
importGrammar PGF
pgf0 Options
opts' [FilePath]
files
         if (Options -> Verbosity -> Bool
verbAtLeast Options
opts Verbosity
Normal)
           then FilePath -> SIO ()
putStrLnFlush (FilePath -> SIO ()) -> FilePath -> SIO ()
forall a b. (a -> b) -> a -> b
$
                  [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"\nLanguages:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (CId -> FilePath) -> [CId] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map CId -> FilePath
showCId (PGF -> [CId]
languages PGF
pgf1)
           else () -> SIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         PGF -> SIO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return PGF
pgf1

tryGetLine :: IO FilePath
tryGetLine = do
  Either SomeException FilePath
res <- IO FilePath -> IO (Either SomeException FilePath)
forall e a. Exception e => IO a -> IO (Either e a)
try IO FilePath
getLine
  case Either SomeException FilePath
res of
   Left (SomeException
e :: SomeException) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"q"
   Right FilePath
l -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
l

prompt :: GFEnv -> FilePath
prompt GFEnv
env
  | GFEnv -> Bool
retain GFEnv
env Bool -> Bool -> Bool
|| CId
abs CId -> CId -> Bool
forall a. Eq a => a -> a -> Bool
== CId
wildCId = FilePath
"> "
  | Bool
otherwise      = CId -> FilePath
showCId CId
abs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"> "
  where
    abs :: CId
abs = PGF -> CId
abstractName (GFEnv -> PGF
multigrammar GFEnv
env)

type CmdEnv = (Grammar,PGFEnv)

data GFEnv = GFEnv {
    GFEnv -> Options
startOpts :: Options,
    GFEnv -> Bool
retain :: Bool,  -- grammar was imported with -retain flag
    GFEnv -> CmdEnv
pgfenv :: CmdEnv,
    GFEnv -> CommandEnv ShellM
commandenv :: CommandEnv ShellM,
    GFEnv -> [FilePath]
history    :: [String]
  }

emptyGFEnv :: Options -> GFEnv
emptyGFEnv Options
opts = Options
-> Bool -> CmdEnv -> CommandEnv ShellM -> [FilePath] -> GFEnv
GFEnv Options
opts Bool
False CmdEnv
emptyCmdEnv CommandEnv ShellM
emptyCommandEnv []

emptyCmdEnv :: CmdEnv
emptyCmdEnv = (SourceGrammar
emptyGrammar,PGF -> PGFEnv
pgfEnv PGF
emptyPGF)

emptyCommandEnv :: CommandEnv ShellM
emptyCommandEnv = Map FilePath (CommandInfo ShellM) -> CommandEnv ShellM
forall (m :: * -> *). Map FilePath (CommandInfo m) -> CommandEnv m
mkCommandEnv Map FilePath (CommandInfo ShellM)
allCommands
multigrammar :: GFEnv -> PGF
multigrammar = PGFEnv -> PGF
pgf (PGFEnv -> PGF) -> (GFEnv -> PGFEnv) -> GFEnv -> PGF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdEnv -> PGFEnv
forall a b. (a, b) -> b
snd (CmdEnv -> PGFEnv) -> (GFEnv -> CmdEnv) -> GFEnv -> PGFEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GFEnv -> CmdEnv
pgfenv

allCommands :: Map FilePath (CommandInfo ShellM)
allCommands =
  Map FilePath (CommandInfo ShellM)
-> [(FilePath, CommandInfo ShellM)]
-> Map FilePath (CommandInfo ShellM)
forall k a. Ord k => Map k a -> [(k, a)] -> Map k a
extend Map FilePath (CommandInfo ShellM)
forall (m :: * -> *). HasPGFEnv m => Map FilePath (CommandInfo m)
pgfCommands (Map FilePath (CommandInfo ShellM) -> (FilePath, CommandInfo ShellM)
forall (m1 :: * -> *) (m2 :: * -> *).
Monad m1 =>
Map FilePath (CommandInfo m2) -> (FilePath, CommandInfo m1)
helpCommand Map FilePath (CommandInfo ShellM)
allCommands(FilePath, CommandInfo ShellM)
-> [(FilePath, CommandInfo ShellM)]
-> [(FilePath, CommandInfo ShellM)]
forall a. a -> [a] -> [a]
:[(FilePath, CommandInfo ShellM)]
moreCommands)
  Map FilePath (CommandInfo ShellM)
-> Map FilePath (CommandInfo ShellM)
-> Map FilePath (CommandInfo ShellM)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map FilePath (CommandInfo ShellM)
forall (m :: * -> *). HasGrammar m => Map FilePath (CommandInfo m)
sourceCommands
  Map FilePath (CommandInfo ShellM)
-> Map FilePath (CommandInfo ShellM)
-> Map FilePath (CommandInfo ShellM)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map FilePath (CommandInfo ShellM)
forall (m :: * -> *).
(Monad m, MonadSIO m) =>
Map FilePath (CommandInfo m)
commonCommands

instance HasGrammar ShellM where getGrammar :: StateT GFEnv SIO SourceGrammar
getGrammar = (GFEnv -> SourceGrammar) -> StateT GFEnv SIO SourceGrammar
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (CmdEnv -> SourceGrammar
forall a b. (a, b) -> a
fst (CmdEnv -> SourceGrammar)
-> (GFEnv -> CmdEnv) -> GFEnv -> SourceGrammar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GFEnv -> CmdEnv
pgfenv)
instance HasPGFEnv ShellM where getPGFEnv :: ShellM PGFEnv
getPGFEnv = (GFEnv -> PGFEnv) -> ShellM PGFEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (CmdEnv -> PGFEnv
forall a b. (a, b) -> b
snd (CmdEnv -> PGFEnv) -> (GFEnv -> CmdEnv) -> GFEnv -> PGFEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GFEnv -> CmdEnv
pgfenv)

wordCompletion :: GFEnv -> CompletionFunc IO
wordCompletion GFEnv
gfenv (FilePath
left,FilePath
right) = do
  case FilePath -> CompletionType
wc_type (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
left) of
    CmplCmd FilePath
pref
      -> Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pref) [FilePath -> Completion
Haskeline.simpleCompletion FilePath
name | FilePath
name <- Map FilePath (CommandInfo ShellM) -> [FilePath]
forall k a. Map k a -> [k]
Map.keys (CommandEnv ShellM -> Map FilePath (CommandInfo ShellM)
forall (m :: * -> *). CommandEnv m -> Map FilePath (CommandInfo m)
commands CommandEnv ShellM
cmdEnv), FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
pref FilePath
name]
    CmplStr (Just (Command FilePath
_ [Option]
opts Argument
_)) FilePath
s0
      -> do Either SomeException ParseState
mb_state0 <- IO ParseState -> IO (Either SomeException ParseState)
forall e a. Exception e => IO a -> IO (Either e a)
try (ParseState -> IO ParseState
forall a. a -> IO a
evaluate (PGF -> CId -> Type -> ParseState
initState PGF
pgf ([Option] -> CId
optLang [Option]
opts) ([Option] -> Type
optType [Option]
opts)))
            case Either SomeException ParseState
mb_state0 of
              Right ParseState
state0 -> let (FilePath
rprefix,FilePath
rs) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
s0)
                                  s :: FilePath
s            = FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
rs
                                  prefix :: FilePath
prefix       = FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
rprefix
                                  ws :: [FilePath]
ws           = FilePath -> [FilePath]
words FilePath
s
                              in case ParseState -> [FilePath] -> Maybe ParseState
loop ParseState
state0 [FilePath]
ws of
                                   Maybe ParseState
Nothing    -> Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret Int
0 []
                                   Just ParseState
state -> let compls :: Map FilePath ParseState
compls = ParseState -> FilePath -> Map FilePath ParseState
getCompletions ParseState
state FilePath
prefix
                                                 in Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
prefix) ((FilePath -> Completion) -> [FilePath] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> FilePath -> Completion
Haskeline.simpleCompletion FilePath
x) (Map FilePath ParseState -> [FilePath]
forall k a. Map k a -> [k]
Map.keys Map FilePath ParseState
compls))
              Left (SomeException
_ :: SomeException) -> Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret Int
0 []
    CmplOpt (Just (Command FilePath
n [Option]
_ Argument
_)) FilePath
pref
      -> case FilePath
-> Map FilePath (CommandInfo ShellM) -> Maybe (CommandInfo ShellM)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
n (CommandEnv ShellM -> Map FilePath (CommandInfo ShellM)
forall (m :: * -> *). CommandEnv m -> Map FilePath (CommandInfo m)
commands CommandEnv ShellM
cmdEnv) of
           Just CommandInfo ShellM
inf -> do let flg_compls :: [Completion]
flg_compls = [FilePath -> FilePath -> Bool -> Completion
Haskeline.Completion (Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
flgFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"=") (Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
flg) Bool
False | (FilePath
flg,FilePath
_) <- CommandInfo ShellM -> [(FilePath, FilePath)]
forall (m :: * -> *). CommandInfo m -> [(FilePath, FilePath)]
flags   CommandInfo ShellM
inf, FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
pref FilePath
flg]
                              opt_compls :: [Completion]
opt_compls = [FilePath -> FilePath -> Bool -> Completion
Haskeline.Completion (Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
opt)      (Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
opt) Bool
True | (FilePath
opt,FilePath
_) <- CommandInfo ShellM -> [(FilePath, FilePath)]
forall (m :: * -> *). CommandInfo m -> [(FilePath, FilePath)]
options CommandInfo ShellM
inf, FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
pref FilePath
opt]
                          Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
prefInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                              ([Completion]
flg_compls[Completion] -> [Completion] -> [Completion]
forall a. [a] -> [a] -> [a]
++[Completion]
opt_compls)
           Maybe (CommandInfo ShellM)
Nothing  -> Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pref) []
    CmplIdent (Just (Command FilePath
"i" [Option]
_ Argument
_)) FilePath
_        -- HACK: file name completion for command i
      -> CompletionFunc IO
forall (m :: * -> *). MonadIO m => CompletionFunc m
Haskeline.completeFilename (FilePath
left,FilePath
right)
    CmplIdent Maybe Command
_ FilePath
pref
      -> do Either SomeException Abstr
mb_abs <- IO Abstr -> IO (Either SomeException Abstr)
forall e a. Exception e => IO a -> IO (Either e a)
try (Abstr -> IO Abstr
forall a. a -> IO a
evaluate (PGF -> Abstr
abstract PGF
pgf))
            case Either SomeException Abstr
mb_abs of
              Right Abstr
abs -> Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pref) [FilePath -> Completion
Haskeline.simpleCompletion FilePath
name | CId
cid <- Map CId (Type, Int, Maybe ([Equation], [[Instr]]), Double) -> [CId]
forall k a. Map k a -> [k]
Map.keys (Abstr -> Map CId (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs Abstr
abs), let name :: FilePath
name = CId -> FilePath
showCId CId
cid, FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
pref FilePath
name]
              Left (SomeException
_ :: SomeException) -> Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pref) []
    CompletionType
_ -> Int -> [Completion] -> IO (FilePath, [Completion])
forall (m :: * -> *) b. Monad m => Int -> b -> m (FilePath, b)
ret Int
0 []
  where
    pgf :: PGF
pgf    = GFEnv -> PGF
multigrammar GFEnv
gfenv
    cmdEnv :: CommandEnv ShellM
cmdEnv = GFEnv -> CommandEnv ShellM
commandenv GFEnv
gfenv
    optLang :: [Option] -> CId
optLang [Option]
opts = FilePath -> CId -> [Option] -> CId
valCIdOpts FilePath
"lang" ([CId] -> CId
forall a. [a] -> a
head (PGF -> [CId]
languages PGF
pgf)) [Option]
opts
    optType :: [Option] -> Type
optType [Option]
opts =
      let str :: FilePath
str = FilePath -> FilePath -> [Option] -> FilePath
valStrOpts FilePath
"cat" (CId -> FilePath
showCId (CId -> FilePath) -> CId -> FilePath
forall a b. (a -> b) -> a -> b
$ PGF -> CId
lookStartCat PGF
pgf) [Option]
opts
      in case FilePath -> Maybe Type
readType FilePath
str of
           Just Type
ty -> Type
ty
           Maybe Type
Nothing -> FilePath -> Type
forall a. HasCallStack => FilePath -> a
error (FilePath
"Can't parse '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
strFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"' as type")

    loop :: ParseState -> [FilePath] -> Maybe ParseState
loop ParseState
ps []     = ParseState -> Maybe ParseState
forall a. a -> Maybe a
Just ParseState
ps
    loop ParseState
ps (FilePath
t:[FilePath]
ts) = case ParseState -> ParseInput -> Either ErrorState ParseState
nextState ParseState
ps (FilePath -> ParseInput
simpleParseInput FilePath
t) of
                       Left  ErrorState
es -> Maybe ParseState
forall a. Maybe a
Nothing
                       Right ParseState
ps -> ParseState -> [FilePath] -> Maybe ParseState
loop ParseState
ps [FilePath]
ts

    ret :: Int -> b -> m (FilePath, b)
ret Int
len b
xs  = (FilePath, b) -> m (FilePath, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
len FilePath
left,b
xs)


data CompletionType
  = CmplCmd                   Ident
  | CmplStr   (Maybe Command) String
  | CmplOpt   (Maybe Command) Ident
  | CmplIdent (Maybe Command) Ident
  deriving Int -> CompletionType -> FilePath -> FilePath
[CompletionType] -> FilePath -> FilePath
CompletionType -> FilePath
(Int -> CompletionType -> FilePath -> FilePath)
-> (CompletionType -> FilePath)
-> ([CompletionType] -> FilePath -> FilePath)
-> Show CompletionType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [CompletionType] -> FilePath -> FilePath
$cshowList :: [CompletionType] -> FilePath -> FilePath
show :: CompletionType -> FilePath
$cshow :: CompletionType -> FilePath
showsPrec :: Int -> CompletionType -> FilePath -> FilePath
$cshowsPrec :: Int -> CompletionType -> FilePath -> FilePath
Show

wc_type :: String -> CompletionType
wc_type :: FilePath -> CompletionType
wc_type = FilePath -> CompletionType
cmd_name
  where
    cmd_name :: FilePath -> CompletionType
cmd_name FilePath
cs =
      let cs1 :: FilePath
cs1 = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace FilePath
cs
      in FilePath -> FilePath -> CompletionType
go FilePath
cs1 FilePath
cs1
      where
        go :: FilePath -> FilePath -> CompletionType
go FilePath
x []       = FilePath -> CompletionType
CmplCmd FilePath
x
        go FilePath
x (Char
c:FilePath
cs)
          | Char -> Bool
isIdent Char
c = FilePath -> FilePath -> CompletionType
go FilePath
x FilePath
cs
          | Bool
otherwise = FilePath -> FilePath -> CompletionType
cmd FilePath
x FilePath
cs

    cmd :: FilePath -> FilePath -> CompletionType
cmd FilePath
x []       = (Maybe Command -> FilePath -> CompletionType)
-> FilePath -> FilePath -> Int -> CompletionType
forall (t :: * -> *) a t.
Foldable t =>
(Maybe Command -> t a -> t) -> FilePath -> t a -> Int -> t
ret Maybe Command -> FilePath -> CompletionType
CmplIdent FilePath
x FilePath
"" Int
0
    cmd FilePath
_ (Char
'|':FilePath
cs) = FilePath -> CompletionType
cmd_name FilePath
cs
    cmd FilePath
_ (Char
';':FilePath
cs) = FilePath -> CompletionType
cmd_name FilePath
cs
    cmd FilePath
x (Char
'"':FilePath
cs) = FilePath -> FilePath -> FilePath -> CompletionType
str FilePath
x FilePath
cs FilePath
cs
    cmd FilePath
x (Char
'-':FilePath
cs) = FilePath -> FilePath -> FilePath -> CompletionType
option FilePath
x FilePath
cs FilePath
cs
    cmd FilePath
x (Char
c  :FilePath
cs)
      | Char -> Bool
isIdent Char
c  = FilePath -> FilePath -> FilePath -> CompletionType
ident FilePath
x (Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
cs) FilePath
cs
      | Bool
otherwise  = FilePath -> FilePath -> CompletionType
cmd FilePath
x FilePath
cs

    option :: FilePath -> FilePath -> FilePath -> CompletionType
option FilePath
x FilePath
y []       = (Maybe Command -> FilePath -> CompletionType)
-> FilePath -> FilePath -> Int -> CompletionType
forall (t :: * -> *) a t.
Foldable t =>
(Maybe Command -> t a -> t) -> FilePath -> t a -> Int -> t
ret Maybe Command -> FilePath -> CompletionType
CmplOpt FilePath
x FilePath
y Int
1
    option FilePath
x FilePath
y (Char
'=':FilePath
cs) = FilePath -> FilePath -> FilePath -> CompletionType
optValue FilePath
x FilePath
y FilePath
cs
    option FilePath
x FilePath
y (Char
c  :FilePath
cs)
      | Char -> Bool
isIdent Char
c       = FilePath -> FilePath -> FilePath -> CompletionType
option FilePath
x FilePath
y FilePath
cs
      | Bool
otherwise       = FilePath -> FilePath -> CompletionType
cmd FilePath
x FilePath
cs

    optValue :: FilePath -> FilePath -> FilePath -> CompletionType
optValue FilePath
x FilePath
y (Char
'"':FilePath
cs) = FilePath -> FilePath -> FilePath -> CompletionType
str FilePath
x FilePath
y FilePath
cs
    optValue FilePath
x FilePath
y FilePath
cs       = FilePath -> FilePath -> CompletionType
cmd FilePath
x FilePath
cs

    ident :: FilePath -> FilePath -> FilePath -> CompletionType
ident FilePath
x FilePath
y []     = (Maybe Command -> FilePath -> CompletionType)
-> FilePath -> FilePath -> Int -> CompletionType
forall (t :: * -> *) a t.
Foldable t =>
(Maybe Command -> t a -> t) -> FilePath -> t a -> Int -> t
ret Maybe Command -> FilePath -> CompletionType
CmplIdent FilePath
x FilePath
y Int
0
    ident FilePath
x FilePath
y (Char
c:FilePath
cs)
      | Char -> Bool
isIdent Char
c    = FilePath -> FilePath -> FilePath -> CompletionType
ident FilePath
x FilePath
y FilePath
cs
      | Bool
otherwise    = FilePath -> FilePath -> CompletionType
cmd FilePath
x FilePath
cs

    str :: FilePath -> FilePath -> FilePath -> CompletionType
str FilePath
x FilePath
y []          = (Maybe Command -> FilePath -> CompletionType)
-> FilePath -> FilePath -> Int -> CompletionType
forall (t :: * -> *) a t.
Foldable t =>
(Maybe Command -> t a -> t) -> FilePath -> t a -> Int -> t
ret Maybe Command -> FilePath -> CompletionType
CmplStr FilePath
x FilePath
y Int
1
    str FilePath
x FilePath
y (Char
'\"':FilePath
cs)   = FilePath -> FilePath -> CompletionType
cmd FilePath
x FilePath
cs
    str FilePath
x FilePath
y (Char
'\\':Char
c:FilePath
cs) = FilePath -> FilePath -> FilePath -> CompletionType
str FilePath
x FilePath
y FilePath
cs
    str FilePath
x FilePath
y (Char
c:FilePath
cs)      = FilePath -> FilePath -> FilePath -> CompletionType
str FilePath
x FilePath
y FilePath
cs

    ret :: (Maybe Command -> t a -> t) -> FilePath -> t a -> Int -> t
ret Maybe Command -> t a -> t
f FilePath
x t a
y Int
d = Maybe Command -> t a -> t
f Maybe Command
cmd t a
y
      where
        x1 :: FilePath
x1 = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d) FilePath
x
        x2 :: FilePath
x2 = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char -> Bool
isIdent Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') FilePath
x1

        cmd :: Maybe Command
cmd = case [Command
x | (Command
x,FilePath
cs) <- ReadP Command -> ReadS Command
forall a. ReadP a -> ReadS a
RP.readP_to_S ReadP Command
pCommand FilePath
x2, (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
cs] of
                [Command
x] -> Command -> Maybe Command
forall a. a -> Maybe a
Just Command
x
                [Command]
_   -> Maybe Command
forall a. Maybe a
Nothing

    isIdent :: Char -> Bool
isIdent Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
c