diff --git a/ghc-mod.cabal b/ghc-mod.cabal
index d8ad7f9..21c4b93 100644
--- a/ghc-mod.cabal
+++ b/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.*)
diff --git a/src/GHCMod.hs b/src/GHCMod.hs
index e633268..18eb4ac 100644
--- a/src/GHCMod.hs
+++ b/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
diff --git a/src/GHCMod/Options.hs b/src/GHCMod/Options.hs
index 577e2de..4a1d355 100644
--- a/src/GHCMod/Options.hs
+++ b/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
diff --git a/src/GHCMod/Options/Commands.hs b/src/GHCMod/Options/Commands.hs
index cd62f70..8bc77b2 100644
--- a/src/GHCMod/Options/Commands.hs
+++ b/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 .
-{-# LANGUAGE TupleSections #-}
-
module GHCMod.Options.Commands where
import Options.Applicative
diff --git a/src/GHCMod/Options/ShellEscape.hs b/src/GHCMod/Options/ShellEscape.hs
new file mode 100644
index 0000000..4671c73
--- /dev/null
+++ b/src/GHCMod/Options/ShellEscape.hs
@@ -0,0 +1,55 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015 Nikolay Yakimov
+--
+-- 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 .
+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
diff --git a/test/ShellEscapeSpec.hs b/test/ShellEscapeSpec.hs
new file mode 100644
index 0000000..bcdceda
--- /dev/null
+++ b/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"]