0c97786 · obelisk · git.iko.soy

lib/cliapp/obelisk-cliapp.cabal+2−1

compare with master

unifiedsplit

@@ -16,12 +16,13 @@ library

16 , logging-effect

17 , monad-loops

18 , mtl

19− , posix-escape

19+ , shell-escape

20 , process

21 , terminal-size

22 , text

23 , time

24 , transformers

25+ , utf8-string

25 exposed-modules:

26 exposed-modules:

26 Obelisk.CliApp

27 Obelisk.CliApp

27 Obelisk.CliApp.Demo

28 Obelisk.CliApp.Demo

lib/cliapp/src/Obelisk/CliApp/Process.hs+4−2

@@ -29,6 +29,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO)

29import Control.Lens (Prism', review)

30import qualified Data.ByteString as BS

31import qualified Data.ByteString.Char8 as BSC

32+import qualified Data.ByteString.UTF8 as BSU

32import Data.Function (fix)

33import Data.Function (fix)

33import Data.Monoid ((<>))

34import Data.Monoid ((<>))

34import Data.Text (Text)

35import Data.Text (Text)

@@ -40,10 +41,10 @@ import System.IO (Handle)

40import System.IO.Streams (InputStream, handleToInputStream)

41import System.IO.Streams (InputStream, handleToInputStream)

41import qualified System.IO.Streams as Streams

42import qualified System.IO.Streams as Streams

42import System.IO.Streams.Concurrent (concurrentMerge)

43import System.IO.Streams.Concurrent (concurrentMerge)

43−import System.Posix.Escape (escape)

44import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), cmdspec, std_err, std_out,

45 waitForProcess)

46import qualified System.Process as Process

47+import Text.ShellEscape (bytes, bash)

47

48

48import Control.Monad.Log (Severity (..))

49import Control.Monad.Log (Severity (..))

49import Obelisk.CliApp.Logging (putLog, putLogRaw)

50import Obelisk.CliApp.Logging (putLog, putLogRaw)

@@ -183,4 +184,5 @@ reconstructCommand :: Process.CmdSpec -> Text

183reconstructCommand (Process.ShellCommand str) = T.pack str

184reconstructCommand (Process.ShellCommand str) = T.pack str

184reconstructCommand (Process.RawCommand c as) = processToShellString c as

185reconstructCommand (Process.RawCommand c as) = processToShellString c as

185 where

186 where

186− processToShellString cmd args = T.pack $ unwords $ map escape (cmd : args)

187+ processToShellString cmd args = T.pack $ unwords $

188+ map (BSU.toString . bytes . bash . BSU.fromString) (cmd : args)

lib/cliapp/src/Obelisk/CliApp/ShellEscape.hsnew file+18

@@ -0,0 +1,18 @@

1+module Obelisk.CliApp.ShellEscape

2+ ( escape

3+ , fromEscaped

4+ , toEscaped

5+ ) where

6+

7+import Shell.Utility.Quote (minimal)

8+

9+newtype ShellEscaped = ShellEscaped { fromEscaped :: String }

10+

11+escape :: String -> String

12+escape = minimal

13+

14+toEscaped :: String -> ShellEscaped

15+toEscaped = ShellEscape . escape

16+

17+escapeCommand :: [String] -> ShellEscape

18+escapeCommand = ShellEscaped . unwords . fmap escape

lib/command/obelisk-command.cabal+2−1

@@ -39,7 +39,7 @@ library

39 , optparse-applicative

40 , placeholders

41 , process

42− , posix-escape

42+ , shell-escape

43 , temporary

44 , terminal-size

45 , text

@@ -47,6 +47,7 @@ library

47 , transformers

48 , unix

49 , unordered-containers

50+ , utf8-string

50 , which

51 , which

51 , yaml

52 , yaml

52 exposed-modules:

53 exposed-modules:

lib/command/src/Obelisk/Command.hs+5−4

@@ -13,6 +13,7 @@ import qualified Data.Binary as Binary

13import Data.Bool (bool)

14import qualified Data.ByteString.Base16 as Base16

15import qualified Data.ByteString.Lazy as LBS

16+import qualified Data.ByteString.UTF8 as BSU

16import Data.List

17import Data.List

17import Data.Maybe (catMaybes)

18import Data.Maybe (catMaybes)

18import qualified Data.Text as T

19import qualified Data.Text as T

@@ -26,7 +27,7 @@ import System.Environment

26import System.FilePath

27import System.FilePath

27import qualified System.Info

28import qualified System.Info

28import System.IO (hIsTerminalDevice, stdout)

29import System.IO (hIsTerminalDevice, stdout)

29−import System.Posix.Escape (escapeMany)

30+import Text.ShellEscape (bash)

30import System.Posix.Process (executeFile)

31import System.Posix.Process (executeFile)

31

32

32import Obelisk.App

33import Obelisk.App

@@ -106,8 +107,8 @@ data ObInternal

106

107

107inNixShell' :: MonadObelisk m => StaticPtr (ObeliskT IO ()) -> m ()

108inNixShell' :: MonadObelisk m => StaticPtr (ObeliskT IO ()) -> m ()

108inNixShell' p = withProjectRoot "." $ \root -> do

109inNixShell' p = withProjectRoot "." $ \root -> do

109− cmd <- liftIO $ escapeMany <$> mkCmd

110+ cmd <- liftIO $ fmap (bash . BSU.fromString) <$> mkCmd

110− projectShell root True "ghc" (Just cmd)

111+ projectProc root True "ghc" (Just cmd)

111 where

112 where

112 mkCmd = do

113 mkCmd = do

113 argsCfg <- getArgsConfig

114 argsCfg <- getArgsConfig

@@ -382,7 +383,7 @@ ob = \case

382 ObCommand_Repl -> runRepl

383 ObCommand_Repl -> runRepl

383 ObCommand_Watch -> inNixShell' $ static runWatch

384 ObCommand_Watch -> inNixShell' $ static runWatch

384 ObCommand_Shell so -> withProjectRoot "." $ \root ->

385 ObCommand_Shell so -> withProjectRoot "." $ \root ->

385− projectShell root False (_shellOpts_shell so) (_shellOpts_command so)

386+ projectProc root False (_shellOpts_shell so) (pure . bash . BSU.fromString <$> _shellOpts_command so)

386 ObCommand_Doc shell pkgs -> withProjectRoot "." $ \root ->

387 ObCommand_Doc shell pkgs -> withProjectRoot "." $ \root ->

387 projectShell root False shell (Just $ haddockCommand pkgs)

388 projectShell root False shell (Just $ haddockCommand pkgs)

388 ObCommand_Internal icmd -> case icmd of

389 ObCommand_Internal icmd -> case icmd of

lib/command/src/Obelisk/Command/Project.hs+15−1

@@ -7,8 +7,10 @@ module Obelisk.Command.Project

7 , findProjectObeliskCommand

8 , findProjectRoot

9 , withProjectRoot

10+ , inProjectProc

10 , inProjectShell

11 , inProjectShell

11 , inImpureProjectShell

12 , inImpureProjectShell

13+ , projectProc

12 , projectShell

14 , projectShell

13

15

14 , toObeliskDir

16 , toObeliskDir

@@ -18,6 +20,7 @@ module Obelisk.Command.Project

18import Control.Monad

20import Control.Monad

19import Control.Monad.IO.Class (liftIO)

21import Control.Monad.IO.Class (liftIO)

20import Control.Monad.State

22import Control.Monad.State

23+import qualified Data.ByteString.UTF8 as BSU

21import Data.Bits

24import Data.Bits

22import Data.Function (on)

25import Data.Function (on)

23import qualified Data.Text as T

26import qualified Data.Text as T

@@ -27,6 +30,7 @@ import System.IO.Temp

27import System.Posix (FileStatus, UserID, deviceID, fileID, fileMode, fileOwner, getFileStatus, getRealUserID)

30import System.Posix (FileStatus, UserID, deviceID, fileID, fileMode, fileOwner, getFileStatus, getRealUserID)

28import System.Posix.Files

31import System.Posix.Files

29import System.Process (CreateProcess, cwd, proc, waitForProcess, delegate_ctlc)

32import System.Process (CreateProcess, cwd, proc, waitForProcess, delegate_ctlc)

33+import Text.ShellEscape (Bash, bytes)

30

34

31import GitHub.Data.GitData (Branch)

35import GitHub.Data.GitData (Branch)

32import GitHub.Data.Name (Name)

36import GitHub.Data.Name (Name)

@@ -193,6 +197,10 @@ walkToImplDir projectRoot myUid = do

193isWritableOnlyBy :: FileStatus -> UserID -> Bool

197isWritableOnlyBy :: FileStatus -> UserID -> Bool

194isWritableOnlyBy s uid = fileOwner s == uid && fileMode s .&. 0o22 == 0

198isWritableOnlyBy s uid = fileOwner s == uid && fileMode s .&. 0o22 == 0

195

199

200+inProjectProc :: MonadObelisk m => String -> [Bash] -> m ()

201+inProjectProc shellName command = withProjectRoot "." $ \root ->

202+ projectProc root True shellName (Just command)

203+

196-- | Run a command in the given shell for the current project

204-- | Run a command in the given shell for the current project

197inProjectShell :: MonadObelisk m => String -> String -> m ()

205inProjectShell :: MonadObelisk m => String -> String -> m ()

198inProjectShell shellName command = withProjectRoot "." $ \root ->

206inProjectShell shellName command = withProjectRoot "." $ \root ->

@@ -202,6 +210,12 @@ inImpureProjectShell :: MonadObelisk m => String -> String -> m ()

202inImpureProjectShell shellName command = withProjectRoot "." $ \root ->

210inImpureProjectShell shellName command = withProjectRoot "." $ \root ->

203 projectShell root False shellName (Just command)

211 projectShell root False shellName (Just command)

204

212

213+projectProc :: MonadObelisk m => FilePath -> Bool -> String -> Maybe [Bash] -> m ()

214+projectProc root isPure shellName command =

215+ projectShell root isPure shellName $ commandToString <$> command

216+ where

217+ commandToString = unwords . fmap (BSU.toString . bytes)

218+

205projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

219projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

206projectShell root isPure shellName command = do

220projectShell root isPure shellName command = do

207 (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCtlc $ setCwd (Just root) $ proc "nix-shell" $

221 (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCtlc $ setCwd (Just root) $ proc "nix-shell" $

@@ -213,7 +227,7 @@ projectShell root isPure shellName command = do

213 , "shells." <> shellName

227 , "shells." <> shellName

214 ] <> case command of

228 ] <> case command of

215 Nothing -> []

229 Nothing -> []

216− Just c -> ["--run", c]

230+ Just c -> ["--run", c]

217 void $ liftIO $ waitForProcess ph

231 void $ liftIO $ waitForProcess ph

218

232

219setCtlc :: CreateProcess -> CreateProcess

233setCtlc :: CreateProcess -> CreateProcess

lib/command/src/Obelisk/Command/Run.hs+5−3

@@ -10,6 +10,8 @@ import Control.Exception (bracket)

10import Control.Monad

11import Control.Monad.IO.Class (liftIO)

12import Control.Monad.Reader (MonadIO)

13+import Data.ByteString (ByteString)

14+import qualified Data.ByteString.UTF8 as BSU

13import Data.Either

15import Data.Either

14import qualified Data.List as L

16import qualified Data.List as L

15import qualified Data.List.NonEmpty as NE

17import qualified Data.List.NonEmpty as NE

@@ -34,14 +36,14 @@ import System.FilePath

34import System.Process (proc)

36import System.Process (proc)

35import System.IO.Temp (withSystemTempDirectory)

37import System.IO.Temp (withSystemTempDirectory)

36import System.Which (staticWhich)

38import System.Which (staticWhich)

37−import Data.ByteString (ByteString)

39+import Text.ShellEscape (bash)

38

40

39import Obelisk.App (MonadObelisk, ObeliskT)

41import Obelisk.App (MonadObelisk, ObeliskT)

40import Obelisk.CliApp

42import Obelisk.CliApp

41 ( CliT (..), HasCliConfig, Severity (..)

43 ( CliT (..), HasCliConfig, Severity (..)

42 , callCommand, failWith, getCliConfig, putLog

44 , callCommand, failWith, getCliConfig, putLog

43 , readProcessAndLogStderr, runCli)

45 , readProcessAndLogStderr, runCli)

44−import Obelisk.Command.Project (inProjectShell, withProjectRoot)

46+import Obelisk.Command.Project (inProjectProc, withProjectRoot)

45

47

46data CabalPackageInfo = CabalPackageInfo

48data CabalPackageInfo = CabalPackageInfo

47 { _cabalPackageInfo_packageRoot :: FilePath

49 { _cabalPackageInfo_packageRoot :: FilePath

@@ -219,7 +221,7 @@ runGhciRepl

219 :: MonadObelisk m

221 :: MonadObelisk m

220 => FilePath -- ^ Path to .ghci

222 => FilePath -- ^ Path to .ghci

221 -> m ()

223 -> m ()

222−runGhciRepl dotGhci = inProjectShell "ghc" $ unwords $ "ghci" : ["-no-user-package-db", "-ghci-script", dotGhci]

224+runGhciRepl dotGhci = inProjectProc "ghc" $ fmap (bash . BSU.fromString) $ "ghci" : ["-no-user-package-db", "-ghci-script", dotGhci]

223

225

224-- | Run ghcid

226-- | Run ghcid

225runGhcid

227runGhcid