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

Factor some common patterns back into Standard

Browse source
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
import Nix.Convert import Nix.Convert
import qualified Nix.Eval as Eval import qualified Nix.Eval as Eval
import Nix.Fresh
import Nix.Fresh.Basic
import Nix.Json import Nix.Json
-- import Nix.Lint -- import Nix.Lint
import Nix.Options.Parser import Nix.Options.Parser
@ -49,10 +47,9 @@ import qualified Text.Show.Pretty as PS
main :: IO () main :: IO ()
main = do main = do
time <- liftIO getCurrentTime time <- getCurrentTime
opts <- execParser (nixOptionsInfo time) opts <- execParser (nixOptionsInfo time)
i <- newVar (1 :: Int) runStandardIO opts $ case readFrom opts of
runStdLazyM opts (runFreshIdT i) $ case readFrom opts of
Just path -> do Just path -> do
let file = addExtension (dropExtension path) "nixc" let file = addExtension (dropExtension path) "nixc"
process opts (Just file) =<< liftIO (readCache path) process opts (Just file) =<< liftIO (readCache path)
@ -98,7 +95,7 @@ main = do
NixException frames -> NixException frames ->
errorWithoutStackTrace errorWithoutStackTrace
. show . show
=<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames
when (repl opts) $ withNixContext Nothing $ Repl.main when (repl opts) $ withNixContext Nothing $ Repl.main
@ -135,7 +132,7 @@ main = do
where where
printer printer
| finder opts | finder opts
= fromValue @(AttrSet (StdThunk StdIdT IO)) >=> findAttrs = fromValue @(AttrSet (StandardThunk IO)) >=> findAttrs
| xml opts | xml opts
= liftIO = liftIO
. putStrLn . putStrLn
@ -165,7 +162,7 @@ main = do
Thunk _ _ ref -> do Thunk _ _ ref -> do
let path = prefix ++ Text.unpack k let path = prefix ++ Text.unpack k
(_, descend) = filterEntry path k (_, descend) = filterEntry path k
val <- readVar @(StdLazy StdIdT IO) ref val <- readVar @(StandardT IO) ref
case val of case val of
Computed _ -> pure (k, Nothing) Computed _ -> pure (k, Nothing)
_ | descend -> (k, ) <$> forceEntry path nv _ | descend -> (k, ) <$> forceEntry path nv
@ -207,7 +204,7 @@ main = do
. (k ++) . (k ++)
. (": " ++) . (": " ++)
. show . show
=<< renderFrames @(StdValue StdIdT IO) @(StdThunk StdIdT IO) frames =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames
return Nothing return Nothing
reduction path mp x = do 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
import Nix.Cited.Basic import Nix.Cited.Basic
import Nix.Exec import Nix.Exec
import Nix.Fresh
import Nix.Fresh.Basic
import Nix.Options import Nix.Options
import Nix.Thunk import Nix.Thunk
import Nix.Thunk.Basic import Nix.Thunk.Basic
@ -95,3 +97,17 @@ runStdLazyM opts run action = do
-- i <- newVar (1 :: Int) -- i <- newVar (1 :: Int)
-- runFreshIdT i $ runLazyM opts action -- runFreshIdT i $ runLazyM opts action
run $ 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 module EvalTests (tests, genEvalCompareTests) where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad (when) import Control.Monad (when, unless)
import Control.Monad.Catch import Control.Monad.Catch
import Control.Monad.IO.Class import Control.Monad.IO.Class
-- import qualified Data.HashMap.Lazy as M -- import qualified Data.HashMap.Lazy as M
@ -22,9 +22,7 @@ import Data.Text (Text)
import Data.Time import Data.Time
import Nix import Nix
import Nix.TH import Nix.TH
import Nix.Fresh
import Nix.Thunk.Standard import Nix.Thunk.Standard
import Nix.Var
import qualified System.Directory as D import qualified System.Directory as D
import System.Environment import System.Environment
import System.FilePath import System.FilePath
@ -422,11 +420,10 @@ genEvalCompareTests = do
constantEqual :: NExprLoc -> NExprLoc -> Assertion constantEqual :: NExprLoc -> NExprLoc -> Assertion
constantEqual a b = do constantEqual a b = do
time <- liftIO getCurrentTime time <- getCurrentTime
let opts = defaultOptions time let opts = defaultOptions time
-- putStrLn =<< lint (stripAnnotation a) -- putStrLn =<< lint (stripAnnotation a)
j <- newVar (1 :: Int) res <- runStandardIO opts $ do
res <- runStdLazyM opts (runFreshIdT j) $ do
a' <- normalForm =<< nixEvalExprLoc Nothing a a' <- normalForm =<< nixEvalExprLoc Nothing a
b' <- normalForm =<< nixEvalExprLoc Nothing b b' <- normalForm =<< nixEvalExprLoc Nothing b
return $ valueNFEq a' b' return $ valueNFEq a' b'
@ -447,18 +444,15 @@ constantEqualText a b = do
assertNixEvalThrows :: Text -> Assertion assertNixEvalThrows :: Text -> Assertion
assertNixEvalThrows a = do assertNixEvalThrows a = do
let Success a' = parseNixTextLoc a let Success a' = parseNixTextLoc a
time <- liftIO getCurrentTime time <- getCurrentTime
let opts = defaultOptions time let opts = defaultOptions time
j <- newVar (1 :: Int) errored <- catch
errored <- catch (False <$ runStandardIO opts
(False <$ runStdLazyM opts (runFreshIdT j) (normalForm =<< nixEvalExprLoc Nothing a'))
(normalForm =<< nixEvalExprLoc Nothing a')) (\(_ :: NixException) -> pure True)
(\(_ :: NixException) -> pure True) unless errored $
if errored then assertFailure "Did not catch nix exception"
pure ()
else
assertFailure "Did not catch nix exception"
freeVarsEqual :: Text -> [VarName] -> Assertion freeVarsEqual :: Text -> [VarName] -> Assertion
freeVarsEqual a xs = do freeVarsEqual a xs = do

8
tests/Main.hs
View file

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

18
tests/TestCommon.hs
View file

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