picnoir
/
hnix
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Factor some common patterns back into Standard

This commit is contained in:
John Wiegley 2019-03-17 21:58:35 -07:00
parent 7b5d134d22
commit a006769124
No known key found for this signature in database
GPG Key ID: C144D8F4F19FE630
5 changed files with 41 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
main/Main.hs
View File

@ -30,8 +30,6 @@ import Data.Text.Prettyprint.Doc.Render.Text
import Nix
import Nix.Convert
import qualified Nix.Eval as Eval
import Nix.Fresh
import Nix.Fresh.Basic
import Nix.Json
-- import Nix.Lint
import Nix.Options.Parser
@ -49,10 +47,9 @@ import qualified Text.Show.Pretty as PS
main :: IO ()
main = do
time <- liftIO getCurrentTime
time <- getCurrentTime
opts <- execParser (nixOptionsInfo time)
i <- newVar (1 :: Int)
runStdLazyM opts (runFreshIdT i) $ case readFrom opts of
runStandardIO opts $ case readFrom opts of
Just path -> do
let file = addExtension (dropExtension path) "nixc"
process opts (Just file) =<< liftIO (readCache path)
@ -98,7 +95,7 @@ main = do
NixException frames ->
errorWithoutStackTrace
. show
=<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames
=<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames
when (repl opts) $ withNixContext Nothing $ Repl.main
@ -135,7 +132,7 @@ main = do
where
printer
| finder opts
= fromValue @(AttrSet (StdThunk StdIdT IO)) >=> findAttrs
= fromValue @(AttrSet (StandardThunk IO)) >=> findAttrs
| xml opts
= liftIO
. putStrLn
@ -165,7 +162,7 @@ main = do
Thunk _ _ ref -> do
let path = prefix ++ Text.unpack k
(_, descend) = filterEntry path k
val <- readVar @(StdLazy StdIdT IO) ref
val <- readVar @(StandardT IO) ref
case val of
Computed _ -> pure (k, Nothing)
_ | descend -> (k, ) <$> forceEntry path nv
@ -207,7 +204,7 @@ main = do
. (k ++)
. (": " ++)
. show
=<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames
=<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames
return Nothing
reduction path mp x = do

16
src/Nix/Thunk/Standard.hs
View File

@ -30,6 +30,8 @@ import GHC.Generics
import Nix.Cited
import Nix.Cited.Basic
import Nix.Exec
import Nix.Fresh
import Nix.Fresh.Basic
import Nix.Options
import Nix.Thunk
import Nix.Thunk.Basic
@ -95,3 +97,17 @@ runStdLazyM opts run action = do
-- i <- newVar (1 :: Int)
-- runFreshIdT i $ runLazyM opts action
run $ runLazyM opts action
type StandardThunk m = StdThunk StdIdT m
type StandardValue m = StdValue StdIdT m
type StandardValueNF m = StdValueNF StdIdT m
type StandardT m = StdLazy StdIdT m
runStandard :: (MonadVar m, MonadIO m)
=> Options -> StdLazy StdIdT m a -> m a
runStandard opts action = do
i <- newVar (1 :: Int)
runStdLazyM opts (runFreshIdT i) action
runStandardIO :: Options -> StdLazy StdIdT IO a -> IO a
runStandardIO = runStandard

30
tests/EvalTests.hs
View File

@ -10,7 +10,7 @@
module EvalTests (tests, genEvalCompareTests) where
import Control.Applicative ((<|>))
import Control.Monad (when)
import Control.Monad (when, unless)
import Control.Monad.Catch
import Control.Monad.IO.Class
-- import qualified Data.HashMap.Lazy as M
@ -22,9 +22,7 @@ import Data.Text (Text)
import Data.Time
import Nix
import Nix.TH
import Nix.Fresh
import Nix.Thunk.Standard
import Nix.Var
import qualified System.Directory as D
import System.Environment
import System.FilePath
@ -422,11 +420,10 @@ genEvalCompareTests = do
constantEqual :: NExprLoc -> NExprLoc -> Assertion
constantEqual a b = do
time <- liftIO getCurrentTime
time <- getCurrentTime
let opts = defaultOptions time
-- putStrLn =<< lint (stripAnnotation a)
j <- newVar (1 :: Int)
res <- runStdLazyM opts (runFreshIdT j) $ do
res <- runStandardIO opts $ do
a' <- normalForm =<< nixEvalExprLoc Nothing a
b' <- normalForm =<< nixEvalExprLoc Nothing b
return $ valueNFEq a' b'
@ -447,18 +444,15 @@ constantEqualText a b = do
assertNixEvalThrows :: Text -> Assertion
assertNixEvalThrows a = do
let Success a' = parseNixTextLoc a
time <- liftIO getCurrentTime
let opts = defaultOptions time
j <- newVar (1 :: Int)
errored <- catch
(False <$ runStdLazyM opts (runFreshIdT j)
(normalForm =<< nixEvalExprLoc Nothing a'))
(\(_ :: NixException) -> pure True)
if errored then
pure ()
else
assertFailure "Did not catch nix exception"
let Success a' = parseNixTextLoc a
time <- getCurrentTime
let opts = defaultOptions time
errored <- catch
(False <$ runStandardIO opts
(normalForm =<< nixEvalExprLoc Nothing a'))
(\(_ :: NixException) -> pure True)
unless errored $
assertFailure "Did not catch nix exception"
freeVarsEqual :: Text -> [VarName] -> Assertion
freeVarsEqual a xs = do

8
tests/Main.hs
View File

@ -9,7 +9,6 @@ import Control.DeepSeq
import qualified Control.Exception as Exc
import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.IO.Class
import Data.Fix
import Data.List (isSuffixOf)
import Data.Maybe
@ -19,13 +18,11 @@ import Data.Time
import qualified EvalTests
import qualified Nix
import Nix.Expr.Types
import Nix.Fresh
import Nix.String
import Nix.Options
import Nix.Parser
import Nix.Thunk.Standard
import Nix.Value
import Nix.Var
import qualified NixLanguageTests
import qualified ParserTests
import qualified PrettyTests
@ -59,9 +56,8 @@ ensureNixpkgsCanParse =
sha256 = "#{sha256}";
}|]) $ \expr -> do
NVStr ns <- do
time <- liftIO getCurrentTime
j <- newVar (1 :: Int)
runStdLazyM (defaultOptions time) (runFreshIdT j) $
time <- getCurrentTime
runStandardIO (defaultOptions time) $
Nix.nixEvalExprLoc Nothing expr
let dir = hackyStringIgnoreContext ns
exists <- fileExist (unpack dir)

18
tests/TestCommon.hs
View File

@ -12,12 +12,7 @@ import Data.Text ( Text
import Data.Time
import Nix
import Nix.Exec ()
import Nix.Cited ()
import Nix.Cited.Basic ()
import Nix.Fresh
import Nix.Fresh.Basic
import Nix.Thunk.Standard
import Nix.Var
import System.Environment
import System.IO
import System.Posix.Files
@ -25,7 +20,7 @@ import System.Posix.Temp
import System.Process
import Test.Tasty.HUnit
hnixEvalFile :: Options -> FilePath -> IO (StdValueNF StdIdT IO)
hnixEvalFile :: Options -> FilePath -> IO (StandardValueNF IO)
hnixEvalFile opts file = do
parseResult <- parseNixFileLoc file
case parseResult of
@ -33,16 +28,15 @@ hnixEvalFile opts file = do
error $ "Parsing failed for file `" ++ file ++ "`.\n" ++ show err
Success expr -> do
setEnv "TEST_VAR" "foo"
i <- newVar (1 :: Int)
runStdLazyM opts (runFreshIdT i)
runStandardIO opts
$ catch (evaluateExpression (Just file) nixEvalExprLoc normalForm expr)
$ \case
NixException frames ->
errorWithoutStackTrace
. show
=<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames
=<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames
hnixEvalText :: Options -> Text -> IO (StdValueNF StdIdT IO)
hnixEvalText :: Options -> Text -> IO (StandardValueNF IO)
hnixEvalText opts src = case parseNixText src of
Failure err ->
error
@ -50,9 +44,7 @@ hnixEvalText opts src = case parseNixText src of
++ unpack src
++ "`.\n"
++ show err
Success expr -> do
i <- newVar (1 :: Int)
runStdLazyM opts (runFreshIdT i) $ normalForm =<< nixEvalExpr Nothing expr
Success expr -> runStandardIO opts $ normalForm =<< nixEvalExpr Nothing expr
nixEvalString :: String -> IO String
nixEvalString expr = do