-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | The full haskell interpretation loads a whole bunch of modules and can be
-- slow.  Shortcut a few common commands so they happen quickly.
module Cmd.Repl.Fast where
import qualified Data.Char as Char

import qualified Util.Then as Then
import qualified Ui.Ui as Ui
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Repl.Global as Global
import qualified Cmd.Repl.LDebug as LDebug
import qualified Cmd.Repl.LInst as LInst
import qualified Cmd.Repl.LState as LState

import qualified App.ReplProtocol as ReplProtocol


-- | 'interpret' loads a whole bunch of modules and can be slow.  Shortcut a
-- few common commands so they happen quickly.
fast_interpret :: String -> Maybe (Cmd.CmdT IO ReplProtocol.CmdResult)
fast_interpret :: [Char] -> Maybe (CmdT IO CmdResult)
fast_interpret [Char]
text = case [Char] -> Maybe [[Char]]
lex_all [Char]
text of
    Maybe [[Char]]
Nothing -> forall a. Maybe a
Nothing
    Just [[Char]]
tokens -> [[Char]] -> Maybe (CmdT IO CmdResult)
interpret [[Char]]
tokens

interpret :: [String] -> Maybe (Cmd.CmdT IO ReplProtocol.CmdResult)
interpret :: [[Char]] -> Maybe (CmdT IO CmdResult)
interpret [[Char]]
tokens = case [[Char]]
tokens of
        -- Called by logview.
        [[Char]
"s", [Char]
str] | Just [Char]
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ [Char] -> CmdL ()
Global.s [Char]
arg
        [[Char]
"collapse", [Char]
int] | Just TrackNum
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
int -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ TrackNum -> CmdL ()
Global.collapse TrackNum
arg
        [[Char]
"expand", [Char]
int] | Just TrackNum
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
int -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ TrackNum -> CmdL ()
Global.expand TrackNum
arg

        -- Called by the browser.
        [[Char]
"load_instrument", [Char]
str] | Just [Char]
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str ->
            forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ [Char] -> CmdL ()
LInst.load [Char]
arg

        -- Called manually via the REPL.

        -- Make blocks and views.
        [[Char]
"LState.rename", [Char]
a1]
            | Just Namespace
v1 <- forall a. Read a => [Char] -> Maybe a
val [Char]
a1 -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ Namespace -> CmdL ()
LState.rename Namespace
v1
        [[Char]
"Create.view", [Char]
str] | Just BlockId
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
arg

        -- Misc.
        [[Char]
"quit"] -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action CmdL ()
Global.quit
        [[Char]
"save"] -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action CmdL ()
Global.save
        [[Char]
"save_state_as", [Char]
str] | Just [Char]
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str ->
            forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ [Char] -> CmdL ()
Global.save_state_as [Char]
arg
        [[Char]
"write_state", [Char]
str] | Just [Char]
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str ->
            forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ [Char] -> CmdL [Char]
Global.write_state [Char]
arg
        [[Char]
"save_git_as", [Char]
str] | Just [Char]
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str ->
            forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ [Char] -> CmdL ()
Global.save_git_as [Char]
arg
        [[Char]
"load", [Char]
str] | Just [Char]
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ [Char] -> CmdL ()
Global.load [Char]
arg

        -- State
        [[Char]
"Ui.lookup_root_id"] -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall (m :: * -> *). M m => m (Maybe BlockId)
Ui.lookup_root_id
        [[Char]
"Ui.set_root_id", [Char]
str] | Just BlockId
arg <- forall a. Read a => [Char] -> Maybe a
val [Char]
str ->
            forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => BlockId -> m ()
Ui.set_root_id BlockId
arg

        -- So I can see memory stats without loading GHC API.  Though it
        -- happens automatically in the background, so I'd have to disable that
        -- manually.
        [[Char]
"LDebug.rtsAllocated"] -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => m Size
LDebug.rtsAllocated
        [[Char]
"LDebug.rssVsize"] -> forall {f :: * -> *} {a}.
(Functor f, Return a) =>
f a -> Maybe (f CmdResult)
action forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => m (Size, Size)
LDebug.rssVsize
        [[Char]]
_ -> forall a. Maybe a
Nothing
    where
    action :: f a -> Maybe (f CmdResult)
action f a
c = forall a. a -> Maybe a
Just (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Result -> CmdResult
cmd_result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Return a => a -> Result
Global._to_result) f a
c)
    cmd_result :: Result -> CmdResult
cmd_result Result
result = Result -> [Msg] -> CmdResult
ReplProtocol.CmdResult Result
result []

val :: Read a => String -> Maybe a
val :: forall a. Read a => [Char] -> Maybe a
val [Char]
text = case forall a. Read a => ReadS a
reads [Char]
text of
    (a
val, [Char]
"") : [(a, [Char])]
_ -> forall a. a -> Maybe a
Just a
val
    [(a, [Char])]
_ -> forall a. Maybe a
Nothing

lex_all :: String -> Maybe [String]
lex_all :: [Char] -> Maybe [[Char]]
lex_all [Char]
text
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
text) = forall a. a -> Maybe a
Just []
    | Bool
otherwise = case [Char] -> [([Char], [Char])]
lex_fancy [Char]
text of
        [] -> forall a. Maybe a
Nothing
        ([Char]
tok, [Char]
rest) : [([Char], [Char])]
_ -> do
            [[Char]]
toks <- [Char] -> Maybe [[Char]]
lex_all [Char]
rest
            forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
tok forall a. a -> [a] -> [a]
: [[Char]]
toks)

-- | A version of 'lex' that understands qualified names.
--
-- It also lexes parenthesized text as a single token, but it doesn't count
-- open parens so it doesn't work for nested ones.
-- TODO count parens, or come up with a better way to parse haskell
lex_fancy :: String -> [(String, String)]
lex_fancy :: [Char] -> [([Char], [Char])]
lex_fancy [Char]
s = case [Char] -> [([Char], [Char])]
lex [Char]
s of
    [([Char]
tok1, Char
'.':[Char]
rest1)] ->
        [([Char]
tok1 forall a. [a] -> [a] -> [a]
++ [Char]
"." forall a. [a] -> [a] -> [a]
++ [Char]
tok2, [Char]
rest2) | ([Char]
tok2, [Char]
rest2) <- [Char] -> [([Char], [Char])]
lex_fancy [Char]
rest1]
    [([Char]
"(", [Char]
rest)] ->
        let ([Char]
pre, [Char]
post) = forall a. (a -> Bool) -> [a] -> ([a], [a])
Then.break1 (forall a. Eq a => a -> a -> Bool
==Char
')') [Char]
rest
        in [(Char
'(' forall a. a -> [a] -> [a]
: [Char]
pre, [Char]
post)]
    [([Char], [Char])]
val -> [([Char], [Char])]
val