Merge pull request #289 from gbwey9/string_context_255
add string context 255
This commit is contained in:
commit
a34dddb669
|
@ -1,11 +1,10 @@
|
|||
cabal-version: >= 1.10
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.29.7.
|
||||
-- This file has been generated from package.yaml by hpack version 0.28.2.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: db047ec647c1294d48f00efbf9730dd31e90dd93940ce25df499b90fa85e8626
|
||||
-- hash: 7e613ce82a3337411d625301abd33a6d7f1c400edadbd602287027f2af1e4fdf
|
||||
|
||||
cabal-version: >= 1.10
|
||||
name: hnix
|
||||
version: 0.5.2
|
||||
synopsis: Haskell implementation of the Nix language
|
||||
|
@ -469,6 +468,7 @@ library
|
|||
Nix.Render
|
||||
Nix.Render.Frame
|
||||
Nix.Scope
|
||||
Nix.String
|
||||
Nix.Strings
|
||||
Nix.TH
|
||||
Nix.Thunk
|
||||
|
|
|
@ -11,6 +11,7 @@ module Nix (module Nix.Cache,
|
|||
module Nix.Render.Frame,
|
||||
module Nix.Normal,
|
||||
module Nix.Options,
|
||||
module Nix.String,
|
||||
module Nix.Parser,
|
||||
module Nix.Pretty,
|
||||
module Nix.Reduce,
|
||||
|
@ -35,6 +36,7 @@ import qualified Nix.Eval as Eval
|
|||
import Nix.Exec
|
||||
import Nix.Expr
|
||||
import Nix.Frames
|
||||
import Nix.String
|
||||
import Nix.Normal
|
||||
import Nix.Options
|
||||
import Nix.Parser
|
||||
|
|
|
@ -79,6 +79,7 @@ import Nix.Exec
|
|||
import Nix.Expr.Types
|
||||
import Nix.Expr.Types.Annotated
|
||||
import Nix.Frames
|
||||
import Nix.String
|
||||
import Nix.Normal
|
||||
import Nix.Options
|
||||
import Nix.Parser hiding (nixPath)
|
||||
|
@ -100,7 +101,7 @@ withNixContext mpath action = do
|
|||
opts :: Options <- asks (view hasLens)
|
||||
let i = value @(NValue m) @(NThunk m) @m $ nvList $
|
||||
map (value @(NValue m) @(NThunk m) @m
|
||||
. flip nvStr mempty . Text.pack) (include opts)
|
||||
. nvStr . hackyMakeNixStringWithoutContext . Text.pack) (include opts)
|
||||
pushScope (M.singleton "__includes" i) $
|
||||
pushScopes base $ case mpath of
|
||||
Nothing -> action
|
||||
|
@ -318,9 +319,9 @@ nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
|
|||
(flip nvSet mempty $ M.fromList
|
||||
[ case ty of
|
||||
PathEntryPath -> ("path", valueThunk $ nvPath p)
|
||||
PathEntryURI -> ("uri", valueThunk $ nvStr (Text.pack p) mempty)
|
||||
PathEntryURI -> ("uri", valueThunk $ nvStr (hackyMakeNixStringWithoutContext (Text.pack p)))
|
||||
, ("prefix", valueThunk $
|
||||
nvStr (Text.pack (fromMaybe "" mn)) mempty) ]) : rest
|
||||
nvStr (hackyMakeNixStringWithoutContext $ Text.pack (fromMaybe "" mn))) ]) : rest
|
||||
|
||||
toString :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
toString str = str >>= coerceToString False True >>= toNix . Text.pack
|
||||
|
@ -339,7 +340,7 @@ attrsetGet k s = case M.lookup k s of
|
|||
|
||||
hasContext :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
hasContext =
|
||||
toNix . not . null . (appEndo ?? []) . snd <=< fromValue @(Text, DList Text)
|
||||
toNix . stringHasContext <=< fromValue
|
||||
|
||||
getAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
getAttr x y =
|
||||
|
@ -350,7 +351,7 @@ getAttr x y =
|
|||
unsafeGetAttrPos :: forall e m. MonadNix e m
|
||||
=> m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of
|
||||
(NVStr key _, NVSet _ apos) -> case M.lookup key apos of
|
||||
(NVStr ns, NVSet _ apos) -> case M.lookup (hackyStringIgnoreContext ns) apos of
|
||||
Nothing -> pure $ nvConstant NNull
|
||||
Just delta -> toValue delta
|
||||
(x, y) -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPos: "
|
||||
|
@ -469,7 +470,7 @@ splitVersion s = case Text.uncons s of
|
|||
splitVersion_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
splitVersion_ = fromValue >=> \s -> do
|
||||
let vals = flip map (splitVersion s) $ \c ->
|
||||
valueThunk $ nvStr (versionComponentToString c) mempty
|
||||
valueThunk $ nvStr $ hackyMakeNixStringWithoutContext $ versionComponentToString c
|
||||
return $ nvList vals
|
||||
|
||||
compareVersions :: Text -> Text -> Ordering
|
||||
|
@ -552,7 +553,7 @@ splitMatches numDropped (((_,(start,len)):captures):mts) haystack =
|
|||
caps = valueThunk $ nvList (map f captures)
|
||||
f (a,(s,_)) = if s < 0 then valueThunk (nvConstant NNull) else thunkStr a
|
||||
|
||||
thunkStr s = valueThunk (nvStr (decodeUtf8 s) mempty)
|
||||
thunkStr s = valueThunk (nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s)))
|
||||
|
||||
substring :: MonadNix e m => Int -> Int -> Text -> Prim m Text
|
||||
substring start len str = Prim $
|
||||
|
@ -583,7 +584,7 @@ mapAttrs_ fun xs = fun >>= \f ->
|
|||
values <- for pairs $ \(key, value) ->
|
||||
thunk $
|
||||
withFrame Debug (ErrorCall "While applying f in mapAttrs:\n") $
|
||||
callFunc ?? force' value =<< callFunc f (pure (nvStr key mempty))
|
||||
callFunc ?? force' value =<< callFunc f (pure (nvStr (hackyMakeNixStringWithoutContext key)))
|
||||
toNix . M.fromList . zip (map fst pairs) $ values
|
||||
|
||||
filter_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
|
||||
|
@ -600,7 +601,7 @@ catAttrs attrName xs =
|
|||
|
||||
baseNameOf :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
baseNameOf x = x >>= \case
|
||||
NVStr path ctx -> pure $ nvStr (Text.pack $ takeFileName $ Text.unpack path) ctx
|
||||
NVStr ns -> pure $ nvStr (hackyModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)
|
||||
NVPath path -> pure $ nvPath $ takeFileName path
|
||||
v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v
|
||||
|
||||
|
@ -621,7 +622,7 @@ bitXor x y =
|
|||
|
||||
dirOf :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
dirOf x = x >>= \case
|
||||
NVStr path ctx -> pure $ nvStr (Text.pack $ takeDirectory $ Text.unpack path) ctx
|
||||
NVStr ns -> pure $ nvStr (hackyModifyNixContents (Text.pack . takeDirectory . Text.unpack) ns)
|
||||
NVPath path -> pure $ nvPath $ takeDirectory path
|
||||
v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v
|
||||
|
||||
|
@ -775,7 +776,7 @@ toPath = fromValue @Path >=> toNix @Path
|
|||
pathExists_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
pathExists_ path = path >>= \case
|
||||
NVPath p -> toNix =<< pathExists p
|
||||
NVStr s _ -> toNix =<< pathExists (Text.unpack s)
|
||||
NVStr ns -> toNix =<< pathExists (Text.unpack (hackyStringIgnoreContext ns))
|
||||
v -> throwError $ ErrorCall $
|
||||
"builtins.pathExists: expected path, got " ++ show v
|
||||
|
||||
|
@ -867,7 +868,7 @@ lessThan ta tb = ta >>= \va -> tb >>= \vb -> do
|
|||
(NInt a, NFloat b) -> pure $ fromInteger a < b
|
||||
(NFloat a, NFloat b) -> pure $ a < b
|
||||
_ -> badType
|
||||
(NVStr a _, NVStr b _) -> pure $ a < b
|
||||
(NVStr a, NVStr b) -> pure $ hackyStringIgnoreContext a < hackyStringIgnoreContext b
|
||||
_ -> badType
|
||||
|
||||
concatLists :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
|
@ -920,8 +921,8 @@ placeHolder = fromValue @Text >=> \_ -> do
|
|||
|
||||
absolutePathFromValue :: MonadNix e m => NValue m -> m FilePath
|
||||
absolutePathFromValue = \case
|
||||
NVStr pathText _ -> do
|
||||
let path = Text.unpack pathText
|
||||
NVStr ns -> do
|
||||
let path = Text.unpack $ hackyStringIgnoreContext ns
|
||||
unless (isAbsolute path) $
|
||||
throwError $ ErrorCall $ "string " ++ show path ++ " doesn't represent an absolute path"
|
||||
pure path
|
||||
|
@ -938,11 +939,11 @@ findFile_ aset filePath =
|
|||
aset >>= \aset' ->
|
||||
filePath >>= \filePath' ->
|
||||
case (aset', filePath') of
|
||||
(NVList x, NVStr name _) -> do
|
||||
mres <- findPath x (Text.unpack name)
|
||||
(NVList x, NVStr ns) -> do
|
||||
mres <- findPath 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
|
||||
(x, NVStr _) -> throwError $ ErrorCall $ "expected a list, got " ++ show x
|
||||
(x, y) -> throwError $ ErrorCall $ "Invalid types for builtins.findFile: " ++ show (x, y)
|
||||
|
||||
data FileType
|
||||
|
@ -982,7 +983,7 @@ fromJSON = fromValue >=> \encoded ->
|
|||
|
||||
toXML_ :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
toXML_ v = v >>= normalForm >>= \x ->
|
||||
pure $ nvStr (Text.pack (toXML x)) mempty
|
||||
pure $ nvStr $ hackyMakeNixStringWithoutContext $ Text.pack (toXML x)
|
||||
|
||||
typeOf :: MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
typeOf v = v >>= toNix @Text . \case
|
||||
|
@ -991,7 +992,7 @@ typeOf v = v >>= toNix @Text . \case
|
|||
NFloat _ -> "float"
|
||||
NBool _ -> "bool"
|
||||
NNull -> "null"
|
||||
NVStr _ _ -> "string"
|
||||
NVStr _ -> "string"
|
||||
NVList _ -> "list"
|
||||
NVSet _ _ -> "set"
|
||||
NVClosure {} -> "lambda"
|
||||
|
@ -1037,7 +1038,7 @@ fetchurl v = v >>= \case
|
|||
where
|
||||
go :: Maybe (NThunk m) -> NValue m -> m (NValue m)
|
||||
go _msha = \case
|
||||
NVStr uri _ -> getURL uri -- msha
|
||||
NVStr ns -> getURL (hackyStringIgnoreContext ns) -- msha
|
||||
v -> throwError $ ErrorCall $
|
||||
"builtins.fetchurl: Expected URI or string, got " ++ show v
|
||||
|
||||
|
@ -1056,7 +1057,7 @@ currentSystem :: MonadNix e m => m (NValue m)
|
|||
currentSystem = do
|
||||
os <- getCurrentSystemOS
|
||||
arch <- getCurrentSystemArch
|
||||
return $ nvStr (arch <> "-" <> os) mempty
|
||||
return $ nvStr $ hackyMakeNixStringWithoutContext (arch <> "-" <> os)
|
||||
|
||||
currentTime_ :: MonadNix e m => m (NValue m)
|
||||
currentTime_ = do
|
||||
|
|
|
@ -42,6 +42,7 @@ import Nix.Effects
|
|||
import Nix.Expr.Types
|
||||
import Nix.Expr.Types.Annotated
|
||||
import Nix.Frames
|
||||
import Nix.String
|
||||
import Nix.Normal
|
||||
import Nix.Thunk
|
||||
import Nix.Utils
|
||||
|
@ -147,7 +148,7 @@ instance Convertible e m
|
|||
instance (Convertible e m, MonadEffects m)
|
||||
=> FromValue Text m (NValueNF m) where
|
||||
fromValueMay = \case
|
||||
Free (NVStrF t _) -> pure $ Just t
|
||||
Free (NVStrF ns) -> pure $ hackyStringIgnoreContextMaybe ns
|
||||
Free (NVPathF p) -> Just . Text.pack . unStorePath <$> addPath p
|
||||
Free (NVSetF s _) -> case M.lookup "outPath" s of
|
||||
Nothing -> pure Nothing
|
||||
|
@ -160,7 +161,7 @@ instance (Convertible e m, MonadEffects m)
|
|||
instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
|
||||
=> FromValue Text m (NValue m) where
|
||||
fromValueMay = \case
|
||||
NVStr t _ -> pure $ Just t
|
||||
NVStr ns -> pure $ hackyStringIgnoreContextMaybe ns
|
||||
NVPath p -> Just . Text.pack . unStorePath <$> addPath p
|
||||
NVSet s _ -> case M.lookup "outPath" s of
|
||||
Nothing -> pure Nothing
|
||||
|
@ -171,26 +172,26 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
|
|||
_ -> throwError $ Expectation TString v
|
||||
|
||||
instance (Convertible e m, MonadEffects m)
|
||||
=> FromValue (Text, DList Text) m (NValueNF m) where
|
||||
=> FromValue NixString m (NValueNF m) where
|
||||
fromValueMay = \case
|
||||
Free (NVStrF t d) -> pure $ Just (t, d)
|
||||
Free (NVPathF p) -> Just . (,mempty) . Text.pack . unStorePath <$> addPath p
|
||||
Free (NVStrF ns) -> pure $ Just ns
|
||||
Free (NVPathF p) -> Just . hackyMakeNixStringWithoutContext . Text.pack . unStorePath <$> addPath p
|
||||
Free (NVSetF s _) -> case M.lookup "outPath" s of
|
||||
Nothing -> pure Nothing
|
||||
Just p -> fmap (,mempty) <$> fromValueMay @Text p
|
||||
Just p -> fmap hackyMakeNixStringWithoutContext <$> fromValueMay @Text p
|
||||
_ -> pure Nothing
|
||||
fromValue v = fromValueMay v >>= \case
|
||||
Just b -> pure b
|
||||
_ -> throwError $ ExpectationNF TString v
|
||||
|
||||
instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
|
||||
=> FromValue (Text, DList Text) m (NValue m) where
|
||||
=> FromValue NixString m (NValue m) where
|
||||
fromValueMay = \case
|
||||
NVStr t d -> pure $ Just (t, d)
|
||||
NVPath p -> Just . (,mempty) . Text.pack . unStorePath <$> addPath p
|
||||
NVStr ns -> pure $ Just ns
|
||||
NVPath p -> Just . hackyMakeNixStringWithoutContext . Text.pack . unStorePath <$> addPath p
|
||||
NVSet s _ -> case M.lookup "outPath" s of
|
||||
Nothing -> pure Nothing
|
||||
Just p -> fmap (,mempty) <$> fromValueMay @Text p
|
||||
Just p -> fmap hackyMakeNixStringWithoutContext <$> fromValueMay @Text p
|
||||
_ -> pure Nothing
|
||||
fromValue v = fromValueMay v >>= \case
|
||||
Just b -> pure b
|
||||
|
@ -199,7 +200,7 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
|
|||
instance Convertible e m
|
||||
=> FromValue ByteString m (NValueNF m) where
|
||||
fromValueMay = \case
|
||||
Free (NVStrF t _) -> pure $ Just (encodeUtf8 t)
|
||||
Free (NVStrF ns) -> pure $ encodeUtf8 <$> hackyStringIgnoreContextMaybe ns
|
||||
_ -> pure Nothing
|
||||
fromValue v = fromValueMay v >>= \case
|
||||
Just b -> pure b
|
||||
|
@ -208,7 +209,7 @@ instance Convertible e m
|
|||
instance Convertible e m
|
||||
=> FromValue ByteString m (NValue m) where
|
||||
fromValueMay = \case
|
||||
NVStr t _ -> pure $ Just (encodeUtf8 t)
|
||||
NVStr ns -> pure $ encodeUtf8 <$> hackyStringIgnoreContextMaybe ns
|
||||
_ -> pure Nothing
|
||||
fromValue v = fromValueMay v >>= \case
|
||||
Just b -> pure b
|
||||
|
@ -220,7 +221,7 @@ newtype Path = Path { getPath :: FilePath }
|
|||
instance Convertible e m => FromValue Path m (NValueNF m) where
|
||||
fromValueMay = \case
|
||||
Free (NVPathF p) -> pure $ Just (Path p)
|
||||
Free (NVStrF s _) -> pure $ Just (Path (Text.unpack s))
|
||||
Free (NVStrF ns) -> pure $ Path . Text.unpack <$> hackyStringIgnoreContextMaybe ns
|
||||
Free (NVSetF s _) -> case M.lookup "outPath" s of
|
||||
Nothing -> pure Nothing
|
||||
Just p -> fromValueMay @Path p
|
||||
|
@ -233,7 +234,7 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)
|
|||
=> FromValue Path m (NValue m) where
|
||||
fromValueMay = \case
|
||||
NVPath p -> pure $ Just (Path p)
|
||||
NVStr s _ -> pure $ Just (Path (Text.unpack s))
|
||||
NVStr ns -> pure $ Path . Text.unpack <$> hackyStringIgnoreContextMaybe ns
|
||||
NVSet s _ -> case M.lookup "outPath" s of
|
||||
Nothing -> pure Nothing
|
||||
Just p -> fromValueMay @Path p
|
||||
|
@ -321,7 +322,7 @@ instance (Convertible e m, MonadEffects m)
|
|||
NFloat n -> toJSON n
|
||||
NBool b -> toJSON b
|
||||
NNull -> A.Null
|
||||
Free (NVStrF s _) -> pure $ Just $ toJSON s
|
||||
Free (NVStrF ns) -> pure $ toJSON <$> hackyStringIgnoreContextMaybe ns
|
||||
Free (NVListF l) ->
|
||||
fmap (A.Array . V.fromList) . sequence
|
||||
<$> traverse fromValueMay l
|
||||
|
@ -367,22 +368,22 @@ instance Applicative m => ToValue Float m (NValue m) where
|
|||
toValue = pure . nvConstant . NFloat
|
||||
|
||||
instance Applicative m => ToValue Text m (NValueNF m) where
|
||||
toValue = pure . Free . flip NVStrF mempty
|
||||
toValue = pure . Free . NVStrF . hackyMakeNixStringWithoutContext
|
||||
|
||||
instance Applicative m => ToValue Text m (NValue m) where
|
||||
toValue = pure . flip nvStr mempty
|
||||
toValue = pure . nvStr . hackyMakeNixStringWithoutContext
|
||||
|
||||
instance Applicative m => ToValue (Text, DList Text) m (NValueNF m) where
|
||||
toValue = pure . Free . uncurry NVStrF
|
||||
instance Applicative m => ToValue NixString m (NValueNF m) where
|
||||
toValue = pure . Free . NVStrF
|
||||
|
||||
instance Applicative m => ToValue (Text, DList Text) m (NValue m) where
|
||||
toValue = pure . uncurry nvStr
|
||||
instance Applicative m => ToValue NixString m (NValue m) where
|
||||
toValue = pure . nvStr
|
||||
|
||||
instance Applicative m => ToValue ByteString m (NValueNF m) where
|
||||
toValue = pure . Free . flip NVStrF mempty . decodeUtf8
|
||||
toValue = pure . Free . NVStrF . hackyMakeNixStringWithoutContext . decodeUtf8
|
||||
|
||||
instance Applicative m => ToValue ByteString m (NValue m) where
|
||||
toValue = pure . flip nvStr mempty . decodeUtf8
|
||||
toValue = pure . nvStr . hackyMakeNixStringWithoutContext . decodeUtf8
|
||||
|
||||
instance Applicative m => ToValue Path m (NValueNF m) where
|
||||
toValue = pure . Free . NVPathF . getPath
|
||||
|
@ -447,7 +448,7 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)
|
|||
A.Array l -> nvList <$>
|
||||
traverse (\x -> thunk . whileForcingThunk (CoercionFromJson @m x)
|
||||
. toValue $ x) (V.toList l)
|
||||
A.String s -> pure $ nvStr s mempty
|
||||
A.String s -> pure $ nvStr $ hackyMakeNixStringWithoutContext s
|
||||
A.Number n -> pure $ nvConstant $ case floatingOrInteger n of
|
||||
Left r -> NFloat r
|
||||
Right i -> NInt i
|
||||
|
@ -495,8 +496,8 @@ instance Convertible e m => FromNix Float m (NValueNF m) where
|
|||
instance Convertible e m => FromNix Float m (NValue m) where
|
||||
instance (Convertible e m, MonadEffects m) => FromNix Text m (NValueNF m) where
|
||||
instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix Text m (NValue m) where
|
||||
instance (Convertible e m, MonadEffects m) => FromNix (Text, DList Text) m (NValueNF m) where
|
||||
instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix (Text, DList Text) m (NValue m) where
|
||||
instance (Convertible e m, MonadEffects m) => FromNix NixString m (NValueNF m) where
|
||||
instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix NixString m (NValue m) where
|
||||
instance Convertible e m => FromNix ByteString m (NValueNF m) where
|
||||
instance Convertible e m => FromNix ByteString m (NValue m) where
|
||||
instance Convertible e m => FromNix Path m (NValueNF m) where
|
||||
|
@ -558,8 +559,8 @@ instance Applicative m => ToNix Float m (NValueNF m) where
|
|||
instance Applicative m => ToNix Float m (NValue m) where
|
||||
instance Applicative m => ToNix Text m (NValueNF m) where
|
||||
instance Applicative m => ToNix Text m (NValue m) where
|
||||
instance Applicative m => ToNix (Text, DList Text) m (NValueNF m) where
|
||||
instance Applicative m => ToNix (Text, DList Text) m (NValue m) where
|
||||
instance Applicative m => ToNix NixString m (NValueNF m) where
|
||||
instance Applicative m => ToNix NixString m (NValue m) where
|
||||
instance Applicative m => ToNix ByteString m (NValueNF m) where
|
||||
instance Applicative m => ToNix ByteString m (NValue m) where
|
||||
instance Applicative m => ToNix Path m (NValueNF m) where
|
||||
|
|
|
@ -33,6 +33,7 @@ import Nix.Atoms
|
|||
import Nix.Convert
|
||||
import Nix.Expr
|
||||
import Nix.Frames
|
||||
import Nix.String
|
||||
import Nix.Scope
|
||||
import Nix.Strings (runAntiquoted)
|
||||
import Nix.Thunk
|
||||
|
@ -82,7 +83,7 @@ type MonadNixEval e v t m =
|
|||
MonadFix m,
|
||||
ToValue Bool m v,
|
||||
ToValue [t] m v,
|
||||
FromValue (Text, DList Text) m v,
|
||||
FromValue NixString m v,
|
||||
ToValue (AttrSet t, AttrSet SourcePos) m v,
|
||||
FromValue (AttrSet t, AttrSet SourcePos) m v)
|
||||
|
||||
|
@ -296,7 +297,7 @@ evalSelect aset attr = do
|
|||
|
||||
-- | Evaluate a component of an attribute path in a context where we are
|
||||
-- *retrieving* a value
|
||||
evalGetterKeyName :: forall v m. (MonadEval v m, FromValue (Text, DList Text) m v)
|
||||
evalGetterKeyName :: forall v m. (MonadEval v m, FromValue NixString m v)
|
||||
=> NKeyName (m v) -> m Text
|
||||
evalGetterKeyName = evalSetterKeyName >=> \case
|
||||
Just k -> pure k
|
||||
|
@ -304,22 +305,24 @@ evalGetterKeyName = evalSetterKeyName >=> \case
|
|||
|
||||
-- | Evaluate a component of an attribute path in a context where we are
|
||||
-- *binding* a value
|
||||
evalSetterKeyName :: (MonadEval v m, FromValue (Text, DList Text) m v)
|
||||
evalSetterKeyName :: (MonadEval v m, FromValue NixString m v)
|
||||
=> NKeyName (m v) -> m (Maybe Text)
|
||||
evalSetterKeyName = \case
|
||||
StaticKey k -> pure (Just k)
|
||||
DynamicKey k ->
|
||||
runAntiquoted "\n" assembleString (>>= fromValueMay) k <&> fmap fst
|
||||
DynamicKey k ->
|
||||
runAntiquoted "\n" assembleString (>>= fromValueMay) k <&>
|
||||
\case Just ns -> Just (hackyStringIgnoreContext ns)
|
||||
_ -> Nothing
|
||||
|
||||
assembleString :: forall v m. (MonadEval v m, FromValue (Text, DList Text) m v)
|
||||
=> NString (m v) -> m (Maybe (Text, DList Text))
|
||||
assembleString :: forall v m. (MonadEval v m, FromValue NixString m v)
|
||||
=> NString (m v) -> m (Maybe NixString)
|
||||
assembleString = \case
|
||||
Indented _ parts -> fromParts parts
|
||||
DoubleQuoted parts -> fromParts parts
|
||||
where
|
||||
fromParts = fmap (fmap mconcat . sequence) . traverse go
|
||||
fromParts = fmap (fmap hackyStringMConcat . sequence) . traverse go
|
||||
|
||||
go = runAntiquoted "\n" (pure . Just . (, mempty)) (>>= fromValueMay)
|
||||
go = runAntiquoted "\n" (pure . Just . hackyMakeNixStringWithoutContext) (>>= fromValueMay)
|
||||
|
||||
buildArgument :: forall e v t m. MonadNixEval e v t m
|
||||
=> Params (m v) -> m v -> m (AttrSet t)
|
||||
|
|
|
@ -60,6 +60,7 @@ import Nix.Effects
|
|||
import Nix.Eval as Eval
|
||||
import Nix.Expr
|
||||
import Nix.Frames
|
||||
import Nix.String
|
||||
import Nix.Normal
|
||||
import Nix.Options
|
||||
import Nix.Parser
|
||||
|
@ -189,11 +190,11 @@ instance MonadNix e m => MonadEval (NValue m) m where
|
|||
pure $ nvConstantP (Provenance scope (NConstant_ span c)) c
|
||||
|
||||
evalString = assembleString >=> \case
|
||||
Just (s, c) -> do
|
||||
Just ns -> do
|
||||
scope <- currentScopes
|
||||
span <- currentPos
|
||||
pure $ nvStrP (Provenance scope
|
||||
(NStr_ span (DoubleQuoted [Plain s]))) s c
|
||||
(NStr_ span (DoubleQuoted [Plain (hackyStringIgnoreContext ns)]))) ns
|
||||
Nothing -> nverr $ ErrorCall "Failed to assemble string"
|
||||
|
||||
evalLiteralPath p = do
|
||||
|
@ -334,8 +335,8 @@ execBinaryOp scope span op lval rarg = do
|
|||
NBool l, NBool r) -> toBool $ not l || r
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(NVStr ls lc, NVStr rs rc) -> case op of
|
||||
NPlus -> pure $ bin nvStrP (ls `mappend` rs) (lc `mappend` rc)
|
||||
(NVStr ls, NVStr rs) -> case op of
|
||||
NPlus -> pure $ bin nvStrP (ls `hackyStringMappend` rs)
|
||||
NEq -> toBool =<< valueEq lval rval
|
||||
NNEq -> toBool . not =<< valueEq lval rval
|
||||
NLt -> toBool $ ls < rs
|
||||
|
@ -344,14 +345,14 @@ execBinaryOp scope span op lval rarg = do
|
|||
NGte -> toBool $ ls >= rs
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(NVStr _ _, NVConstant NNull) -> case op of
|
||||
NEq -> toBool =<< valueEq lval (nvStr "" mempty)
|
||||
NNEq -> toBool . not =<< valueEq lval (nvStr "" mempty)
|
||||
(NVStr _, NVConstant NNull) -> case op of
|
||||
NEq -> toBool =<< valueEq lval (nvStr (hackyMakeNixStringWithoutContext ""))
|
||||
NNEq -> toBool . not =<< valueEq lval (nvStr (hackyMakeNixStringWithoutContext ""))
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(NVConstant NNull, NVStr _ _) -> case op of
|
||||
NEq -> toBool =<< valueEq (nvStr "" mempty) rval
|
||||
NNEq -> toBool . not =<< valueEq (nvStr "" mempty) rval
|
||||
(NVConstant NNull, NVStr _) -> case op of
|
||||
NEq -> toBool =<< valueEq (nvStr (hackyMakeNixStringWithoutContext "")) rval
|
||||
NNEq -> toBool . not =<< valueEq (nvStr (hackyMakeNixStringWithoutContext "")) rval
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(NVSet ls lp, NVSet rs rp) -> case op of
|
||||
|
@ -372,15 +373,15 @@ execBinaryOp scope span op lval rarg = do
|
|||
NNEq -> toBool . not =<< valueEq (nvSet M.empty M.empty) rval
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(ls@NVSet {}, NVStr rs rc) -> case op of
|
||||
NPlus -> (\ls -> bin nvStrP (Text.pack ls `mappend` rs) rc)
|
||||
(ls@NVSet {}, NVStr rs) -> case op of
|
||||
NPlus -> (\ls -> bin nvStrP (hackyModifyNixContents (Text.pack ls `mappend`) rs))
|
||||
<$> coerceToString False False ls
|
||||
NEq -> toBool =<< valueEq lval rval
|
||||
NNEq -> toBool . not =<< valueEq lval rval
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(NVStr ls lc, rs@NVSet {}) -> case op of
|
||||
NPlus -> (\rs -> bin nvStrP (ls `mappend` Text.pack rs) lc)
|
||||
(NVStr ls, rs@NVSet {}) -> case op of
|
||||
NPlus -> (\rs -> bin nvStrP (hackyModifyNixContents (`mappend` Text.pack rs) ls))
|
||||
<$> coerceToString False False rs
|
||||
NEq -> toBool =<< valueEq lval rval
|
||||
NNEq -> toBool . not =<< valueEq lval rval
|
||||
|
@ -404,10 +405,10 @@ execBinaryOp scope span op lval rarg = do
|
|||
NNEq -> toBool . not =<< valueEq (nvList []) rval
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(NVPath p, NVStr s _) -> case op of
|
||||
NEq -> toBool $ p == Text.unpack s
|
||||
NNEq -> toBool $ p /= Text.unpack s
|
||||
NPlus -> bin nvPathP <$> makeAbsolutePath (p `mappend` Text.unpack s)
|
||||
(NVPath p, NVStr ns) -> case op of
|
||||
NEq -> toBool $ Just p == fmap Text.unpack (hackyStringIgnoreContextMaybe ns)
|
||||
NNEq -> toBool $ Just p /= fmap Text.unpack (hackyStringIgnoreContextMaybe ns)
|
||||
NPlus -> bin nvPathP <$> makeAbsolutePath (p `mappend` Text.unpack (hackyStringIgnoreContext ns))
|
||||
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
|
||||
|
||||
(NVPath ls, NVPath rs) -> case op of
|
||||
|
@ -453,7 +454,7 @@ coerceToString copyToStore coerceMore = go
|
|||
NVConstant (NFloat n) | coerceMore -> pure $ show n
|
||||
NVConstant NNull | coerceMore -> pure ""
|
||||
|
||||
NVStr t _ -> pure $ Text.unpack t
|
||||
NVStr ns -> pure $ Text.unpack (hackyStringIgnoreContext ns)
|
||||
NVPath p | copyToStore -> unStorePath <$> addPath p
|
||||
| otherwise -> pure p
|
||||
NVList l | coerceMore -> unwords <$> traverse (`force` go) l
|
||||
|
@ -565,6 +566,7 @@ instance (MonadFix m, MonadCatch m, MonadIO m, Alternative m,
|
|||
pure expr
|
||||
|
||||
getEnvVar = liftIO . lookupEnv
|
||||
|
||||
getCurrentSystemOS = return $ Text.pack System.Info.os
|
||||
|
||||
-- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4
|
||||
|
@ -817,7 +819,7 @@ fetchTarball v = v >>= \case
|
|||
where
|
||||
go :: Maybe (NThunk m) -> NValue m -> m (NValue m)
|
||||
go msha = \case
|
||||
NVStr uri _ -> fetch uri msha
|
||||
NVStr ns -> fetch (hackyStringIgnoreContext ns) msha
|
||||
v -> throwError $ ErrorCall $
|
||||
"builtins.fetchTarball: Expected URI or string, got " ++ show v
|
||||
|
||||
|
|
|
@ -44,6 +44,7 @@ import Nix.Eval (MonadEval(..))
|
|||
import qualified Nix.Eval as Eval
|
||||
import Nix.Expr
|
||||
import Nix.Frames
|
||||
import Nix.String
|
||||
import Nix.Options
|
||||
import Nix.Scope
|
||||
import Nix.Thunk
|
||||
|
@ -237,7 +238,7 @@ instance ToValue Bool m (Symbolic m) where
|
|||
|
||||
instance ToValue [SThunk m] m (Symbolic m) where
|
||||
|
||||
instance FromValue (Text, DList Text) m (Symbolic m) where
|
||||
instance FromValue NixString m (Symbolic m) where
|
||||
|
||||
instance FromValue (AttrSet (SThunk m), AttrSet SourcePos) m (Symbolic m) where
|
||||
|
||||
|
|
|
@ -25,6 +25,7 @@ import Nix.Atoms
|
|||
import Nix.Effects
|
||||
import Nix.Frames
|
||||
-- import Nix.Pretty
|
||||
import Nix.String
|
||||
import Nix.Thunk
|
||||
import Nix.Utils
|
||||
import Nix.Value
|
||||
|
@ -43,7 +44,7 @@ normalFormBy
|
|||
-> StateT [Var m Bool] m (NValueNF m)
|
||||
normalFormBy k n v = case v of
|
||||
NVConstant a -> return $ Free $ NVConstantF a
|
||||
NVStr t s -> return $ Free $ NVStrF t s
|
||||
NVStr ns -> return $ Free $ NVStrF ns
|
||||
NVList l ->
|
||||
fmap (Free . NVListF) $ forM (zip [0..] l) $ \(i :: Int, t) -> do
|
||||
traceM $ show n ++ ": normalFormBy: List[" ++ show i ++ "]"
|
||||
|
@ -101,7 +102,7 @@ embed :: forall m. (MonadThunk (NValue m) (NThunk m) m)
|
|||
embed (Pure v) = return v
|
||||
embed (Free x) = case x of
|
||||
NVConstantF a -> return $ nvConstant a
|
||||
NVStrF t s -> return $ nvStr t s
|
||||
NVStrF ns -> return $ nvStr ns
|
||||
NVListF l -> nvList . fmap (value @_ @_ @m) <$> traverse embed l
|
||||
NVSetF s p -> flip nvSet p . fmap (value @_ @_ @m) <$> traverse embed s
|
||||
NVClosureF p f -> return $ nvClosure p f
|
||||
|
@ -109,15 +110,15 @@ embed (Free x) = case x of
|
|||
NVBuiltinF n f -> return $ nvBuiltin n f
|
||||
|
||||
valueText :: forall e m. (Framed e m, MonadEffects m, Typeable m)
|
||||
=> Bool -> NValueNF m -> m (Text, DList Text)
|
||||
=> Bool -> NValueNF m -> m NixString
|
||||
valueText addPathsToStore = iter phi . check
|
||||
where
|
||||
check :: NValueNF m -> Free (NValueF m) (m (Text, DList Text))
|
||||
check = fmap (const $ pure ("<CYCLE>", mempty))
|
||||
check :: NValueNF m -> Free (NValueF m) (m NixString)
|
||||
check = fmap (const $ pure (hackyMakeNixStringWithoutContext "<CYCLE>"))
|
||||
|
||||
phi :: NValueF m (m (Text, DList Text)) -> m (Text, DList Text)
|
||||
phi (NVConstantF a) = pure (atomText a, mempty)
|
||||
phi (NVStrF t c) = pure (t, c)
|
||||
phi :: NValueF m (m NixString) -> m NixString
|
||||
phi (NVConstantF a) = pure (hackyMakeNixStringWithoutContext (atomText a))
|
||||
phi (NVStrF ns) = pure ns
|
||||
phi v@(NVListF _) = coercionFailed v
|
||||
phi v@(NVSetF s _)
|
||||
| Just asString <- M.lookup "__asString" s = asString
|
||||
|
@ -126,8 +127,8 @@ valueText addPathsToStore = iter phi . check
|
|||
phi (NVPathF originalPath)
|
||||
| addPathsToStore = do
|
||||
storePath <- addPath originalPath
|
||||
pure (Text.pack $ unStorePath storePath, mempty)
|
||||
| otherwise = pure (Text.pack originalPath, mempty)
|
||||
pure (hackyMakeNixStringWithoutContext $ Text.pack $ unStorePath storePath)
|
||||
| otherwise = pure (hackyMakeNixStringWithoutContext (Text.pack originalPath))
|
||||
phi v@(NVBuiltinF _ _) = coercionFailed v
|
||||
|
||||
coercionFailed v =
|
||||
|
@ -135,4 +136,4 @@ valueText addPathsToStore = iter phi . check
|
|||
|
||||
valueTextNoContext :: (Framed e m, MonadEffects m, Typeable m)
|
||||
=> Bool -> NValueNF m -> m Text
|
||||
valueTextNoContext addPathsToStore = fmap fst . valueText addPathsToStore
|
||||
valueTextNoContext addPathsToStore = fmap hackyStringIgnoreContext . valueText addPathsToStore
|
||||
|
|
|
@ -27,6 +27,7 @@ import qualified Data.Text as Text
|
|||
import Nix.Atoms
|
||||
import Nix.Expr
|
||||
import Nix.Parser
|
||||
import Nix.String
|
||||
import Nix.Strings
|
||||
import Nix.Thunk
|
||||
#if ENABLE_TRACING
|
||||
|
@ -246,13 +247,13 @@ prettyNValueNF :: Functor m => NValueNF m -> Doc
|
|||
prettyNValueNF = prettyNix . valueToExpr
|
||||
where
|
||||
check :: NValueNF m -> Fix (NValueF m)
|
||||
check = fixate (const (NVStrF "<CYCLE>" mempty))
|
||||
check = fixate (const (NVStrF (hackyMakeNixStringWithoutContext "<CYCLE>")))
|
||||
|
||||
valueToExpr :: Functor m => NValueNF m -> NExpr
|
||||
valueToExpr = transport go . check
|
||||
|
||||
go (NVConstantF a) = NConstant a
|
||||
go (NVStrF t _) = NStr (DoubleQuoted [Plain t])
|
||||
go (NVStrF ns) = NStr (DoubleQuoted [Plain (hackyStringIgnoreContext ns)])
|
||||
go (NVListF l) = NList l
|
||||
go (NVSetF s p) = NSet
|
||||
[ NamedVar (StaticKey k :| []) v (fromMaybe nullPos (M.lookup k p))
|
||||
|
@ -269,7 +270,7 @@ printNix = iter phi . check
|
|||
|
||||
phi :: NValueF m String -> String
|
||||
phi (NVConstantF a) = unpack $ atomText a
|
||||
phi (NVStrF t _) = show t
|
||||
phi (NVStrF ns) = show $ hackyStringIgnoreContext ns
|
||||
phi (NVListF l) = "[ " ++ unwords l ++ " ]"
|
||||
phi (NVSetF s _) =
|
||||
"{ " ++ concat [ unpack k ++ " = " ++ v ++ "; "
|
||||
|
@ -282,7 +283,7 @@ removeEffects :: Functor m => NValueF m (NThunk m) -> NValueNF m
|
|||
removeEffects = Free . fmap dethunk
|
||||
where
|
||||
dethunk (NThunk _ (Value v)) = removeEffects (_baseValue v)
|
||||
dethunk (NThunk _ _) = Free $ NVStrF "<thunk>" mempty
|
||||
dethunk (NThunk _ _) = Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
|
||||
|
||||
removeEffectsM :: MonadVar m => NValueF m (NThunk m) -> m (NValueNF m)
|
||||
removeEffectsM = fmap Free . traverse dethunk
|
||||
|
@ -314,11 +315,11 @@ dethunk = \case
|
|||
NThunk _ (Thunk _ active ref) -> do
|
||||
nowActive <- atomicModifyVar active (True,)
|
||||
if nowActive
|
||||
then pure $ Free $ NVStrF "<thunk>" mempty
|
||||
then pure $ Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
|
||||
else do
|
||||
eres <- readVar ref
|
||||
res <- case eres of
|
||||
Computed v -> removeEffectsM (_baseValue v)
|
||||
_ -> pure $ Free $ NVStrF "<thunk>" mempty
|
||||
_ -> pure $ Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
|
||||
_ <- atomicModifyVar active (False,)
|
||||
return res
|
||||
return res
|
|
@ -0,0 +1,81 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
||||
module Nix.String (
|
||||
NixString
|
||||
, stringHasContext
|
||||
, hackyStringIgnoreContextMaybe
|
||||
, hackyStringIgnoreContext
|
||||
, hackyMakeNixStringWithoutContext
|
||||
, hackyModifyNixContents
|
||||
, hackyStringMappend
|
||||
, hackyStringMConcat
|
||||
) where
|
||||
|
||||
import qualified Data.HashSet as S
|
||||
import Data.Hashable
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics
|
||||
import Data.Semigroup
|
||||
|
||||
-- {-# WARNING hackyStringMappend, hackyStringMConcat, hackyStringIgnoreContextMaybe, hackyStringIgnoreContext, hackyMakeNixStringWithoutContext, hackyModifyNixContents "This NixString function needs to be replaced" #-}
|
||||
|
||||
-- | A 'ContextFlavor' describes the sum of possible derivations for string contexts
|
||||
data ContextFlavor =
|
||||
DirectPath
|
||||
| DerivationOutput !Text
|
||||
deriving (Show, Eq, Ord, Generic)
|
||||
|
||||
instance Hashable ContextFlavor
|
||||
|
||||
-- | A 'StringContext' ...
|
||||
data StringContext =
|
||||
StringContext { scPath :: !Text
|
||||
, scFlavor :: !ContextFlavor
|
||||
} deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
instance Hashable StringContext
|
||||
|
||||
data NixString = NixString
|
||||
{ nsContents :: !Text
|
||||
, nsContext :: !(S.HashSet StringContext)
|
||||
} deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
instance Hashable NixString
|
||||
|
||||
-- | Combine two NixStrings using mappend
|
||||
hackyStringMappend :: NixString -> NixString -> NixString
|
||||
hackyStringMappend (NixString s1 t1) (NixString s2 t2) = NixString (s1 <> s2) (t1 <> t2)
|
||||
|
||||
-- | Combine NixStrings using mconcat
|
||||
hackyStringMConcat :: [NixString] -> NixString
|
||||
hackyStringMConcat = foldr hackyStringMappend (NixString mempty mempty)
|
||||
|
||||
--instance Semigroup NixString where
|
||||
--NixString s1 t1 <> NixString s2 t2 = NixString (s1 <> s2) (t1 <> t2)
|
||||
|
||||
--instance Monoid NixString where
|
||||
-- mempty = NixString mempty mempty
|
||||
-- mappend = (<>)
|
||||
|
||||
-- | Extract the string contents from a NixString that has no context
|
||||
hackyStringIgnoreContextMaybe :: NixString -> Maybe Text
|
||||
hackyStringIgnoreContextMaybe (NixString s c) | null c = Just s
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Extract the string contents from a NixString even if the NixString has an associated context
|
||||
hackyStringIgnoreContext :: NixString -> Text
|
||||
hackyStringIgnoreContext (NixString s _) = s
|
||||
|
||||
-- | Returns True if the NixString has an associated context
|
||||
stringHasContext :: NixString -> Bool
|
||||
stringHasContext (NixString _ c) = not (null c)
|
||||
|
||||
-- | Constructs a NixString without a context
|
||||
hackyMakeNixStringWithoutContext :: Text -> NixString
|
||||
hackyMakeNixStringWithoutContext = flip NixString mempty
|
||||
|
||||
-- | Modify the string part of the NixString -- ignores the context
|
||||
hackyModifyNixContents :: (Text -> Text) -> NixString -> NixString
|
||||
hackyModifyNixContents f (NixString s c) = NixString (f s) c
|
||||
|
||||
|
|
@ -47,6 +47,7 @@ import Nix.Eval (MonadEval(..))
|
|||
import qualified Nix.Eval as Eval
|
||||
import Nix.Expr.Types
|
||||
import Nix.Expr.Types.Annotated
|
||||
import Nix.String
|
||||
import Nix.Scope
|
||||
import Nix.Thunk
|
||||
import qualified Nix.Type.Assumption as As
|
||||
|
@ -444,7 +445,7 @@ data Judgment s = Judgment
|
|||
}
|
||||
deriving Show
|
||||
|
||||
instance FromValue (Text, DList Text) (Infer s) (Judgment s) where
|
||||
instance FromValue NixString (Infer s) (Judgment s) where
|
||||
fromValueMay _ = return Nothing
|
||||
fromValue _ = error "Unused"
|
||||
|
||||
|
|
|
@ -38,8 +38,6 @@ import Data.Functor.Classes
|
|||
import Data.HashMap.Lazy (HashMap)
|
||||
import qualified Data.HashMap.Lazy as M
|
||||
import Data.Hashable
|
||||
import Data.Monoid (appEndo)
|
||||
import Data.Text (Text)
|
||||
import Data.These
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics
|
||||
|
@ -50,6 +48,7 @@ import Nix.Atoms
|
|||
import Nix.Expr.Types
|
||||
import Nix.Expr.Types.Annotated
|
||||
import Nix.Frames
|
||||
import Nix.String
|
||||
import Nix.Scope
|
||||
import Nix.Thunk
|
||||
import Nix.Utils
|
||||
|
@ -61,7 +60,7 @@ data NValueF m r
|
|||
= NVConstantF NAtom
|
||||
-- | A string has a value and a context, which can be used to record what a
|
||||
-- string has been build from
|
||||
| NVStrF Text (DList Text)
|
||||
| NVStrF NixString
|
||||
| NVPathF FilePath
|
||||
| NVListF [r]
|
||||
| NVSetF (AttrSet r) (AttrSet SourcePos)
|
||||
|
@ -123,10 +122,10 @@ pattern NVConstant x <- NValue _ (NVConstantF x)
|
|||
nvConstant x = NValue [] (NVConstantF x)
|
||||
nvConstantP p x = NValue [p] (NVConstantF x)
|
||||
|
||||
pattern NVStr s d <- NValue _ (NVStrF s d)
|
||||
pattern NVStr ns <- NValue _ (NVStrF ns)
|
||||
|
||||
nvStr s d = NValue [] (NVStrF s d)
|
||||
nvStrP p s d = NValue [p] (NVStrF s d)
|
||||
nvStr ns = NValue [] (NVStrF ns)
|
||||
nvStrP p ns = NValue [p] (NVStrF ns)
|
||||
|
||||
pattern NVPath x <- NValue _ (NVPathF x)
|
||||
|
||||
|
@ -156,7 +155,7 @@ nvBuiltinP p name f = NValue [p] (NVBuiltinF name f)
|
|||
instance Show (NValueF m (Fix (NValueF m))) where
|
||||
showsPrec = flip go where
|
||||
go (NVConstantF atom) = showsCon1 "NVConstant" atom
|
||||
go (NVStrF txt ctxt) = showsCon2 "NVStr" txt (appEndo ctxt [])
|
||||
go (NVStrF ns) = showsCon1 "NVStr" (hackyStringIgnoreContext ns)
|
||||
go (NVListF lst) = showsCon1 "NVList" lst
|
||||
go (NVSetF attrs _) = showsCon1 "NVSet" attrs
|
||||
go (NVClosureF p _) = showsCon1 "NVClosure" p
|
||||
|
@ -166,7 +165,7 @@ instance Show (NValueF m (Fix (NValueF m))) where
|
|||
showsCon1 :: Show a => String -> a -> Int -> String -> String
|
||||
showsCon1 con a d =
|
||||
showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a
|
||||
|
||||
{-
|
||||
showsCon2 :: (Show a, Show b)
|
||||
=> String -> a -> b -> Int -> String -> String
|
||||
showsCon2 con a b d =
|
||||
|
@ -175,13 +174,13 @@ instance Show (NValueF m (Fix (NValueF m))) where
|
|||
. showsPrec 11 a
|
||||
. showString " "
|
||||
. showsPrec 11 b
|
||||
|
||||
-}
|
||||
instance Eq (NValue m) where
|
||||
NVConstant (NFloat x) == NVConstant (NInt y) = x == fromInteger y
|
||||
NVConstant (NInt x) == NVConstant (NFloat y) = fromInteger x == y
|
||||
NVConstant (NInt x) == NVConstant (NInt y) = x == y
|
||||
NVConstant (NFloat x) == NVConstant (NFloat y) = x == y
|
||||
NVStr x _ == NVStr y _ = x == y
|
||||
NVStr x == NVStr y = hackyStringIgnoreContext x == hackyStringIgnoreContext y
|
||||
NVPath x == NVPath y = x == y
|
||||
_ == _ = False
|
||||
|
||||
|
@ -190,7 +189,7 @@ instance Ord (NValue m) where
|
|||
NVConstant (NInt x) <= NVConstant (NFloat y) = fromInteger x <= y
|
||||
NVConstant (NInt x) <= NVConstant (NInt y) = x <= y
|
||||
NVConstant (NFloat x) <= NVConstant (NFloat y) = x <= y
|
||||
NVStr x _ <= NVStr y _ = x <= y
|
||||
NVStr x <= NVStr y = hackyStringIgnoreContext x <= hackyStringIgnoreContext y
|
||||
NVPath x <= NVPath y = x <= y
|
||||
_ <= _ = False
|
||||
|
||||
|
@ -200,7 +199,7 @@ checkComparable x y = case (x, y) of
|
|||
(NVConstant (NInt _), NVConstant (NFloat _)) -> pure ()
|
||||
(NVConstant (NInt _), NVConstant (NInt _)) -> pure ()
|
||||
(NVConstant (NFloat _), NVConstant (NFloat _)) -> pure ()
|
||||
(NVStr _ _, NVStr _ _) -> pure ()
|
||||
(NVStr _, NVStr _) -> pure ()
|
||||
(NVPath _, NVPath _) -> pure ()
|
||||
_ -> throwError $ Comparison x y
|
||||
|
||||
|
@ -250,15 +249,15 @@ isDerivation :: MonadThunk (NValue m) (NThunk m) m
|
|||
=> AttrSet (NThunk m) -> m Bool
|
||||
isDerivation m = case M.lookup "type" m of
|
||||
Nothing -> pure False
|
||||
Just t -> force t $ valueEq (nvStr "derivation" mempty)
|
||||
Just t -> force t $ valueEq (nvStr (hackyMakeNixStringWithoutContext "derivation"))
|
||||
|
||||
valueEq :: MonadThunk (NValue m) (NThunk m) m
|
||||
=> NValue m -> NValue m -> m Bool
|
||||
valueEq l r = case (l, r) of
|
||||
(NVConstant lc, NVConstant rc) -> pure $ lc == rc
|
||||
(NVStr ls _, NVStr rs _) -> pure $ ls == rs
|
||||
(NVStr ls _, NVConstant NNull) -> pure $ ls == ""
|
||||
(NVConstant NNull, NVStr rs _) -> pure $ "" == rs
|
||||
(NVStr ls, NVStr rs) -> pure (ls == rs)
|
||||
(NVStr ns, NVConstant NNull) -> pure (hackyStringIgnoreContextMaybe ns == Just "")
|
||||
(NVConstant NNull, NVStr ns) -> pure (Just "" == hackyStringIgnoreContextMaybe ns)
|
||||
(NVList ls, NVList rs) -> alignEqM thunkEq ls rs
|
||||
(NVSet lm _, NVSet rm _) -> do
|
||||
let compareAttrs = alignEqM thunkEq lm rm
|
||||
|
@ -324,7 +323,7 @@ instance Show (NThunk m) where
|
|||
|
||||
instance Eq1 (NValueF m) where
|
||||
liftEq _ (NVConstantF x) (NVConstantF y) = x == y
|
||||
liftEq _ (NVStrF x _) (NVStrF y _) = x == y
|
||||
liftEq _ (NVStrF x) (NVStrF y) = x == y
|
||||
liftEq eq (NVListF x) (NVListF y) = liftEq eq x y
|
||||
liftEq eq (NVSetF x _) (NVSetF y _) = liftEq eq x y
|
||||
liftEq _ (NVPathF x) (NVPathF y) = x == y
|
||||
|
@ -333,7 +332,7 @@ instance Eq1 (NValueF m) where
|
|||
instance Show1 (NValueF m) where
|
||||
liftShowsPrec sp sl p = \case
|
||||
NVConstantF atom -> showsUnaryWith showsPrec "NVConstantF" p atom
|
||||
NVStrF txt _ -> showsUnaryWith showsPrec "NVStrF" p txt
|
||||
NVStrF ns -> showsUnaryWith showsPrec "NVStrF" p (hackyStringIgnoreContext ns)
|
||||
NVListF lst -> showsUnaryWith (liftShowsPrec sp sl) "NVListF" p lst
|
||||
NVSetF attrs _ -> showsUnaryWith (liftShowsPrec sp sl) "NVSetF" p attrs
|
||||
NVClosureF c _ -> showsUnaryWith showsPrec "NVClosureF" p c
|
||||
|
|
|
@ -9,6 +9,7 @@ import Data.Ord
|
|||
import qualified Data.Text as Text
|
||||
import Nix.Atoms
|
||||
import Nix.Expr.Types
|
||||
import Nix.String
|
||||
import Nix.Value
|
||||
import Text.XML.Light
|
||||
|
||||
|
@ -31,7 +32,7 @@ toXML = ("<?xml version='1.0' encoding='utf-8'?>\n" ++)
|
|||
NBool b -> mkElem "bool" "value" (if b then "true" else "false")
|
||||
NNull -> Element (unqual "null") [] [] Nothing
|
||||
|
||||
NVStrF t _ -> mkElem "string" "value" (Text.unpack t)
|
||||
NVStrF ns -> mkElem "string" "value" (Text.unpack $ hackyStringIgnoreContext ns)
|
||||
NVListF l -> Element (unqual "list") [] (Elem <$> l) Nothing
|
||||
|
||||
NVSetF s _ -> Element (unqual "attrs") []
|
||||
|
|
|
@ -366,7 +366,7 @@ genEvalCompareTests = do
|
|||
|
||||
instance (Show r, Show (NValueF m r), Eq r) => Eq (NValueF m r) where
|
||||
NVConstantF x == NVConstantF y = x == y
|
||||
NVStrF x _ == NVStrF y _ = x == y
|
||||
NVStrF ls == NVStrF rs = hackyStringIgnoreContext ls == hackyStringIgnoreContext rs
|
||||
NVListF x == NVListF y = and (zipWith (==) x y)
|
||||
NVSetF x _ == NVSetF y _ =
|
||||
M.keys x == M.keys y &&
|
||||
|
|
|
@ -20,6 +20,7 @@ import qualified EvalTests
|
|||
import qualified Nix
|
||||
import Nix.Exec
|
||||
import Nix.Expr.Types
|
||||
import Nix.String
|
||||
import Nix.Options
|
||||
import Nix.Parser
|
||||
import Nix.Value
|
||||
|
@ -63,9 +64,10 @@ ensureNixpkgsCanParse =
|
|||
url = "https://github.com/NixOS/nixpkgs/archive/#{rev}.tar.gz";
|
||||
sha256 = "#{sha256}";
|
||||
}|]) $ \expr -> do
|
||||
NVStr dir _ <- do
|
||||
NVStr ns <- do
|
||||
time <- liftIO getCurrentTime
|
||||
runLazyM (defaultOptions time) $ Nix.nixEvalExprLoc Nothing expr
|
||||
let dir = hackyStringIgnoreContext ns
|
||||
exists <- fileExist (unpack dir)
|
||||
unless exists $
|
||||
errorWithoutStackTrace $
|
||||
|
@ -118,3 +120,4 @@ main = do
|
|||
, nixLanguageTests ] ++
|
||||
[ testCase "Nixpkgs parses without errors" ensureNixpkgsCanParse
|
||||
| isJust nixpkgsTestsEnv ]
|
||||
|
||||
|
|
Loading…
Reference in New Issue