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

import PlutusCore.Analysis.Definitions
import PlutusCore.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,
        HasUnique tyname TypeUnique,
        AsUniqueError e ann,
        MonadError e m)
    => (UniqueError ann -> Bool)
    -> Program tyname name uni fun ann
    -> m ()
checkProgram :: (UniqueError ann -> Bool)
-> Program tyname name uni fun ann -> m ()
checkProgram UniqueError ann -> Bool
p (Program ann
_ Version ann
_ Term tyname name uni fun ann
t) = (UniqueError ann -> Bool) -> Term tyname name uni fun ann -> m ()
forall ann name tyname e (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique, HasUnique tyname TypeUnique,
 AsUniqueError e ann, MonadError e m) =>
(UniqueError ann -> Bool) -> Term tyname name uni fun ann -> m ()
checkTerm UniqueError ann -> Bool
p Term tyname name uni fun ann
t

checkTerm
    :: (Ord ann,
        HasUnique name TermUnique,
        HasUnique tyname TypeUnique,
        AsUniqueError e ann,
        MonadError e m)
    => (UniqueError ann -> Bool)
    -> Term tyname name uni fun ann
    -> m ()
checkTerm :: (UniqueError ann -> Bool) -> Term tyname name uni fun ann -> m ()
checkTerm UniqueError ann -> Bool
p Term tyname name uni fun ann
t = do
    (UniqueInfos ann
_, [UniqueError ann]
errs) <- Term tyname name uni fun ann
-> m (UniqueInfos ann, [UniqueError ann])
forall ann name tyname (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique, HasUnique tyname TypeUnique,
 Monad m) =>
Term tyname name uni fun ann
-> m (UniqueInfos ann, [UniqueError ann])
runTermDefs Term tyname 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

checkType
    :: (Ord ann,
        HasUnique tyname TypeUnique,
        AsUniqueError e ann,
        MonadError e m)
    => (UniqueError ann -> Bool)
    -> Type tyname uni ann
    -> m ()
checkType :: (UniqueError ann -> Bool) -> Type tyname uni ann -> m ()
checkType UniqueError ann -> Bool
p Type tyname uni ann
t = do
    (UniqueInfos ann
_, [UniqueError ann]
errs) <- Type tyname uni ann -> m (UniqueInfos ann, [UniqueError ann])
forall ann tyname (m :: * -> *) (uni :: * -> *).
(Ord ann, HasUnique tyname TypeUnique, Monad m) =>
Type tyname uni ann -> m (UniqueInfos ann, [UniqueError ann])
runTypeDefs Type tyname uni 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