Use Data.Attoparsec.Args to parse --docker-run-args option

commercialhaskell · Jun 30, 2015 · e328d63 · e328d63
1 parent 68bfcff
commit e328d63
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 7 deletions.
diff --git a/src/Data/Attoparsec/Args.hs b/src/Data/Attoparsec/Args.hs
@@ -1,7 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Parsing argument-like things.
 
-module Data.Attoparsec.Args (EscapingMode(..), argsParser, withInterpreterArgs) where
+module Data.Attoparsec.Args
+    ( EscapingMode(..)
+    , argsParser
+    , parseArgs
+    , withInterpreterArgs
+    ) where
 
 import           Control.Applicative
 import           Data.Attoparsec.Text ((<?>))
@@ -24,6 +29,10 @@ data EscapingMode
     | NoEscaping
     deriving (Show,Eq,Enum)
 
+-- | Parse arguments using 'argsParser'.
+parseArgs :: EscapingMode -> Text -> Either String [String]
+parseArgs mode t = P.parseOnly (argsParser mode) t
+
 -- | A basic argument parser. It supports space-separated text, and
 -- string quotation with identity escaping: \x -> x.
 argsParser :: EscapingMode -> Parser Text [String]
@@ -77,10 +86,10 @@ sinkInterpreterArgs progName =
     await >>= maybe (return Nothing) checkShebang
   where
     checkShebang bs
-        | "#!" `S.isPrefixOf` bs = fmap (maybe Nothing parseArgs) await
-        | otherwise = return (parseArgs bs)
+        | "#!" `S.isPrefixOf` bs = fmap (maybe Nothing parseArgs') await
+        | otherwise = return (parseArgs' bs)
 
-    parseArgs bs =
+    parseArgs' bs =
         case decodeUtf8' bs of
             Left _ -> Nothing
             Right t ->

diff --git a/src/Stack/Docker.hs b/src/Stack/Docker.hs
@@ -29,6 +29,7 @@ import           Control.Monad.Reader (MonadReader,asks)
 import           Control.Monad.Writer (execWriter,runWriter,tell)
 import           Control.Monad.Trans.Control (MonadBaseControl)
 import           Data.Aeson.Extended (FromJSON(..),(.:),(.:?),(.!=),eitherDecode)
+import           Data.Attoparsec.Args (EscapingMode (Escaping), parseArgs)
 import           Data.ByteString.Builder (stringUtf8,charUtf8,toLazyByteString)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
@@ -688,7 +689,7 @@ dockerOptsParser showOptions =
                         hide <>
                         metavar "NAME" <>
                         help "Docker container name")
-    <*> wordsStrOption (long (dockerOptName dockerRunArgsArgName) <>
+    <*> argsStrOption (long (dockerOptName dockerRunArgsArgName) <>
                         hide <>
                         value [] <>
                         metavar "'ARG1 [ARG2 ...]'" <>
@@ -708,7 +709,7 @@ dockerOptsParser showOptions =
   where
     dockerOptName optName = dockerCmdName ++ "-" ++ T.unpack optName
     maybeStrOption = optional . option str
-    wordsStrOption = option (fmap words str)
+    argsStrOption = option (fmap (either error id . parseArgs Escaping . T.pack) str)
     hide = if showOptions
               then idm
               else internal <> hidden

diff --git a/src/Stack/Ide.hs b/src/Stack/Ide.hs
@@ -24,7 +24,6 @@ import           Data.Maybe
 import           Data.Monoid
 import qualified Data.Set as S
 import           Data.Text (Text)
-import qualified Data.Text as T
 import           Path
 import           Path.IO
 import           Stack.Build.Source