-
Notifications
You must be signed in to change notification settings - Fork 272
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #5498 from unisonweb/24-12-04-fix-5427
- Loading branch information
Showing
6 changed files
with
426 additions
and
144 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
62 changes: 31 additions & 31 deletions
62
parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | ||
} |
Oops, something went wrong.