{-# LANGUAGE CPP, ScopedTypeVariables, FlexibleInstances #-}
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.Directory(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)
import Control.Monad.Trans.Instances ()
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}))
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
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
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
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
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)
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
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
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
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
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
[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
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
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
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
(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,
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
_
-> 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