From 54030284fa7905b748b8df93d6c095c40f45ae2f Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Thu, 23 Jul 2020 02:52:21 +0200 Subject: [PATCH] Update to data-fix-0.3 Changelog: http://hackage.haskell.org/package/data-fix-0.3.0/changelog Context: https://github.com/commercialhaskell/stackage/issues/5535 --- default.nix | 14 ++++++++++++++ hnix.cabal | 2 +- src/Nix/Builtins.hs | 4 ++-- src/Nix/Expr/Types/Annotated.hs | 8 ++------ src/Nix/Pretty.hs | 4 ++-- src/Nix/Reduce.hs | 18 +++++++++--------- src/Nix/Type/Infer.hs | 4 ++-- tests/PrettyParseTests.hs | 2 +- 8 files changed, 33 insertions(+), 23 deletions(-) diff --git a/default.nix b/default.nix index 376571229..70a32ffb1 100644 --- a/default.nix +++ b/default.nix @@ -212,6 +212,20 @@ let # require n-i >= 0.4. dontCheck helps us avoid conflicts with # neat-interpolation's test dependencies. neat-interpolation = pkgs.haskell.lib.dontCheck super.neat-interpolation_0_5_1; + + # 2020-07-23 hnix uses multiple functions that are unavailable in + # data-fix < 0.3. + data-fix = haskellPackages.callPackage + ({ mkDerivation, base, deepseq, hashable, stdenv }: + mkDerivation { + pname = "data-fix"; + version = "0.3.0"; + sha256 = "9e59b3ed694b5139316093b3767842e60ad4821858459e7cd763e5773dfa99a0"; + libraryHaskellDepends = [ base deepseq hashable ]; + homepage = "https://github.com/spell-music/data-fix"; + description = "Fixpoint data types"; + license = stdenv.lib.licenses.bsd3; + }) {}; }; modifier = drv: pkgs.haskell.lib.overrideCabal drv (attrs: { diff --git a/hnix.cabal b/hnix.cabal index c07c52d74..f66669215 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -873,7 +873,7 @@ library , bytestring >= 0.10.8 && < 0.11 , comonad >= 5.0.4 && < 5.1 , containers >= 0.5.11.0 && < 0.7 - , data-fix >= 0.2.0 && < 0.3 + , data-fix >= 0.3.0 && < 0.4 , deepseq >= 1.4.3 && <1.5 , deriving-compat >= 0.3 && < 0.6 , directory >= 1.3.1 && < 1.4 diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 3a3a223f3..fdd31d6bf 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -43,7 +43,7 @@ import Data.ByteString ( ByteString ) import qualified Data.ByteString as B import Data.ByteString.Base16 as Base16 import Data.Char ( isDigit ) -import Data.Fix ( cata ) +import Data.Fix ( foldFix ) import Data.Foldable ( foldrM ) import qualified Data.HashMap.Lazy as M import Data.List @@ -196,7 +196,7 @@ builtinsList = sequence outputsList = map outputToAttrListElement outputs; in (builtins.head outputsList).value|] - [| cata Eval.eval expr |] + [| foldFix Eval.eval expr |] ) , add TopLevel "derivationStrict" derivationStrict_ diff --git a/src/Nix/Expr/Types/Annotated.hs b/src/Nix/Expr/Types/Annotated.hs index b1fc4b40a..d6e4b5404 100644 --- a/src/Nix/Expr/Types/Annotated.hs +++ b/src/Nix/Expr/Types/Annotated.hs @@ -35,7 +35,7 @@ import Data.Aeson.TH import Data.Binary ( Binary(..) ) import Data.Data import Data.Eq.Deriving -import Data.Fix +import Data.Fix ( Fix(..), unfoldFix ) import Data.Function ( on ) import Data.Functor.Compose import Data.Hashable @@ -108,14 +108,10 @@ type NExprLocF = AnnF SrcSpan NExprF -- | A nix expression with source location at each subexpression. type NExprLoc = Fix NExprLocF -instance NFData NExprLoc - #ifdef MIN_VERSION_serialise instance Serialise NExprLoc #endif -instance Hashable NExprLoc - instance Binary SrcSpan instance (Binary ann, Binary a) => Binary (Ann ann a) instance Binary r => Binary (NExprLocF r) @@ -135,7 +131,7 @@ pattern AnnE :: forall ann (g :: * -> *). ann pattern AnnE ann a = Fix (Compose (Ann ann a)) stripAnnotation :: Functor f => Fix (AnnF ann f) -> Fix f -stripAnnotation = ana (annotated . getCompose . unFix) +stripAnnotation = unfoldFix (annotated . getCompose . unFix) stripAnn :: AnnF ann f r -> f r stripAnn = annotated . getCompose diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index 469bfe484..9f9049520 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -18,7 +18,7 @@ module Nix.Pretty where import Control.Applicative ( (<|>) ) import Control.Comonad import Control.Monad.Free -import Data.Fix +import Data.Fix ( Fix(..), foldFix ) import Data.HashMap.Lazy ( toList ) import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as HashSet @@ -190,7 +190,7 @@ prettyAtom :: NAtom -> NixDoc ann prettyAtom atom = simpleExpr $ pretty $ unpack $ atomText atom prettyNix :: NExpr -> Doc ann -prettyNix = withoutParens . cata exprFNixDoc +prettyNix = withoutParens . foldFix exprFNixDoc instance HasCitations1 m v f => HasCitations m v (NValue' t f m a) where diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs index d462bdf76..92ef7de38 100644 --- a/src/Nix/Reduce.hs +++ b/src/Nix/Reduce.hs @@ -43,7 +43,7 @@ import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Reader import Control.Monad.State.Strict -import Data.Fix +import Data.Fix ( Fix(..), foldFix, foldFixM ) -- import Data.Foldable import Data.HashMap.Lazy ( HashMap ) import qualified Data.HashMap.Lazy as M @@ -117,12 +117,12 @@ staticImport pann path = do x' = Fix (NLet_ span [cur] x) modify (M.insert path x') local (const (Just path, emptyScopes @m @NExprLoc)) $ do - x'' <- cata reduce x' + x'' <- foldFix reduce x' modify (M.insert path x'') return x'' -- gatherNames :: NExprLoc -> HashSet VarName --- gatherNames = cata $ \case +-- gatherNames = foldFix $ \case -- NSym_ _ var -> S.singleton var -- Compose (Ann _ x) -> fold x @@ -132,7 +132,7 @@ reduceExpr mpath expr = (`evalStateT` M.empty) . (`runReaderT` (mpath, emptyScopes)) . runReducer - $ cata reduce expr + $ foldFix reduce expr reduce :: forall m @@ -173,7 +173,7 @@ reduce (NBinary_ bann NApp fun arg) = fun >>= \case Fix (NAbs_ _ (Param name) body) -> do x <- arg - pushScope (M.singleton name x) (cata reduce body) + pushScope (M.singleton name x) (foldFix reduce body) f -> Fix . NBinary_ bann NApp f <$> arg @@ -299,15 +299,15 @@ instance Show (f r) => Show (FlaggedF f r) where type Flagged f = Fix (FlaggedF f) flagExprLoc :: (MonadIO n, Traversable f) => Fix f -> n (Flagged f) -flagExprLoc = cataM $ \x -> do +flagExprLoc = foldFixM $ \x -> do flag <- liftIO $ newIORef False pure $ Fix $ FlaggedF (flag, x) -- stripFlags :: Functor f => Flagged f -> Fix f --- stripFlags = cata $ Fix . snd . flagged +-- stripFlags = foldFix $ Fix . snd . flagged pruneTree :: MonadIO n => Options -> Flagged NExprLocF -> n (Maybe NExprLoc) -pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do +pruneTree opts = foldFixM $ \(FlaggedF (b, Compose x)) -> do used <- liftIO $ readIORef b pure $ if used then Fix . Compose <$> traverse prune x else Nothing where @@ -414,7 +414,7 @@ reducingEvalExpr -> m (NExprLoc, Either r a) reducingEvalExpr eval mpath expr = do expr' <- flagExprLoc =<< liftIO (reduceExpr mpath expr) - eres <- catch (Right <$> cata (addEvalFlags eval) expr') (pure . Left) + eres <- catch (Right <$> foldFix (addEvalFlags eval) expr') (pure . Left) opts :: Options <- asks (view hasLens) expr'' <- pruneTree opts expr' return (fromMaybe nNull expr'', eres) diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs index 39aa63baa..9d786a564 100644 --- a/src/Nix/Type/Infer.hs +++ b/src/Nix/Type/Infer.hs @@ -39,7 +39,7 @@ import Control.Monad.Reader import Control.Monad.Ref import Control.Monad.ST import Control.Monad.State.Strict -import Data.Fix ( cata ) +import Data.Fix ( foldFix ) import Data.Foldable import qualified Data.HashMap.Lazy as M import Data.List ( delete @@ -564,7 +564,7 @@ instance MonadInfer m => ToValue Bool (InferT s m) (Judgment s) where toValue _ = pure $ Judgment As.empty [] typeBool infer :: MonadInfer m => NExpr -> InferT s m (Judgment s) -infer = cata Eval.eval +infer = foldFix Eval.eval inferTop :: Env -> [(Text, NExpr)] -> Either InferError Env inferTop env [] = Right env diff --git a/tests/PrettyParseTests.hs b/tests/PrettyParseTests.hs index 94d7b2d4d..d27e19112 100644 --- a/tests/PrettyParseTests.hs +++ b/tests/PrettyParseTests.hs @@ -143,7 +143,7 @@ equivUpToNormalization :: NExpr -> NExpr -> Bool equivUpToNormalization x y = normalize x == normalize y normalize :: NExpr -> NExpr -normalize = cata $ \case +normalize = foldFix $ \case NConstant (NInt n) | n < 0 -> Fix (NUnary NNeg (Fix (NConstant (NInt (negate n))))) NConstant (NFloat n) | n < 0 ->