Rename the internal version of ToNix/FromNix to ToValue/FromValue
This commit is contained in:
John Wiegley
parent
ef82d5e9f2
commit
fb6191c949
|
|
@ -98,7 +98,7 @@ valueThunk = value @_ @_ @m
|
|||
|
||||
builtinsList :: forall e m. MonadBuiltins e m => m [ Builtin m ]
|
||||
builtinsList = sequence [
|
||||
do version <- toNix ("2.0" :: Text)
|
||||
do version <- toValue ("2.0" :: Text)
|
||||
pure $ Builtin Normal ("nixVersion", version)
|
||||
|
||||
, add0 TopLevel "__nixPath" nixPath
|
||||
|
|
@ -278,7 +278,7 @@ unsafeGetAttrPos x y = force x $ \x' -> force y $ \y' -> case (x', y') of
|
|||
Nothing ->
|
||||
throwError $ "unsafeGetAttrPos: field '" ++ Text.unpack key
|
||||
++ "' does not exist in attr set: " ++ show apos
|
||||
Just delta -> toNix delta
|
||||
Just delta -> toValue delta
|
||||
(x, y) -> throwError $ "Invalid types for builtin.unsafeGetAttrPos: "
|
||||
++ show (x, y)
|
||||
|
||||
|
|
@ -414,12 +414,12 @@ splitDrvName s =
|
|||
in (Text.intercalate sep namePieces, Text.intercalate sep versionPieces)
|
||||
|
||||
parseDrvName :: forall e m. MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
parseDrvName = flip force $ fromNix >=> \(s :: Text) -> do
|
||||
parseDrvName = flip force $ fromValue >=> \(s :: Text) -> do
|
||||
let (name :: Text, version :: Text) = splitDrvName s
|
||||
-- jww (2018-04-15): There should be an easier way to write this.
|
||||
(toNix =<<) $ sequence $ M.fromList
|
||||
[ ("name" :: Text, thunk (toNix name))
|
||||
, ("version", thunk (toNix version)) ]
|
||||
(toValue =<<) $ sequence $ M.fromList
|
||||
[ ("name" :: Text, thunk (toValue name))
|
||||
, ("version", thunk (toValue version)) ]
|
||||
|
||||
match_ :: forall e m. MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
|
||||
match_ pat str = force pat $ \pat' -> force str $ \str' ->
|
||||
|
|
@ -431,7 +431,7 @@ match_ pat str = force pat $ \pat' -> force str $ \str' ->
|
|||
case matchOnceText re (encodeUtf8 s) of
|
||||
Just ("", sarr, "") -> do
|
||||
let s = map fst (elems sarr)
|
||||
NVList <$> traverse (toNix . decodeUtf8)
|
||||
NVList <$> traverse (toValue . decodeUtf8)
|
||||
(if length s > 1 then tail s else s)
|
||||
_ -> pure $ NVConstant NNull
|
||||
(p, s) ->
|
||||
|
|
@ -475,7 +475,7 @@ substring start len str = Prim $
|
|||
|
||||
attrNames :: forall e m. MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
attrNames = flip force $ \case
|
||||
NVSet m _ -> toNix =<< traverse (thunk . toNix) (sort (M.keys m))
|
||||
NVSet m _ -> toValue =<< traverse (thunk . toValue) (sort (M.keys m))
|
||||
v -> throwError $ "builtins.attrNames: Expected attribute set, got "
|
||||
++ show v
|
||||
|
||||
|
|
@ -508,9 +508,9 @@ catAttrs attrName lt = force lt $ \case
|
|||
++ show v
|
||||
|
||||
concatStringsSep :: MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
|
||||
concatStringsSep s1 s2 = force s1 $ fromNix >=> \(s1' :: Text) ->
|
||||
force s2 $ fromNix >=> traverse (`force` fromNix) >=> \(s2' :: [Text]) ->
|
||||
toNix $ Text.intercalate s1' s2'
|
||||
concatStringsSep s1 s2 = force s1 $ fromValue >=> \(s1' :: Text) ->
|
||||
force s2 $ fromValue >=> traverse (`force` fromValue) >=> \(s2' :: [Text]) ->
|
||||
toValue $ Text.intercalate s1' s2'
|
||||
|
||||
baseNameOf :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
baseNameOf = flip force $ \case
|
||||
|
|
@ -548,7 +548,7 @@ deepSeq a b = do
|
|||
|
||||
elem_ :: MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
|
||||
elem_ x xs = force xs $ \case
|
||||
NVList l -> toNix =<< anyM (thunkEq x) l
|
||||
NVList l -> toValue =<< anyM (thunkEq x) l
|
||||
v -> throwError $ "builtins.elem: Expected a list, got " ++ show v
|
||||
|
||||
elemAt_ :: MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
|
||||
|
|
@ -562,16 +562,16 @@ elemAt_ xs n = force n $ extractInt >=> \n' -> force xs $ \case
|
|||
genList :: MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
|
||||
genList generator length = force length $ \case
|
||||
NVConstant (NInt n) | n >= 0 -> fmap NVList $ forM [0 .. n - 1] $ \i ->
|
||||
thunk $ force generator (`callFunc` toNix i)
|
||||
thunk $ force generator (`callFunc` toValue i)
|
||||
v -> throwError $ "builtins.genList: Expected a non-negative number, got "
|
||||
++ show v
|
||||
|
||||
--TODO: Preserve string context
|
||||
replaceStrings :: MonadBuiltins e m => NThunk m -> NThunk m -> NThunk m -> m (NValue m)
|
||||
replaceStrings tfrom tto ts =
|
||||
force tfrom $ fromNix >=> traverse (`force` fromNix) >=> \(from :: [Text]) ->
|
||||
force tto $ fromNix >=> traverse (`force` fromNix) >=> \(to :: [Text]) ->
|
||||
force ts $ fromNix >=> \(s :: Text) -> do
|
||||
force tfrom $ fromValue >=> traverse (`force` fromValue) >=> \(from :: [Text]) ->
|
||||
force tto $ fromValue >=> traverse (`force` fromValue) >=> \(to :: [Text]) ->
|
||||
force ts $ fromValue >=> \(s :: Text) -> do
|
||||
when (length from /= length to) $
|
||||
throwError $ "'from' and 'to' arguments to 'replaceStrings'"
|
||||
++ " have different lengths"
|
||||
|
|
@ -594,11 +594,11 @@ replaceStrings tfrom tto ts =
|
|||
, Builder.singleton h
|
||||
]
|
||||
_ -> go rest $ result <> Builder.fromText replacement
|
||||
toNix $ go s mempty
|
||||
toValue $ go s mempty
|
||||
|
||||
removeAttrs :: MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
|
||||
removeAttrs set list = force list $
|
||||
fromNix >=> traverse (`force` fromNix) >=> \(toRemove :: [Text]) ->
|
||||
fromValue >=> traverse (`force` fromValue) >=> \(toRemove :: [Text]) ->
|
||||
force set $ \case
|
||||
NVSet m p -> return $ NVSet (go m toRemove) (go p toRemove)
|
||||
v -> throwError $ "removeAttrs: expected set, got " ++ show v
|
||||
|
|
@ -642,43 +642,43 @@ pathExists_ = flip force $ \case
|
|||
|
||||
isAttrs :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isAttrs = flip force $ \case
|
||||
NVSet _ _ -> toNix True
|
||||
_ -> toNix False
|
||||
NVSet _ _ -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
isList :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isList = flip force $ \case
|
||||
NVList _ -> toNix True
|
||||
_ -> toNix False
|
||||
NVList _ -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
isFunction :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isFunction = flip force $ \case
|
||||
NVClosure {} -> toNix True
|
||||
_ -> toNix False
|
||||
NVClosure {} -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
isString :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isString = flip force $ \case
|
||||
NVStr _ _ -> toNix True
|
||||
_ -> toNix False
|
||||
NVStr _ _ -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
isInt :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isInt = flip force $ \case
|
||||
NVConstant (NInt _) -> toNix True
|
||||
_ -> toNix False
|
||||
NVConstant (NInt _) -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
isFloat :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isFloat = flip force $ \case
|
||||
NVConstant (NFloat _) -> toNix True
|
||||
_ -> toNix False
|
||||
NVConstant (NFloat _) -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
isBool :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isBool = flip force $ \case
|
||||
NVConstant (NBool _) -> toNix True
|
||||
_ -> toNix False
|
||||
NVConstant (NBool _) -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
isNull :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
isNull = flip force $ \case
|
||||
NVConstant NNull -> toNix True
|
||||
_ -> toNix False
|
||||
NVConstant NNull -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
throw_ :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
throw_ = flip force $ \case
|
||||
|
|
@ -713,11 +713,11 @@ sort_ comparator list = force list $ \case
|
|||
where
|
||||
cmp a b = do
|
||||
isLessThan <- call2 comparator a b
|
||||
fromNix isLessThan >>= \case
|
||||
fromValue isLessThan >>= \case
|
||||
True -> pure LT
|
||||
False -> do
|
||||
isGreaterThan <- call2 comparator b a
|
||||
fromNix isGreaterThan >>= \case
|
||||
fromValue isGreaterThan >>= \case
|
||||
True -> pure GT
|
||||
False -> pure EQ
|
||||
v -> throwError $ "builtins.sort: expected list, got " ++ show v
|
||||
|
|
@ -783,7 +783,7 @@ absolutePathFromValue = \case
|
|||
--TODO: Move all liftIO things into MonadNixEnv or similar
|
||||
readFile_ :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
readFile_ path = force path $
|
||||
toNix <=< Nix.Stack.readFile <=< absolutePathFromValue
|
||||
toValue <=< Nix.Stack.readFile <=< absolutePathFromValue
|
||||
|
||||
data FileType
|
||||
= FileType_Regular
|
||||
|
|
@ -792,8 +792,8 @@ data FileType
|
|||
| FileType_Unknown
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
|
||||
instance Applicative m => ToNix FileType m (NValue m) where
|
||||
toNix = toNix . \case
|
||||
instance Applicative m => ToValue FileType m (NValue m) where
|
||||
toValue = toValue . \case
|
||||
FileType_Regular -> "regular" :: Text
|
||||
FileType_Directory -> "directory"
|
||||
FileType_Symlink -> "symlink"
|
||||
|
|
@ -811,20 +811,20 @@ readDir_ pathThunk = do
|
|||
| isSymbolicLink s -> FileType_Symlink
|
||||
| otherwise -> FileType_Unknown
|
||||
pure (Text.pack item, t)
|
||||
toNix =<< traverse (thunk . toNix) (M.fromList itemsWithTypes)
|
||||
toValue =<< traverse (thunk . toValue) (M.fromList itemsWithTypes)
|
||||
|
||||
fromJSON :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
fromJSON t = force t $ fromNix >=> \encoded ->
|
||||
fromJSON t = force t $ fromValue >=> \encoded ->
|
||||
case A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded of
|
||||
Left jsonError -> throwError $ "builtins.fromJSON: " ++ jsonError
|
||||
Right v -> toNix v
|
||||
Right v -> toValue v
|
||||
|
||||
toXML_ :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
toXML_ = flip force $ normalForm >=> \x ->
|
||||
pure $ NVStr (Text.pack (toXML x)) mempty
|
||||
|
||||
typeOf :: MonadBuiltins e m => NThunk m -> m (NValue m)
|
||||
typeOf t = force t $ \v -> toNix @Text $ case v of
|
||||
typeOf t = force t $ \v -> toValue @Text $ case v of
|
||||
NVConstant a -> case a of
|
||||
NInt _ -> "int"
|
||||
NFloat _ -> "float"
|
||||
|
|
@ -921,14 +921,14 @@ newtype Prim m a = Prim { runPrim :: m a }
|
|||
class ToBuiltin m a | a -> m where
|
||||
toBuiltin :: String -> a -> m (NValue m)
|
||||
|
||||
instance (MonadBuiltins e m, ToNix a m (NValue m)) => ToBuiltin m (Prim m a) where
|
||||
toBuiltin _ p = toNix =<< runPrim p
|
||||
instance (MonadBuiltins e m, ToValue a m (NValue m)) => ToBuiltin m (Prim m a) where
|
||||
toBuiltin _ p = toValue =<< runPrim p
|
||||
|
||||
instance (MonadBuiltins e m, FromNix a m (NValue m), ToBuiltin m b)
|
||||
instance (MonadBuiltins e m, FromValue a m (NValue m), ToBuiltin m b)
|
||||
=> ToBuiltin m (a -> b) where
|
||||
toBuiltin name f =
|
||||
return $ NVBuiltin name $
|
||||
force ?? (fromNix >=> toBuiltin name . f)
|
||||
force ?? (fromValue >=> toBuiltin name . f)
|
||||
|
||||
toEncodingSorted :: A.Value -> A.Encoding
|
||||
toEncodingSorted = \case
|
||||
|
|
|
|||
|
|
@ -35,115 +35,115 @@ import Nix.Stack
|
|||
import Nix.Thunk
|
||||
import Nix.Value
|
||||
|
||||
class FromNix a m v where
|
||||
fromNix :: v -> m a
|
||||
class FromValue a m v where
|
||||
fromValue :: v -> m a
|
||||
fromNixMay :: v -> m (Maybe a)
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Bool m (NValueNF m) where
|
||||
=> FromValue Bool m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVConstant (NBool b)) -> pure $ Just b
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a bool, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Bool m (NValue m) where
|
||||
=> FromValue Bool m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVConstant (NBool b) -> pure $ Just b
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a bool, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Int m (NValueNF m) where
|
||||
=> FromValue Int m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVConstant (NInt b)) -> pure $ Just (fromInteger b)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an integer, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Int m (NValue m) where
|
||||
=> FromValue Int m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVConstant (NInt b) -> pure $ Just (fromInteger b)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an integer, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Integer m (NValueNF m) where
|
||||
=> FromValue Integer m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVConstant (NInt b)) -> pure $ Just b
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an integer, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Integer m (NValue m) where
|
||||
=> FromValue Integer m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVConstant (NInt b) -> pure $ Just b
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an integer, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Float m (NValueNF m) where
|
||||
=> FromValue Float m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVConstant (NFloat b)) -> pure $ Just b
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a float, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Float m (NValue m) where
|
||||
=> FromValue Float m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVConstant (NFloat b) -> pure $ Just b
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a float, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Text m (NValueNF m) where
|
||||
=> FromValue Text m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVStr t _) -> pure $ Just t
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a string, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Text m (NValue m) where
|
||||
=> FromValue Text m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVStr t _ -> pure $ Just t
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a string, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix ByteString m (NValueNF m) where
|
||||
=> FromValue ByteString m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVStr t _) -> pure $ Just (encodeUtf8 t)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a string, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix ByteString m (NValue m) where
|
||||
=> FromValue ByteString m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVStr t _ -> pure $ Just (encodeUtf8 t)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a string, but saw: " ++ show v
|
||||
|
||||
|
|
@ -151,114 +151,114 @@ newtype Path = Path { getPath :: FilePath }
|
|||
deriving Show
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Path m (NValueNF m) where
|
||||
=> FromValue Path m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVPath p) -> pure $ Just (Path p)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a path, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix Path m (NValue m) where
|
||||
=> FromValue Path m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVPath p -> pure $ Just (Path p)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a path, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m,
|
||||
FromNix a m (NValueNF m), Show a)
|
||||
=> FromNix [a] m (NValueNF m) where
|
||||
FromValue a m (NValueNF m), Show a)
|
||||
=> FromValue [a] m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVList l) -> sequence <$> traverse fromNixMay l
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
-- jww (2018-04-15): This instance does not work, because when the desired
|
||||
-- conversion is FromNix [NThunk m] m (NValue m), we then use traverse with
|
||||
-- FromNix (NThunk m) m (NValue m), and this use of 'traverse' causes the
|
||||
-- conversion is FromValue [NThunk m] m (NValue m), we then use traverse with
|
||||
-- FromValue (NThunk m) m (NValue m), and this use of 'traverse' causes the
|
||||
-- monadic effects to be sequence'd too early.
|
||||
|
||||
-- instance (Framed e m, MonadVar m, MonadFile m) => (MonadThunk (NValue m) (NThunk m) m,
|
||||
-- FromNix a m (NValue m), Show a) => FromNix [a] m (NValue m) where
|
||||
-- FromValue a m (NValue m), Show a) => FromValue [a] m (NValue m) where
|
||||
-- fromNixMay = \case
|
||||
-- NVList l -> sequence <$> traverse (`force` fromNixMay) l
|
||||
-- _ -> pure Nothing
|
||||
-- fromNix = fromNixMay >=> \case
|
||||
-- fromValue = fromNixMay >=> \case
|
||||
-- Just b -> pure b
|
||||
-- v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix [NThunk m] m (NValue m) where
|
||||
=> FromValue [NThunk m] m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVList l -> pure $ Just l
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix (HashMap Text (NValueNF m)) m (NValueNF m) where
|
||||
=> FromValue (HashMap Text (NValueNF m)) m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVSet s _) -> pure $ Just s
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
-- instance (Framed e m, MonadVar m, MonadFile m) => (MonadThunk (NValue m) (NThunk m) m,
|
||||
-- FromNix a m (NValue m), Show a)
|
||||
-- => FromNix (HashMap Text a) m (NValue m) where
|
||||
-- FromValue a m (NValue m), Show a)
|
||||
-- => FromValue (HashMap Text a) m (NValue m) where
|
||||
-- fromNixMay = \case
|
||||
-- NVSet s _ -> sequence <$> traverse (`force` fromNixMay) s
|
||||
-- _ -> pure Nothing
|
||||
-- fromNix = fromNixMay >=> \case
|
||||
-- fromValue = fromNixMay >=> \case
|
||||
-- Just b -> pure b
|
||||
-- v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix (HashMap Text (NThunk m)) m (NValue m) where
|
||||
=> FromValue (HashMap Text (NThunk m)) m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVSet s _ -> pure $ Just s
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix (HashMap Text (NValueNF m),
|
||||
=> FromValue (HashMap Text (NValueNF m),
|
||||
HashMap Text SourcePos) m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVSet s p) -> pure $ Just (s, p)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix (HashMap Text (NThunk m),
|
||||
=> FromValue (HashMap Text (NThunk m),
|
||||
HashMap Text SourcePos) m (NValue m) where
|
||||
fromNixMay = \case
|
||||
NVSet s p -> pure $ Just (s, p)
|
||||
_ -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected an attrset, but saw: " ++ show v
|
||||
|
||||
instance (MonadThunk (NValue m) (NThunk m) m,
|
||||
Framed e m, MonadVar m, MonadFile m)
|
||||
=> FromNix (NThunk m) m (NValue m) where
|
||||
=> FromValue (NThunk m) m (NValue m) where
|
||||
fromNixMay = pure . Just . value @_ @_ @m
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Expected a thunk, but saw: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m, MonadEffects m)
|
||||
=> FromNix A.Value m (NValueNF m) where
|
||||
=> FromValue A.Value m (NValueNF m) where
|
||||
fromNixMay = \case
|
||||
Fix (NVConstant a) -> pure $ Just $ case a of
|
||||
NInt n -> toJSON n
|
||||
|
|
@ -273,117 +273,117 @@ instance (Framed e m, MonadVar m, MonadFile m, MonadEffects m)
|
|||
Fix NVClosure {} -> pure Nothing
|
||||
Fix (NVPath p) -> Just . toJSON . unStorePath <$> addPath p
|
||||
Fix (NVBuiltin _ _) -> pure Nothing
|
||||
fromNix = fromNixMay >=> \case
|
||||
fromValue = fromNixMay >=> \case
|
||||
Just b -> pure b
|
||||
v -> throwError $ "Cannot convert value to JSON: " ++ show v
|
||||
|
||||
instance (Framed e m, MonadVar m, MonadFile m,
|
||||
MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
|
||||
=> FromNix A.Value m (NValue m) where
|
||||
=> FromValue A.Value m (NValue m) where
|
||||
fromNixMay = normalForm >=> fromNixMay
|
||||
fromNix = normalForm >=> fromNix
|
||||
fromValue = normalForm >=> fromValue
|
||||
|
||||
class ToNix a m v where
|
||||
toNix :: a -> m v
|
||||
class ToValue a m v where
|
||||
toValue :: a -> m v
|
||||
|
||||
instance Applicative m => ToNix Bool m (NValueNF m) where
|
||||
toNix = pure . Fix . NVConstant . NBool
|
||||
instance Applicative m => ToValue Bool m (NValueNF m) where
|
||||
toValue = pure . Fix . NVConstant . NBool
|
||||
|
||||
instance Applicative m => ToNix Bool m (NValue m) where
|
||||
toNix = pure . NVConstant . NBool
|
||||
instance Applicative m => ToValue Bool m (NValue m) where
|
||||
toValue = pure . NVConstant . NBool
|
||||
|
||||
instance Applicative m => ToNix Int m (NValueNF m) where
|
||||
toNix = pure . Fix . NVConstant . NInt . toInteger
|
||||
instance Applicative m => ToValue Int m (NValueNF m) where
|
||||
toValue = pure . Fix . NVConstant . NInt . toInteger
|
||||
|
||||
instance Applicative m => ToNix Int m (NValue m) where
|
||||
toNix = pure . NVConstant . NInt . toInteger
|
||||
instance Applicative m => ToValue Int m (NValue m) where
|
||||
toValue = pure . NVConstant . NInt . toInteger
|
||||
|
||||
instance Applicative m => ToNix Integer m (NValueNF m) where
|
||||
toNix = pure . Fix . NVConstant . NInt
|
||||
instance Applicative m => ToValue Integer m (NValueNF m) where
|
||||
toValue = pure . Fix . NVConstant . NInt
|
||||
|
||||
instance Applicative m => ToNix Integer m (NValue m) where
|
||||
toNix = pure . NVConstant . NInt
|
||||
instance Applicative m => ToValue Integer m (NValue m) where
|
||||
toValue = pure . NVConstant . NInt
|
||||
|
||||
instance Applicative m => ToNix Float m (NValueNF m) where
|
||||
toNix = pure . Fix . NVConstant . NFloat
|
||||
instance Applicative m => ToValue Float m (NValueNF m) where
|
||||
toValue = pure . Fix . NVConstant . NFloat
|
||||
|
||||
instance Applicative m => ToNix Float m (NValue m) where
|
||||
toNix = pure . NVConstant . NFloat
|
||||
instance Applicative m => ToValue Float m (NValue m) where
|
||||
toValue = pure . NVConstant . NFloat
|
||||
|
||||
instance Applicative m => ToNix Text m (NValueNF m) where
|
||||
toNix = pure . Fix . flip NVStr mempty
|
||||
instance Applicative m => ToValue Text m (NValueNF m) where
|
||||
toValue = pure . Fix . flip NVStr mempty
|
||||
|
||||
instance Applicative m => ToNix Text m (NValue m) where
|
||||
toNix = pure . flip NVStr mempty
|
||||
instance Applicative m => ToValue Text m (NValue m) where
|
||||
toValue = pure . flip NVStr mempty
|
||||
|
||||
instance Applicative m => ToNix ByteString m (NValueNF m) where
|
||||
toNix = pure . Fix . flip NVStr mempty . decodeUtf8
|
||||
instance Applicative m => ToValue ByteString m (NValueNF m) where
|
||||
toValue = pure . Fix . flip NVStr mempty . decodeUtf8
|
||||
|
||||
instance Applicative m => ToNix ByteString m (NValue m) where
|
||||
toNix = pure . flip NVStr mempty . decodeUtf8
|
||||
instance Applicative m => ToValue ByteString m (NValue m) where
|
||||
toValue = pure . flip NVStr mempty . decodeUtf8
|
||||
|
||||
instance Applicative m => ToNix Path m (NValueNF m) where
|
||||
toNix = pure . Fix . NVPath . getPath
|
||||
instance Applicative m => ToValue Path m (NValueNF m) where
|
||||
toValue = pure . Fix . NVPath . getPath
|
||||
|
||||
instance Applicative m => ToNix Path m (NValue m) where
|
||||
toNix = pure . NVPath . getPath
|
||||
instance Applicative m => ToValue Path m (NValue m) where
|
||||
toValue = pure . NVPath . getPath
|
||||
|
||||
instance MonadThunk (NValue m) (NThunk m) m
|
||||
=> ToNix SourcePos m (NValue m) where
|
||||
toNix (SourcePos f l c) = do
|
||||
f' <- toNix @_ @_ @(NValue m) (Text.pack f)
|
||||
l' <- toNix (unPos l)
|
||||
c' <- toNix (unPos c)
|
||||
=> ToValue SourcePos m (NValue m) where
|
||||
toValue (SourcePos f l c) = do
|
||||
f' <- toValue @_ @_ @(NValue m) (Text.pack f)
|
||||
l' <- toValue (unPos l)
|
||||
c' <- toValue (unPos c)
|
||||
let pos = M.fromList
|
||||
[ ("file" :: Text, value @_ @_ @m f')
|
||||
, ("line", value @_ @_ @m l')
|
||||
, ("column", value @_ @_ @m c') ]
|
||||
pure $ NVSet pos mempty
|
||||
|
||||
instance (ToNix a m (NValueNF m), Applicative m)
|
||||
=> ToNix [a] m (NValueNF m) where
|
||||
toNix = fmap (Fix . NVList) . traverse toNix
|
||||
instance (ToValue a m (NValueNF m), Applicative m)
|
||||
=> ToValue [a] m (NValueNF m) where
|
||||
toValue = fmap (Fix . NVList) . traverse toValue
|
||||
|
||||
-- instance Applicative m => (MonadThunk (NValue m) (NThunk m) m,
|
||||
-- ToNix a m (NValue m)) => ToNix [a] m (NValue m) where
|
||||
-- toNix = pure . NVList . fmap toNix
|
||||
-- ToValue a m (NValue m)) => ToValue [a] m (NValue m) where
|
||||
-- toValue = pure . NVList . fmap toValue
|
||||
|
||||
instance Applicative m => ToNix [NThunk m] m (NValue m) where
|
||||
toNix = pure . NVList
|
||||
instance Applicative m => ToValue [NThunk m] m (NValue m) where
|
||||
toValue = pure . NVList
|
||||
|
||||
instance Applicative m
|
||||
=> ToNix (HashMap Text (NValueNF m)) m (NValueNF m) where
|
||||
toNix = pure . Fix . flip NVSet M.empty
|
||||
=> ToValue (HashMap Text (NValueNF m)) m (NValueNF m) where
|
||||
toValue = pure . Fix . flip NVSet M.empty
|
||||
|
||||
-- instance Applicative m => (MonadThunk (NValue m) (NThunk m) m,
|
||||
-- ToNix a m (NValue m))
|
||||
-- => ToNix (HashMap Text a) m (NValue m) where
|
||||
-- toNix = pure . flip NVSet M.empty . fmap toNix
|
||||
-- ToValue a m (NValue m))
|
||||
-- => ToValue (HashMap Text a) m (NValue m) where
|
||||
-- toValue = pure . flip NVSet M.empty . fmap toValue
|
||||
|
||||
instance Applicative m => ToNix (HashMap Text (NThunk m)) m (NValue m) where
|
||||
toNix = pure . flip NVSet M.empty
|
||||
instance Applicative m => ToValue (HashMap Text (NThunk m)) m (NValue m) where
|
||||
toValue = pure . flip NVSet M.empty
|
||||
|
||||
instance Applicative m => ToNix (HashMap Text (NValueNF m),
|
||||
instance Applicative m => ToValue (HashMap Text (NValueNF m),
|
||||
HashMap Text SourcePos) m (NValueNF m) where
|
||||
toNix (s, p) = pure $ Fix $ NVSet s p
|
||||
toValue (s, p) = pure $ Fix $ NVSet s p
|
||||
|
||||
instance Applicative m => ToNix (HashMap Text (NThunk m),
|
||||
instance Applicative m => ToValue (HashMap Text (NThunk m),
|
||||
HashMap Text SourcePos) m (NValue m) where
|
||||
toNix (s, p) = pure $ NVSet s p
|
||||
toValue (s, p) = pure $ NVSet s p
|
||||
|
||||
instance (MonadThunk (NValue m) (NThunk m) m, ToNix a m (NValue m))
|
||||
=> ToNix a m (NThunk m) where
|
||||
toNix = fmap (value @(NValue m) @_ @m) . toNix
|
||||
instance (MonadThunk (NValue m) (NThunk m) m, ToValue a m (NValue m))
|
||||
=> ToValue a m (NThunk m) where
|
||||
toValue = fmap (value @(NValue m) @_ @m) . toValue
|
||||
|
||||
instance Applicative m => ToNix Bool m (NExprF r) where
|
||||
toNix = pure . NConstant . NBool
|
||||
instance Applicative m => ToValue Bool m (NExprF r) where
|
||||
toValue = pure . NConstant . NBool
|
||||
|
||||
instance MonadThunk (NValue m) (NThunk m) m
|
||||
=> ToNix A.Value m (NValue m) where
|
||||
toNix = \case
|
||||
=> ToValue A.Value m (NValue m) where
|
||||
toValue = \case
|
||||
A.Object m -> flip NVSet M.empty
|
||||
<$> traverse (thunk . toNix @_ @_ @(NValue m)) m
|
||||
A.Array l -> NVList <$> traverse (thunk . toNix) (V.toList l)
|
||||
<$> traverse (thunk . toValue @_ @_ @(NValue m)) m
|
||||
A.Array l -> NVList <$> traverse (thunk . toValue) (V.toList l)
|
||||
A.String s -> pure $ NVStr s mempty
|
||||
A.Number n -> pure $ NVConstant $ case floatingOrInteger n of
|
||||
Left r -> NFloat r
|
||||
|
|
|
|||
|
|
@ -74,10 +74,10 @@ class (Show v, Monoid (MText v), Monad m) => MonadEval v m | v -> m where
|
|||
type MonadNixEval e v t m =
|
||||
(MonadEval v m, Scoped e t m, MonadThunk v t m, MonadFix m,
|
||||
Framed e m, MonadFile m, MonadVar m,
|
||||
ToNix Bool m v, ToNix [t] m v,
|
||||
ToNix (AttrSet t) m v, FromNix (AttrSet t) m v,
|
||||
ToNix (AttrSet t, AttrSet SourcePos) m v,
|
||||
FromNix (AttrSet t, AttrSet SourcePos) m v)
|
||||
ToValue Bool m v, ToValue [t] m v,
|
||||
ToValue (AttrSet t) m v, FromValue (AttrSet t) m v,
|
||||
ToValue (AttrSet t, AttrSet SourcePos) m v,
|
||||
FromValue (AttrSet t, AttrSet SourcePos) m v)
|
||||
|
||||
-- | Evaluate an nix expression, with a given NThunkSet as environment
|
||||
evalExpr :: MonadNixEval e v t m => NExpr -> m v
|
||||
|
|
@ -117,27 +117,27 @@ eval (NSelect aset attr alt) = do
|
|||
|
||||
eval (NHasAttr aset attr) = do
|
||||
traceM "NHasAttr"
|
||||
toNix . either (const False) (const True)
|
||||
toValue . either (const False) (const True)
|
||||
=<< evalSelect aset attr
|
||||
|
||||
eval (NList l) = do
|
||||
traceM "NList"
|
||||
scope <- currentScopes
|
||||
toNix =<< for l (thunk . withScopes @t scope)
|
||||
toValue =<< for l (thunk . withScopes @t scope)
|
||||
|
||||
eval (NSet binds) = do
|
||||
traceM "NSet..1"
|
||||
(s, p) <- evalBinds True False binds
|
||||
traceM $ "NSet..2: s = " ++ show (void s)
|
||||
traceM $ "NSet..2: p = " ++ show (void p)
|
||||
toNix (s, p)
|
||||
toValue (s, p)
|
||||
|
||||
eval (NRecSet binds) = do
|
||||
traceM "NRecSet..1"
|
||||
(s, p) <- evalBinds True True binds
|
||||
traceM $ "NRecSet..2: s = " ++ show (void s)
|
||||
traceM $ "NRecSet..2: p = " ++ show (void p)
|
||||
toNix (s, p)
|
||||
toValue (s, p)
|
||||
|
||||
eval (NLet binds e) = do
|
||||
traceM "Let..1"
|
||||
|
|
@ -185,7 +185,7 @@ attrSetAlter (p:ps) m val = case M.lookup p m of
|
|||
|
||||
-- jww (2018-04-13): Need to record positions for attr paths as well
|
||||
recurse s = attrSetAlter ps s val <&> \m' ->
|
||||
M.insert p (toNix =<< fmap (value @_ @_ @m) <$> sequence m') m
|
||||
M.insert p (toValue =<< fmap (value @_ @_ @m) <$> sequence m') m
|
||||
|
||||
evalBinds :: forall e v t m. MonadNixEval e v t m
|
||||
=> Bool
|
||||
|
|
@ -216,7 +216,7 @@ evalBinds allowDynamic recursive binds = do
|
|||
h : t -> evalSetterKeyName allowDynamic h >>= \case
|
||||
(Nothing, _) ->
|
||||
pure ([], Nothing,
|
||||
toNix (mempty :: AttrSet t))
|
||||
toValue (mempty :: AttrSet t))
|
||||
(Just k, pos) -> do
|
||||
(restOfPath, _, v) <- go t
|
||||
pure (k : restOfPath, pos, v)
|
||||
|
|
@ -272,7 +272,7 @@ evalSelect aset attr =
|
|||
extract x (k:ks) = fromNixMay x >>= \case
|
||||
Just (s :: AttrSet t, p :: AttrSet SourcePos) -> case M.lookup k s of
|
||||
Just v -> force v $ extract ?? ks
|
||||
Nothing -> Left . (, k:ks) <$> toNix (s, p)
|
||||
Nothing -> Left . (, k:ks) <$> toValue (s, p)
|
||||
Nothing -> return $ Left (x, k:ks)
|
||||
|
||||
evalSelector :: MonadEval v m
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ instance MonadNix e m => MonadEval (NValue m) m where
|
|||
Compose (Ann (SrcSpan delta _) _):_ <-
|
||||
asks (mapMaybe (either (const Nothing) Just)
|
||||
. view @_ @Frames hasLens)
|
||||
toNix delta
|
||||
toValue delta
|
||||
|
||||
evalConstant = pure . NVConstant
|
||||
evalString = pure . uncurry NVStr
|
||||
|
|
@ -198,82 +198,82 @@ execBinaryOp op larg rarg = do
|
|||
-> NAtom -> NAtom -> m (NValue m)
|
||||
numBinOp' intF floatF l r = case (l, r) of
|
||||
(NInt li, NInt ri) ->
|
||||
toNix $ li `intF` ri
|
||||
toValue $ li `intF` ri
|
||||
(NInt li, NFloat rf) ->
|
||||
toNix $ fromInteger li `floatF` rf
|
||||
toValue $ fromInteger li `floatF` rf
|
||||
(NFloat lf, NInt ri) ->
|
||||
toNix $ lf `floatF` fromInteger ri
|
||||
toValue $ lf `floatF` fromInteger ri
|
||||
(NFloat lf, NFloat rf) ->
|
||||
toNix $ lf `floatF` rf
|
||||
toValue $ lf `floatF` rf
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
nverr = evalError @(NValue m)
|
||||
|
||||
case (lval, rval) of
|
||||
(NVConstant lc, NVConstant rc) -> case (op, lc, rc) of
|
||||
(NEq, _, _) -> toNix =<< valueEq lval rval
|
||||
(NNEq, _, _) -> toNix . not =<< valueEq lval rval
|
||||
(NLt, l, r) -> toNix $ l < r
|
||||
(NLte, l, r) -> toNix $ l <= r
|
||||
(NGt, l, r) -> toNix $ l > r
|
||||
(NGte, l, r) -> toNix $ l >= r
|
||||
(NEq, _, _) -> toValue =<< valueEq lval rval
|
||||
(NNEq, _, _) -> toValue . not =<< valueEq lval rval
|
||||
(NLt, l, r) -> toValue $ l < r
|
||||
(NLte, l, r) -> toValue $ l <= r
|
||||
(NGt, l, r) -> toValue $ l > r
|
||||
(NGte, l, r) -> toValue $ l >= r
|
||||
(NAnd, _, _) -> nverr "should be impossible: && is handled above"
|
||||
(NOr, _, _) -> nverr "should be impossible: || is handled above"
|
||||
(NPlus, l, r) -> numBinOp (+) l r
|
||||
(NMinus, l, r) -> numBinOp (-) l r
|
||||
(NMult, l, r) -> numBinOp (*) l r
|
||||
(NDiv, l, r) -> numBinOp' div (/) l r
|
||||
(NImpl, NBool l, NBool r) -> toNix $ not l || r
|
||||
(NImpl, NBool l, NBool r) -> toValue $ not l || r
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVStr ls lc, NVStr rs rc) -> case op of
|
||||
NPlus -> pure $ NVStr (ls `mappend` rs) (lc `mappend` rc)
|
||||
NEq -> toNix =<< valueEq lval rval
|
||||
NNEq -> toNix . not =<< valueEq lval rval
|
||||
NLt -> toNix $ ls < rs
|
||||
NLte -> toNix $ ls <= rs
|
||||
NGt -> toNix $ ls > rs
|
||||
NGte -> toNix $ ls >= rs
|
||||
NEq -> toValue =<< valueEq lval rval
|
||||
NNEq -> toValue . not =<< valueEq lval rval
|
||||
NLt -> toValue $ ls < rs
|
||||
NLte -> toValue $ ls <= rs
|
||||
NGt -> toValue $ ls > rs
|
||||
NGte -> toValue $ ls >= rs
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVStr _ _, NVConstant NNull) -> case op of
|
||||
NEq -> toNix =<< valueEq lval (NVStr "" mempty)
|
||||
NNEq -> toNix . not =<< valueEq lval (NVStr "" mempty)
|
||||
NEq -> toValue =<< valueEq lval (NVStr "" mempty)
|
||||
NNEq -> toValue . not =<< valueEq lval (NVStr "" mempty)
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVConstant NNull, NVStr _ _) -> case op of
|
||||
NEq -> toNix =<< valueEq (NVStr "" mempty) rval
|
||||
NNEq -> toNix . not =<< valueEq (NVStr "" mempty) rval
|
||||
NEq -> toValue =<< valueEq (NVStr "" mempty) rval
|
||||
NNEq -> toValue . not =<< valueEq (NVStr "" mempty) rval
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVSet ls lp, NVSet rs rp) -> case op of
|
||||
NUpdate -> pure $ NVSet (rs `M.union` ls) (rp `M.union` lp)
|
||||
NEq -> toNix =<< valueEq lval rval
|
||||
NNEq -> toNix . not =<< valueEq lval rval
|
||||
NEq -> toValue =<< valueEq lval rval
|
||||
NNEq -> toValue . not =<< valueEq lval rval
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVList ls, NVList rs) -> case op of
|
||||
NConcat -> pure $ NVList $ ls ++ rs
|
||||
NEq -> toNix =<< valueEq lval rval
|
||||
NNEq -> toNix . not =<< valueEq lval rval
|
||||
NEq -> toValue =<< valueEq lval rval
|
||||
NNEq -> toValue . not =<< valueEq lval rval
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVList ls, NVConstant NNull) -> case op of
|
||||
NConcat -> pure $ NVList ls
|
||||
NEq -> toNix =<< valueEq lval (NVList [])
|
||||
NNEq -> toNix . not =<< valueEq lval (NVList [])
|
||||
NEq -> toValue =<< valueEq lval (NVList [])
|
||||
NNEq -> toValue . not =<< valueEq lval (NVList [])
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVConstant NNull, NVList rs) -> case op of
|
||||
NConcat -> pure $ NVList rs
|
||||
NEq -> toNix =<< valueEq (NVList []) rval
|
||||
NNEq -> toNix . not =<< valueEq (NVList []) rval
|
||||
NEq -> toValue =<< valueEq (NVList []) rval
|
||||
NNEq -> toValue . not =<< valueEq (NVList []) rval
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
(NVPath p, NVStr s _) -> case op of
|
||||
-- jww (2018-04-13): Do we need to make the path absolute here?
|
||||
NEq -> toNix $ p == Text.unpack s
|
||||
NNEq -> toNix $ p /= Text.unpack s
|
||||
NEq -> toValue $ p == Text.unpack s
|
||||
NNEq -> toValue $ p /= Text.unpack s
|
||||
NPlus -> NVPath <$> makeAbsolutePath (p `mappend` Text.unpack s)
|
||||
_ -> nverr unsupportedTypes
|
||||
|
||||
|
|
@ -440,7 +440,7 @@ findEnvPathM name = do
|
|||
mres <- lookupVar @_ @(NThunk m) "__nixPath"
|
||||
mpath <- case mres of
|
||||
Nothing -> error "impossible"
|
||||
Just x -> force x $ fromNix >=> \(l :: [NThunk m]) ->
|
||||
Just x -> force x $ fromValue >=> \(l :: [NThunk m]) ->
|
||||
foldM go Nothing l
|
||||
case mpath of
|
||||
Nothing ->
|
||||
|
|
@ -451,9 +451,9 @@ findEnvPathM name = do
|
|||
where
|
||||
go :: Maybe FilePath -> NThunk m -> m (Maybe FilePath)
|
||||
go p@(Just _) _ = pure p
|
||||
go Nothing l = force l $ fromNix >=> \(s :: HashMap Text (NThunk m)) ->
|
||||
go Nothing l = force l $ fromValue >=> \(s :: HashMap Text (NThunk m)) ->
|
||||
case M.lookup "path" s of
|
||||
Just p -> force p $ fromNix >=> \(Path path) ->
|
||||
Just p -> force p $ fromValue >=> \(Path path) ->
|
||||
case M.lookup "prefix" s of
|
||||
Nothing -> tryPath path Nothing
|
||||
Just pf -> force pf $ fromNixMay >=> \case
|
||||
|
|
|
|||
|
|
@ -241,17 +241,17 @@ unify context (Symbolic x) (Symbolic y) = do
|
|||
writeVar y (NMany m)
|
||||
packSymbolic (NMany m)
|
||||
|
||||
instance FromNix (AttrSet (SThunk m)) m (Symbolic m) where
|
||||
instance FromValue (AttrSet (SThunk m)) m (Symbolic m) where
|
||||
|
||||
instance FromNix (AttrSet (SThunk m), AttrSet SourcePos) m (Symbolic m) where
|
||||
instance FromValue (AttrSet (SThunk m), AttrSet SourcePos) m (Symbolic m) where
|
||||
|
||||
instance ToNix (AttrSet (SThunk m)) m (Symbolic m) where
|
||||
instance ToValue (AttrSet (SThunk m)) m (Symbolic m) where
|
||||
|
||||
instance ToNix (AttrSet (SThunk m), AttrSet SourcePos) m (Symbolic m) where
|
||||
instance ToValue (AttrSet (SThunk m), AttrSet SourcePos) m (Symbolic m) where
|
||||
|
||||
instance ToNix [SThunk m] m (Symbolic m) where
|
||||
instance ToValue [SThunk m] m (Symbolic m) where
|
||||
|
||||
instance ToNix Bool m (Symbolic m) where
|
||||
instance ToValue Bool m (Symbolic m) where
|
||||
|
||||
instance MonadLint e m => MonadThunk (Symbolic m) (SThunk m) m where
|
||||
thunk = fmap coerce . buildThunk
|
||||
|
|
|
|||
Loading…
Reference in a new issue