Skip to content

Commit

Permalink
Merge pull request #5498 from unisonweb/24-12-04-fix-5427
Browse files Browse the repository at this point in the history
  • Loading branch information
aryairani authored Dec 19, 2024
2 parents 436abd8 + 28884e3 commit 8e32841
Show file tree
Hide file tree
Showing 6 changed files with 426 additions and 144 deletions.
1 change: 1 addition & 0 deletions parser-typechecker/package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,7 @@ default-extensions:
- ApplicativeDo
- BangPatterns
- BlockArguments
- ConstraintKinds
- DeriveAnyClass
- DeriveFunctor
- DeriveGeneric
Expand Down
62 changes: 31 additions & 31 deletions parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs
Original file line number Diff line number Diff line change
@@ -1,47 +1,47 @@
{-# LANGUAGE ConstraintKinds #-}

module Unison.PrettyPrintEnv.MonadPretty where

import Control.Lens (views, _1, _2)
module Unison.PrettyPrintEnv.MonadPretty
( MonadPretty,
Env (..),
runPretty,
addTypeVars,
willCaptureType,
)
where

import Control.Lens (views)
import Control.Monad.Reader (MonadReader, Reader, local, runReader)
import Data.Set qualified as Set
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv)
import Unison.Util.Set qualified as Set
import Unison.Var (Var)

type MonadPretty v m = (Var v, MonadReader (PrettyPrintEnv, Set v) m)

getPPE :: (MonadPretty v m) => m PrettyPrintEnv
getPPE = view _1

-- | Run a computation with a modified PrettyPrintEnv, restoring the original
withPPE :: (MonadPretty v m) => PrettyPrintEnv -> m a -> m a
withPPE p = local (set _1 p)
type MonadPretty v m = (Var v, MonadReader (Env v) m)

applyPPE :: (MonadPretty v m) => (PrettyPrintEnv -> a) -> m a
applyPPE = views _1

applyPPE2 :: (MonadPretty v m) => (PrettyPrintEnv -> a -> b) -> a -> m b
applyPPE2 f a = views _1 (`f` a)

applyPPE3 :: (MonadPretty v m) => (PrettyPrintEnv -> a -> b -> c) -> a -> b -> m c
applyPPE3 f a b = views _1 (\ppe -> f ppe a b)

-- | Run a computation with a modified PrettyPrintEnv, restoring the original
modifyPPE :: (MonadPretty v m) => (PrettyPrintEnv -> PrettyPrintEnv) -> m a -> m a
modifyPPE = local . over _1
data Env v = Env
{ boundTerms :: !(Set v),
boundTypes :: !(Set v),
ppe :: !PrettyPrintEnv
}
deriving stock (Generic)

modifyTypeVars :: (MonadPretty v m) => (Set v -> Set v) -> m a -> m a
modifyTypeVars = local . over _2
modifyTypeVars = local . over #boundTypes

-- | Add type variables to the set of variables that need to be avoided
addTypeVars :: (MonadPretty v m) => [v] -> m a -> m a
addTypeVars = modifyTypeVars . Set.union . Set.fromList

-- | Check if a list of type variables contains any variables that need to be
-- avoided
willCapture :: (MonadPretty v m) => [v] -> m Bool
willCapture vs = views _2 (not . Set.null . Set.intersection (Set.fromList vs))

runPretty :: (Var v) => PrettyPrintEnv -> Reader (PrettyPrintEnv, Set v) a -> a
runPretty ppe m = runReader m (ppe, mempty)
willCaptureType :: (MonadPretty v m) => [v] -> m Bool
willCaptureType vs = views #boundTypes (Set.intersects (Set.fromList vs))

runPretty :: (Var v) => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty ppe m =
runReader
m
Env
{ boundTerms = Set.empty,
boundTypes = Set.empty,
ppe
}
Loading

0 comments on commit 8e32841

Please sign in to comment.