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

Generalize some definitions in Trace.hs

Browse source
This commit is contained in:
John Wiegley 2018-04-19 22:56:03 -07:00
parent a23d42ffc7
commit bc832ed58a
1 changed files with 6 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
src/Nix/Trace.hs
View file

@ -75,21 +75,22 @@ processImports mfile expr = do
processImports (Just path') x'
x -> pure $ Fix x
newtype FlaggedF (f :: * -> *) r = FlaggedF { flagged :: (IORef Bool, f r) }
newtype FlaggedF f r = FlaggedF { flagged :: (IORef Bool, f r) }
deriving (Functor, Foldable, Traversable)
instance Show (f r) => Show (FlaggedF f r) where
show (FlaggedF (_, x)) = show x
type Flagged (f :: * -> *) = Fix (FlaggedF f)
type Flagged f = Fix (FlaggedF f)
flagExprLoc :: MonadIO n => NExprLoc -> n (Flagged NExprLocF)
flagExprLoc :: (MonadIO n, Traversable f)
=> Fix f -> n (Flagged f)
flagExprLoc = cataM $ \x -> do
flag <- liftIO $ newIORef False
pure $ Fix $ FlaggedF (flag, x)
stripFlags :: Flagged NExprLocF -> NExprLoc
stripFlags = cata $ \(FlaggedF (_, x)) -> Fix x
stripFlags :: Functor f => Flagged f -> Fix f
stripFlags = cata $ Fix . snd . flagged
pruneTree :: MonadIO n => Flagged NExprLocF -> n (Maybe NExprLoc)
pruneTree = cataM $ \(FlaggedF (b, Compose x)) -> do