Shell-like syntax for interactive mode

ghc-mod.cabal

@@ -192,6 +192,7 @@ Executable ghc-mod
                       , GHCMod.Options.Commands
                       , GHCMod.Version
                       , GHCMod.Options.DocUtils
+                      , GHCMod.Options.ShellEscape
   GHC-Options:          -Wall -fno-warn-deprecations -threaded
   Default-Extensions:   ConstraintKinds, FlexibleContexts
   HS-Source-Dirs:       src
@@ -247,7 +248,7 @@ Test-Suite spec
                         ConstraintKinds, FlexibleContexts,
                         DataKinds, KindSignatures, TypeOperators, ViewPatterns
   Main-Is:              Main.hs
-  Hs-Source-Dirs:       test, .
+  Hs-Source-Dirs:       test, ., src
   Ghc-Options:          -Wall -fno-warn-deprecations
   CPP-Options:          -DSPEC=1
   Type:                 exitcode-stdio-1.0
@@ -267,6 +268,7 @@ Test-Suite spec
                         PathsAndFilesSpec
                         HomeModuleGraphSpec
                         FileMappingSpec
+                        ShellEscapeSpec
 
   Build-Depends:        hspec >= 2.0.0
   if impl(ghc == 7.4.*)

src/GHCMod.hs

@@ -8,7 +8,6 @@ import Control.Monad
 import Data.Typeable (Typeable)
 import Data.List
 import Data.List.Split
-import Data.Char (isSpace)
 import Data.Maybe
 import Exception
 import Language.Haskell.GhcMod
@@ -32,43 +31,6 @@ ghcModStyle = style { lineLength = 80, ribbonsPerLine = 1.2 }
 
 ----------------------------------------------------------------
 
-{-
-File map docs:
-
-CLI options:
-* `--map-file "file1.hs=file2.hs"` can be used to tell
-    ghc-mod that it should take source code for `file1.hs` from `file2.hs`.
-    `file1.hs` can be either full path, or path relative to project root.
-    `file2.hs` has to be either relative to project root,
-    or full path (preferred).
-* `--map-file "file.hs"` can be used to tell ghc-mod that it should take
-    source code for `file.hs` from stdin. File end marker is `\EOT\n`,
-    i.e. `\x04\x0A`. `file.hs` may or may not exist, and should be
-    either full path, or relative to project root.
-
-Interactive commands:
-* `map-file file.hs` -- tells ghc-modi to read `file.hs` source from stdin.
-    Works the same as second form of `--map-file` CLI option.
-* `unmap-file file.hs` -- unloads previously mapped file, so that it's
-    no longer mapped. `file.hs` can be full path or relative to
-    project root, either will work.
-
-Exposed functions:
-* `loadMappedFile :: FilePath -> FilePath -> GhcModT m ()` -- maps `FilePath`,
-    given as first argument to take source from `FilePath` given as second
-    argument. Works exactly the same as first form of `--map-file`
-    CLI option.
-* `loadMappedFileSource :: FilePath -> String -> GhcModT m ()` -- maps
-    `FilePath`, given as first argument to have source as given
-    by second argument. Works exactly the same as second form of `--map-file`
-    CLI option, sans reading from stdin.
-* `unloadMappedFile :: FilePath -> GhcModT m ()` -- unmaps `FilePath`, given as
-    first argument, and removes any temporary files created when file was
-    mapped. Works exactly the same as `unmap-file` interactive command
--}
-
-----------------------------------------------------------------
-
 data CmdError = UnknownCommand String
               | NoSuchFileError String
               | LibraryError GhcModError
@@ -145,29 +107,18 @@ legacyInteractiveLoop symdbreq world = do
 
     when changed dropSession
 
-    let (cmd':args') = split (keepDelimsR $ condense $ whenElt isSpace) cmdArg
-        arg = concat args'
-        cmd = dropWhileEnd isSpace cmd'
-        args = dropWhileEnd isSpace `map` args'
-
     res <- flip gcatches interactiveHandlers $ do
-      pargs <- maybe (throw $ InvalidCommandLine $ Left $ concat (cmd':args')) return
-              $ parseArgsInteractive (cmd:args)
+      pargs <- maybe (throw $ InvalidCommandLine $ Left cmdArg) return
+              $ parseArgsInteractive cmdArg
       case fst pargs of
-        CmdCheck{}     -> checkSyntax [arg]
-        CmdLint{}      -> lint defaultLintOpts arg
-        CmdFind{}      ->
-            lookupSymbol arg =<< checkDb symdbreq =<< getDb symdbreq
+        CmdFind symbol ->
+            lookupSymbol symbol =<< checkDb symdbreq =<< getDb symdbreq
 
-        CmdInfo{}      -> info (head args) $ Expression $ concat $ tail args'
-
-        CmdRefine{}    -> locArgs' refine args
-
-        CmdMapFile{}   ->  liftIO getFileSourceFromStdin
-                       >>= loadMappedFileSource arg
+        CmdMapFile f   ->  liftIO getFileSourceFromStdin
+                       >>= loadMappedFileSource f
                        >>  return ""
 
-        CmdUnmapFile{} -> unloadMappedFile arg
+        CmdUnmapFile f -> unloadMappedFile f
                        >> return ""
 
         CmdQuit        -> liftIO exitSuccess
@@ -183,8 +134,6 @@ legacyInteractiveLoop symdbreq world = do
           , GHandler $ \e@(ExitFailure _) -> throw e
           , GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return ""
           ]
-    locArgs' a (f:l:c:xs) = a f (read l) (read c) (Expression $ unwords xs)
-    locArgs' _ args = throw $ InvalidCommandLine $ Left $ unwords args
 
 getFileSourceFromStdin :: IO String
 getFileSourceFromStdin = do

src/GHCMod/Options.hs

@@ -27,6 +27,7 @@ import Control.Arrow
 import GHCMod.Options.Commands
 import GHCMod.Version
 import GHCMod.Options.DocUtils
+import GHCMod.Options.ShellEscape
 
 parseArgs :: IO (Options, GhcModCommands)
 parseArgs =
@@ -36,9 +37,9 @@ parseArgs =
            $$  fullDesc
            <=> header "ghc-mod: Happy Haskell Programming"
 
-parseArgsInteractive :: [String] -> Maybe (GhcModCommands, [String])
+parseArgsInteractive :: String -> Maybe (GhcModCommands, [String])
 parseArgsInteractive args =
-  getParseResult $ execParserPure (prefs idm) opts args
+  getParseResult $ execParserPure (prefs idm) opts $ parseCmdLine args
   where
     opts = info interactiveCommandsSpec $$ fullDesc
 

src/GHCMod/Options/Commands.hs

@@ -13,8 +13,6 @@
 --
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-{-# LANGUAGE TupleSections #-}
-
 module GHCMod.Options.Commands where
 
 import Options.Applicative

src/GHCMod/Options/ShellEscape.hs

@@ -0,0 +1,55 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015  Nikolay Yakimov <root@livid.pp.ru>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+module GHCMod.Options.ShellEscape (parseCmdLine) where
+
+import Data.Char
+import Data.Maybe
+
+isQuote :: Char -> Bool
+isQuote = (`elem` "\"'")
+
+isEscapeChar :: Char -> Bool
+isEscapeChar = (==) '\\'
+
+isEscapable :: Char -> Bool
+isEscapable c = any ($ c) [isSpace, isQuote, isEscapeChar]
+
+go :: String -> String -> [String] -> Maybe Char -> [String]
+-- result
+go [] curarg accargs _ = reverse $ reverse curarg : accargs
+-- escaped character
+go (esc:c:cl) curarg accargs quote
+  | isEscapeChar esc
+  = if isEscapable c
+    then go cl (c:curarg) accargs quote
+    else go (c:cl) ('\\':curarg) accargs quote
+-- quote character -- opens quotes
+go (c:cl) curarg accargs Nothing
+  | isQuote c = go cl curarg accargs (Just c)
+-- close quotes
+go (c:cl) curarg accargs (Just q)
+  | c == q = go cl curarg accargs Nothing
+go (c:cl) curarg accargs quotes
+  -- space separates argumetns outside quotes
+  | isSpace c && isNothing quotes
+  = if null curarg
+      then go cl curarg accargs quotes
+      else go cl [] (reverse curarg : accargs) quotes
+  -- general character
+  | otherwise = go cl (c:curarg) accargs quotes
+
+parseCmdLine :: String -> [String]
+parseCmdLine comline = go comline [] [] Nothing

test/ShellEscapeSpec.hs

@@ -0,0 +1,58 @@
+module ShellEscapeSpec where
+
+
+import GHCMod.Options.ShellEscape
+
+import Test.Hspec
+
+spec :: Spec
+spec =
+  describe "parseCmdLine" $ do
+    it "splits arguments" $
+      parseCmdLine "test command line" `shouldBe` ["test", "command", "line"]
+    it "honors double quotes" $
+      parseCmdLine "test command line \"with double quotes\""
+        `shouldBe` ["test", "command", "line", "with double quotes"]
+    it "honors single quotes" $
+      parseCmdLine "test command line 'with single quotes'"
+        `shouldBe` ["test", "command", "line", "with single quotes"]
+    it "understands single quote in double quotes" $
+      parseCmdLine "test for \"quoted argument with ' single quote\" here"
+        `shouldBe` ["test", "for", "quoted argument with ' single quote", "here"]
+    it "understands double quote in single quotes" $
+      parseCmdLine "test for \'quoted argument with \" double quote\' here"
+        `shouldBe` ["test", "for", "quoted argument with \" double quote", "here"]
+    it "escapes spaces" $ do
+      parseCmdLine "with\\ spaces"
+        `shouldBe` ["with spaces"]
+      parseCmdLine "'with\\ spaces'"
+        `shouldBe` ["with spaces"]
+      parseCmdLine "\"with\\ spaces\""
+        `shouldBe` ["with spaces"]
+    it "escapes '\\'" $ do
+      parseCmdLine "\\\\"
+        `shouldBe` ["\\"]
+      parseCmdLine "\"\\\\\""
+        `shouldBe` ["\\"]
+      parseCmdLine "'\\\\'"
+        `shouldBe` ["\\"]
+    it "escapes single quotes" $ do
+      parseCmdLine "\\'"
+        `shouldBe` ["'"]
+      parseCmdLine "'\\''"
+        `shouldBe` ["'"]
+      parseCmdLine "\"\\'\""
+        `shouldBe` ["'"]
+    it "escapes double quotes" $ do
+      parseCmdLine "\\\""
+        `shouldBe` ["\""]
+      parseCmdLine "'\\\"'"
+        `shouldBe` ["\""]
+      parseCmdLine "\"\\\"\""
+        `shouldBe` ["\""]
+    it "doesn't escape random characters" $
+      parseCmdLine "\\a\\b\\c"
+        `shouldBe` ["\\a\\b\\c"]
+    it "squashes multiple spaces" $
+      parseCmdLine "test       command"
+        `shouldBe` ["test", "command"]