nix-eval 0.1.0.2 → 0.3.3.0

raw patch · 7 files changed

+365/−62 lines, 7 filesdep +hindentdep +strictdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: hindent, strict

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +33/−19
• ghcEnvWithPkgs.nix +17/−0
• nix-eval.cabal +11/−3
• src/Language/Eval.hs +4/−1
• src/Language/Eval/Internal.hs +153/−35
• tests/Main.hs +70/−4
• wrapper.sh +77/−0

@@ -7,26 +7,39 @@  What sets this package apart from other `eval` implementations, is the ability to control which packages and modules are available during evaluation. This is-achieved by calling out to the [Nix package manager](http://nix.nixos.org).+achieved by calling out to the [Nix package manager](http://nixos.org/nix). -# Implementation Details+## Implementation Details  `Expr` is the type of expressions, which contains a list of package names, a-list of modules to import and a `String` of Haskell code. All of these are just-`String`s internally, but the wrappers prevent accidentally using package as-modules, etc. A few combinators are provided for common manipulations, and the-`OverloadedStrings` extension allows packages, modules and expressions to be-written as literals. Note that literal expressions are given an empty context;-you will have to specify any required modules or packages separately.+list of modules to import, a list of compiler flags, a list of `String`s to+put in the generated module and a `String` of Haskell code to evaluate. All of+these are just `String`s internally, but we use wrappers to prevent accidentally+using packages as modules, etc. -When evaluated, the Haskell code is prefixed by an import of each module and-wrapped in `main = putStr (..)`, then piped into `runhaskell`. That process is-invoked via the `nix-shell` command, using Nix's standard-`haskellPackages.ghcWithPackages` function to ensure the GHC instance has all of-the given packages available.+A few combinators are provided for common manipulations, for example+`qualified "Foo" "bar"` will produce the expression `"Foo.bar"` with `"Foo"` in+its module list. The `OverloadedStrings` extension allows packages, modules,+flags and expressions to be written as literals. Note that literal expressions+are given an empty context; you will have to specify any required modules,+packages, etc. separately. +When evaluated, the Haskell code is prefixed by an import of each module, the+"preamble" strings (if any) and wrapped in `main = putStr (..)`. This code is+piped into `runhaskell`. If any flags are specified, they are appended as+arguments to the `runhaskell` command.++The `runhaskell` process itself is invoked via the `nix-shell` command, which+provides all of the required packages via the `ghcWithPackages` mechanism of+nixpkgs. Packages are taken from nixpkgs's `haskellPackages` set by default,+which can be overridden by setting the `NIX_EVAL_HASKELL_PKGS` environment+variable to the path of a Nix file. Note that the package names used in your+Haskell code should correspond to the keys in this package set, which might+differ from those used on Hackage.+ If the process exits successfully, its stdout will be returned wrapped in-`Just`; otherwise `Nothing` is returned.+`Just`; otherwise `Nothing` is returned. If you wish to alter the `main`+implementation, use `Language.Eval.Internal.eval'`  This implementation is a little rough; for example, you may prefer to use `Text` rather than `String`; use a better representation like the syntax trees from@@ -42,10 +55,11 @@ it into a more appropriate type: it's not our place to choose how the result should be parsed, so we avoid the problem; by that point, our job is done. -# Limitations+## Limitations   - Since evaluation takes place in a separate GHC process, there can be no-   sharing of data (unless you provide a separate mechanism like a FIFO)+   sharing of data outside the strings provided (unless you provide a separate+   mechanism like a FIFO)  - Expressions are wrapped in `putStr`, so the expression must be a `String`.    You may need to marshall your data into a form which is more amenable to    serialising/deserialising via `String`.@@ -67,7 +81,7 @@       instances.     - Combining both package lists can make modules ambiguous.     - If the dependencies of two packages conflict, evaluation will fail.- - Language extensions aren't handled yet. I'll add them as and when the need-   arises.  - As with any kind of `eval`, there is absolutely no security. Do not pass-   potentially-malicious user input to this library.+   potentially-malicious user input to this library! Not only can arbitrary+   Haskell code be run (eg. using `unsafePerformIO`, but the flags are also a+   shell injection vector.

@@ -0,0 +1,17 @@+with builtins;++{ hsPkgs ? null, pkgNames, name }:++let pkgs            = import <nixpkgs> {};+    envPkgs         = getEnv "NIX_EVAL_HASKELL_PKGS";+    haskellPackages = if hsPkgs == null+                         then if envPkgs == ""+                                 then pkgs.haskellPackages+                                 else import envPkgs+                         else hsPkgs;++ in pkgs.buildEnv {+      inherit name;+      paths = [ (haskellPackages.ghcWithPackages+                   (h: map (p: h."${p}") pkgNames)) ];+    }

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                nix-eval-version:             0.1.0.2+version:             0.3.3.0 synopsis:            Evaluate Haskell expressions using Nix to get packages description:         Evaluate Haskell expressions using Nix to get packages homepage:            http://chriswarbo.net/git/nix-eval@@ -15,14 +15,22 @@ build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.10+data-files:          wrapper.sh+                   , ghcEnvWithPkgs.nix +source-repository head+  type:     git+  location: http://chriswarbo.net/git/nix-eval.git+ library   exposed-modules:     Language.Eval.Internal                      , Language.Eval-  -- other-modules:       +  other-modules:       Paths_nix_eval   -- other-extensions:    -  build-depends:       base >=4.8 && <4.9+  build-depends:       base >=4.8 && < 4.10                      , process+                     , strict+                     , hindent >= 4.0   hs-source-dirs:      src   default-language:    Haskell2010 

@@ -20,6 +20,7 @@ module Language.Eval (     Pkg(..)   , Mod(..)+  , Flag(..)   , Expr(..)   , eval   , raw@@ -27,6 +28,8 @@   , asString   , qualified   , withMods-  , withPkgs) where+  , withPkgs+  , withFlags+  , withPreamble) where  import Language.Eval.Internal

@@ -22,21 +22,38 @@ import Data.Char import Data.List import Data.String+import Paths_nix_eval (getDataFileName) import System.Exit import System.IO+import qualified System.IO.Strict+import System.IO.Unsafe import System.Process  -- We're stringly typed, with a veneer of safety -newtype Pkg  = Pkg String deriving (Eq, Ord, Show)-newtype Mod  = Mod String deriving (Eq, Ord, Show)-newtype Expr = Expr ([Pkg], [Mod], String) deriving (Show)+newtype Pkg  = Pkg  String deriving (Eq, Ord, Show)+newtype Mod  = Mod  String deriving (Eq, Ord, Show)+newtype Flag = Flag String deriving (Eq, Ord, Show) +data Expr = Expr {+    ePkgs :: [Pkg]+    -- ^ Packages+  , eMods :: [Mod]+    -- ^ Modules+  , eFlags :: [Flag]+    -- ^ Required runhaskell arguments+  , ePreamble :: [String]+    -- ^ Extra lines to add to the generated module's top-level+  , eExpr :: String+    -- ^ The Haskell expression+  } deriving (Show)+ -- Allow permutations of package and module lists instance Eq Expr where-  (Expr (p1, m1, e1)) == (Expr (p2, m2, e2)) = e1 == e2   &&-                                               perm p1 p2 &&-                                               perm m1 m2+  e1 == e2 = eExpr e1 == eExpr e2       &&+             perm (ePkgs e1) (ePkgs e2) &&+             perm (eMods e1) (eMods e2) &&+             perm (eFlags e1) (eFlags e2)     where perm  xs ys = allIn xs ys && allIn ys xs           allIn xs ys = all (`elem` ys) xs @@ -51,58 +68,151 @@ instance IsString Mod where   fromString = Mod +instance IsString Flag where+  fromString = Flag+ -- Evaluation via `nix-shell`  -- | Evaluate an `Expr`; this is where the magic happens! If successful, returns --   `Just` a `String`, which you can do what you like with. eval :: Expr -> IO (Maybe String)-eval x@(Expr (pkgs, mods, expr)) = do-    (code, out, err) <- let (cmd, args) = mkCmd x-                         in readProcessWithExitCode cmd args (mkHs x)-    hPutStr stderr err-    return $ case code of-      ExitSuccess   -> Just (trim out)-      ExitFailure _ -> Nothing+eval = eval' mkHs +-- | Same as `eval`, but allows a custom formatting function to be supplied, eg.+--   if you want an alternative to the default "main = putStr (..)" behaviour.+eval' :: (String -> String) -> Expr -> IO (Maybe String)+eval' f x = do+  cmd         <- decideCmd x+  (out, code) <- runCmdStdIO cmd (buildInput f x)+  case code of+    ExitSuccess   -> return $ Just (trim out)+    ExitFailure _ -> hPutStr stderr out >> return Nothing++-- | Runs the given command, piping the given String into stdin, returning+--   stdout and the ExitCode. stderr is inherited.+runCmdStdIO :: CreateProcess -> String -> IO (String, ExitCode)+runCmdStdIO c i = do (Just hIn, Just hOut, Nothing, hProc) <- createProcess c+                     hPutContents hIn i+                     out  <- System.IO.Strict.hGetContents hOut+                     code <- waitForProcess hProc+                     return (out, code)++buildInput f x = unlines (map mkImport mods ++ ePreamble x ++ [f expr])+  where mods  = nub $ eMods x+        expr  = eExpr x++decideCmd :: Expr -> IO CreateProcess+decideCmd x = do+  newEnv <- needNewEnv (nub $ ePkgs x)+  return (buildCmd (if newEnv then mkCmd      x+                              else noShellCmd x))++buildCmd (cmd, args) = (proc cmd args) {+                         std_in  = CreatePipe,+                         std_out = CreatePipe,+                         std_err = Inherit+                       }++noShellCmd :: Expr -> (String, [String])+noShellCmd x = ("sh", wrapCmd' x)++flagsOf x = map (\(Flag x) -> x) (nub $ eFlags x)++hPutContents h c = hPutStr h c >> hClose h++-- | Construct the nix-shell command. We use wrapper.sh as a layer of+--   indirection, to work around buggy environments. mkCmd :: Expr -> (String, [String])-mkCmd (Expr (ps, _, _)) = ("nix-shell", ["--run", "runhaskell",-                                         "-p", mkGhcPkg ps])+mkCmd x = ("nix-shell", ["--show-trace", "--run", cmdLine x, "-p", pkgOf x]) --- The prefix "h." is arbitrary, as long as it matches the argument "h:"-mkGhcPkg ps = let pkgs = map (\(Pkg p) -> "(h." ++ p ++ ")") ps-               in concat ["haskellPackages.ghcWithPackages ",-                          "(h: [", unwords pkgs, "])"]+pkgOf = mkGhcPkg . nub . ePkgs +cmdLine x = unwords (map shellEscape ("sh" : wrapCmd' x ++ [show (pkgsToName pkgs)]))+  where pkgs = nub $ ePkgs x++shellEscape s = if ' ' `elem` s then show s else s++wrapCmd' x = [wrapperPath, unwords . ("runhaskell" :) . flagsOf $ x]++wrapperPath :: FilePath+{-# NOINLINE wrapperPath #-}+wrapperPath = unsafePerformIO (getDataFileName "wrapper.sh")++ghcEnvWithPkgsPath :: FilePath+{-# NOINLINE ghcEnvWithPkgsPath #-}+ghcEnvWithPkgsPath = unsafePerformIO (getDataFileName "ghcEnvWithPkgs.nix")++-- | Creates a Nix expression which will use ghcEnvWithPkgs.nix to make a+--   Haskell environment containing all of the given packages+mkGhcPkg ps = env ++ " { name = " ++ name ++ "; pkgNames = " ++ args ++ "; }"+  where env  = "import " ++ show ghcEnvWithPkgsPath+        args = "[ " ++ unwords pkgs ++ " ]"+        pkgs = map (\(Pkg p) -> show p) ps+        name = show (pkgsToName ps)++-- | This creates a name for our Haskell environment. We make it here once, and+--   pass it into both Nix and wrapper.sh, to ensure consistency+pkgsToName [] = "ghc-env"+pkgsToName ps = "ghc-env-with-" ++ intercalate "-" (map clean pkgs)+  where pkgs  = map (\(Pkg p) -> p) ps+        clean = filter isAlphaNum++-- | Check if all of the required packages are already available, i.e. whether+--   we need to create a new Haskell environment+havePkgs :: [Pkg] -> IO Bool+havePkgs []         = return True+havePkgs (Pkg p:ps) = do+  out <- readProcess "ghc-pkg" ["--simple-output", "list", p] ""+  if p `isInfixOf` out+     then havePkgs ps+     else return False++-- | Do we need to create a new Haskell environment, because we don't have+--   GHC available or because the packages we need aren't available?+needNewEnv ps = do+  hgp <- haveGhcPkg+  if hgp then fmap not (havePkgs ps)+         else return True++mkImport :: Mod -> String+mkImport (Mod m) = "import " ++ m+ -- | Turn an expression into a Haskell module, complete with imports and `main`-mkHs :: Expr -> String-mkHs (Expr (_, ms, e)) = unlines (imports ++ [main])-  where imports = map (\(Mod m) -> "import " ++ m) ms-        main    = "main = putStr (" ++ e ++ ")"+mkHs :: String -> String+mkHs e = "main = Prelude.putStr (" ++ e ++ ")"  -- | Strip leading and trailing whitespace trim :: String -> String trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace +-- | Check if a shell command is available+haveCommand c = do+  (c, _, _) <- readCreateProcessWithExitCode (shell ("hash " ++ c)) ""+  return (c == ExitSuccess)+ -- | Check if the `nix-shell` command is available via the shell haveNix :: IO Bool-haveNix = do-  (c, _, _) <- readCreateProcessWithExitCode (shell "hash nix-shell") ""-  return (c == ExitSuccess)+haveNix = haveCommand "nix-shell" +-- | Check if the `ghc-pkg` command is available via the shell+haveGhcPkg = haveCommand "ghc-pkg"+ -- User-facing combinators  -- | A raw String of Haskell code, with no packages or modules. You can use --   OverloadedStrings to call this automatically. raw :: String -> Expr-raw s = Expr ([], [], s)+raw s = Expr { ePkgs = [], eMods = [], eExpr = s, eFlags = [], ePreamble = [] }  -- | Apply the first Expr to the second, eg. `f $$ x` ==> `f x` infixr 8 $$ ($$) :: Expr -> Expr -> Expr-(Expr (p1, m1, e1)) $$ (Expr (p2, m2, e2)) = Expr-  (nub (p1 ++ p2),-   nub (m1 ++ m2),-   concat ["((", e1, ") (", e2, "))"])+x $$ y = Expr {+  ePkgs     = nub (ePkgs     x ++ ePkgs     y),+  eMods     = nub (eMods     x ++ eMods     y),+  eFlags    = nub (eFlags    x ++ eFlags    y),+  ePreamble =      ePreamble x ++ ePreamble y ,+  eExpr  = concat ["((", eExpr x, ") (", eExpr y, "))"] }  -- | Convert the argument to a String, then send to `raw` asString :: (Show a) => a -> Expr@@ -110,13 +220,21 @@  -- | Qualify an expression, eg. `qualified "Data.Bool" "not"` gives the --   expression `Data.Bool.not` with "Data.Bool" in its module list-qualified :: Mod -> String -> Expr-qualified (Mod m) e = Expr ([], [Mod m], m ++ "." ++ e)+qualified :: Mod -> Expr -> Expr+qualified (Mod m) x = x { eMods = Mod m : eMods x,+                          eExpr = m ++ "." ++ eExpr x }  -- | Append modules to an expression's context withMods :: [Mod] -> Expr -> Expr-withMods ms (Expr (ps, ms', e)) = Expr (ps, ms' ++ ms, e)+withMods ms x = x { eMods = eMods x ++ ms }  -- | Append packages to an expression's context withPkgs :: [Pkg] -> Expr -> Expr-withPkgs ps (Expr (ps', ms, e)) = Expr (ps' ++ ps, ms, e)+withPkgs ps x = x { ePkgs = ePkgs x ++ ps }++-- | Append arguments to an expression's context+withFlags :: [Flag] -> Expr -> Expr+withFlags fs x = x { eFlags = eFlags x ++ fs }++withPreamble :: String -> Expr -> Expr+withPreamble p x = x { ePreamble = ePreamble x ++ [p] }

@@ -21,9 +21,10 @@  module Main where +import Data.List import Data.Maybe import Language.Eval-import Language.Eval.Internal (haveNix)+import Language.Eval.Internal import Test.QuickCheck.Monadic import Test.Tasty (defaultMain, testGroup) import Test.Tasty.QuickCheck@@ -38,6 +39,9 @@               , testProperty "Can import modules"  modulesImport               , testProperty "Can import packages" packagesImport               , testProperty "$$ precedence"       precedence+              , testProperty "Preamble added"      preambleAdded+              , testProperty "Flags work"          checkFlags+              , testProperty "Nesting works"       checkNesting               ]             else [] @@ -65,9 +69,71 @@                               asString s))           (Just (show s)) +preambleAdded :: Int -> Property+preambleAdded i =+  checkIO (withPreamble ("foo = " ++ show i) "foo * foo")+          (Just (show (i * i)))++checkFlags :: Int -> Property+checkFlags i = checkIO e (Just (show i))+  where e = withFlags ["-XTemplateHaskell"] . raw $+                "$([|" ++ show i ++ "|])"++-- Run nix-shells inside nix-shells, each with different Haskell packages+-- available, to make sure the environments are set up correctly+checkNesting = checkIO' id expr (Just "True")+  where expr   = unsafe $$ runHaskell nested+        -- Runs a String of Haskell in a sub-process+        runHaskell s = ((process $$ asString "runhaskell") $$ "[]") $$ asString s+        process    = withPkgs ["process"] $ qualified "System.Process" "readProcess"+        -- A String of Haskell code, which should invoke several `runhaskell`+        -- instances inside `nix-shell`s with different elements of `pkgs`+        -- available. The inner layer executes `base`, the others just propagate+        -- the result back up to us+        nested = recursiveHaskell pkgs base+        -- A selection of non-default packages/modules+        pkgs = [(Pkg "text",       Mod "Data.Text"),+                (Pkg "containers", Mod "Data.Graph"),+                (Pkg "parsec",     Mod "Text.Parsec")]+        -- This value should be propagated up through each putStrLn+        base = "main = putStr \"True\""+ -- Helpers +-- | `checkIO' gen x s` runs `gen x` to get an `Expr`, evaluates it, and asserts+--   that the result equals `s`+checkIO' :: Show a => (a -> Expr) -> a -> Maybe String -> Property+checkIO' pre i o = once $ monadicIO $ do+  dbg (("expression", pre i),+       ("expected",   o))+  result <- run $ eval (pre i)+  dbg ("result", result)+  assert (result == o)+ checkIO :: Expr -> Maybe String -> Property-checkIO i o = once $ ioProperty $ do-  result <- eval ("show" $$ i)-  return (result === o)+checkIO = checkIO' ("show" $$)++mkHaskell :: Pkg -> Mod -> String -> String+mkHaskell p (Mod m) str = unlines [+          "import System.Process",+          "main = System.Process.readProcess",+          indent (show cmd),+          indent args',+          indent (show inner ++ " >>= putStrLn")]+  where inner = "import " ++ m ++ "\n" ++ str+        args' = "[" ++ intercalate "," (map show args) ++ "]"+        indent = ("  " ++)+        (cmd, args) = mkCmd expr+        expr = withPkgs [p] . withMods [Mod m] $ "undefined"++pkgString :: [Pkg] -> String+pkgString [Pkg p] = "haskellPackages.ghcWithPackages (h: [ h." ++ p ++ "])"++recursiveHaskell :: [(Pkg, Mod)] -> String -> String+recursiveHaskell []          base = base+recursiveHaskell ((p, m):xs) base = mkHaskell p m (recursiveHaskell xs base)++unsafe = qualified "System.IO.Unsafe" "unsafePerformIO"++dbg :: (Monad m, Show a) => a -> PropertyM m ()+dbg = monitor . counterexample . show

@@ -0,0 +1,77 @@+#!/usr/bin/env bash++# This script will invoke $CMD, which will usually be "runhaskell" with a bunch+# of flags set.+CMD="$1"++function shouldDebug {+    [[ -n "$NIX_EVAL_DEBUG" ]]+}++function debugMsg {+    # Debug output, if requested+    if shouldDebug+    then+        echo -e "nix-eval: $1" 1>&2+    fi+}++if [[ -n "$2" ]]+then+    # If we're running in a nested nix-shell, the PATH may not be set up+    # correctly. To work around this, we accept the desired environment's name+    # as $2 (e.g. "ghc-env-with-text") and look for it in PATH. If found, we+    # push it to the front of PATH, so its binaries (`ghc`, etc.) will be used.++    NAME="$2"++    debugMsg "Looking for Haskell environment '$NAME'"++    DIR=$(echo "$PATH" | grep -o -- "[^:]*${NAME}/[^:]*") || {+        echo "Couldn't find $NAME in PATH: $PATH" 1>&2+        exit 1+    }++    debugMsg "Moving '$DIR' to the front of PATH" 1>&2+    export PATH=$DIR:$PATH+fi++# Now we can run the given command+debugMsg "Running command '$CMD'"++debugMsg "PATH is $PATH"++ORIG_INPUT=$(cat)+INPUT="$ORIG_INPUT"++# If we're debugging, use hindent if available, so error message line numbers+# are more specific+if shouldDebug && command -v hindent > /dev/null+then+    debugMsg "Trying hindent on given input:\n\n$INPUT"+    if command -v timeout > /dev/null+    then+        INPUT=$(echo "$ORIG_INPUT" | timeout 20 hindent --style fundamental) || {+            echo "WARNING: hindent failed!" 1>&2+            INPUT="$ORIG_INPUT"+        }+    else+        INPUT=$(echo "$ORIG_INPUT" | hindent --style fundamental) || {+            echo "WARNING: hindent failed!" 1>&2+            INPUT="$ORIG_INPUT"+        }+    fi+fi++debugMsg "Evaluating:\n\n$INPUT\n---\n"++OUTPUT=$(echo "$INPUT" | $CMD)+CODE="$?"++debugMsg "Output:\n\n$OUTPUT"++echo "$OUTPUT"++debugMsg "Finished; exit code was '$CODE'"++exit "$CODE"