module UntypedPlutusCore.Check.Uniques
    ( checkProgram
    , checkTerm
    , UniqueError (..)
    , AsUniqueError (..)
    ) where

import UntypedPlutusCore.Analysis.Definitions
import UntypedPlutusCore.Core

import PlutusCore.Error
import PlutusCore.Name

import Control.Monad.Error.Lens
import Control.Monad.Except

import Data.Foldable

checkProgram
    :: (Ord ann,
        HasUnique name TermUnique,
        AsUniqueError e ann,
        MonadError e m)
    => (UniqueError ann -> Bool)
    -> Program name uni fun ann
    -> m ()
checkProgram :: (UniqueError ann -> Bool) -> Program name uni fun ann -> m ()
checkProgram UniqueError ann -> Bool
p (Program ann
_ Version ann
_ Term name uni fun ann
t) = (UniqueError ann -> Bool) -> Term name uni fun ann -> m ()
forall ann name e (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique, AsUniqueError e ann,
 MonadError e m) =>
(UniqueError ann -> Bool) -> Term name uni fun ann -> m ()
checkTerm UniqueError ann -> Bool
p Term name uni fun ann
t

checkTerm
    :: (Ord ann,
        HasUnique name TermUnique,
        AsUniqueError e ann,
        MonadError e m)
    => (UniqueError ann -> Bool)
    -> Term name uni fun ann
    -> m ()
checkTerm :: (UniqueError ann -> Bool) -> Term name uni fun ann -> m ()
checkTerm UniqueError ann -> Bool
p Term name uni fun ann
t = do
    (UniqueInfos ann
_, [UniqueError ann]
errs) <- Term name uni fun ann -> m (UniqueInfos ann, [UniqueError ann])
forall ann name (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique, Monad m) =>
Term name uni fun ann -> m (UniqueInfos ann, [UniqueError ann])
runTermDefs Term name uni fun ann
t
    [UniqueError ann] -> (UniqueError ann -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [UniqueError ann]
errs ((UniqueError ann -> m ()) -> m ())
-> (UniqueError ann -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \UniqueError ann
e -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UniqueError ann -> Bool
p UniqueError ann
e) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AReview e (UniqueError ann) -> UniqueError ann -> m ()
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e (UniqueError ann)
forall r ann. AsUniqueError r ann => Prism' r (UniqueError ann)
_UniqueError UniqueError ann
e