mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
fix compilation errors in tests
This commit is contained in:
parent
f8abe26b9d
commit
2d677d0ba3
@ -5,10 +5,7 @@ import Unison.Builtin qualified as Builtin
|
||||
import Unison.NamesWithHistory qualified as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.PrintError
|
||||
( defaultWidth,
|
||||
prettyParseError,
|
||||
)
|
||||
import Unison.PrintError (defaultWidth, prettyParseError)
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.FileParser qualified as FileParser
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
|
@ -8,6 +8,7 @@ module Unison.Test.Common
|
||||
where
|
||||
|
||||
import Control.Monad.Writer (tell)
|
||||
import Data.Functor.Identity (runIdentity)
|
||||
import Data.Sequence (Seq)
|
||||
import Text.Megaparsec.Error qualified as MPE
|
||||
import Unison.ABT qualified as ABT
|
||||
@ -41,6 +42,7 @@ t s =
|
||||
-- . either (error . show ) id
|
||||
-- . Type.bindSomeNames B.names0
|
||||
. either (error . showParseError s) tweak
|
||||
. runIdentity
|
||||
$ Parser.run (Parser.root TypeParser.valueType) s parsingEnv
|
||||
where
|
||||
tweak = Type.generalizeLowercase mempty
|
||||
@ -48,10 +50,10 @@ t s =
|
||||
tm :: String -> Term Symbol
|
||||
tm s =
|
||||
either (error . showParseError s) id
|
||||
-- . Term.bindSomeNames mempty B.names0
|
||||
-- . either (error . showParseError s) id
|
||||
$
|
||||
Parser.run (Parser.root TermParser.term) s parsingEnv
|
||||
-- . Term.bindSomeNames mempty B.names0
|
||||
-- . either (error . showParseError s) id
|
||||
. runIdentity
|
||||
$ Parser.run (Parser.root TermParser.term) s parsingEnv
|
||||
|
||||
showParseError ::
|
||||
(Var v) =>
|
||||
@ -68,7 +70,7 @@ parseAndSynthesizeAsFile ::
|
||||
(Seq (Note Symbol Ann))
|
||||
(Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
|
||||
parseAndSynthesizeAsFile ambient filename s = do
|
||||
file <- Result.fromParsing (Parsers.parseFile filename s parsingEnv)
|
||||
file <- Result.fromParsing (runIdentity (Parsers.parseFile filename s parsingEnv))
|
||||
typecheckingEnv <-
|
||||
FP.computeTypecheckingEnvironment
|
||||
(FP.ShouldUseTndr'Yes parsingEnv)
|
||||
|
@ -41,7 +41,7 @@ test =
|
||||
|
||||
file :: UnisonFile Symbol Ann
|
||||
file =
|
||||
flip unsafeParseFile Common.parsingEnv $
|
||||
runIdentity . flip unsafeParseFile Common.parsingEnv $
|
||||
[r|
|
||||
|
||||
structural type Bool = True | False
|
||||
|
@ -1,5 +1,6 @@
|
||||
module Unison.Test.Syntax.FileParser where
|
||||
|
||||
import Data.Functor.Identity (Identity (..))
|
||||
import Data.List (uncons)
|
||||
import Data.Set (elems)
|
||||
import EasyTest
|
||||
@ -66,7 +67,7 @@ test =
|
||||
|
||||
expectFileParseFailure :: String -> (P.Error Symbol -> Test ()) -> Test ()
|
||||
expectFileParseFailure s expectation = scope s $ do
|
||||
let result = P.run (P.rootFile file) s Common.parsingEnv
|
||||
let result = runIdentity (P.run (P.rootFile file) s Common.parsingEnv)
|
||||
case result of
|
||||
Right _ -> crash "Parser succeeded"
|
||||
Left (MPE.FancyError _ sets) ->
|
||||
@ -140,6 +141,6 @@ parses :: String -> Test ()
|
||||
parses s = scope s $ do
|
||||
let p :: UnisonFile Symbol P.Ann
|
||||
!p =
|
||||
unsafeGetRightFrom s $
|
||||
unsafeGetRightFrom s . runIdentity $
|
||||
P.run (P.rootFile file) s Common.parsingEnv
|
||||
pure p >> ok
|
||||
|
@ -5,6 +5,7 @@ module Unison.Test.Syntax.TermParser where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad (join)
|
||||
import Data.Functor.Identity (Identity (..))
|
||||
import EasyTest
|
||||
import Text.Megaparsec qualified as P
|
||||
import Text.RawString.QQ
|
||||
@ -205,7 +206,7 @@ unitTests =
|
||||
]
|
||||
where
|
||||
-- type TermP v = P v (AnnotatedTerm v Ann)
|
||||
t :: P Symbol a -> String -> Test ()
|
||||
t :: P Symbol Identity a -> String -> Test ()
|
||||
t = parseWith
|
||||
w = wordyDefinitionName
|
||||
s = symbolyDefinitionName
|
||||
@ -213,9 +214,9 @@ unitTests =
|
||||
parses :: String -> Test ()
|
||||
parses = parseWith TP.term
|
||||
|
||||
parseWith :: P Symbol a -> String -> Test ()
|
||||
parseWith :: P Symbol Identity a -> String -> Test ()
|
||||
parseWith p s = scope (join . take 1 $ lines s) $
|
||||
case Ps.parse @Symbol p s Common.parsingEnv of
|
||||
case runIdentity (Ps.parse @_ @Symbol p s Common.parsingEnv) of
|
||||
Left e -> do
|
||||
note $ renderParseErrorAsANSI 60 s e
|
||||
crash $ renderParseErrorAsANSI 60 s e
|
||||
|
@ -133,7 +133,7 @@ resultTest rt uf filepath = do
|
||||
if rFileExists
|
||||
then scope "result" $ do
|
||||
values <- io $ unpack <$> readUtf8 valueFile
|
||||
let term = Parsers.parseTerm values parsingEnv
|
||||
let term = runIdentity (Parsers.parseTerm values parsingEnv)
|
||||
let report e = throwIO (userError $ toPlain 10000 e)
|
||||
(bindings, watches) <-
|
||||
io $
|
||||
|
@ -331,7 +331,7 @@ typecheckSrc name src = do
|
||||
let ambientAbilities = []
|
||||
let parseNames = mempty
|
||||
let parsingEnv = Parser.ParsingEnv uniqueName parseNames
|
||||
case Parsers.parseFile name (Text.unpack src) parsingEnv of
|
||||
Parsers.parseFile name (Text.unpack src) parsingEnv >>= \case
|
||||
Left err -> pure (Left (crash ("Failed to parse: " ++ show err)))
|
||||
-- tf <- maybe (crash "Failed to typecheck") pure maytf
|
||||
Right unisonFile -> do
|
||||
@ -342,9 +342,9 @@ typecheckSrc name src = do
|
||||
codebase
|
||||
ambientAbilities
|
||||
unisonFile
|
||||
pure case FileParsers.synthesizeFile typecheckingEnv unisonFile of
|
||||
Result.Result notes Nothing -> Left (crash ("Failed to typecheck: " ++ show (Foldable.toList @Seq notes)))
|
||||
Result.Result _ (Just typecheckedUnisonFile) -> Right (unisonFile, typecheckedUnisonFile)
|
||||
Result.runResultT (FileParsers.synthesizeFile typecheckingEnv unisonFile) <&> \case
|
||||
(Nothing, notes) -> Left (crash ("Failed to typecheck: " ++ show (Foldable.toList @Seq notes)))
|
||||
(Just typecheckedUnisonFile, _) -> Right (unisonFile, typecheckedUnisonFile)
|
||||
|
||||
case result of
|
||||
Left action -> action
|
||||
|
Loading…
Reference in New Issue
Block a user