Merge branch 'master' of github.com:jwiegley/hnix

Nix.hs

@@ -15,10 +15,12 @@ import           Control.Monad
 import           Control.Monad.Fix
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader (MonadReader)
+import           Control.Monad.ST
+import           Control.Monad.ST.Unsafe
 import           Control.Monad.Trans.Reader
 import qualified Data.ByteString as BS
 import qualified Data.HashMap.Lazy as M
-import           Data.IORef
+import           Data.STRef
 import           Data.Text (Text)
 import           Nix.Builtins
 import qualified Nix.Eval as Eval
@@ -82,31 +84,30 @@ tracingEvalLoc mpath expr = do
             runLazyM (baseEnv >>= (`pushScopes` pushScope m traced)
                                  >>= normalForm)
 
-newtype Lint m a = Lint
-    { runLint :: ReaderT (Context (Lint m) (SThunk (Lint m))) m a }
-    deriving (Functor, Applicative, Monad, MonadFix, MonadIO,
-              MonadReader (Context (Lint m) (SThunk (Lint m))))
+newtype Lint s a = Lint
+    { runLint :: ReaderT (Context (Lint s) (SThunk (Lint s))) (ST s) a }
+    deriving (Functor, Applicative, Monad, MonadFix,
+              MonadReader (Context (Lint s) (SThunk (Lint s))))
 
-instance MonadIO m => MonadVar (Lint m) where
-    type Var (Lint m) = IORef
+instance MonadVar (Lint s) where
+    type Var (Lint s) = STRef s
 
-    newVar   = liftIO . newIORef
-    readVar  = liftIO . readIORef
-    writeVar = (liftIO .) . writeIORef
+    newVar x     = Lint $ ReaderT $ \_ -> newSTRef x
+    readVar x    = Lint $ ReaderT $ \_ -> readSTRef x
+    writeVar x y = Lint $ ReaderT $ \_ -> writeSTRef x y
 
-instance MonadIO m => MonadFile (Lint m) where
-    readFile = liftIO . BS.readFile
+instance MonadFile (Lint s) where
+    readFile x = Lint $ ReaderT $ \_ -> unsafeIOToST $ BS.readFile x
 
-instance MonadIO m =>
-      Eval.MonadExpr (SThunk (Lint m))
-          (IORef (NSymbolicF (NTypeF (Lint m) (SThunk (Lint m)))))
-          (Lint m) where
+instance Eval.MonadExpr (SThunk (Lint s))
+             (STRef s (NSymbolicF (NTypeF (Lint s) (SThunk (Lint s)))))
+             (Lint s) where
     embedSet s = mkSymbolic [TSet (Just s)]
     projectSet = unpackSymbolic >=> \case
         NMany [TSet s] -> return s
         _ -> return Nothing
 
-    type MText (Lint m) = Text
+    type MText (Lint s) = Text
 
     wrapText   = return
     unwrapText = return
@@ -114,12 +115,12 @@ instance MonadIO m =>
     embedText   = const $ mkSymbolic [TStr]
     projectText = const $ return Nothing
 
-runLintM :: Lint m a -> m a
+runLintM :: Lint s a -> ST s a
 runLintM = flip runReaderT (Context emptyScopes []) . runLint
 
 symbolicBaseEnv :: Monad m => m (Scopes m (SThunk m))
 symbolicBaseEnv = return []     -- jww (2018-04-02): TODO
 
-lint :: (MonadFix m, MonadIO m) => NExpr -> m (Symbolic (Lint m))
+lint :: NExpr -> ST s (Symbolic (Lint s))
 lint expr = runLintM $ symbolicBaseEnv
     >>= (`pushScopes` Lint.lintExpr expr)

Nix/Eval.hs

@@ -593,3 +593,14 @@ framedEvalExpr :: Framed e m
 framedEvalExpr eval = adi (eval . annotated . getCompose) psi
   where
     psi k v@(Fix x) = withExprContext (() <$ x) (k v)
+
+-----
+
+{-
+streamValues :: MonadVar m => NValue m -> Stream (NValueF m) m ()
+streamValues = void . yields . fmap go
+  where
+    go (NThunk (Left v)) = streamValues v
+    go (NThunk v) = effect (streamValues <$> forceThunk v)
+-}
+

README.md

@@ -4,7 +4,8 @@ Haskell parser, evaluator and type checker for the Nix language.
 
 ## Prerequisites
 
-Nix is installed and in your `$PATH`.
+Nix is installed and in your `$PATH`. This is so that `nix-store` can be used
+for interacting with store paths, until `hnix-store` is ready.
 
 ## Getting Started
 
@@ -28,6 +29,7 @@ If you're looking for a way to help out, try taking a look [here](https://github
 
 When you're ready to submit a pull request, test it with:
 ```
+git submodule update --init --recursive
 nix-shell --run "LANGUAGE_TESTS=yes cabal test"
 ```
 

default.nix

@@ -1,4 +1,12 @@
-{ nixpkgs ? import <nixpkgs> {}, compiler ? "default", doBenchmark ? false }:
+let
+  hostPkgs = import <nixpkgs> {};
+  pinnedPkgs = hostPkgs.fetchFromGitHub {
+    owner = "NixOS";
+    repo = "nixpkgs-channels";
+    rev = "ee28e35ba37ab285fc29e4a09f26235ffe4123e2";
+    sha256 = "0a6xrqjj2ihkz1bizhy5r843n38xgimzw5s2mfc42kk2rgc95gw5";
+  };
+in { nixpkgs ? import pinnedPkgs {}, compiler ? "default", doBenchmark ? false }:
 
 let
 

main/Main.hs

@@ -5,6 +5,7 @@
 module Main where
 
 import           Control.Monad
+import           Control.Monad.ST
 import qualified Nix
 import           Nix.Expr.Types.Annotated (stripAnnotation)
 import           Nix.Lint
@@ -65,8 +66,9 @@ main = do
         Failure err -> hPutStrLn stderr $ "Parse failed: " ++ show err
         Success expr -> do
             when (check opts) $
-                putStrLn =<< Nix.runLintM . renderSymbolic
-                         =<< Nix.lint (stripAnnotation expr)
+                putStrLn $ runST $ Nix.runLintM . renderSymbolic
+                    =<< Nix.lint (stripAnnotation expr)
+
             if | evaluate opts, debug opts ->
                      print =<< Nix.tracingEvalLoc mpath expr
                | evaluate opts ->

tests/NixLanguageTests.hs

@@ -7,6 +7,7 @@ module NixLanguageTests (genTests) where
 import           Control.Arrow ((&&&))
 import           Control.Exception
 import           Control.Monad
+import           Control.Monad.ST
 import           Data.List (delete, sort)
 import           Data.List.Split (splitOn)
 import           Data.Map (Map)
@@ -72,7 +73,7 @@ genTests = do
 
 assertParse :: FilePath -> Assertion
 assertParse file = parseNixFile file >>= \case
-  Success expr -> void $ lint expr
+  Success expr -> pure $! runST $ void $ lint expr
   Failure err  -> assertFailure $ "Failed to parse " ++ file ++ ":\n" ++ show err
 
 assertParseFail :: FilePath -> Assertion
@@ -80,7 +81,7 @@ assertParseFail file = do
     eres <- parseNixFile file
     catch (case eres of
                Success expr -> do
-                   _ <- lint expr
+                   _ <- pure $! runST $ void $ lint expr
                    assertFailure $ "Unexpected success parsing `"
                        ++ file ++ ":\nParsed value: " ++ show expr
                Failure _ -> return ()) $ \(_ :: SomeException) ->