diff --git a/ChangeLog.md b/ChangeLog.md index 6acf7737e..1be0ec1d2 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -3,10 +3,17 @@ ## [(diff)](https://github.com/haskell-nix/hnix/compare/0.16.0...0.17.0#files_bucket) 0.17.0 +* Introduction: + * `Nix.Value` + * [(link)](https://github.com/haskell-nix/hnix/pull/1046/files) Constraint `NVConstraint f = (Comonad f, Applicative f)` was introduced, in order to unify builder `mkNV*` and `NV*` patterns. + * Breaking: * `Nix.Expr.Types` * [(link)](https://github.com/haskell-nix/hnix/pull/1042/files) The central HNix type `NExprF` changed, the `NApp` was moved out of `NBinary` & now a `NExprF` constructor of its own, the type signatures were changed accordingly. * [(link)](https://github.com/haskell-nix/hnix/pull/1038/files) project was using `megaparsec` `{,Source}Pos` and to use it shipped a lot of orphan instances. To improve the situation & performance (reports [#1026](https://github.com/haskell-nix/hnix/issues/1026), [#746](https://github.com/haskell-nix/hnix/issues/746)) project uses `N{,Source}Pos` types, related type signatures were changed accordingly. + * `Nix.Value` + * [(link)](https://github.com/haskell-nix/hnix/pull/1046/files) Unify builder `mkNV*` and `NV*` patterns by bidirectional synonyms, a lot of builders `mkNV*` are removed, and merged to `NV*`. e.g. instead of builder `mkNVList`, `NVList` should be used. + ## [(diff)](https://github.com/haskell-nix/hnix/compare/0.15.0...0.16.0#files_bucket) 0.16.0 diff --git a/src/Nix.hs b/src/Nix.hs index 176b97906..a6cacaf46 100644 --- a/src/Nix.hs +++ b/src/Nix.hs @@ -114,7 +114,7 @@ evaluateExpression mpath evaluator handler expr = f' <- demand f val <- case f' of - NVClosure _ g -> g $ mkNVSet mempty $ M.fromList args + NVClosure _ g -> g $ NVSet mempty $ M.fromList args _ -> pure f processResult handler val where diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 207913935..65655e000 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -7,6 +7,7 @@ {-# language MultiWayIf #-} {-# language PartialTypeSignatures #-} {-# language QuasiQuotes #-} +{-# language PatternSynonyms #-} {-# language TemplateHaskell #-} {-# language UndecidableInstances #-} {-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@ @@ -23,7 +24,6 @@ where import Nix.Prelude import GHC.Exception ( ErrorCall(ErrorCall) ) -import Control.Comonad ( Comonad ) import Control.Monad ( foldM ) import Control.Monad.Catch ( MonadCatch(catch) ) import Control.Monad.ListM ( sortByM ) @@ -126,14 +126,14 @@ instance ) => ToBuiltin t f m (a -> b) where toBuiltin name f = - pure $ mkNVBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper + pure $ NVBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper -- *** @WValue@ closure wrapper to have @Ord@ -- We wrap values solely to provide an Ord instance for genericClosure newtype WValue t f m = WValue (NValue t f m) -instance Comonad f => Eq (WValue t f m) where +instance NVConstraint f => Eq (WValue t f m) where WValue (NVConstant (NFloat x)) == WValue (NVConstant (NInt y)) = x == fromInteger y WValue (NVConstant (NInt x)) == WValue (NVConstant (NFloat y)) = @@ -145,7 +145,7 @@ instance Comonad f => Eq (WValue t f m) where ignoreContext x == ignoreContext y _ == _ = False -instance Comonad f => Ord (WValue t f m) where +instance NVConstraint f => Ord (WValue t f m) where WValue (NVConstant (NFloat x)) <= WValue (NVConstant (NInt y)) = x <= fromInteger y WValue (NVConstant (NInt x)) <= WValue (NVConstant (NFloat y)) = @@ -159,11 +159,8 @@ instance Comonad f => Ord (WValue t f m) where -- ** Helpers -mkNVBool - :: MonadNix e t f m - => Bool - -> NValue t f m -mkNVBool = mkNVConstant . NBool +pattern NVBool :: MonadNix e t f m => Bool -> NValue t f m +pattern NVBool a = NVConstant (NBool a) data NixPathEntryType = PathEntryPath @@ -331,15 +328,15 @@ splitMatches numDropped (((_, (start, len)) : captures) : mts) haystack = relStart = max 0 start - numDropped (before, rest) = B.splitAt relStart haystack caps :: NValue t f m - caps = mkNVList (f <$> captures) + caps = NVList (f <$> captures) f :: (ByteString, (Int, b)) -> NValue t f m f (a, (s, _)) = bool - nvNull + NVNull (thunkStr a) (s >= 0) -thunkStr :: Applicative f => ByteString -> NValue t f m +thunkStr :: NVConstraint f => ByteString -> NValue t f m thunkStr s = mkNVStrWithoutContext $ decodeUtf8 s hasKind @@ -422,16 +419,16 @@ derivationNix = foldFix Eval.eval $$(do nixPathNix :: forall e t f m . MonadNix e t f m => m (NValue t f m) nixPathNix = fmap - mkNVList + NVList $ foldNixPath mempty $ \p mn ty rest -> pure $ pure - (mkNVSet + (NVSet mempty (M.fromList [case ty of - PathEntryPath -> ("path", mkNVPath p) + PathEntryPath -> ("path", NVPath p) PathEntryURI -> ( "uri", mkNVStrWithoutContext $ fromString $ coerce p) , ( "prefix", mkNVStrWithoutContext $ maybeToMonoid mn) @@ -500,7 +497,7 @@ unsafeGetAttrPosNix nvX nvY = case (x, y) of (NVStr ns, NVSet apos _) -> maybe - (pure nvNull) + (pure NVNull) toValue (M.lookup @VarName (coerce $ ignoreContext ns) apos) _xy -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPosNix: " <> show _xy @@ -613,7 +610,7 @@ tailNix :: forall e t f m. MonadNix e t f m => NValue t f m -> m (NValue t f m) tailNix = maybe (throwError $ ErrorCall "builtins.tail: empty list") - (pure . mkNVList) + (pure . NVList) . viaNonEmpty tail <=< fromValue @[NValue t f m] splitVersionNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) @@ -621,7 +618,7 @@ splitVersionNix v = do version <- fromStringNoContext =<< fromValue v pure $ - mkNVList $ + NVList $ mkNVStrWithoutContext . show <$> splitVersion version @@ -642,7 +639,7 @@ compareVersionsNix t1 t2 = EQ -> 0 GT -> 1 - pure $ mkNVConstant $ NInt cmpVers + pure $ NVConstant $ NInt cmpVers where mkText = fromStringNoContext <=< fromValue @@ -689,7 +686,7 @@ matchNix pat str = re = makeRegex p :: Regex mkMatch t = bool - (pure nvNull) + (pure NVNull) (toValue $ mkNixStringWithoutContext t) (not $ Text.null t) @@ -697,7 +694,7 @@ matchNix pat str = Just ("", sarr, "") -> do let submatches = fst <$> elems sarr - mkNVList <$> + NVList <$> traverse mkMatch (case submatches of @@ -705,7 +702,7 @@ matchNix pat str = [a] -> one a _:xs -> xs -- return only the matched groups, drop the full string ) - _ -> pure nvNull + _ -> pure NVNull splitNix :: forall e t f m @@ -726,7 +723,7 @@ splitNix pat str = regex = makeRegex p :: Regex haystack = encodeUtf8 s - pure $ mkNVList $ splitMatches 0 (elems <$> matchAllText regex haystack) haystack + pure $ NVList $ splitMatches 0 (elems <$> matchAllText regex haystack) haystack substringNix :: forall e t f m. MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString substringNix start len str = @@ -825,7 +822,7 @@ catAttrsNix attrName xs = n <- fromStringNoContext =<< fromValue attrName l <- fromValue @[NValue t f m] xs - mkNVList . catMaybes <$> + NVList . catMaybes <$> traverse (fmap (M.lookup @VarName $ coerce n) . fromValue <=< demand) l @@ -835,7 +832,7 @@ baseNameOfNix x = do ns <- coerceStringlikeToNixString DontCopyToStore x pure $ - mkNVStr $ + NVStr $ modifyNixContents (fromString . coerce takeFileName . toString) ns @@ -917,7 +914,7 @@ pathNix arg = Right (coerce . toText . coerce @StorePath @String -> s) <- addToStore name path recursive False -- TODO: Ensure that s matches sha256 when not empty - pure $ mkNVStr $ mkNixStringWithSingletonContext (StringContext DirectPath s) s + pure $ NVStr $ mkNixStringWithSingletonContext (StringContext DirectPath s) s where coerceToPath = coerceToString callFunc DontCopyToStore CoerceAny @@ -927,8 +924,8 @@ dirOfNix nvdir = dir <- demand nvdir case dir of - NVStr ns -> pure $ mkNVStr $ modifyNixContents (fromString . coerce takeDirectory . toString) ns - NVPath path -> pure $ mkNVPath $ takeDirectory path + NVStr ns -> pure $ NVStr $ modifyNixContents (fromString . coerce takeDirectory . toString) 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? @@ -1158,7 +1155,7 @@ intersectAttrsNix set1 set2 = (s1, p1) <- fromValue @(AttrSet (NValue t f m), PositionSet) set1 (s2, p2) <- fromValue @(AttrSet (NValue t f m), PositionSet) set2 - pure $ mkNVSet (p2 `M.intersection` p1) (s2 `M.intersection` s1) + pure $ NVSet (p2 `M.intersection` p1) (s2 `M.intersection` s1) functionArgsNix :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) @@ -1167,7 +1164,7 @@ functionArgsNix nvfun = fun <- demand nvfun case fun of NVClosure p _ -> - toValue @(AttrSet (NValue t f m)) $ mkNVBool <$> + toValue @(AttrSet (NValue t f m)) $ NVBool <$> case p of Param name -> one (name, False) ParamSet _ _ pset -> isJust <$> M.fromList pset @@ -1272,7 +1269,7 @@ throwNix = -- importNix :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) -importNix = scopedImportNix $ mkNVSet mempty mempty +importNix = scopedImportNix $ NVSet mempty mempty -- | @scopedImport scope path@ -- An undocumented secret powerful function. @@ -1383,7 +1380,7 @@ lessThanNix ta tb = let badType = throwError $ ErrorCall $ "builtins.lessThan: expected two numbers or two strings, got '" <> show va <> "' and '" <> show vb <> "'." - mkNVBool <$> + NVBool <$> case (va, vb) of (NVConstant ca, NVConstant cb) -> case (ca, cb) of @@ -1433,7 +1430,7 @@ listToAttrsNix lst = do l <- fromValue @[NValue t f m] lst fmap - (mkNVSet mempty . M.fromList . reverse) + (NVSet mempty . M.fromList . reverse) (traverse (\ nvattrset -> do @@ -1500,8 +1497,8 @@ groupByNix nvfun nvlist = do list <- demand nvlist fun <- demand nvfun (f, l) <- extractP (fun, list) - mkNVSet mempty - . fmap (mkNVList . reverse) + NVSet mempty + . fmap (NVList . reverse) . M.fromListWith (<>) <$> traverse (app f) l where @@ -1565,7 +1562,7 @@ findFileNix nvaset nvfilepath = do mres <- findPath @t @f @m x $ coerce $ toString $ ignoreContext ns - pure $ mkNVPath mres + pure $ NVPath mres (NVList _, _y ) -> throwError $ ErrorCall $ "expected a string, got " <> show _y (_x , NVStr _) -> throwError $ ErrorCall $ "expected a list, got " <> show _x @@ -1620,32 +1617,32 @@ fromJSONNix nvjson = \case A.Object m -> traverseToNValue - (mkNVSet mempty) + (NVSet mempty) #if MIN_VERSION_aeson(2,0,0) (M.mapKeys (coerce . AKM.toText) $ AKM.toHashMap m) #else (M.mapKeys coerce m) #endif - A.Array l -> traverseToNValue mkNVList (V.toList l) + A.Array l -> traverseToNValue NVList (V.toList l) A.String s -> pure $ mkNVStrWithoutContext s A.Number n -> pure $ - mkNVConstant $ + NVConstant $ either NFloat NInt (floatingOrInteger n) - A.Bool b -> pure $ mkNVBool b - A.Null -> pure nvNull + A.Bool b -> pure $ NVBool b + A.Null -> pure NVNull where traverseToNValue :: Traversable t0 => (t0 (NValue t f m) -> b) -> t0 A.Value -> m b traverseToNValue f v = f <$> traverse jsonToNValue v toJSONNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) -toJSONNix = (fmap mkNVStr . toJSONNixString) <=< demand +toJSONNix = (fmap NVStr . toJSONNixString) <=< demand toXMLNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) -toXMLNix = (fmap (mkNVStr . toXML) . normalForm) <=< demand +toXMLNix = (fmap (NVStr . toXML) . normalForm) <=< demand typeOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) typeOfNix nvv = @@ -1677,19 +1674,19 @@ tryEvalNix e = (`catch` (pure . onError)) (onSuccess <$> demand e) where onSuccess v = - mkNVSet + NVSet mempty $ M.fromList - [ ("success", mkNVBool True) + [ ("success", NVBool True) , ("value" , v ) ] onError :: SomeException -> NValue t f m onError _ = - mkNVSet + NVSet mempty $ M.fromList - $ (, mkNVBool False) <$> + $ (, NVBool False) <$> [ "success" , "value" ] @@ -1762,7 +1759,7 @@ partitionNix f nvlst = let (right, wrong) = partition fst selection - makeSide = mkNVList . fmap snd + makeSide = NVList . fmap snd toValue @(AttrSet (NValue t f m)) $ M.fromList @@ -1787,15 +1784,15 @@ currentTimeNix = derivationStrictNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) derivationStrictNix = derivationStrict -getRecursiveSizeNix :: (MonadIntrospect m, Applicative f) => a -> m (NValue t f m) -getRecursiveSizeNix = fmap (mkNVConstant . NInt . fromIntegral) . recursiveSize +getRecursiveSizeNix :: (MonadIntrospect m, NVConstraint f) => a -> m (NValue t f m) +getRecursiveSizeNix = fmap (NVConstant . NInt . fromIntegral) . recursiveSize getContextNix :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) getContextNix = \case (NVStr ns) -> - mkNVSet mempty <$> traverseToValue (getNixLikeContext $ toNixLikeContext $ getStringContext ns) + NVSet mempty <$> traverseToValue (getNixLikeContext $ toNixLikeContext $ getStringContext ns) x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x <=< demand @@ -1923,7 +1920,7 @@ builtinsList = , add2 Normal "elem" elemNix , add2 Normal "elemAt" elemAtNix , add Normal "exec" execNix - , add0 Normal "false" (pure $ mkNVBool False) + , add0 Normal "false" (pure $ NVBool False) --, add Normal "fetchGit" fetchGit --, add Normal "fetchMercurial" fetchMercurial , add Normal "fetchTarball" fetchTarball @@ -1962,7 +1959,7 @@ builtinsList = , add2 Normal "match" matchNix , add2 Normal "mul" mulNix , add0 Normal "nixPath" nixPathNix - , add0 Normal "null" (pure nvNull) + , add0 Normal "null" (pure NVNull) , add Normal "parseDrvName" parseDrvNameNix , add2 Normal "partition" partitionNix , add Normal "path" pathNix @@ -1984,7 +1981,7 @@ builtinsList = , add Normal "toJSON" toJSONNix , add Normal "toPath" toPathNix -- Deprecated in Nix: https://github.com/NixOS/nix/pull/2524 , add Normal "toXML" toXMLNix - , add0 Normal "true" (pure $ mkNVBool True) + , add0 Normal "true" (pure $ NVBool True) , add Normal "tryEval" tryEvalNix , add Normal "typeOf" typeOfNix , add Normal "unsafeDiscardOutputDependency" unsafeDiscardOutputDependencyNix @@ -2084,7 +2081,7 @@ withNixContext mpath action = opts <- askOptions pushScope - (one ("__includes", mkNVList $ mkNVStrWithoutContext . fromString . coerce <$> getInclude opts)) + (one ("__includes", NVList $ mkNVStrWithoutContext . fromString . coerce <$> getInclude opts)) (pushScopes base $ maybe @@ -2092,7 +2089,7 @@ withNixContext mpath action = (\ path act -> do traceM $ "Setting __cur_file = " <> show path - pushScope (one ("__cur_file", mkNVPath path)) act + pushScope (one ("__cur_file", NVPath path)) act ) mpath action @@ -2106,7 +2103,7 @@ builtins => m (Scopes m (NValue t f m)) builtins = do - ref <- defer $ mkNVSet mempty <$> buildMap + ref <- defer $ NVSet mempty <$> buildMap (`pushScope` askScopes) . coerce . M.fromList . (one ("builtins", ref) <>) =<< topLevelBuiltins where buildMap :: m (HashMap VarName (NValue t f m)) diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index 41bb7ee12..62d7898bf 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -370,39 +370,39 @@ instance ( Convertible e t f m instance Convertible e t f m => ToValue () m (NValue' t f m (NValue t f m)) where - toValue = const $ pure nvNull' + toValue = const $ pure NVNull' instance Convertible e t f m => ToValue Bool m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVConstant' . NBool + toValue = pure . NVConstant' . NBool instance Convertible e t f m => ToValue Int m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVConstant' . NInt . toInteger + toValue = pure . NVConstant' . NInt . toInteger instance Convertible e t f m => ToValue Integer m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVConstant' . NInt + toValue = pure . NVConstant' . NInt instance Convertible e t f m => ToValue Float m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVConstant' . NFloat + toValue = pure . NVConstant' . NFloat instance Convertible e t f m => ToValue NixString m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVStr' + toValue = pure . NVStr' instance Convertible e t f m => ToValue ByteString m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVStr' . mkNixStringWithoutContext . decodeUtf8 + toValue = pure . NVStr' . mkNixStringWithoutContext . decodeUtf8 instance Convertible e t f m => ToValue Text m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVStr' . mkNixStringWithoutContext + toValue = pure . NVStr' . mkNixStringWithoutContext instance Convertible e t f m => ToValue Path m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVPath' . coerce + toValue = pure . NVPath' . coerce instance Convertible e t f m => ToValue StorePath m (NValue' t f m (NValue t f m)) where @@ -415,40 +415,40 @@ instance Convertible e t f m l' <- toValue $ unPos $ coerce l c' <- toValue $ unPos $ coerce c let pos = M.fromList [("file" :: VarName, f'), ("line", l'), ("column", c')] - pure $ mkNVSet' mempty pos + pure $ NVSet' mempty pos -- | With 'ToValue', we can always act recursively instance Convertible e t f m => ToValue [NValue t f m] m (NValue' t f m (NValue t f m)) where - toValue = pure . mkNVList' + toValue = pure . NVList' instance (Convertible e t f m , ToValue a m (NValue t f m) ) => ToValue [a] m (Deeper (NValue' t f m (NValue t f m))) where - toValue l = Deeper . mkNVList' <$> traverseToValue l + toValue l = Deeper . NVList' <$> traverseToValue l instance Convertible e t f m => ToValue (AttrSet (NValue t f m)) m (NValue' t f m (NValue t f m)) where - toValue s = pure $ mkNVSet' mempty s + toValue s = pure $ NVSet' mempty s instance (Convertible e t f m, ToValue a m (NValue t f m)) => ToValue (AttrSet a) m (Deeper (NValue' t f m (NValue t f m))) where toValue s = - liftA2 (\ v s -> Deeper $ mkNVSet' s v) + liftA2 (\ v s -> Deeper $ NVSet' s v) (traverseToValue s) stub instance Convertible e t f m => ToValue (AttrSet (NValue t f m), PositionSet) m (NValue' t f m (NValue t f m)) where - toValue (s, p) = pure $ mkNVSet' p s + toValue (s, p) = pure $ NVSet' p s instance (Convertible e t f m, ToValue a m (NValue t f m)) => ToValue (AttrSet a, PositionSet) m (Deeper (NValue' t f m (NValue t f m))) where toValue (s, p) = - liftA2 (\ v s -> Deeper $ mkNVSet' s v) + liftA2 (\ v s -> Deeper $ NVSet' s v) (traverseToValue s) (pure p) @@ -472,7 +472,7 @@ instance Convertible e t f m (pure Nothing) (fmap pure . toValue) ts - pure $ mkNVSet' mempty $ M.fromList $ catMaybes + pure $ NVSet' mempty $ M.fromList $ catMaybes [ ("path" ,) <$> path , ("allOutputs",) <$> allOutputs , ("outputs" ,) <$> outputs diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs index fe0989024..27438011d 100644 --- a/src/Nix/Effects/Derivation.hs +++ b/src/Nix/Effects/Derivation.hs @@ -292,10 +292,10 @@ defaultDerivationStrict val = do (\out (coerce -> path) -> mkNixStringWithSingletonContext (StringContext (DerivationOutput out) drvPath) path) (outputs drv') drvPathWithContext = mkNixStringWithSingletonContext (StringContext AllOutputs drvPath) drvPath - attrSet = mkNVStr <$> M.fromList (("drvPath", drvPathWithContext) : Map.toList outputsWithContext) + attrSet = NVStr <$> M.fromList (("drvPath", drvPathWithContext) : Map.toList outputsWithContext) -- TODO: Add location information for all the entries. -- here --v - pure $ mkNVSet mempty $ M.mapKeys coerce attrSet + pure $ NVSet mempty $ M.mapKeys coerce attrSet where @@ -368,7 +368,7 @@ buildDerivationWithContext drvAttrs = do env <- if useJson then do - jsonString :: NixString <- lift $ toJSONNixString $ mkNVSet mempty $ M.mapKeys coerce $ + jsonString :: NixString <- lift $ toJSONNixString $ NVSet mempty $ M.mapKeys coerce $ deleteKeys [ "args", "__ignoreNulls", "__structuredAttrs" ] attrs rawString :: Text <- extractNixString jsonString pure $ one ("__json", rawString) diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index 93a30866a..71bec3547 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -61,7 +61,7 @@ mkNVConstantWithProvenance -> NAtom -> NValue t f m mkNVConstantWithProvenance scopes span x = - addProvenance (Provenance scopes . NConstantAnnF span $ x) $ mkNVConstant x + addProvenance (Provenance scopes . NConstantAnnF span $ x) $ NVConstant x mkNVStrWithProvenance :: MonadCited t f m @@ -70,7 +70,7 @@ mkNVStrWithProvenance -> NixString -> NValue t f m mkNVStrWithProvenance scopes span x = - addProvenance (Provenance scopes . NStrAnnF span . DoubleQuoted . one . Plain . ignoreContext $ x) $ mkNVStr x + addProvenance (Provenance scopes . NStrAnnF span . DoubleQuoted . one . Plain . ignoreContext $ x) $ NVStr x mkNVPathWithProvenance :: MonadCited t f m @@ -80,7 +80,7 @@ mkNVPathWithProvenance -> Path -> NValue t f m mkNVPathWithProvenance scope span lit real = - addProvenance (Provenance scope . NLiteralPathAnnF span $ lit) $ mkNVPath real + addProvenance (Provenance scope . NLiteralPathAnnF span $ lit) $ NVPath real mkNVClosureWithProvenance :: MonadCited t f m @@ -90,7 +90,7 @@ mkNVClosureWithProvenance -> (NValue t f m -> m (NValue t f m)) -> NValue t f m mkNVClosureWithProvenance scopes span x f = - addProvenance (Provenance scopes $ NAbsAnnF span (Nothing <$ x) Nothing) $ mkNVClosure x f + addProvenance (Provenance scopes $ NAbsAnnF span (Nothing <$ x) Nothing) $ NVClosure x f mkNVUnaryOpWithProvenance :: MonadCited t f m @@ -350,7 +350,7 @@ execUnaryOp scope span op arg = throwError $ ErrorCall $ "argument to unary operator must evaluate to an atomic type: " <> show _x where mkUnaryOp :: (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m) - mkUnaryOp c b a = pure . mkNVUnaryOpWithProvenance scope span op (pure arg) . mkNVConstant $ c (b a) + mkUnaryOp c b a = pure . mkNVUnaryOpWithProvenance scope span op (pure arg) . NVConstant $ c (b a) execBinaryOp :: forall e t f m @@ -401,7 +401,7 @@ execBinaryOp scope span op lval rarg = toBoolOp :: Maybe (NValue t f m) -> Bool -> m (NValue t f m) toBoolOp r b = - pure $ mkNVBinaryOpWithProvenance scope span op (pure lval) r $ mkNVConstant $ NBool b + pure $ mkNVBinaryOpWithProvenance scope span op (pure lval) r $ NVConstant $ NBool b execBinaryOpForced :: forall e t f m @@ -463,25 +463,25 @@ execBinaryOpForced scope span op lval rval = mkNVBinaryOpWithProvenance scope span op (pure lval) (pure rval) mkBoolP :: Bool -> m (NValue t f m) - mkBoolP = pure . addProv . mkNVConstant . NBool + mkBoolP = pure . addProv . NVConstant . NBool mkIntP :: Integer -> m (NValue t f m) - mkIntP = pure . addProv . mkNVConstant . NInt + mkIntP = pure . addProv . NVConstant . NInt mkFloatP :: Float -> m (NValue t f m) - mkFloatP = pure . addProv . mkNVConstant . NFloat + mkFloatP = pure . addProv . NVConstant . NFloat mkListP :: [NValue t f m] -> NValue t f m - mkListP = addProv . mkNVList + mkListP = addProv . NVList mkStrP :: NixString -> NValue t f m - mkStrP = addProv . mkNVStr + mkStrP = addProv . NVStr mkPathP :: Path -> NValue t f m - mkPathP = addProv . mkNVPath + mkPathP = addProv . NVPath mkSetP :: (PositionSet -> AttrSet (NValue t f m) -> NValue t f m) - mkSetP x s = addProv $ mkNVSet x s + mkSetP x s = addProv $ NVSet x s mkCmpOp :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m) mkCmpOp op = case (lval, rval) of diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 54c8f7b81..3fa34c88c 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -1,7 +1,6 @@ {-# language ConstraintKinds #-} {-# language CPP #-} {-# language DataKinds #-} -{-# language GADTs #-} {-# language GeneralizedNewtypeDeriving #-} {-# language TypeFamilies #-} {-# language UndecidableInstances #-} diff --git a/src/Nix/Normal.hs b/src/Nix/Normal.hs index 53e22691e..b9ae8f08c 100644 --- a/src/Nix/Normal.hs +++ b/src/Nix/Normal.hs @@ -1,7 +1,6 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} {-# language DataKinds #-} -{-# language GADTs #-} {-# language TypeFamilies #-} {-# language RankNTypes #-} @@ -141,7 +140,7 @@ normalForm_ -> m () normalForm_ t = void $ normalizeValue t -opaqueVal :: Applicative f => NValue t f m +opaqueVal :: NVConstraint f => NValue t f m opaqueVal = mkNVStrWithoutContext "<cycle>" -- | Detect cycles & stub them. @@ -167,14 +166,14 @@ stubCycles = where Free (NValue' cyc) = opaqueVal -thunkStubVal :: Applicative f => NValue t f m +thunkStubVal :: NVConstraint f => NValue t f m thunkStubVal = mkNVStrWithoutContext thunkStubText -- | Check if thunk @t@ is computed, -- then bind it into first arg. -- else bind the thunk stub val. bindComputedThunkOrStub - :: ( Applicative f + :: ( NVConstraint f , MonadThunk t m (NValue t f m) ) => (NValue t f m -> m a) diff --git a/src/Nix/Render.hs b/src/Nix/Render.hs index 50fc17fdb..a31d5520b 100644 --- a/src/Nix/Render.hs +++ b/src/Nix/Render.hs @@ -2,7 +2,6 @@ {-# language CPP #-} {-# language ConstraintKinds #-} {-# language DefaultSignatures #-} -{-# language GADTs #-} {-# language TypeFamilies #-} {-# language TypeOperators #-} {-# language MultiWayIf #-} diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index a19942f83..175b71378 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -2,7 +2,6 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} {-# language MultiWayIf #-} -{-# language GADTs #-} {-# language TypeFamilies #-} diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index aafdc25a5..f38c7bf4c 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -266,6 +266,12 @@ hoistNValueF lft = -- * @__NValue'__@: forming the (F(A)) +-- | NVConstraint constraint the f layer in @NValue'@. +-- It makes bijection between sub category of Hask and Nix Value possible. +-- 'Comonad' enable Nix Value to Hask part. +-- 'Applicative' enable Hask to Nix Value part. +type NVConstraint f = (Comonad f, Applicative f) + -- | At the time of constructor, the expected arguments to closures are values -- that may contain thunks. The type of such thunks are fixed at that time. newtype NValue' t f m a = @@ -276,13 +282,13 @@ newtype NValue' t f m a = } deriving (Generic, Typeable, Functor, Foldable) -instance (Comonad f, Show a) => Show (NValue' t f m a) where +instance (NVConstraint f, Show a) => Show (NValue' t f m a) where show (NValue' (extract -> v)) = show v -- ** Show1 -instance Comonad f => Show1 (NValue' t f m) where +instance NVConstraint f => Show1 (NValue' t f m) where liftShowsPrec sp sl p = \case NVConstant' atom -> showsUnaryWith showsPrec "NVConstantF" p atom NVStr' ns -> showsUnaryWith showsPrec "NVStrF" p $ ignoreContext ns @@ -378,10 +384,9 @@ unliftNValue' = hoistNValue' lift -- ** Bijective Hask subcategory <-> @NValue'@ --- *** @F: Hask subcategory → NValue'@ --- +-- *** @F: Hask subcategory <-> NValue'@ -- #mantra# --- $Methods @F: Hask → NValue'@ +-- $Patterns @F: Hask <-> NValue'@ -- -- Since Haskell and Nix are both recursive purely functional lazy languages. -- And since recursion-schemes. @@ -395,88 +400,57 @@ unliftNValue' = hoistNValue' lift -- -- Since it is a proper way of scientific implementation, we would eventually form a -- lawful functor. +-- +-- Module pattens use @language PatternSynonyms@: bidirectional synonyms (@<-@), +-- and @ViewPatterns@: (@->@) at the same time. +-- @ViewPatterns Control.Comonad.extract@ extracts +-- from the @NValue (Free (NValueF a))@ +-- the @NValueF a@. Which is @NValueF p m r@. Since it extracted from the +-- @NValue@, which is formed by \( (F a -> a) F a \) in the first place. +-- So @NValueF p m r@ which is extracted here, internally holds the next NValue. -- --- Facts of which are seen below: +-- Facts of bijection between Hask subcategory objects and Nix objects, +-- and between Hask subcategory morphisms and Nix morphisms are seen blow: --- | Haskell constant to the Nix constant, -mkNVConstant' :: Applicative f - => NAtom - -> NValue' t f m r -mkNVConstant' = NValue' . pure . NVConstantF - -- | Using of Nulls is generally discouraged (in programming language design et al.), but, if you need it. -nvNull' :: Applicative f - => NValue' t f m r -nvNull' = mkNVConstant' NNull +pattern NVNull' :: NVConstraint w => NValue' t w m a +pattern NVNull' = NVConstant' NNull +-- | Haskell constant to the Nix constant, +pattern NVConstant' :: NVConstraint w => NAtom -> NValue' t w m a +pattern NVConstant' x <- NValue' (extract -> NVConstantF x) + where NVConstant' = NValue' . pure . NVConstantF -- | Haskell text & context to the Nix text & context, -mkNVStr' :: Applicative f - => NixString - -> NValue' t f m r -mkNVStr' = NValue' . pure . NVStrF - +pattern NVStr' :: NVConstraint w => NixString -> NValue' t w m a +pattern NVStr' ns <- NValue' (extract -> NVStrF ns) + where NVStr' = NValue' . pure . NVStrF -- | Haskell @Path@ to the Nix path, -mkNVPath' :: Applicative f - => Path - -> NValue' t f m r -mkNVPath' = NValue' . pure . NVPathF . coerce - +pattern NVPath' :: NVConstraint w => Path -> NValue' t w m a +pattern NVPath' x <- NValue' (extract -> NVPathF x) + where NVPath' = NValue' . pure . NVPathF . coerce -- | Haskell @[]@ to the Nix @[]@, -mkNVList' :: Applicative f - => [r] - -> NValue' t f m r -mkNVList' = NValue' . pure . NVListF - +pattern NVList' :: NVConstraint w => [a] -> NValue' t w m a +pattern NVList' l <- NValue' (extract -> NVListF l) + where NVList' = NValue' . pure . NVListF -- | Haskell key-value to the Nix key-value, -mkNVSet' :: Applicative f - => PositionSet - -> AttrSet r - -> NValue' t f m r -mkNVSet' p s = NValue' $ pure $ NVSetF p s - +pattern NVSet' :: NVConstraint w => PositionSet -> AttrSet a -> NValue' t w m a +pattern NVSet' p s <- NValue' (extract -> NVSetF p s) + where NVSet' p s = NValue' $ pure $ NVSetF p s -- | Haskell closure to the Nix closure, -mkNVClosure' :: (Applicative f, Functor m) - => Params () - -> (NValue t f m - -> m r - ) - -> NValue' t f m r -mkNVClosure' x f = NValue' $ pure $ NVClosureF x f - +pattern NVClosure' :: NVConstraint w => Params () -> (NValue t w m -> m a) -> NValue' t w m a +pattern NVClosure' x f <- NValue' (extract -> NVClosureF x f) + where NVClosure' x f = NValue' $ pure $ NVClosureF x f -- | Haskell functions to the Nix functions! -mkNVBuiltin' :: (Applicative f, Functor m) - => VarName - -> (NValue t f m -> m r) - -> NValue' t f m r -mkNVBuiltin' name f = NValue' $ pure $ NVBuiltinF name f - - --- So above we have maps of Hask subcategory objects to Nix objects, --- and Hask subcategory morphisms to Nix morphisms. - --- *** @F: NValue -> NValue'@ - --- | Module pattens use @language PatternSynonyms@: unidirectional synonyms (@<-@), --- and @ViewPatterns@: (@->@) at the same time. --- @ViewPatterns Control.Comonad.extract@ extracts --- from the @NValue (Free (NValueF a))@ --- the @NValueF a@. Which is @NValueF p m r@. Since it extracted from the --- @NValue@, which is formed by \( (F a -> a) F a \) in the first place. --- So @NValueF p m r@ which is extracted here, internally holds the next NValue. -pattern NVConstant' x <- NValue' (extract -> NVConstantF x) -pattern NVStr' ns <- NValue' (extract -> NVStrF ns) -pattern NVPath' x <- NValue' (extract -> NVPathF x) -pattern NVList' l <- NValue' (extract -> NVListF l) -pattern NVSet' p s <- NValue' (extract -> NVSetF p s) -pattern NVClosure' x f <- NValue' (extract -> NVClosureF x f) +pattern NVBuiltin' :: NVConstraint w => VarName -> (NValue t w m -> m a) -> NValue' t w m a pattern NVBuiltin' name f <- NValue' (extract -> NVBuiltinF name f) + where NVBuiltin' name f = NValue' $ pure $ NVBuiltinF name f {-# complete NVConstant', NVStr', NVPath', NVList', NVSet', NVClosure', NVBuiltin' #-} @@ -574,72 +548,12 @@ unliftNValue = hoistNValue lift -- The morphisms of the functor @Hask → NValue@. -- Continuation of the mantra: "Nix.Value#mantra" - --- | Life of a Haskell thunk to the life of a Nix thunk, -mkNVThunk :: Applicative f - => t - -> NValue t f m -mkNVThunk = Pure - - --- | Life of a Haskell constant to the life of a Nix constant, -mkNVConstant :: Applicative f - => NAtom - -> NValue t f m -mkNVConstant = Free . mkNVConstant' - -- | Using of Nulls is generally discouraged (in programming language design et al.), but, if you need it. -nvNull :: Applicative f - => NValue t f m -nvNull = mkNVConstant NNull - --- | Life of a Haskell sting & context to the life of a Nix string & context, -mkNVStr :: Applicative f - => NixString - -> NValue t f m -mkNVStr = Free . mkNVStr' -mkNVStrWithoutContext :: Applicative f +mkNVStrWithoutContext :: NVConstraint f => Text -> NValue t f m -mkNVStrWithoutContext = mkNVStr . mkNixStringWithoutContext - - --- | Life of a Haskell FilePath to the life of a Nix path -mkNVPath :: Applicative f - => Path - -> NValue t f m -mkNVPath = Free . mkNVPath' - - -mkNVList :: Applicative f - => [NValue t f m] - -> NValue t f m -mkNVList = Free . mkNVList' - - -mkNVSet :: Applicative f - => PositionSet - -> AttrSet (NValue t f m) - -> NValue t f m -mkNVSet p s = Free $ mkNVSet' p s - -mkNVClosure :: (Applicative f, Functor m) - => Params () - -> (NValue t f m - -> m (NValue t f m) - ) - -> NValue t f m -mkNVClosure x f = Free $ mkNVClosure' x f - - -mkNVBuiltin :: (Applicative f, Functor m) - => VarName - -> (NValue t f m - -> m (NValue t f m) - ) - -> NValue t f m -mkNVBuiltin name f = Free $ mkNVBuiltin' name f +mkNVStrWithoutContext = NVStr . mkNixStringWithoutContext builtin @@ -650,7 +564,7 @@ builtin -> m (NValue t f m) ) -- ^ unary function -> m (NValue t f m) -builtin = (pure .) . mkNVBuiltin +builtin = (pure .) . NVBuiltin builtin2 @@ -680,20 +594,22 @@ builtin3 = -- *** @F: Evaluation -> NValue@ -pattern NVThunk t <- Pure t -pattern NVValue v <- Free v -{-# complete NVThunk, NVValue #-} -pattern NVConstant x <- Free (NVConstant' x) -pattern NVStr ns <- Free (NVStr' ns) -pattern NVPath x <- Free (NVPath' x) -pattern NVList l <- Free (NVList' l) -pattern NVSet s x <- Free (NVSet' s x) -pattern NVClosure x f <- Free (NVClosure' x f) -pattern NVBuiltin name f <- Free (NVBuiltin' name f) +pattern NVNull = Free NVNull' +pattern NVThunk t = Pure t +pattern NVValue v = Free v +{-# complete NVThunk, NVValue, NVNull #-} +pattern NVConstant x = Free (NVConstant' x) +pattern NVStr ns = Free (NVStr' ns) +pattern NVPath x = Free (NVPath' x) +pattern NVList l = Free (NVList' l) +pattern NVSet s x = Free (NVSet' s x) +pattern NVClosure x f = Free (NVClosure' x f) +pattern NVBuiltin name f = Free (NVBuiltin' name f) {-# complete NVThunk, NVConstant, NVStr, NVPath, NVList, NVSet, NVClosure, NVBuiltin #-} + -- * @TStringContext@ data TStringContext = NoContext | HasContext @@ -784,7 +700,7 @@ data ValueFrame t f m | Expectation ValueType (NValue t f m) deriving Typeable -deriving instance (Comonad f, Show t) => Show (ValueFrame t f m) +deriving instance (NVConstraint f, Show t) => Show (ValueFrame t f m) -- * @MonadDataContext@ diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs index 556d9d182..d078e7544 100644 --- a/src/Nix/Value/Equal.hs +++ b/src/Nix/Value/Equal.hs @@ -167,7 +167,7 @@ compareAttrSets f eq lm rm = runIdentity $ compareAttrSetsM (Identity . f) ((Identity .) . eq) lm rm valueEqM - :: (MonadThunk t m (NValue t f m), Comonad f) + :: (MonadThunk t m (NValue t f m), NVConstraint f) => NValue t f m -> NValue t f m -> m Bool @@ -195,7 +195,7 @@ valueEqM (Free (NValue' (extract -> x))) (Free (NValue' (extract -> y))) = _ -> mempty ) -thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool +thunkEqM :: (MonadThunk t m (NValue t f m), NVConstraint f) => t -> t -> m Bool thunkEqM lt rt = do lv <- force lt