Noncompiling inscrutable type error hell trying to get puzzle pieces to fit

This commit is contained in:
Paul Chiusano 2021-07-13 00:16:32 -04:00
parent f7ea984479
commit 787feb1639

View File

@ -9,7 +9,7 @@
module Unison.Server.Backend where module Unison.Server.Backend where
import Control.Lens (_2, over) import Control.Lens (_2, over)
import Control.Error.Util ((??)) import Control.Error.Util ((??),hush)
import Control.Monad.Except import Control.Monad.Except
( ExceptT (..), ( ExceptT (..),
throwError, throwError,
@ -25,6 +25,7 @@ import qualified Text.FuzzyFind as FZF
import qualified Unison.ABT as ABT import qualified Unison.ABT as ABT
import qualified Unison.Builtin as B import qualified Unison.Builtin as B
import qualified Unison.Builtin.Decls as Decls import qualified Unison.Builtin.Decls as Decls
import qualified Unison.Codebase.Runtime as Rt
import qualified Unison.Runtime.IOSource as DD import qualified Unison.Runtime.IOSource as DD
import Unison.Codebase (Codebase) import Unison.Codebase (Codebase)
import qualified Unison.Codebase as Codebase import qualified Unison.Codebase as Codebase
@ -542,10 +543,11 @@ prettyDefinitionsBySuffixes
-> Maybe Branch.Hash -> Maybe Branch.Hash
-> Maybe Width -> Maybe Width
-> Suffixify -> Suffixify
-> Rt.Runtime v
-> Codebase m v Ann -> Codebase m v Ann
-> [HQ.HashQualified Name] -> [HQ.HashQualified Name]
-> Backend m DefinitionDisplayResults -> Backend m DefinitionDisplayResults
prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings codebase query prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings rt codebase query
= do = do
branch <- resolveBranchHash root codebase branch <- resolveBranchHash root codebase
DefinitionResults terms types misses <- definitionsBySuffixes relativeTo DefinitionResults terms types misses <- definitionsBySuffixes relativeTo
@ -606,13 +608,14 @@ prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings codeba
eval tm = do eval tm = do
let ppes = PPE.suffixifiedPPE ppe let ppes = PPE.suffixifiedPPE ppe
let codeLookup = Codebase.toCodeLookup codebase let codeLookup = Codebase.toCodeLookup codebase
let cache = Codebase.lookupWatchCache codebase let cache r = fmap Term.unannotate <$> Codebase.lookupWatchCache codebase r
r <- Runtime.evaluateTerm' codeLookup cache ppes rt tm r <- fmap hush . liftIO $ Rt.evaluateTerm' codeLookup cache ppes rt tm
lift $ case r of lift $ case r of
Right tmr -> Codebase.putWatch codebase UF.RegularWatch (Term.hashClosedTerm tm) Just tmr -> Codebase.putWatch codebase UF.RegularWatch
(Term.amap (const Parser.External) tmr) (Term.hashClosedTerm tm)
Left _ -> pure () (Term.amap (const mempty) tmr)
pure $ r <&> Term.amap (const Parser.External) Nothing -> pure ()
pure $ r <&> Term.unannotate
decls (Reference.DerivedId r) = fmap (DD.amap (const ())) <$> lift (Codebase.getTypeDeclaration codebase r) decls (Reference.DerivedId r) = fmap (DD.amap (const ())) <$> lift (Codebase.getTypeDeclaration codebase r)
decls _ = pure Nothing decls _ = pure Nothing