Get most of Builtins.hs type checking again
This commit is contained in:
John Wiegley
parent
483dded8db
commit
c9f4e40ec0
|
|
@ -32,7 +32,7 @@ import Control.Monad.Reader (asks)
|
|||
-- us to put the hashing package in the unconditional dependency list.
|
||||
-- See https://github.com/NixOS/cabal2nix/issues/348 for more info
|
||||
#if MIN_VERSION_hashing(0, 1, 0)
|
||||
import qualified "hashing" Crypto.Hash
|
||||
import "hashing" Crypto.Hash
|
||||
import qualified "hashing" Crypto.Hash.MD5 as MD5
|
||||
import qualified "hashing" Crypto.Hash.SHA1 as SHA1
|
||||
import qualified "hashing" Crypto.Hash.SHA256 as SHA256
|
||||
|
|
@ -95,24 +95,40 @@ import System.Posix.Files (isRegularFile, isDirectory, isSymbolicLink)
|
|||
import Text.Read
|
||||
import Text.Regex.TDFA
|
||||
|
||||
-- | This constraint synonym establishes all the ways in which we must be able
|
||||
-- to relate different Haskell values to the thunk representation that will
|
||||
-- be chosen by the caller.
|
||||
type MonadBuiltins e t f m =
|
||||
( MonadNix e t f m
|
||||
, FromValue NixString m t
|
||||
, FromValue Path m t
|
||||
, FromValue [t] m t
|
||||
, FromValue (M.HashMap Text t) m t
|
||||
, ToValue NixString m t
|
||||
, ToValue Int m t
|
||||
, ToValue () m t
|
||||
, FromNix [NixString] m t
|
||||
, ToNix t m (NValue t f m)
|
||||
)
|
||||
|
||||
-- | Evaluate a nix expression in the default context
|
||||
withNixContext :: forall e t f m r. (MonadNix e t f m, Has e Options)
|
||||
withNixContext :: forall e t f m r. (MonadBuiltins e t f m, Has e Options)
|
||||
=> Maybe FilePath -> m r -> m r
|
||||
withNixContext mpath action = do
|
||||
base <- builtins
|
||||
opts :: Options <- asks (view hasLens)
|
||||
let i = wrapValue @(NValue t f m) @t @m $ nvList $
|
||||
map (wrapValue @(NValue t f m) @t @m
|
||||
let i = wrapValue @t @m @(NValue t f m) $ nvList $
|
||||
map (wrapValue @t @m @(NValue t f m)
|
||||
. nvStr . hackyMakeNixStringWithoutContext . Text.pack) (include opts)
|
||||
pushScope (M.singleton "__includes" i) $
|
||||
pushScopes base $ case mpath of
|
||||
Nothing -> action
|
||||
Just path -> do
|
||||
traceM $ "Setting __cur_file = " ++ show path
|
||||
let ref = wrapValue @(NValue t f m) @t @m $ nvPath path
|
||||
let ref = wrapValue @t @m @(NValue t f m) $ nvPath path
|
||||
pushScope (M.singleton "__cur_file" ref) action
|
||||
|
||||
builtins :: (MonadNix e t f m, Scoped t m)
|
||||
builtins :: (MonadBuiltins e t f m, Scoped t m)
|
||||
=> m (Scopes m t)
|
||||
builtins = do
|
||||
ref <- thunk $ flip nvSet M.empty <$> buildMap
|
||||
|
|
@ -134,13 +150,13 @@ data Builtin t = Builtin
|
|||
, mapping :: (Text, t)
|
||||
}
|
||||
|
||||
valueThunk :: forall e t f m. MonadNix e t f m => NValue t f m -> t
|
||||
valueThunk = wrapValue @_ @_ @m
|
||||
valueThunk :: forall e t f m. MonadBuiltins e t f m => NValue t f m -> t
|
||||
valueThunk = wrapValue @_ @m
|
||||
|
||||
force' :: forall e t f m. MonadNix e t f m => t -> m (NValue t f m)
|
||||
force' :: forall e t f m. MonadBuiltins e t f m => t -> m (NValue t f m)
|
||||
force' = force ?? pure
|
||||
|
||||
builtinsList :: forall e t f m. MonadNix e t f m => m [Builtin t]
|
||||
builtinsList :: forall e t f m. MonadBuiltins e t f m => m [Builtin t]
|
||||
builtinsList = sequence [
|
||||
do version <- toValue (principledMakeNixStringWithoutContext "2.0")
|
||||
pure $ Builtin Normal ("nixVersion", version)
|
||||
|
|
@ -288,12 +304,12 @@ builtinsList = sequence [
|
|||
add2 t n v = wrap t n <$> mkThunk n (builtin2 (Text.unpack n) v)
|
||||
add3 t n v = wrap t n <$> mkThunk n (builtin3 (Text.unpack n) v)
|
||||
|
||||
add' :: ToBuiltin t m a => BuiltinType -> Text -> a -> m (Builtin t)
|
||||
add' :: ToBuiltin t f m a => BuiltinType -> Text -> a -> m (Builtin t)
|
||||
add' t n v = wrap t n <$> mkThunk n (toBuiltin (Text.unpack n) v)
|
||||
|
||||
-- Primops
|
||||
|
||||
foldNixPath :: forall e t f m r. MonadNix e t f m
|
||||
foldNixPath :: forall e t f m r. MonadBuiltins e t f m
|
||||
=> (FilePath -> Maybe String -> NixPathEntryType -> r -> m r) -> r -> m r
|
||||
foldNixPath f z = do
|
||||
mres <- lookupVar "__includes"
|
||||
|
|
@ -313,7 +329,7 @@ foldNixPath f z = do
|
|||
[n, p] -> f (Text.unpack p) (Just (Text.unpack n)) ty rest
|
||||
_ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " ++ show x
|
||||
|
||||
nixPath :: MonadNix e t f m => m (NValue t f m)
|
||||
nixPath :: MonadBuiltins e t f m => m (NValue t f m)
|
||||
nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
|
||||
pure $ valueThunk
|
||||
(flip nvSet mempty $ M.fromList
|
||||
|
|
@ -323,32 +339,32 @@ nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
|
|||
, ("prefix", valueThunk $
|
||||
nvStr (hackyMakeNixStringWithoutContext $ Text.pack (fromMaybe "" mn))) ]) : rest
|
||||
|
||||
toString :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toString :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toString str = str >>= coerceToString DontCopyToStore CoerceAny >>= toNix
|
||||
|
||||
hasAttr :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
hasAttr :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
hasAttr x y =
|
||||
fromValue x >>= fromStringNoContext >>= \key ->
|
||||
fromValue @(AttrSet t, AttrSet SourcePos) y >>= \(aset, _) ->
|
||||
toNix $ M.member key aset
|
||||
|
||||
attrsetGet :: MonadNix e t f m => Text -> AttrSet t -> m t
|
||||
attrsetGet :: MonadBuiltins e t f m => Text -> AttrSet t -> m t
|
||||
attrsetGet k s = case M.lookup k s of
|
||||
Just v -> pure v
|
||||
Nothing ->
|
||||
throwError $ ErrorCall $ "Attribute '" ++ Text.unpack k ++ "' required"
|
||||
|
||||
hasContext :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
hasContext :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
hasContext =
|
||||
toNix . stringHasContext <=< fromValue
|
||||
|
||||
getAttr :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
getAttr :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
getAttr x y =
|
||||
fromValue x >>= fromStringNoContext >>= \key ->
|
||||
fromValue @(AttrSet t, AttrSet SourcePos) y >>= \(aset, _) ->
|
||||
attrsetGet key aset >>= force'
|
||||
|
||||
unsafeGetAttrPos :: forall e t f m. MonadNix e t f m
|
||||
unsafeGetAttrPos :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVStr ns, NVSet _ apos) -> case M.lookup (hackyStringIgnoreContext ns) apos of
|
||||
|
|
@ -359,10 +375,10 @@ unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
|||
|
||||
-- This function is a bit special in that it doesn't care about the contents
|
||||
-- of the list.
|
||||
length_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
length_ :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
length_ = toValue . (length :: [t] -> Int) <=< fromValue
|
||||
|
||||
add_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
add_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
add_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVConstant (NInt x), NVConstant (NInt y)) ->
|
||||
toNix ( x + y :: Integer)
|
||||
|
|
@ -372,7 +388,7 @@ add_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
|||
(_, _) ->
|
||||
throwError $ Addition x' y'
|
||||
|
||||
mul_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
mul_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
mul_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVConstant (NInt x), NVConstant (NInt y)) ->
|
||||
toNix ( x * y :: Integer)
|
||||
|
|
@ -382,7 +398,7 @@ mul_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
|||
(_, _) ->
|
||||
throwError $ Multiplication x' y'
|
||||
|
||||
div_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
div_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
div_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVConstant (NInt x), NVConstant (NInt y)) | y /= 0 ->
|
||||
toNix (floor (fromInteger x / fromInteger y :: Double) :: Integer)
|
||||
|
|
@ -402,7 +418,7 @@ anyM p (x:xs) = do
|
|||
if q then return True
|
||||
else anyM p xs
|
||||
|
||||
any_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
any_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
any_ fun xs = fun >>= \f ->
|
||||
toNix <=< anyM fromValue <=< mapM ((f `callFunc`) . force')
|
||||
<=< fromValue $ xs
|
||||
|
|
@ -414,24 +430,24 @@ allM p (x:xs) = do
|
|||
if q then allM p xs
|
||||
else return False
|
||||
|
||||
all_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
all_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
all_ fun xs = fun >>= \f ->
|
||||
toNix <=< allM fromValue <=< mapM ((f `callFunc`) . force')
|
||||
<=< fromValue $ xs
|
||||
|
||||
foldl'_ :: forall e t f m. MonadNix e t f m
|
||||
foldl'_ :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
foldl'_ fun z xs =
|
||||
fun >>= \f -> fromValue @[t] xs >>= foldl' (go f) z
|
||||
where
|
||||
go f b a = f `callFunc` b >>= (`callFunc` force' a)
|
||||
|
||||
head_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
head_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
head_ = fromValue >=> \case
|
||||
[] -> throwError $ ErrorCall "builtins.head: empty list"
|
||||
h:_ -> force' h
|
||||
|
||||
tail_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
tail_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
tail_ = fromValue >=> \case
|
||||
[] -> throwError $ ErrorCall "builtins.tail: empty list"
|
||||
_:t -> return $ nvList t
|
||||
|
|
@ -467,7 +483,7 @@ splitVersion s = case Text.uncons s of
|
|||
x -> VersionComponent_String x
|
||||
in thisComponent : splitVersion rest
|
||||
|
||||
splitVersion_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
splitVersion_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
splitVersion_ = fromValue >=> fromStringNoContext >=> \s ->
|
||||
return $ nvList $ flip map (splitVersion s) $ \c ->
|
||||
valueThunk $ nvStr $ principledMakeNixStringWithoutContext $ versionComponentToString c
|
||||
|
|
@ -479,7 +495,7 @@ compareVersions s1 s2 =
|
|||
z = VersionComponent_String ""
|
||||
f = uncurry compare . fromThese z z
|
||||
|
||||
compareVersions_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
compareVersions_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
compareVersions_ t1 t2 =
|
||||
fromValue t1 >>= fromStringNoContext >>= \s1 ->
|
||||
fromValue t2 >>= fromStringNoContext >>= \s2 ->
|
||||
|
|
@ -507,19 +523,19 @@ splitDrvName s =
|
|||
breakAfterFirstItem isFirstVersionPiece pieces
|
||||
in (Text.intercalate sep namePieces, Text.intercalate sep versionPieces)
|
||||
|
||||
parseDrvName :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
parseDrvName :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
parseDrvName = fromValue >=> fromStringNoContext >=> \s -> do
|
||||
let (name :: Text, version :: Text) = splitDrvName s
|
||||
-- jww (2018-04-15): There should be an easier way to write this.
|
||||
(toValue =<<) $ sequence $ M.fromList
|
||||
[ ("name" :: Text,
|
||||
thunk @_ @t
|
||||
thunk @t
|
||||
(toValue $ principledMakeNixStringWithoutContext name))
|
||||
, ("version",
|
||||
thunk @_ @t
|
||||
thunk @t
|
||||
(toValue $ principledMakeNixStringWithoutContext version)) ]
|
||||
|
||||
match_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
match_ :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
match_ pat str =
|
||||
fromValue pat >>= fromStringNoContext >>= \p ->
|
||||
fromValue str >>= \ns -> do
|
||||
|
|
@ -540,7 +556,7 @@ match_ pat str =
|
|||
(if length s > 1 then tail s else s)
|
||||
_ -> pure $ nvConstant NNull
|
||||
|
||||
split_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
split_ :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
split_ pat str =
|
||||
fromValue pat >>= fromStringNoContext >>= \p ->
|
||||
fromValue str >>= \ns -> do
|
||||
|
|
@ -555,7 +571,7 @@ split_ pat str =
|
|||
splitMatches 0 (map elems $ matchAllText re haystack) haystack
|
||||
|
||||
splitMatches
|
||||
:: forall e t f m. MonadNix e t f m
|
||||
:: forall e t f m. MonadBuiltins e t f m
|
||||
=> Int
|
||||
-> [[(ByteString, (Int, Int))]]
|
||||
-> ByteString
|
||||
|
|
@ -572,88 +588,88 @@ splitMatches numDropped (((_,(start,len)):captures):mts) haystack =
|
|||
|
||||
thunkStr s = valueThunk (nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s)))
|
||||
|
||||
substring :: MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString
|
||||
substring :: MonadBuiltins e t f m => Int -> Int -> NixString -> Prim m NixString
|
||||
substring start len str = Prim $
|
||||
if start < 0 --NOTE: negative values of 'len' are OK
|
||||
then throwError $ ErrorCall $ "builtins.substring: negative start position: " ++ show start
|
||||
else pure $ principledModifyNixContents (Text.take len . Text.drop start) str
|
||||
|
||||
attrNames :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
attrNames :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
attrNames = fromValue @(AttrSet t)
|
||||
>=> toNix . map principledMakeNixStringWithoutContext . sort . M.keys
|
||||
|
||||
attrValues :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
attrValues :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
attrValues = fromValue @(AttrSet t) >=>
|
||||
toValue . fmap snd . sortOn (fst @Text @t) . M.toList
|
||||
|
||||
map_ :: forall e t f m. MonadNix e t f m
|
||||
map_ :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
map_ fun xs = fun >>= \f ->
|
||||
toNix <=< traverse (thunk @_ @t . withFrame Debug
|
||||
(ErrorCall "While applying f in map:\n")
|
||||
. (f `callFunc`) . force')
|
||||
toNix <=< traverse (thunk @t . withFrame Debug
|
||||
(ErrorCall "While applying f in map:\n")
|
||||
. (f `callFunc`) . force')
|
||||
<=< fromValue @[t] $ xs
|
||||
|
||||
mapAttrs_ :: forall e t f m. MonadNix e t f m
|
||||
mapAttrs_ :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
mapAttrs_ fun xs = fun >>= \f ->
|
||||
fromValue @(AttrSet t) xs >>= \aset -> do
|
||||
let pairs = M.toList aset
|
||||
values <- for pairs $ \(key, value) ->
|
||||
thunk @_ @t $
|
||||
thunk @t $
|
||||
withFrame Debug (ErrorCall "While applying f in mapAttrs:\n") $
|
||||
callFunc ?? force' value
|
||||
=<< callFunc f (pure (nvStr (principledMakeNixStringWithoutContext key)))
|
||||
toNix . M.fromList . zip (map fst pairs) $ values
|
||||
|
||||
filter_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
filter_ :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
filter_ fun xs = fun >>= \f ->
|
||||
toNix <=< filterM (fromValue <=< callFunc f . force')
|
||||
<=< fromValue @[t] $ xs
|
||||
|
||||
catAttrs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
catAttrs :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
catAttrs attrName xs =
|
||||
fromValue attrName >>= fromStringNoContext >>= \n ->
|
||||
fromValue @[t] xs >>= \l ->
|
||||
fmap (nvList . catMaybes) $
|
||||
forM l $ fmap (M.lookup n) . fromValue
|
||||
|
||||
baseNameOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
baseNameOf :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
baseNameOf x = do
|
||||
ns <- coerceToString DontCopyToStore CoerceStringy =<< x
|
||||
pure $ nvStr (principledModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)
|
||||
|
||||
bitAnd :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitAnd :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitAnd x y =
|
||||
fromValue @Integer x >>= \a ->
|
||||
fromValue @Integer y >>= \b -> toNix (a .&. b)
|
||||
|
||||
bitOr :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitOr :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitOr x y =
|
||||
fromValue @Integer x >>= \a ->
|
||||
fromValue @Integer y >>= \b -> toNix (a .|. b)
|
||||
|
||||
bitXor :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitXor :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
bitXor x y =
|
||||
fromValue @Integer x >>= \a ->
|
||||
fromValue @Integer y >>= \b -> toNix (a `xor` b)
|
||||
|
||||
dirOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
dirOf :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
dirOf x = x >>= \case
|
||||
NVStr ns -> pure $ nvStr (principledModifyNixContents (Text.pack . takeDirectory . Text.unpack) ns)
|
||||
NVPath path -> pure $ nvPath $ takeDirectory path
|
||||
v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v
|
||||
|
||||
-- jww (2018-04-28): This should only be a string argument, and not coerced?
|
||||
unsafeDiscardStringContext :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
unsafeDiscardStringContext :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
unsafeDiscardStringContext mnv = do
|
||||
ns <- fromValue mnv
|
||||
toNix $ principledMakeNixStringWithoutContext $ principledStringIgnoreContext ns
|
||||
|
||||
seq_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
seq_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
seq_ a b = a >> b
|
||||
|
||||
deepSeq :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
deepSeq :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
deepSeq a b = do
|
||||
-- We evaluate 'a' only for its effects, so data cycles are ignored.
|
||||
normalForm_ =<< a
|
||||
|
|
@ -663,7 +679,7 @@ deepSeq a b = do
|
|||
-- recursive data structures in Haskell).
|
||||
b
|
||||
|
||||
elem_ :: forall e t f m. MonadNix e t f m
|
||||
elem_ :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
elem_ x xs = x >>= \x' ->
|
||||
toValue <=< anyM (valueEq x' <=< force') <=< fromValue @[t] $ xs
|
||||
|
|
@ -673,23 +689,23 @@ elemAt ls i = case drop i ls of
|
|||
[] -> Nothing
|
||||
a:_ -> Just a
|
||||
|
||||
elemAt_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
elemAt_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
elemAt_ xs n = fromValue n >>= \n' -> fromValue xs >>= \xs' ->
|
||||
case elemAt xs' n' of
|
||||
Just a -> force' a
|
||||
Nothing -> throwError $ ErrorCall $ "builtins.elem: Index " ++ show n'
|
||||
++ " too large for list of length " ++ show (length xs')
|
||||
|
||||
genList :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
genList :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
genList generator = fromValue @Integer >=> \n ->
|
||||
if n >= 0
|
||||
then generator >>= \f ->
|
||||
toNix =<< forM [0 .. n - 1]
|
||||
(\i -> thunk @_ @t $ f `callFunc` toNix i)
|
||||
(\i -> thunk @t $ f `callFunc` toNix i)
|
||||
else throwError $ ErrorCall $ "builtins.genList: Expected a non-negative number, got "
|
||||
++ show n
|
||||
|
||||
genericClosure :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
genericClosure :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
genericClosure = fromValue @(AttrSet t) >=> \s ->
|
||||
case (M.lookup "startSet" s, M.lookup "operator" s) of
|
||||
(Nothing, Nothing) ->
|
||||
|
|
@ -726,7 +742,7 @@ genericClosure = fromValue @(AttrSet t) >=> \s ->
|
|||
j:_ -> checkComparable k' j
|
||||
fmap (t:) <$> go op (ts ++ ys) (S.insert k' ks)
|
||||
|
||||
replaceStrings :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
replaceStrings :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
replaceStrings tfrom tto ts =
|
||||
fromNix tfrom >>= \(nsFrom :: [NixString]) ->
|
||||
fromNix tto >>= \(nsTo :: [NixString]) ->
|
||||
|
|
@ -760,7 +776,7 @@ replaceStrings tfrom tto ts =
|
|||
_ -> go rest (result <> Builder.fromText replacement) (ctx <> newCtx)
|
||||
toNix $ go (principledStringIgnoreContext ns) mempty $ principledGetContext ns
|
||||
|
||||
removeAttrs :: forall e t f m. MonadNix e t f m
|
||||
removeAttrs :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
removeAttrs set = fromNix >=> \(nsToRemove :: [NixString]) ->
|
||||
fromValue @(AttrSet t,
|
||||
|
|
@ -770,7 +786,7 @@ removeAttrs set = fromNix >=> \(nsToRemove :: [NixString]) ->
|
|||
where
|
||||
go = foldl' (flip M.delete)
|
||||
|
||||
intersectAttrs :: forall e t f m. MonadNix e t f m
|
||||
intersectAttrs :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
intersectAttrs set1 set2 =
|
||||
fromValue @(AttrSet t,
|
||||
|
|
@ -779,7 +795,7 @@ intersectAttrs set1 set2 =
|
|||
AttrSet SourcePos) set2 >>= \(s2, p2) ->
|
||||
return $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1)
|
||||
|
||||
functionArgs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
functionArgs :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
functionArgs fun = fun >>= \case
|
||||
NVClosure p _ -> toValue @(AttrSet t) $
|
||||
valueThunk . nvConstant . NBool <$>
|
||||
|
|
@ -789,7 +805,7 @@ functionArgs fun = fun >>= \case
|
|||
v -> throwError $ ErrorCall $
|
||||
"builtins.functionArgs: expected function, got " ++ show v
|
||||
|
||||
toFile :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
toFile :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
toFile name s = do
|
||||
name' <- fromStringNoContext =<< fromValue name
|
||||
s' <- fromValue s
|
||||
|
|
@ -801,60 +817,60 @@ toFile name s = do
|
|||
sc = StringContext t DirectPath
|
||||
toNix $ principledMakeNixStringWithSingletonContext t sc
|
||||
|
||||
toPath :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toPath :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toPath = fromValue @Path >=> toNix @Path
|
||||
|
||||
pathExists_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
pathExists_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
pathExists_ path = path >>= \case
|
||||
NVPath p -> toNix =<< pathExists p
|
||||
NVStr ns -> toNix =<< pathExists (Text.unpack (hackyStringIgnoreContext ns))
|
||||
v -> throwError $ ErrorCall $
|
||||
"builtins.pathExists: expected path, got " ++ show v
|
||||
|
||||
hasKind :: forall a e t f m. (MonadNix e t f m, FromValue a m (NValue t f m))
|
||||
hasKind :: forall a e t f m. (MonadBuiltins e t f m, FromValue a m (NValue t f m))
|
||||
=> m (NValue t f m) -> m (NValue t f m)
|
||||
hasKind = fromValueMay >=> toNix . \case Just (_ :: a) -> True; _ -> False
|
||||
|
||||
isAttrs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isAttrs :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isAttrs = hasKind @(AttrSet t)
|
||||
|
||||
isList :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isList :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isList = hasKind @[t]
|
||||
|
||||
isString :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isString :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isString = hasKind @NixString
|
||||
|
||||
isInt :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isInt :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isInt = hasKind @Int
|
||||
|
||||
isFloat :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isFloat :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isFloat = hasKind @Float
|
||||
|
||||
isBool :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isBool :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isBool = hasKind @Bool
|
||||
|
||||
isNull :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isNull :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isNull = hasKind @()
|
||||
|
||||
isFunction :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isFunction :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
isFunction func = func >>= \case
|
||||
NVClosure {} -> toValue True
|
||||
_ -> toValue False
|
||||
|
||||
throw_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
throw_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
throw_ mnv = do
|
||||
ns <- coerceToString CopyToStore CoerceStringy =<< mnv
|
||||
throwError . ErrorCall . Text.unpack $ principledStringIgnoreContext ns
|
||||
|
||||
import_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
import_ :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
import_ = scopedImport (pure (nvSet M.empty M.empty))
|
||||
|
||||
scopedImport :: forall e t f m. MonadNix e t f m
|
||||
scopedImport :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
scopedImport asetArg pathArg =
|
||||
fromValue @(AttrSet t) asetArg >>= \s ->
|
||||
fromValue pathArg >>= \(Path p) -> do
|
||||
path <- pathToDefaultNix p
|
||||
path <- pathToDefaultNix @t @f @m p
|
||||
mres <- lookupVar "__cur_file"
|
||||
path' <- case mres of
|
||||
Nothing -> do
|
||||
|
|
@ -866,9 +882,9 @@ scopedImport asetArg pathArg =
|
|||
clearScopes @t $
|
||||
withNixContext (Just path') $
|
||||
pushScope s $
|
||||
importPath @m path'
|
||||
importPath @t @f @m path'
|
||||
|
||||
getEnv_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
getEnv_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
getEnv_ = fromValue >=> fromStringNoContext >=> \s -> do
|
||||
mres <- getEnvVar (Text.unpack s)
|
||||
toNix $ principledMakeNixStringWithoutContext $
|
||||
|
|
@ -876,7 +892,7 @@ getEnv_ = fromValue >=> fromStringNoContext >=> \s -> do
|
|||
Nothing -> ""
|
||||
Just v -> Text.pack v
|
||||
|
||||
sort_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
sort_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
sort_ comparator xs = comparator >>= \comp ->
|
||||
fromValue xs >>= sortByM (cmp comp) >>= toValue
|
||||
where
|
||||
|
|
@ -890,7 +906,7 @@ sort_ comparator xs = comparator >>= \comp ->
|
|||
True -> GT
|
||||
False -> EQ
|
||||
|
||||
lessThan :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
lessThan :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
lessThan ta tb = ta >>= \va -> tb >>= \vb -> do
|
||||
let badType = throwError $ ErrorCall $
|
||||
"builtins.lessThan: expected two numbers or two strings, "
|
||||
|
|
@ -905,12 +921,12 @@ lessThan ta tb = ta >>= \va -> tb >>= \vb -> do
|
|||
(NVStr a, NVStr b) -> pure $ principledStringIgnoreContext a < principledStringIgnoreContext b
|
||||
_ -> badType
|
||||
|
||||
concatLists :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
concatLists :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
concatLists = fromValue @[t]
|
||||
>=> mapM (fromValue @[t] >=> pure)
|
||||
>=> toValue . concat
|
||||
|
||||
listToAttrs :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
listToAttrs :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
listToAttrs = fromValue @[t] >=> \l ->
|
||||
fmap (flip nvSet M.empty . M.fromList . reverse) $
|
||||
forM l $ fromValue @(AttrSet t) >=> \s -> do
|
||||
|
|
@ -921,7 +937,7 @@ listToAttrs = fromValue @[t] >=> \l ->
|
|||
-- prim_hashString from nix/src/libexpr/primops.cc
|
||||
-- fail if context in the algo arg
|
||||
-- propagate context from the s arg
|
||||
hashString :: MonadNix e t f m => NixString -> NixString -> Prim m NixString
|
||||
hashString :: MonadBuiltins e t f m => NixString -> NixString -> Prim m NixString
|
||||
hashString nsAlgo ns = Prim $ do
|
||||
algo <- fromStringNoContext nsAlgo
|
||||
let f g = pure $ principledModifyNixContents g ns
|
||||
|
|
@ -953,7 +969,7 @@ hashString nsAlgo ns = Prim $ do
|
|||
_ -> throwError $ ErrorCall $ "builtins.hashString: "
|
||||
++ "expected \"md5\", \"sha1\", \"sha256\", or \"sha512\", got " ++ show algo
|
||||
|
||||
placeHolder :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
placeHolder :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
placeHolder = fromValue >=> fromStringNoContext >=> \t -> do
|
||||
h <- runPrim (hashString (principledMakeNixStringWithoutContext "sha256")
|
||||
(principledMakeNixStringWithoutContext ("nix-output:" <> t)))
|
||||
|
|
@ -961,7 +977,7 @@ placeHolder = fromValue >=> fromStringNoContext >=> \t -> do
|
|||
-- The result coming out of hashString is base16 encoded
|
||||
fst $ Base16.decode $ encodeUtf8 $ principledStringIgnoreContext h
|
||||
|
||||
absolutePathFromValue :: MonadNix e t f m => NValue t f m -> m FilePath
|
||||
absolutePathFromValue :: MonadBuiltins e t f m => NValue t f m -> m FilePath
|
||||
absolutePathFromValue = \case
|
||||
NVStr ns -> do
|
||||
let path = Text.unpack $ hackyStringIgnoreContext ns
|
||||
|
|
@ -971,18 +987,18 @@ absolutePathFromValue = \case
|
|||
NVPath path -> pure path
|
||||
v -> throwError $ ErrorCall $ "expected a path, got " ++ show v
|
||||
|
||||
readFile_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
readFile_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
readFile_ path =
|
||||
path >>= absolutePathFromValue >>= Nix.Render.readFile >>= toNix
|
||||
|
||||
findFile_ :: forall e t f m. MonadNix e t f m
|
||||
findFile_ :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
findFile_ aset filePath =
|
||||
aset >>= \aset' ->
|
||||
filePath >>= \filePath' ->
|
||||
case (aset', filePath') of
|
||||
(NVList x, NVStr ns) -> do
|
||||
mres <- findPath x (Text.unpack (hackyStringIgnoreContext ns))
|
||||
mres <- findPath @t @f @m x (Text.unpack (hackyStringIgnoreContext ns))
|
||||
pure $ nvPath mres
|
||||
(NVList _, y) -> throwError $ ErrorCall $ "expected a string, got " ++ show y
|
||||
(x, NVStr _) -> throwError $ ErrorCall $ "expected a list, got " ++ show x
|
||||
|
|
@ -1002,7 +1018,7 @@ instance Applicative m => ToNix FileType m (NValue t f m) where
|
|||
FileTypeSymlink -> "symlink"
|
||||
FileTypeUnknown -> "unknown"
|
||||
|
||||
readDir_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
readDir_ :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
readDir_ pathThunk = do
|
||||
path <- absolutePathFromValue =<< pathThunk
|
||||
items <- listDirectory path
|
||||
|
|
@ -1016,7 +1032,8 @@ readDir_ pathThunk = do
|
|||
pure (Text.pack item, t)
|
||||
toNix (M.fromList itemsWithTypes)
|
||||
|
||||
fromJSON :: forall e t f m. (MonadNix e t f m, Typeable m) => m (NValue t f m) -> m (NValue t f m)
|
||||
fromJSON :: forall e t f m. (MonadBuiltins e t f m, Typeable m)
|
||||
=> m (NValue t f m) -> m (NValue t f m)
|
||||
fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->
|
||||
case A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded of
|
||||
Left jsonError ->
|
||||
|
|
@ -1027,8 +1044,10 @@ fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->
|
|||
A.Object m -> flip nvSet M.empty
|
||||
<$> traverse (thunk . jsonToNValue) m
|
||||
A.Array l -> nvList <$>
|
||||
traverse (\x -> thunk . whileForcingThunk (CoercionFromJson @m x)
|
||||
. jsonToNValue $ x) (V.toList l)
|
||||
traverse (\x -> thunk @t @m @(NValue t f m)
|
||||
. whileForcingThunk @t @f (CoercionFromJson x)
|
||||
. jsonToNValue $ x)
|
||||
(V.toList l)
|
||||
A.String s -> pure $ nvStr $ hackyMakeNixStringWithoutContext s
|
||||
A.Number n -> pure $ nvConstant $ case floatingOrInteger n of
|
||||
Left r -> NFloat r
|
||||
|
|
@ -1037,15 +1056,15 @@ fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->
|
|||
A.Null -> pure $ nvConstant NNull
|
||||
|
||||
prim_toJSON
|
||||
:: MonadNix e t f m
|
||||
:: MonadBuiltins e t f m
|
||||
=> m (NValue t f m)
|
||||
-> m (NValue t f m)
|
||||
prim_toJSON x = x >>= nvalueToJSONNixString >>= pure . nvStr
|
||||
|
||||
toXML_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toXML_ :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
toXML_ v = v >>= normalForm >>= pure . nvStr . toXML
|
||||
|
||||
typeOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
typeOf :: MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
typeOf v = v >>= toNix . principledMakeNixStringWithoutContext . \case
|
||||
NVConstant a -> case a of
|
||||
NInt _ -> "int"
|
||||
|
|
@ -1060,7 +1079,7 @@ typeOf v = v >>= toNix . principledMakeNixStringWithoutContext . \case
|
|||
NVBuiltin _ _ -> "lambda"
|
||||
_ -> error "Pattern synonyms obscure complete patterns"
|
||||
|
||||
tryEval :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
tryEval :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
tryEval e = catch (onSuccess <$> e) (pure . onError)
|
||||
where
|
||||
onSuccess v = flip nvSet M.empty $ M.fromList
|
||||
|
|
@ -1074,16 +1093,21 @@ tryEval e = catch (onSuccess <$> e) (pure . onError)
|
|||
, ("value", valueThunk (nvConstant (NBool False)))
|
||||
]
|
||||
|
||||
trace_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
trace_ :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
trace_ msg action = do
|
||||
traceEffect . Text.unpack . principledStringIgnoreContext =<< fromValue msg
|
||||
traceEffect @t @f @m
|
||||
. Text.unpack
|
||||
. principledStringIgnoreContext
|
||||
=<< fromValue msg
|
||||
action
|
||||
|
||||
-- TODO: remember error context
|
||||
addErrorContext :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
addErrorContext :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
addErrorContext _ action = action
|
||||
|
||||
exec_ :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
exec_ :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
exec_ xs = do
|
||||
ls <- fromValue @[t] xs
|
||||
xs <- traverse (coerceToString DontCopyToStore CoerceStringy <=< force') ls
|
||||
|
|
@ -1092,7 +1116,7 @@ exec_ xs = do
|
|||
-- Requires the implementation of EvalState::realiseContext
|
||||
exec (map (Text.unpack . hackyStringIgnoreContext) xs)
|
||||
|
||||
fetchurl :: forall e t f m. MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
fetchurl :: forall e t f m. MonadBuiltins e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
fetchurl v = v >>= \case
|
||||
NVSet s _ -> attrsetGet "url" s >>= force ?? (go (M.lookup "sha256" s))
|
||||
v@NVStr {} -> go Nothing v
|
||||
|
|
@ -1112,7 +1136,7 @@ fetchurl v = v >>= \case
|
|||
"builtins.fetchurl: unsupported arguments to url"
|
||||
Just t -> pure t
|
||||
|
||||
partition_ :: forall e t f m. MonadNix e t f m
|
||||
partition_ :: forall e t f m. MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
|
||||
partition_ fun xs = fun >>= \f ->
|
||||
fromValue @[t] xs >>= \l -> do
|
||||
|
|
@ -1123,30 +1147,34 @@ partition_ fun xs = fun >>= \f ->
|
|||
toValue @(AttrSet t) $
|
||||
M.fromList [("right", makeSide right), ("wrong", makeSide wrong)]
|
||||
|
||||
currentSystem :: MonadNix e t f m => m (NValue t f m)
|
||||
currentSystem :: MonadBuiltins e t f m => m (NValue t f m)
|
||||
currentSystem = do
|
||||
os <- getCurrentSystemOS
|
||||
arch <- getCurrentSystemArch
|
||||
return $ nvStr $ principledMakeNixStringWithoutContext (arch <> "-" <> os)
|
||||
|
||||
currentTime_ :: MonadNix e t f m => m (NValue t f m)
|
||||
currentTime_ :: MonadBuiltins e t f m => m (NValue t f m)
|
||||
currentTime_ = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
toNix @Integer $ round $ Time.utcTimeToPOSIXSeconds (currentTime opts)
|
||||
|
||||
derivationStrict_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)
|
||||
derivationStrict_ :: MonadBuiltins e t f m
|
||||
=> m (NValue t f m) -> m (NValue t f m)
|
||||
derivationStrict_ = (>>= derivationStrict)
|
||||
|
||||
newtype Prim m a = Prim { runPrim :: m a }
|
||||
|
||||
-- | Types that support conversion to nix in a particular monad
|
||||
class ToBuiltin t m a | a -> m where
|
||||
class ToBuiltin t f m a | a -> m where
|
||||
toBuiltin :: String -> a -> m (NValue t f m)
|
||||
|
||||
instance (MonadNix e t f m, ToNix a m (NValue t f m))
|
||||
=> ToBuiltin t m (Prim m a) where
|
||||
instance (MonadBuiltins e t f m, ToNix a m (NValue t f m))
|
||||
=> ToBuiltin t f m (Prim m a) where
|
||||
toBuiltin _ p = toNix =<< runPrim p
|
||||
|
||||
instance (MonadNix e t f m, FromNix a m (NValue t f m), ToBuiltin t m b)
|
||||
=> ToBuiltin t m (a -> b) where
|
||||
toBuiltin name f = return $ nvBuiltin name (fromNix >=> toBuiltin name . f)
|
||||
instance ( MonadBuiltins e t f m
|
||||
, FromNix a m (NValue t f m)
|
||||
, ToBuiltin t f m b)
|
||||
=> ToBuiltin t f m (a -> b) where
|
||||
toBuiltin name f =
|
||||
return $ nvBuiltin name (fromNix >=> toBuiltin name . f)
|
||||
|
|
|
|||
Loading…
Reference in a new issue