module Unison.Codebase.Editor.HandleInput.Tests
  ( handleTest,
    handleIOTest,
    handleAllIOTests,
    isTestOk,
  )
where

import Control.Lens
import Control.Monad.Reader (ask)
import Control.Monad.Trans.Maybe (mapMaybeT)
import Data.Foldable qualified as Foldable
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as NESet
import Unison.ABT qualified as ABT
import Unison.Builtin.Decls qualified as DD
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
import Unison.Codebase.Editor.Input (TestInput (..))
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Runtime qualified as Runtime
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Names (Names)
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (TermReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.ShortHash qualified as SH
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ
import Unison.Syntax.Name qualified as Name
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type qualified as Type
import Unison.Typechecker qualified as Typechecker
import Unison.UnisonFile qualified as UF
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Relation qualified as R
import Unison.Util.Set qualified as Set
import Unison.WatchKind qualified as WK

-- | Handle a @test@ command.
-- Run pure tests in the current subnamespace.
handleTest :: TestInput -> Cli ()
handleTest :: TestInput -> Cli ()
handleTest TestInput {Bool
includeLibNamespace :: Bool
$sel:includeLibNamespace:TestInput :: TestInput -> Bool
includeLibNamespace, Path
path :: Path
$sel:path:TestInput :: TestInput -> Path
path, Bool
showFailures :: Bool
$sel:showFailures:TestInput :: TestInput -> Bool
showFailures, Bool
showSuccesses :: Bool
$sel:showSuccesses:TestInput :: TestInput -> Bool
showSuccesses} = do
  Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

  Set Id
testRefs <- Codebase IO Symbol Ann
-> Bool -> Path -> NESet (Type Symbol Ann) -> Cli (Set Id)
forall (m :: * -> *).
Codebase m Symbol Ann
-> Bool -> Path -> NESet (Type Symbol Ann) -> Cli (Set Id)
findTermsOfTypes Codebase IO Symbol Ann
codebase Bool
includeLibNamespace Path
path (Type Symbol Ann -> NESet (Type Symbol Ann)
forall a. a -> NESet a
NESet.singleton (Ann -> Type Symbol Ann
forall v a. Ord v => a -> Type v a
DD.testResultListType Ann
forall a. Monoid a => a
mempty))

  Map Id (Term Symbol Ann)
cachedTests <-
    [(Id, Term Symbol Ann)] -> Map Id (Term Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Id, Term Symbol Ann)] -> Map Id (Term Symbol Ann))
-> Cli [(Id, Term Symbol Ann)] -> Cli (Map Id (Term Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transaction [(Id, Term Symbol Ann)] -> Cli [(Id, Term Symbol Ann)]
forall a. Transaction a -> Cli a
Cli.runTransaction do
      Set Id -> [Id]
forall a. Set a -> [a]
Set.toList Set Id
testRefs [Id]
-> ([Id] -> Transaction [(Id, Term Symbol Ann)])
-> Transaction [(Id, Term Symbol Ann)]
forall a b. a -> (a -> b) -> b
& (Id -> Transaction (Maybe (Id, Term Symbol Ann)))
-> [Id] -> Transaction [(Id, Term Symbol Ann)]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
wither \case
        Id
rid -> (Term Symbol Ann -> (Id, Term Symbol Ann))
-> Maybe (Term Symbol Ann) -> Maybe (Id, Term Symbol Ann)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Id
rid,) (Maybe (Term Symbol Ann) -> Maybe (Id, Term Symbol Ann))
-> Transaction (Maybe (Term Symbol Ann))
-> Transaction (Maybe (Id, Term Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> WatchKind -> Id -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> WatchKind -> Id -> Transaction (Maybe (Term v a))
Codebase.getWatch Codebase IO Symbol Ann
codebase WatchKind
forall a. (Eq a, IsString a) => a
WK.TestWatch Id
rid
  let (Map Id [Text]
fails, Map Id [Text]
oks) = Map Id (Term Symbol Ann) -> (Map Id [Text], Map Id [Text])
forall r v a.
Ord r =>
Map r (Term v a) -> (Map r [Text], Map r [Text])
passFails Map Id (Term Symbol Ann)
cachedTests
      passFails :: (Ord r) => Map r (Term v a) -> (Map r [Text], Map r [Text])
      passFails :: forall r v a.
Ord r =>
Map r (Term v a) -> (Map r [Text], Map r [Text])
passFails =
        (r
 -> Term v a
 -> (Map r [Text], Map r [Text])
 -> (Map r [Text], Map r [Text]))
-> (Map r [Text], Map r [Text])
-> Map r (Term v a)
-> (Map r [Text], Map r [Text])
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
          (\r
r Term v a
v (Map r [Text]
f, Map r [Text]
o) -> ([Text] -> Map r [Text])
-> ([Text] -> Map r [Text])
-> ([Text], [Text])
-> (Map r [Text], Map r [Text])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\[Text]
ts -> if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts then Map r [Text]
f else r -> [Text] -> Map r [Text] -> Map r [Text]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert r
r [Text]
ts Map r [Text]
f) (\[Text]
ts -> if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts then Map r [Text]
o else r -> [Text] -> Map r [Text] -> Map r [Text]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert r
r [Text]
ts Map r [Text]
o) (([Text], [Text]) -> (Map r [Text], Map r [Text]))
-> ([Either Text Text] -> ([Text], [Text]))
-> [Either Text Text]
-> (Map r [Text], Map r [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Text Text] -> ([Text], [Text])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Text Text] -> (Map r [Text], Map r [Text]))
-> [Either Text Text] -> (Map r [Text], Map r [Text])
forall a b. (a -> b) -> a -> b
$ Term v a -> [Either Text Text]
forall v a. Term v a -> [Either Text Text]
p Term v a
v)
          (Map r [Text]
forall k a. Map k a
Map.empty, Map r [Text]
forall k a. Map k a
Map.empty)
        where
          p :: Term v a -> [Either Text Text]
          p :: forall v a. Term v a -> [Either Text Text]
p = \case
            Term.List' Seq (Term v a)
ts -> (Term v a -> Maybe (Either Text Text))
-> [Term v a] -> [Either Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Term v a -> Maybe (Either Text Text)
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> Maybe (Either Text Text)
q ([Term v a] -> [Either Text Text])
-> [Term v a] -> [Either Text Text]
forall a b. (a -> b) -> a -> b
$ Seq (Term v a) -> [Term v a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term v a)
ts
            Term v a
_ -> []
          q :: Term (F typeVar typeAnn patternAnn) v a -> Maybe (Either Text Text)
q = \case
            Term.App' (Term.Constructor' (ConstructorReference TypeReference
ref ConstructorId
cid)) (Term.Text' Text
msg) ->
              if
                | TypeReference
ref TypeReference -> TypeReference -> Bool
forall a. Eq a => a -> a -> Bool
== TypeReference
DD.testResultRef ->
                    if
                      | ConstructorId
cid ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
DD.okConstructorId -> Either Text Text -> Maybe (Either Text Text)
forall a. a -> Maybe a
Just (Text -> Either Text Text
forall a b. b -> Either a b
Right Text
msg)
                      | ConstructorId
cid ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
DD.failConstructorId -> Either Text Text -> Maybe (Either Text Text)
forall a. a -> Maybe a
Just (Text -> Either Text Text
forall a b. a -> Either a b
Left Text
msg)
                      | Bool
otherwise -> Maybe (Either Text Text)
forall a. Maybe a
Nothing
                | Bool
otherwise -> Maybe (Either Text Text)
forall a. Maybe a
Nothing
            Term (F typeVar typeAnn patternAnn) v a
_ -> Maybe (Either Text Text)
forall a. Maybe a
Nothing
  let stats :: TestReportStats
stats = Int -> Int -> TestReportStats
Output.CachedTests (Set Id -> Int
forall a. Set a -> Int
Set.size Set Id
testRefs) (Map Id (Term Symbol Ann) -> Int
forall k a. Map k a -> Int
Map.size Map Id (Term Symbol Ann)
cachedTests)
  Names
names <- Cli Names
Cli.currentNames
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let fqnPPE :: PrettyPrintEnv
fqnPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped
  NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$
    TestReportStats
-> PrettyPrintEnv
-> Bool
-> Bool
-> Map Id [Text]
-> Map Id [Text]
-> NumberedOutput
TestResults
      TestReportStats
stats
      PrettyPrintEnv
fqnPPE
      Bool
showSuccesses
      Bool
showFailures
      Map Id [Text]
oks
      Map Id [Text]
fails
  let toCompute :: Set Id
toCompute = Set Id -> Set Id -> Set Id
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Id
testRefs (Map Id (Term Symbol Ann) -> Set Id
forall k a. Map k a -> Set k
Map.keysSet Map Id (Term Symbol Ann)
cachedTests)
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Set Id -> Bool
forall a. Set a -> Bool
Set.null Set Id
toCompute)) do
    let total :: Int
total = Set Id -> Int
forall a. Set a -> Int
Set.size Set Id
toCompute
    [(Id, Term Symbol Ann)]
computedTests <- ([[(Id, Term Symbol Ann)]] -> [(Id, Term Symbol Ann)])
-> Cli [[(Id, Term Symbol Ann)]] -> Cli [(Id, Term Symbol Ann)]
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(Id, Term Symbol Ann)]] -> [(Id, Term Symbol Ann)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Cli [[(Id, Term Symbol Ann)]] -> Cli [(Id, Term Symbol Ann)])
-> (((Id, Int) -> Cli [(Id, Term Symbol Ann)])
    -> Cli [[(Id, Term Symbol Ann)]])
-> ((Id, Int) -> Cli [(Id, Term Symbol Ann)])
-> Cli [(Id, Term Symbol Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Id, Int)]
-> ((Id, Int) -> Cli [(Id, Term Symbol Ann)])
-> Cli [[(Id, Term Symbol Ann)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set Id -> [Id]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Id
toCompute [Id] -> [Int] -> [(Id, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1 ..]) (((Id, Int) -> Cli [(Id, Term Symbol Ann)])
 -> Cli [(Id, Term Symbol Ann)])
-> ((Id, Int) -> Cli [(Id, Term Symbol Ann)])
-> Cli [(Id, Term Symbol Ann)]
forall a b. (a -> b) -> a -> b
$ \(Id
r, Int
n) ->
      Transaction (Maybe (Term Symbol Ann))
-> Cli (Maybe (Term Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Term v a))
Codebase.getTerm Codebase IO Symbol Ann
codebase Id
r) Cli (Maybe (Term Symbol Ann))
-> (Maybe (Term Symbol Ann) -> Cli [(Id, Term Symbol Ann)])
-> Cli [(Id, Term Symbol Ann)]
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Term Symbol Ann)
Nothing -> do
          Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
          Output -> Cli ()
Cli.respond (ShortHash -> Output
TermNotFound' (ShortHash -> Output)
-> (TypeReference -> ShortHash) -> TypeReference -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShortHash -> ShortHash
SH.shortenTo Int
hqLength (ShortHash -> ShortHash)
-> (TypeReference -> ShortHash) -> TypeReference -> ShortHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShortHash
Reference.toShortHash (TypeReference -> Output) -> TypeReference -> Output
forall a b. (a -> b) -> a -> b
$ Id -> TypeReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId Id
r)
          pure []
        Just Term Symbol Ann
tm -> do
          Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> (Int, Int) -> Id -> Output
TestIncrementalOutputStart PrettyPrintEnv
fqnPPE (Int
n, Int
total) Id
r
          --                        v don't cache; test cache populated below
          Either Error (Term Symbol Ann)
tm' <- PrettyPrintEnv
-> Bool -> Term Symbol Ann -> Cli (Either Error (Term Symbol Ann))
RuntimeUtils.evalPureUnison PrettyPrintEnv
fqnPPE Bool
False Term Symbol Ann
tm
          case Either Error (Term Symbol Ann)
tm' of
            Left Error
e -> do
              Output -> Cli ()
Cli.respond (Error -> Output
EvaluationFailure Error
e)
              pure []
            Right Term Symbol Ann
tm' -> do
              -- After evaluation, cache the result of the test
              Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (WatchKind -> Id -> Term Symbol Ann -> Transaction ()
Codebase.putWatch WatchKind
forall a. (Eq a, IsString a) => a
WK.TestWatch Id
r Term Symbol Ann
tm')
              Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> (Int, Int) -> Id -> Bool -> Output
TestIncrementalOutputEnd PrettyPrintEnv
fqnPPE (Int
n, Int
total) Id
r (Term Symbol Ann -> Bool
forall v. Term v Ann -> Bool
isTestOk Term Symbol Ann
tm')
              pure [(Id
r, Term Symbol Ann
tm')]

    let m :: Map Id (Term Symbol Ann)
m = [(Id, Term Symbol Ann)] -> Map Id (Term Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Id, Term Symbol Ann)]
computedTests
        (Map Id [Text]
mFails, Map Id [Text]
mOks) = Map Id (Term Symbol Ann) -> (Map Id [Text], Map Id [Text])
passFails Map Id (Term Symbol Ann)
m
    NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ TestReportStats
-> PrettyPrintEnv
-> Bool
-> Bool
-> Map Id [Text]
-> Map Id [Text]
-> NumberedOutput
TestResults TestReportStats
Output.NewlyComputed PrettyPrintEnv
fqnPPE Bool
showSuccesses Bool
showFailures Map Id [Text]
mOks Map Id [Text]
mFails

handleIOTest :: HQ.HashQualified Name -> Cli ()
handleIOTest :: HashQualified Name -> Cli ()
handleIOTest HashQualified Name
main = do
  Cli.Env {Runtime Symbol
runtime :: Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Names
names <- Cli Names
Cli.currentNames
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  let isIOTest :: Type Symbol Ann -> Bool
isIOTest Type Symbol Ann
typ = (Type Symbol Ann -> Bool) -> NESet (Type Symbol Ann) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.any (Type Symbol Ann -> Type Symbol Ann -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isSubtype Type Symbol Ann
typ) (NESet (Type Symbol Ann) -> Bool)
-> NESet (Type Symbol Ann) -> Bool
forall a b. (a -> b) -> a -> b
$ Runtime Symbol -> NESet (Type Symbol Ann)
forall v. Runtime v -> NESet (Type v Ann)
Runtime.ioTestTypes Runtime Symbol
runtime
  Set (Id, Type Symbol Ann)
refs <- Names
-> Set (HashQualified Name) -> Cli (Set (Id, Type Symbol Ann))
resolveHQNames Names
names (HashQualified Name -> Set (HashQualified Name)
forall a. a -> Set a
Set.singleton HashQualified Name
main)
  (Map Id [Text]
fails, Map Id [Text]
oks) <-
    ((Id, Type Symbol Ann)
 -> (Map Id [Text], Map Id [Text])
 -> Cli (Map Id [Text], Map Id [Text]))
-> (Map Id [Text], Map Id [Text])
-> Set (Id, Type Symbol Ann)
-> Cli (Map Id [Text], Map Id [Text])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
Foldable.foldrM
      ( \(Id
ref, Type Symbol Ann
typ) (Map Id [Text]
f, Map Id [Text]
o) -> do
          Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Type Symbol Ann -> Bool
isIOTest Type Symbol Ann
typ) (Cli () -> Cli ()) -> Cli () -> Cli ()
forall a b. (a -> b) -> a -> b
$
            Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Text
-> HashQualified Name
-> Type Symbol Ann
-> PrettyPrintEnv
-> [Type Symbol Ann]
-> Output
BadMainFunction Text
"io.test" HashQualified Name
main Type Symbol Ann
typ PrettyPrintEnv
suffixifiedPPE (NESet (Type Symbol Ann) -> [Type Symbol Ann]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (NESet (Type Symbol Ann) -> [Type Symbol Ann])
-> NESet (Type Symbol Ann) -> [Type Symbol Ann]
forall a b. (a -> b) -> a -> b
$ Runtime Symbol -> NESet (Type Symbol Ann)
forall v. Runtime v -> NESet (Type v Ann)
Runtime.ioTestTypes Runtime Symbol
runtime))
          ([Text] -> Map Id [Text])
-> ([Text] -> Map Id [Text])
-> ([Text], [Text])
-> (Map Id [Text], Map Id [Text])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\[Text]
ts -> if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts then Map Id [Text]
f else Id -> [Text] -> Map Id [Text] -> Map Id [Text]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id
ref [Text]
ts Map Id [Text]
f) (\[Text]
ts -> if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts then Map Id [Text]
o else Id -> [Text] -> Map Id [Text] -> Map Id [Text]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id
ref [Text]
ts Map Id [Text]
o) (([Text], [Text]) -> (Map Id [Text], Map Id [Text]))
-> Cli ([Text], [Text]) -> Cli (Map Id [Text], Map Id [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnv -> Id -> Cli ([Text], [Text])
runIOTest PrettyPrintEnv
suffixifiedPPE Id
ref
      )
      (Map Id [Text]
forall k a. Map k a
Map.empty, Map Id [Text]
forall k a. Map k a
Map.empty)
      Set (Id, Type Symbol Ann)
refs
  NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ TestReportStats
-> PrettyPrintEnv
-> Bool
-> Bool
-> Map Id [Text]
-> Map Id [Text]
-> NumberedOutput
TestResults TestReportStats
Output.NewlyComputed PrettyPrintEnv
suffixifiedPPE Bool
True Bool
True Map Id [Text]
oks Map Id [Text]
fails

findTermsOfTypes :: Codebase.Codebase m Symbol Ann -> Bool -> Path -> NESet (Type.Type Symbol Ann) -> Cli (Set TermReferenceId)
findTermsOfTypes :: forall (m :: * -> *).
Codebase m Symbol Ann
-> Bool -> Path -> NESet (Type Symbol Ann) -> Cli (Set Id)
findTermsOfTypes Codebase m Symbol Ann
codebase Bool
includeLib Path
path NESet (Type Symbol Ann)
filterTypes = do
  Branch0 IO
branch <- Path -> Cli (Branch0 IO)
Cli.expectBranch0AtPath Path
path

  let possibleTests :: Set Id
possibleTests =
        Branch0 IO
branch
          Branch0 IO -> (Branch0 IO -> Branch0 IO) -> Branch0 IO
forall a b. a -> (a -> b) -> b
& (if Bool
includeLib then Branch0 IO -> Branch0 IO
forall a. a -> a
id else Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutLib)
          Branch0 IO
-> (Branch0 IO -> Relation Referent Name) -> Relation Referent Name
forall a b. a -> (a -> b) -> b
& Branch0 IO -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms
          Relation Referent Name
-> (Relation Referent Name -> Set Referent) -> Set Referent
forall a b. a -> (a -> b) -> b
& Relation Referent Name -> Set Referent
forall a b. Relation a b -> Set a
R.dom
          Set Referent -> (Set Referent -> Set Id) -> Set Id
forall a b. a -> (a -> b) -> b
& (Referent -> Maybe Id) -> Set Referent -> Set Id
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe Id
Referent.toTermReferenceId
  Transaction (Set Id) -> Cli (Set Id)
forall a. Transaction a -> Cli a
Cli.runTransaction do
    NESet (Type Symbol Ann)
filterTypes NESet (Type Symbol Ann)
-> (NESet (Type Symbol Ann) -> Transaction (Set Id))
-> Transaction (Set Id)
forall a b. a -> (a -> b) -> b
& (Type Symbol Ann -> Transaction (Set Id))
-> NESet (Type Symbol Ann) -> Transaction (Set Id)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \Type Symbol Ann
matchTyp -> do
      Codebase m Symbol Ann
-> Type Symbol Ann -> Set Id -> Transaction (Set Id)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Type v a -> Set Id -> Transaction (Set Id)
Codebase.filterTermsByReferenceIdHavingType Codebase m Symbol Ann
codebase Type Symbol Ann
matchTyp Set Id
possibleTests

handleAllIOTests :: Cli ()
handleAllIOTests :: Cli ()
handleAllIOTests = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase, Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime :: Runtime Symbol
runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Names
names <- Cli Names
Cli.currentNames
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  Set Id
ioTestRefs <- Codebase IO Symbol Ann
-> Bool -> Path -> NESet (Type Symbol Ann) -> Cli (Set Id)
forall (m :: * -> *).
Codebase m Symbol Ann
-> Bool -> Path -> NESet (Type Symbol Ann) -> Cli (Set Id)
findTermsOfTypes Codebase IO Symbol Ann
codebase Bool
False Path
Path.empty (Runtime Symbol -> NESet (Type Symbol Ann)
forall v. Runtime v -> NESet (Type v Ann)
Runtime.ioTestTypes Runtime Symbol
runtime)
  case Set Id -> Maybe (NESet Id)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet Set Id
ioTestRefs of
    Maybe (NESet Id)
Nothing -> NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ TestReportStats
-> PrettyPrintEnv
-> Bool
-> Bool
-> Map Id [Text]
-> Map Id [Text]
-> NumberedOutput
TestResults TestReportStats
Output.NewlyComputed PrettyPrintEnv
suffixifiedPPE Bool
True Bool
True Map Id [Text]
forall k a. Map k a
Map.empty Map Id [Text]
forall k a. Map k a
Map.empty
    Just NESet Id
neTestRefs -> do
      let total :: Int
total = NESet Id -> Int
forall a. NESet a -> Int
NESet.size NESet Id
neTestRefs
      (Map Id [Text]
fails, Map Id [Text]
oks) <-
        NESet Id -> [Id]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESet Id
neTestRefs
          [Id] -> ([Id] -> [(Int, Id)]) -> [(Int, Id)]
forall a b. a -> (a -> b) -> b
& [Int] -> [Id] -> [(Int, Id)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..]
          [(Int, Id)]
-> ([(Int, Id)] -> Cli (Map Id [Text], Map Id [Text]))
-> Cli (Map Id [Text], Map Id [Text])
forall a b. a -> (a -> b) -> b
& ((Int, Id)
 -> (Map Id [Text], Map Id [Text])
 -> Cli (Map Id [Text], Map Id [Text]))
-> (Map Id [Text], Map Id [Text])
-> [(Int, Id)]
-> Cli (Map Id [Text], Map Id [Text])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
Foldable.foldrM
            ( \(Int
n, Id
r) (Map Id [Text]
f, Map Id [Text]
o) -> do
                Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> (Int, Int) -> Id -> Output
TestIncrementalOutputStart PrettyPrintEnv
suffixifiedPPE (Int
n, Int
total) Id
r
                ([Text]
fails, [Text]
oks) <- PrettyPrintEnv -> Id -> Cli ([Text], [Text])
runIOTest PrettyPrintEnv
suffixifiedPPE Id
r
                Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> (Int, Int) -> Id -> Bool -> Output
TestIncrementalOutputEnd PrettyPrintEnv
suffixifiedPPE (Int
n, Int
total) Id
r ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fails)
                pure (if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fails then Map Id [Text]
f else Id -> [Text] -> Map Id [Text] -> Map Id [Text]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id
r [Text]
fails Map Id [Text]
f, if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
oks then Map Id [Text]
o else Id -> [Text] -> Map Id [Text] -> Map Id [Text]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id
r [Text]
oks Map Id [Text]
o)
            )
            (Map Id [Text]
forall k a. Map k a
Map.empty, Map Id [Text]
forall k a. Map k a
Map.empty)
      NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ TestReportStats
-> PrettyPrintEnv
-> Bool
-> Bool
-> Map Id [Text]
-> Map Id [Text]
-> NumberedOutput
TestResults TestReportStats
Output.NewlyComputed PrettyPrintEnv
suffixifiedPPE Bool
True Bool
True Map Id [Text]
oks Map Id [Text]
fails

resolveHQNames :: Names -> Set (HQ.HashQualified Name) -> Cli (Set (Reference.Id, Type.Type Symbol Ann))
resolveHQNames :: Names
-> Set (HashQualified Name) -> Cli (Set (Id, Type Symbol Ann))
resolveHQNames Names
parseNames Set (HashQualified Name)
hqNames =
  [(Id, Type Symbol Ann)] -> Set (Id, Type Symbol Ann)
forall a. Ord a => [a] -> Set a
Set.fromList ([(Id, Type Symbol Ann)] -> Set (Id, Type Symbol Ann))
-> Cli [(Id, Type Symbol Ann)] -> Cli (Set (Id, Type Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    (Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList Set (HashQualified Name)
hqNames) [HashQualified Name]
-> ([HashQualified Name] -> Cli [(Id, Type Symbol Ann)])
-> Cli [(Id, Type Symbol Ann)]
forall a b. a -> (a -> b) -> b
& (HashQualified Name -> Cli [(Id, Type Symbol Ann)])
-> [HashQualified Name] -> Cli [(Id, Type Symbol Ann)]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \HashQualified Name
main -> do
      (Maybe (Id, Type Symbol Ann) -> [(Id, Type Symbol Ann)])
-> Cli (Maybe (Id, Type Symbol Ann)) -> Cli [(Id, Type Symbol Ann)]
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Id, Type Symbol Ann) -> [(Id, Type Symbol Ann)]
forall a. Maybe a -> [a]
maybeToList (Cli (Maybe (Id, Type Symbol Ann)) -> Cli [(Id, Type Symbol Ann)])
-> (MaybeT Cli (Id, Type Symbol Ann)
    -> Cli (Maybe (Id, Type Symbol Ann)))
-> MaybeT Cli (Id, Type Symbol Ann)
-> Cli [(Id, Type Symbol Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT Cli (Id, Type Symbol Ann)
-> Cli (Maybe (Id, Type Symbol Ann))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Cli (Id, Type Symbol Ann) -> Cli [(Id, Type Symbol Ann)])
-> MaybeT Cli (Id, Type Symbol Ann) -> Cli [(Id, Type Symbol Ann)]
forall a b. (a -> b) -> a -> b
$ do
        HashQualified Name -> MaybeT Cli (Id, Type Symbol Ann)
getNameFromScratchFile HashQualified Name
main MaybeT Cli (Id, Type Symbol Ann)
-> MaybeT Cli (Id, Type Symbol Ann)
-> MaybeT Cli (Id, Type Symbol Ann)
forall a. MaybeT Cli a -> MaybeT Cli a -> MaybeT Cli a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Names -> HashQualified Name -> MaybeT Cli (Id, Type Symbol Ann)
getNameFromCodebase Names
parseNames HashQualified Name
main
  where
    getNameFromScratchFile :: HQ.HashQualified Name -> MaybeT Cli (Reference.Id, Type.Type Symbol Ann)
    getNameFromScratchFile :: HashQualified Name -> MaybeT Cli (Id, Type Symbol Ann)
getNameFromScratchFile HashQualified Name
main = do
      TypecheckedUnisonFile Symbol Ann
typecheckedFile <- Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> MaybeT Cli (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile
      Name
mainName <- Maybe Name -> MaybeT Cli Name
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe Name -> MaybeT Cli Name) -> Maybe Name -> MaybeT Cli Name
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Name
Name.parseText (HashQualified Name -> Text
HQ.toText HashQualified Name
main)
      (Ann
_, Id
ref, Maybe WatchKind
_wk, Term Symbol Ann
_term, Type Symbol Ann
typ) <- Maybe (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
-> MaybeT
     Cli (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
 -> MaybeT
      Cli (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann))
-> Maybe
     (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
-> MaybeT
     Cli (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ Symbol
-> Map
     Symbol (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
-> Maybe
     (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
mainName) (TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol (Ann, Id, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe WatchKind, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol Ann
typecheckedFile)
      (Id, Type Symbol Ann) -> MaybeT Cli (Id, Type Symbol Ann)
forall a. a -> MaybeT Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id
ref, Type Symbol Ann
typ)

    getNameFromCodebase :: Names -> HQ.HashQualified Name -> MaybeT Cli (Reference.Id, Type.Type Symbol Ann)
    getNameFromCodebase :: Names -> HashQualified Name -> MaybeT Cli (Id, Type Symbol Ann)
getNameFromCodebase Names
parseNames HashQualified Name
main = do
      Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- MaybeT Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
      (Transaction (Maybe (Id, Type Symbol Ann))
 -> Cli (Maybe (Id, Type Symbol Ann)))
-> MaybeT Transaction (Id, Type Symbol Ann)
-> MaybeT Cli (Id, Type Symbol Ann)
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT Transaction (Maybe (Id, Type Symbol Ann))
-> Cli (Maybe (Id, Type Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
        (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList (SearchType -> HashQualified Name -> Names -> Set Referent
Names.lookupHQTerm SearchType
Names.IncludeSuffixes HashQualified Name
main Names
parseNames)) [Referent]
-> ([Referent] -> MaybeT Transaction (Id, Type Symbol Ann))
-> MaybeT Transaction (Id, Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& (Referent -> MaybeT Transaction (Id, Type Symbol Ann))
-> [Referent] -> MaybeT Transaction (Id, Type Symbol Ann)
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap \Referent
ref0 -> do
          Id
ref <- Maybe Id -> MaybeT Transaction Id
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Referent -> Maybe Id
Referent.toTermReferenceId Referent
ref0)
          Type Symbol Ann
typ <- Transaction (Maybe (Type Symbol Ann))
-> MaybeT Transaction (Type Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Codebase IO Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Referent -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfReferent Codebase IO Symbol Ann
codebase (Id -> Referent
Referent.fromTermReferenceId Id
ref))
          pure (Id
ref, Type Symbol Ann
typ)

runIOTest :: PPE.PrettyPrintEnv -> Reference.Id -> Cli ([Text], [Text])
runIOTest :: PrettyPrintEnv -> Id -> Cli ([Text], [Text])
runIOTest PrettyPrintEnv
ppe Id
ref = do
  let a :: Ann
a = Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
tm
      tm :: Term Symbol Ann
tm = Ann -> Ann -> Term Symbol Ann -> Term Symbol Ann
forall v a. Var v => a -> a -> Term v a -> Term v a
DD.forceTerm Ann
a Ann
a (Ann -> Id -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Id -> Term2 vt at ap v a
Term.refId Ann
a Id
ref)
  -- Don't cache IO tests
  Term Symbol Ann
tm' <- Bool
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Term Symbol Ann)
RuntimeUtils.evalUnisonTerm Bool
False PrettyPrintEnv
ppe Bool
False Term Symbol Ann
tm
  pure $ Term Symbol Ann -> ([Text], [Text])
partitionTestResults Term Symbol Ann
tm'

partitionTestResults :: Term Symbol Ann -> ([Text {- fails -}], [Text {- oks -}])
partitionTestResults :: Term Symbol Ann -> ([Text], [Text])
partitionTestResults Term Symbol Ann
tm = [([Text], [Text])] -> ([Text], [Text])
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([([Text], [Text])] -> ([Text], [Text]))
-> [([Text], [Text])] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ do
  Term Symbol Ann
element <- case Term Symbol Ann
tm of
    Term.List' Seq (Term Symbol Ann)
ts -> Seq (Term Symbol Ann) -> [Term Symbol Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term Symbol Ann)
ts
    Term Symbol Ann
_ -> [Term Symbol Ann]
forall a. [a]
forall (f :: * -> *) a. Alternative f => f a
empty
  case Term Symbol Ann
element of
    Term.App' (Term.Constructor' (ConstructorReference TypeReference
conRef ConstructorId
cid)) (Term.Text' Text
msg) -> do
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TypeReference
conRef TypeReference -> TypeReference -> Bool
forall a. Eq a => a -> a -> Bool
== TypeReference
DD.testResultRef)
      if
        | ConstructorId
cid ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
DD.okConstructorId -> ([Text], [Text]) -> [([Text], [Text])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
forall a. Monoid a => a
mempty, [Text
msg])
        | ConstructorId
cid ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
DD.failConstructorId -> ([Text], [Text]) -> [([Text], [Text])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text
msg], [Text]
forall a. Monoid a => a
mempty)
        | Bool
otherwise -> [([Text], [Text])]
forall a. [a]
forall (f :: * -> *) a. Alternative f => f a
empty
    Term Symbol Ann
_ -> [([Text], [Text])]
forall a. [a]
forall (f :: * -> *) a. Alternative f => f a
empty

isTestOk :: Term v Ann -> Bool
isTestOk :: forall v. Term v Ann -> Bool
isTestOk Term v Ann
tm = case Term v Ann
tm of
  Term.List' Seq (Term v Ann)
ts -> (Term v Ann -> Bool) -> Seq (Term v Ann) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Term v Ann -> Bool
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> Bool
isSuccess Seq (Term v Ann)
ts
    where
      isSuccess :: Term (F typeVar typeAnn patternAnn) v a -> Bool
isSuccess (Term.App' (Term.Constructor' (ConstructorReference TypeReference
ref ConstructorId
cid)) Term (F typeVar typeAnn patternAnn) v a
_) =
        ConstructorId
cid ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
DD.okConstructorId
          Bool -> Bool -> Bool
&& TypeReference
ref TypeReference -> TypeReference -> Bool
forall a. Eq a => a -> a -> Bool
== TypeReference
DD.testResultRef
      isSuccess Term (F typeVar typeAnn patternAnn) v a
_ = Bool
False
  Term v Ann
_ -> Bool
False