Merge pull request #3 from rnhmjoj/master

Rewrite. Merges pull request #3

README.md

@@ -27,6 +27,7 @@ To use `nix-script`, you need to add a header to your file. Here is an example f
 ```haskell
 #!/usr/bin/env nix-script
 #!> haskell
+#! env     | EDITOR
 #! haskell | text lens optparse-applicative
 #! shell   | nix nix-prefetch-scripts
 
@@ -40,6 +41,8 @@ The first line just tells the shell to use `nix-script` when executing the scrip
 
 The next lines the specify dependencies of the script. The first entry on each line is the language of the following dependencies. This is required so that language-specific names can be converted to the correct nix attribute names. You should have one line per language. In our case, we say that we want to use the `text`, `lens` and `optparse-applicative` haskell packages. We also want that `nix` and `nix-prefetch-scripts` are available in $PATH (the `shell` language doesn't apply any renaming to their dependencies and just passes them through unmodified).
 
+The lines starting with `env` specify additional environment variables to be kept in the environment where the script will run. In this case the variable`EDITOR` editor.
+
 We can now mark the script executable and run it:
 
 ```

default.nix

@@ -6,7 +6,7 @@ pkgs.stdenv.mkDerivation {
   phases = [ "buildPhase" "installPhase" "fixupPhase" ];
   buildPhase = ''mkdir -p $out/bin; ghc -O2 $src -o $out/bin/nix-script -odir $TMP'';
   installPhase = ''ln -s $out/bin/nix-script $out/bin/nix-scripti'';
-  buildInputs = [ (pkgs.haskellPackages.ghcWithPackages (hs: with hs; [lens text])) ];
+  buildInputs = [ (pkgs.haskellPackages.ghcWithPackages (hs: with hs; [posix-escape])) ];
   meta = {
     homepage = https://github.com/bennofs/nix-script;
     description = "A shebang for running inside nix-shell.";

example.hs

@@ -3,6 +3,8 @@
 #! haskell | text lens optparse-applicative
 #! shell | nix nix-prefetch-scripts
 
+import Control.Lens
+
 main :: IO ()
 main = do
   putStrLn "It works!"

example.sh

@@ -0,0 +1,8 @@
+#!/usr/bin/env nix-script
+#!>zsh
+#! nix | zsh
+
+function a { echo "this is zsh!" }
+a
+echo $#
+echo "your args: $@"

nix-script.hs

@@ -1,118 +1,151 @@
-#!/usr/bin/env nix-script
+-- | A shebang for running scripts inside nix-shell with defined dependencies
-#!> haskell
+module Main where
-#! haskell | text lens
-#! shell   | nix
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
 
-import Control.Monad
+import Control.Monad                (when)
-import Control.Applicative
+import Data.Maybe                   (fromMaybe)
-import System.Environment
+import Data.Char                    (isSpace)
-import Data.List
+import Data.List                    (isPrefixOf, find, (\\))
-import Data.Text (Text)
+import System.Environment           (lookupEnv, getProgName, getArgs)
-import Data.Text.Lens (_Text)
+import System.Process               (callProcess)
-import Control.Lens
+import System.Posix.Escape.Unicode  (escapeMany)
-import Control.Exception.Lens
-import System.IO.Error.Lens
-import System.Exit
-import System.Posix.Process
-import System.Posix.IO
-import System.IO
-import Data.Char
-import Data.Monoid
 
-import qualified Data.Text as Text
+-- | Enviroment variables
+type Env   = [String]
 
--- | Information about a languages
+-- | Program arguments
-data LangDef = LangDef
+type Args  = [String]
-  { name :: String                         -- ^ Name of this language
+
-  , deps :: [Text]   -> [Text]             -- ^ Convert langunage-specific dependencies to nix packages
+-- | interpreter name and arguments
-  , run  :: FilePath -> (String, [String]) -- ^ Command to run the given file as script
+type Inter = (String, Args)
-  , repl :: FilePath -> (String, [String]) -- ^ Command to load the given file in an interpreter
+
+
+-- | Information about a language
+data Language = Language
+  { name      :: String
+    -- ^ Name of the language
+  , depsTrans :: [String] -> [String]
+    -- ^ Transform language-specific dependencies to nix packages
+  , run       :: FilePath -> Inter
+    -- ^ Command to run the given file as script
+  , repl      :: FilePath -> Inter
+    -- ^ Command to load the given file in an interpreter
   }
 
-languages :: [LangDef]
+
+-- | Basic packages always present
+basePackages :: [String]
+basePackages = ["coreutils", "utillinux"]
+
+-- | Preserved environment variables
+baseEnv :: [String]
+baseEnv = ["LOCALE_ARCHIVE", "SSL_CERT_FILE" ,"LANG", "TERMINFO", "TERM"]
+
+
+-- | List of supported language definitions
+languages :: [Language]
 languages = [haskell, python, javascript, perl, shell]
+  where
+    haskell = Language "haskell" d r i where
+      d pkgs = pure ("haskellPackages.ghcWithPackages (hs: with hs; [" ++ 
+                     unwords pkgs ++ "])")
+      r script = ("runghc" , [script])
+      i script = ("ghci"   , [script])
 
-haskell :: LangDef
+    python = Language "python" d r i where
-haskell = LangDef "haskell" d r i where
+      d pkgs   = "python" : map ("pythonPackages." ++) pkgs
-  d pkgs = return $
+      r script = ("python" , [script])
-    "haskellPackages.ghcWithPackages (hs: with hs; [" <> Text.unwords pkgs <> "])"
+      i script = ("python" , ["-i", script])
-  r script = ("runhaskell" , [script])
-  i script = ("ghci"       , [script])
 
-python :: LangDef
+    javascript = Language "javascript" d r i where
-python = LangDef "python" d r i where
+      d pkgs   = "node" : map ("nodePackages." ++) pkgs
-  d pkgs = "python" : map ("pythonPackages." <>) pkgs
+      r script = ("node" , [script])
-  r script = ("python" , [script])
+      i script = ("node" , [])
-  i script = ("python" , ["-i", script])
 
-javascript :: LangDef
+    perl = Language "perl" d r i where
-javascript = LangDef "javascript" d r i where
+      d pkgs   = "perl" : map ("perlPackages." ++) pkgs
-  d pkgs = "node" : map ("nodePackages." <>) pkgs
+      r script = ("perl" , [script])
-  r script = ("node" , [script])
+      i script = ("perl" , ["-d", script])
-  i script = ("node" , [])
 
-perl :: LangDef
+    shell = Language "shell" d r i where
-perl = LangDef "perl" d r i where
+      d        = mappend ("bash" : basePackages)
-  d pkgs = "perl" : map ("perlPackages." <>) pkgs
+      r script = ("bash", [script])
-  r script = ("perl" , [script])
+      i _      = ("bash", [])
-  i script = ("perl" , ["-d", script])
 
-shell :: LangDef
-shell = LangDef "shell" (extraPackages ++) r i where
-  r script = ("bash", [script])
-  i _      = ("bash", [])
-  extraPackages = ["bash", "coreutils", "utillinux", "gitAndTools.hub", "git"]
 
-lookupLangDef :: String -> IO LangDef
+-- | Create ad-hoc definitions for unknown languages
-lookupLangDef n
+passthrough :: String -> Language
-  | Just def <- find ((n ==) . name) languages = return def
+passthrough name = Language name d r i where
-  | otherwise = fail $ "Unknown language: " ++ n
+  d        = mappend basePackages
+  r script = (name, [script])
+  i _      = (name, [])
 
-makeDeps :: String -> [String] -> IO [String]
-makeDeps lang ds = lookupLangDef lang <&> \def ->
-  map (view _Text) $ deps def (map (review _Text) ds)
 
-parseDepLine :: [String] -> IO (String, [String])
+-- | Find the appropriate language definition
-parseDepLine (lang:"|":deps) = return (lang, deps)
+lookupLang :: String -> Language
-parseDepLine x = fail $ "Invalid dependency specification: " ++ unwords x
+lookupLang n =
+  fromMaybe (passthrough n) (find ((n ==) . name) languages)
 
-makeCommand :: String -> Bool -> String -> IO (String, [String])
-makeCommand lang interactive file = lookupLangDef lang <&> \def ->
-  (if interactive then repl else run) def file
 
-makeEnvArg :: String -> IO String
+-- | Extract environment declaration from the header
-makeEnvArg env = f $ getEnv env <&> \val -> env ++ "=" ++ val where
+filterEnv :: [String] -> (Env, [String])
-  f = handling_ (_IOException.errorType._NoSuchThing) $ return ""
+filterEnv header = (vars env, header \\ env)
+  where
+    vars = concatMap (drop 2 . words)
+    env  = filter (isPrefixOf "env" . dropWhile isSpace) header
 
-makeXargsCommand :: String -> Int -> IO String
-makeXargsCommand cmd fd = do
-  let xargsFile = "/proc/self/fd/" ++ show fd
-  envStr <- unwords <$> traverse makeEnvArg
-    ["LOCALE_ARCHIVE", "LANG", "TERMINFO", "TERM"]
-  return $ "env " ++ envStr ++ " xargs -a " ++ xargsFile ++ " -d '\\n' " ++ cmd ++ ""
 
+-- | Parse dependencies declaration line
+parseHeader :: String -> [String]
+parseHeader = uncurry trans . split . words
+  where
+    trans lang = depsTrans (lookupLang lang)
+    split (lang : "|" : deps) = (lang, deps)
+    split line = error ("Invalid dependency declaration: " ++ unwords line)
+
+
+-- | Find command to run/load the script
+makeInter :: String -> Bool -> String -> Inter
+makeInter lang interactive = 
+  (if interactive then repl else run) (lookupLang lang)
+
+
+-- | Create command to add the shell environment
+makeCmd :: Inter -> Args -> Env -> String
+makeCmd (program, args) args' defs =
+  env defs ++ interpreter ++ escapeMany args'
+  where
+    interpreter = program ++ " " ++ unwords args ++ " "
+    env defs   = "env " ++ unwords defs ++ " "
+
+
+-- | Create environment variable to run the script with
+makeEnv :: Env -> IO Env
+makeEnv extra = mapM format (baseEnv ++ extra) where
+  format var = maybe "" (\x -> var ++ "=" ++ x) <$> lookupEnv var
+
+
+-- | run a script or load it in an interactive interpreter
 main :: IO ()
 main = do
   progName <- getProgName
-  args <- getArgs
+  progArgs <- getArgs
-  let interactive = "i" `isSuffixOf` progName
+
-  case args ^? _Cons of
+  when (null progArgs) (fail $ "usage: " ++ progName ++ " <file>")
-    Nothing -> fail $ "usage: " ++ progName ++ " <file>" ++ "   [missing file name]"
+
-    Just (file, args') -> do
+  let shebang     = takeWhile (isPrefixOf "#!") . lines
-      header <- drop 1 . map (drop 2) . takeWhile ("#!" `isPrefixOf`) . lines <$> readFile file
+      header      = drop 1  . map (drop 2) . shebang
-      case header ^? _Cons of
+      (file:args) = progArgs
-        Just ('>':lang, depHeader) -> do
+
-          deps   <- concat <$> traverse (uncurry makeDeps <=< parseDepLine . words) depHeader
+  script <- readFile file
-          let deps' = "findutils" : deps
+  case header script of
-          let depArgs = concatMap (\x -> ["-p", x]) deps'
+    (('>':identifier) : lines) -> do
-          (cmd,cmdArgs) <- makeCommand (under _Text Text.strip lang) interactive file
+      let (env, deps) = filterEnv lines
-          (readFd, writeFd) <- createPipe
+          pkgs        = concatMap parseHeader deps
-          writeH <- fdToHandle writeFd
+          language    = dropWhile isSpace identifier
-          hPutStrLn writeH (unlines cmdArgs) >> hFlush writeH
+          interactive = last progName == 'i'
-          hClose writeH
+          interpreter = makeInter language interactive file
-          xargsCmd <- makeXargsCommand cmd (fromIntegral readFd)
+
-          let finalArgs = "--pure" : "--command" : xargsCmd : depArgs
+      cmd <- makeCmd interpreter args <$> makeEnv env
-          executeFile "nix-shell" True finalArgs Nothing
+      callProcess "nix-shell" ("--pure" : "--command" : cmd : "-p" : pkgs)
-        _ -> fail "missing language to run as"
+
+    _ -> fail "missing or invalid header"