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

Merge pull request #289 from gbwey9/string_context_255 

add string context 255
This commit is contained in:
John Wiegley 2018-10-15 15:07:55 -07:00 committed by GitHub
parent 2f418b26aa 54492e3905
commit a34dddb669
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
15 changed files with 220 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hnix.cabal
View File

@ -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

2
src/Nix.hs
View File

@ -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

43
src/Nix/Builtins.hs
View File

@ -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

57
src/Nix/Convert.hs
View File

@ -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

21
src/Nix/Eval.hs
View File

@ -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)

42
src/Nix/Exec.hs
View File

@ -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

3
src/Nix/Lint.hs
View File

@ -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

23
src/Nix/Normal.hs
View File

@ -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

15
src/Nix/Pretty.hs
View File

@ -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

81
src/Nix/String.hs Normal file
View File

@ -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

3
src/Nix/Type/Infer.hs
View File

@ -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"

35
src/Nix/Value.hs
View File

@ -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

3
src/Nix/XML.hs
View File

@ -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") []

2
tests/EvalTests.hs
View File

@ -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 &&

5
tests/Main.hs
View File

@ -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 ]