{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Conformance where
import Control.Exception
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Writer.Strict
import Data.Functor.Identity
newtype ConformT ue fe w m a = ConformT
{ forall ue fe w (m :: * -> *) a.
ConformT ue fe w m a
-> ReaderT
(fe -> Bool)
(WriterT (Notes fe w) (ExceptT (HaltReason ue fe) m))
a
unConformT ::
ReaderT (fe -> Bool) (WriterT (Notes fe w) (ExceptT (HaltReason ue fe) m)) a
}
deriving newtype
( forall a b. a -> ConformT ue fe w m b -> ConformT ue fe w m a
forall a b.
(a -> b) -> ConformT ue fe w m a -> ConformT ue fe w m b
forall ue fe w (m :: * -> *) a b.
Functor m =>
a -> ConformT ue fe w m b -> ConformT ue fe w m a
forall ue fe w (m :: * -> *) a b.
Functor m =>
(a -> b) -> ConformT ue fe w m a -> ConformT ue fe w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ConformT ue fe w m b -> ConformT ue fe w m a
$c<$ :: forall ue fe w (m :: * -> *) a b.
Functor m =>
a -> ConformT ue fe w m b -> ConformT ue fe w m a
fmap :: forall a b.
(a -> b) -> ConformT ue fe w m a -> ConformT ue fe w m b
$cfmap :: forall ue fe w (m :: * -> *) a b.
Functor m =>
(a -> b) -> ConformT ue fe w m a -> ConformT ue fe w m b
Functor,
forall a. a -> ConformT ue fe w m a
forall a b.
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m a
forall a b.
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
forall a b.
ConformT ue fe w m (a -> b)
-> ConformT ue fe w m a -> ConformT ue fe w m b
forall a b c.
(a -> b -> c)
-> ConformT ue fe w m a
-> ConformT ue fe w m b
-> ConformT ue fe w m c
forall {ue} {fe} {w} {m :: * -> *}.
Monad m =>
Functor (ConformT ue fe w m)
forall ue fe w (m :: * -> *) a.
Monad m =>
a -> ConformT ue fe w m a
forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m a
forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m (a -> b)
-> ConformT ue fe w m a -> ConformT ue fe w m b
forall ue fe w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ConformT ue fe w m a
-> ConformT ue fe w m b
-> ConformT ue fe w m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m a
$c<* :: forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m a
*> :: forall a b.
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
$c*> :: forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
liftA2 :: forall a b c.
(a -> b -> c)
-> ConformT ue fe w m a
-> ConformT ue fe w m b
-> ConformT ue fe w m c
$cliftA2 :: forall ue fe w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ConformT ue fe w m a
-> ConformT ue fe w m b
-> ConformT ue fe w m c
<*> :: forall a b.
ConformT ue fe w m (a -> b)
-> ConformT ue fe w m a -> ConformT ue fe w m b
$c<*> :: forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m (a -> b)
-> ConformT ue fe w m a -> ConformT ue fe w m b
pure :: forall a. a -> ConformT ue fe w m a
$cpure :: forall ue fe w (m :: * -> *) a.
Monad m =>
a -> ConformT ue fe w m a
Applicative,
forall a. a -> ConformT ue fe w m a
forall a b.
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
forall a b.
ConformT ue fe w m a
-> (a -> ConformT ue fe w m b) -> ConformT ue fe w m b
forall ue fe w (m :: * -> *).
Monad m =>
Applicative (ConformT ue fe w m)
forall ue fe w (m :: * -> *) a.
Monad m =>
a -> ConformT ue fe w m a
forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> (a -> ConformT ue fe w m b) -> ConformT ue fe w m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ConformT ue fe w m a
$creturn :: forall ue fe w (m :: * -> *) a.
Monad m =>
a -> ConformT ue fe w m a
>> :: forall a b.
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
$c>> :: forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> ConformT ue fe w m b -> ConformT ue fe w m b
>>= :: forall a b.
ConformT ue fe w m a
-> (a -> ConformT ue fe w m b) -> ConformT ue fe w m b
$c>>= :: forall ue fe w (m :: * -> *) a b.
Monad m =>
ConformT ue fe w m a
-> (a -> ConformT ue fe w m b) -> ConformT ue fe w m b
Monad,
MonadReader (fe -> Bool),
MonadError (HaltReason ue fe),
MonadWriter (Notes fe w)
)
altConform :: Monad m => ConformT ue fe w m a -> ConformT ue fe w m a -> ConformT ue fe w m a
altConform :: forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a
-> ConformT ue fe w m a -> ConformT ue fe w m a
altConform ConformT ue fe w m a
cf1 ConformT ue fe w m a
cf2 = do
fe -> Bool
decider <- forall r (m :: * -> *). MonadReader r m => m r
ask
Either (HaltReason ue fe) (a, Notes fe w)
errOrTup1 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible fe -> Bool
decider ConformT ue fe w m a
cf1
case Either (HaltReason ue fe) (a, Notes fe w)
errOrTup1 of
Right (a
a, Notes fe w
notes) -> do
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Notes fe w
notes
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Left HaltReason ue fe
_ -> do
Either (HaltReason ue fe) (a, Notes fe w)
errOrTup2 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible fe -> Bool
decider ConformT ue fe w m a
cf2
case Either (HaltReason ue fe) (a, Notes fe w)
errOrTup2 of
Right (a
a, Notes fe w
notes) -> do
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Notes fe w
notes
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Left HaltReason ue fe
err2 -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError HaltReason ue fe
err2
instance MonadTrans (ConformT ue fe w) where
lift :: forall (m :: * -> *) a. Monad m => m a -> ConformT ue fe w m a
lift = forall ue fe w (m :: * -> *) a.
ReaderT
(fe -> Bool)
(WriterT (Notes fe w) (ExceptT (HaltReason ue fe) m))
a
-> ConformT ue fe w m a
ConformT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
data HaltReason ue fe
= HaltedBecauseOfUnfixableError !ue
| HaltedBecauseOfStrictness !fe
deriving (Int -> HaltReason ue fe -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ue fe.
(Show ue, Show fe) =>
Int -> HaltReason ue fe -> ShowS
forall ue fe. (Show ue, Show fe) => [HaltReason ue fe] -> ShowS
forall ue fe. (Show ue, Show fe) => HaltReason ue fe -> String
showList :: [HaltReason ue fe] -> ShowS
$cshowList :: forall ue fe. (Show ue, Show fe) => [HaltReason ue fe] -> ShowS
show :: HaltReason ue fe -> String
$cshow :: forall ue fe. (Show ue, Show fe) => HaltReason ue fe -> String
showsPrec :: Int -> HaltReason ue fe -> ShowS
$cshowsPrec :: forall ue fe.
(Show ue, Show fe) =>
Int -> HaltReason ue fe -> ShowS
Show, HaltReason ue fe -> HaltReason ue fe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ue fe.
(Eq ue, Eq fe) =>
HaltReason ue fe -> HaltReason ue fe -> Bool
/= :: HaltReason ue fe -> HaltReason ue fe -> Bool
$c/= :: forall ue fe.
(Eq ue, Eq fe) =>
HaltReason ue fe -> HaltReason ue fe -> Bool
== :: HaltReason ue fe -> HaltReason ue fe -> Bool
$c== :: forall ue fe.
(Eq ue, Eq fe) =>
HaltReason ue fe -> HaltReason ue fe -> Bool
Eq)
instance (Exception ue, Exception fe) => Exception (HaltReason ue fe) where
displayException :: HaltReason ue fe -> String
displayException = \case
HaltedBecauseOfUnfixableError ue
ue -> forall e. Exception e => e -> String
displayException ue
ue
HaltedBecauseOfStrictness fe
fe -> forall e. Exception e => e -> String
displayException fe
fe
data Notes fe w = Notes
{ forall fe w. Notes fe w -> [fe]
notesFixableErrors :: ![fe],
forall fe w. Notes fe w -> [w]
notesWarnings :: ![w]
}
deriving (Int -> Notes fe w -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall fe w. (Show fe, Show w) => Int -> Notes fe w -> ShowS
forall fe w. (Show fe, Show w) => [Notes fe w] -> ShowS
forall fe w. (Show fe, Show w) => Notes fe w -> String
showList :: [Notes fe w] -> ShowS
$cshowList :: forall fe w. (Show fe, Show w) => [Notes fe w] -> ShowS
show :: Notes fe w -> String
$cshow :: forall fe w. (Show fe, Show w) => Notes fe w -> String
showsPrec :: Int -> Notes fe w -> ShowS
$cshowsPrec :: forall fe w. (Show fe, Show w) => Int -> Notes fe w -> ShowS
Show, Notes fe w -> Notes fe w -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall fe w. (Eq fe, Eq w) => Notes fe w -> Notes fe w -> Bool
/= :: Notes fe w -> Notes fe w -> Bool
$c/= :: forall fe w. (Eq fe, Eq w) => Notes fe w -> Notes fe w -> Bool
== :: Notes fe w -> Notes fe w -> Bool
$c== :: forall fe w. (Eq fe, Eq w) => Notes fe w -> Notes fe w -> Bool
Eq)
instance Semigroup (Notes w fe) where
<> :: Notes w fe -> Notes w fe -> Notes w fe
(<>) (Notes [w]
fes1 [fe]
ws1) (Notes [w]
fes2 [fe]
ws2) =
Notes
{ notesFixableErrors :: [w]
notesFixableErrors = [w]
fes1 forall a. [a] -> [a] -> [a]
++ [w]
fes2,
notesWarnings :: [fe]
notesWarnings = [fe]
ws1 forall a. [a] -> [a] -> [a]
++ [fe]
ws2
}
instance Monoid (Notes w fe) where
mempty :: Notes w fe
mempty = forall fe w. [fe] -> [w] -> Notes fe w
Notes [] []
mappend :: Notes w fe -> Notes w fe -> Notes w fe
mappend = forall a. Semigroup a => a -> a -> a
(<>)
nullNotes :: Notes w fe -> Bool
nullNotes :: forall w fe. Notes w fe -> Bool
nullNotes Notes {[w]
[fe]
notesWarnings :: [fe]
notesFixableErrors :: [w]
notesWarnings :: forall fe w. Notes fe w -> [w]
notesFixableErrors :: forall fe w. Notes fe w -> [fe]
..} = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [w]
notesFixableErrors Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [fe]
notesWarnings
runConformTFlexible ::
(fe -> Bool) ->
ConformT ue fe w m a ->
m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible :: forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible fe -> Bool
predicate (ConformT ReaderT
(fe -> Bool)
(WriterT (Notes fe w) (ExceptT (HaltReason ue fe) m))
a
func) = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
(fe -> Bool)
(WriterT (Notes fe w) (ExceptT (HaltReason ue fe) m))
a
func fe -> Bool
predicate))
runConformT ::
Monad m =>
ConformT ue fe w m a ->
m (Either (HaltReason ue fe) (a, [w]))
runConformT :: forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a -> m (Either (HaltReason ue fe) (a, [w]))
runConformT ConformT ue fe w m a
func = do
Either (HaltReason ue fe) (a, Notes fe w)
errOrTup <- forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible forall fe. fe -> Bool
fixNone ConformT ue fe w m a
func
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
(a
a, Notes fe w
notes) <- Either (HaltReason ue fe) (a, Notes fe w)
errOrTup
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, forall fe w. Notes fe w -> [w]
notesWarnings Notes fe w
notes)
runConformTStrict ::
Monad m =>
ConformT ue fe w m a ->
m (Either (Either ue (Notes fe w)) a)
runConformTStrict :: forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a -> m (Either (Either ue (Notes fe w)) a)
runConformTStrict ConformT ue fe w m a
func = do
Either (HaltReason ue fe) (a, Notes fe w)
errOrTup <- forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible forall fe. fe -> Bool
fixNone ConformT ue fe w m a
func
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either (HaltReason ue fe) (a, Notes fe w)
errOrTup of
Left HaltReason ue fe
haltReason -> case HaltReason ue fe
haltReason of
HaltedBecauseOfUnfixableError ue
ue -> forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left ue
ue)
HaltedBecauseOfStrictness fe
fe -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right (forall fe w. [fe] -> [w] -> Notes fe w
Notes [fe
fe] []))
Right (a
a, Notes fe w
notes) -> if forall w fe. Notes w fe -> Bool
nullNotes Notes fe w
notes then forall a b. b -> Either a b
Right a
a else forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right Notes fe w
notes)
runConformTLenient ::
Monad m =>
ConformT ue fe w m a ->
m (Either ue (a, Notes fe w))
runConformTLenient :: forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a -> m (Either ue (a, Notes fe w))
runConformTLenient ConformT ue fe w m a
func = do
Either (HaltReason ue fe) (a, Notes fe w)
errOrTup <- forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible forall fe. fe -> Bool
fixAll ConformT ue fe w m a
func
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either (HaltReason ue fe) (a, Notes fe w)
errOrTup of
Left HaltReason ue fe
hr -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ case HaltReason ue fe
hr of
HaltedBecauseOfStrictness fe
_ -> forall a. HasCallStack => String -> a
error String
"cannot happen, but this cannot be proven to the compiler."
HaltedBecauseOfUnfixableError ue
ue -> ue
ue
Right (a, Notes fe w)
r -> forall a b. b -> Either a b
Right (a, Notes fe w)
r
type Conform ue fe w = ConformT ue fe w Identity
runConformFlexible ::
(fe -> Bool) ->
Conform ue fe w a ->
Either (HaltReason ue fe) (a, Notes fe w)
runConformFlexible :: forall fe ue w a.
(fe -> Bool)
-> Conform ue fe w a -> Either (HaltReason ue fe) (a, Notes fe w)
runConformFlexible fe -> Bool
predicate = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible fe -> Bool
predicate
runConform ::
Conform ue fe w a ->
Either (HaltReason ue fe) (a, [w])
runConform :: forall ue fe w a.
Conform ue fe w a -> Either (HaltReason ue fe) (a, [w])
runConform = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a -> m (Either (HaltReason ue fe) (a, [w]))
runConformT
runConformStrict ::
Conform ue fe w a ->
Either (Either ue (Notes fe w)) a
runConformStrict :: forall ue fe w a.
Conform ue fe w a -> Either (Either ue (Notes fe w)) a
runConformStrict = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a -> m (Either (Either ue (Notes fe w)) a)
runConformTStrict
runConformLenient ::
Conform ue fe w a ->
Either ue (a, Notes fe w)
runConformLenient :: forall ue fe w a. Conform ue fe w a -> Either ue (a, Notes fe w)
runConformLenient = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a -> m (Either ue (a, Notes fe w))
runConformTLenient
tryConform ::
Monad m =>
ConformT ue fe w m a ->
ConformT ue fe w m (Maybe a)
tryConform :: forall (m :: * -> *) ue fe w a.
Monad m =>
ConformT ue fe w m a -> ConformT ue fe w m (Maybe a)
tryConform ConformT ue fe w m a
c = forall ue fe w (m :: * -> *) a.
ReaderT
(fe -> Bool)
(WriterT (Notes fe w) (ExceptT (HaltReason ue fe) m))
a
-> ConformT ue fe w m a
ConformT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \fe -> Bool
predicate -> do
Either (HaltReason ue fe) (a, Notes fe w)
errOrRes <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall fe ue w (m :: * -> *) a.
(fe -> Bool)
-> ConformT ue fe w m a
-> m (Either (HaltReason ue fe) (a, Notes fe w))
runConformTFlexible fe -> Bool
predicate ConformT ue fe w m a
c
case Either (HaltReason ue fe) (a, Notes fe w)
errOrRes of
Left HaltReason ue fe
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Right (a
result, Notes fe w
notes) -> do
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Notes fe w
notes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
result)
fixAll :: fe -> Bool
fixAll :: forall fe. fe -> Bool
fixAll = forall a b. a -> b -> a
const Bool
True
fixNone :: fe -> Bool
fixNone :: forall fe. fe -> Bool
fixNone = forall a b. a -> b -> a
const Bool
False
conformFromEither :: Monad m => Either ue a -> ConformT ue fe w m a
conformFromEither :: forall (m :: * -> *) ue a fe w.
Monad m =>
Either ue a -> ConformT ue fe w m a
conformFromEither = \case
Left ue
ue -> forall (m :: * -> *) ue fe w a.
Monad m =>
ue -> ConformT ue fe w m a
unfixableError ue
ue
Right a
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
conformMapAll :: Monad m => (ue1 -> ue2) -> (fe1 -> fe2) -> (w1 -> w2) -> ConformT ue1 fe1 w1 m a -> ConformT ue2 fe2 w2 m a
conformMapAll :: forall (m :: * -> *) ue1 ue2 fe1 fe2 w1 w2 a.
Monad m =>
(ue1 -> ue2)
-> (fe1 -> fe2)
-> (w1 -> w2)
-> ConformT ue1 fe1 w1 m a
-> ConformT ue2 fe2 w2 m a
conformMapAll ue1 -> ue2
ueFunc fe1 -> fe2
feFunc w1 -> w2
wFunc (ConformT ReaderT
(fe1 -> Bool)
(WriterT (Notes fe1 w1) (ExceptT (HaltReason ue1 fe1) m))
a
cFunc) =
forall ue fe w (m :: * -> *) a.
ReaderT
(fe -> Bool)
(WriterT (Notes fe w) (ExceptT (HaltReason ue fe) m))
a
-> ConformT ue fe w m a
ConformT forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT
( forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT
( \ExceptT (HaltReason ue1 fe1) m (a, Notes fe1 w1)
func -> do
(a
res, Notes fe1 w1
notes) <- forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HaltReason ue1 fe1 -> HaltReason ue2 fe2
haltReasonMapError ExceptT (HaltReason ue1 fe1) m (a, Notes fe1 w1)
func
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
res, Notes fe1 w1 -> Notes fe2 w2
notesMapError Notes fe1 w1
notes)
)
)
(forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\fe2 -> Bool
predicate -> fe2 -> Bool
predicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. fe1 -> fe2
feFunc) ReaderT
(fe1 -> Bool)
(WriterT (Notes fe1 w1) (ExceptT (HaltReason ue1 fe1) m))
a
cFunc)
where
notesMapError :: Notes fe1 w1 -> Notes fe2 w2
notesMapError (Notes [fe1]
fes [w1]
wes) =
forall fe w. [fe] -> [w] -> Notes fe w
Notes
(forall a b. (a -> b) -> [a] -> [b]
map fe1 -> fe2
feFunc [fe1]
fes)
(forall a b. (a -> b) -> [a] -> [b]
map w1 -> w2
wFunc [w1]
wes)
haltReasonMapError :: HaltReason ue1 fe1 -> HaltReason ue2 fe2
haltReasonMapError = \case
HaltedBecauseOfUnfixableError ue1
ue -> forall ue fe. ue -> HaltReason ue fe
HaltedBecauseOfUnfixableError (ue1 -> ue2
ueFunc ue1
ue)
HaltedBecauseOfStrictness fe1
fe -> forall ue fe. fe -> HaltReason ue fe
HaltedBecauseOfStrictness (fe1 -> fe2
feFunc fe1
fe)
conformMapErrors :: Monad m => (ue1 -> ue2) -> (fe1 -> fe2) -> ConformT ue1 fe1 w m a -> ConformT ue2 fe2 w m a
conformMapErrors :: forall (m :: * -> *) ue1 ue2 fe1 fe2 w a.
Monad m =>
(ue1 -> ue2)
-> (fe1 -> fe2) -> ConformT ue1 fe1 w m a -> ConformT ue2 fe2 w m a
conformMapErrors ue1 -> ue2
ueFunc fe1 -> fe2
feFunc = forall (m :: * -> *) ue1 ue2 fe1 fe2 w1 w2 a.
Monad m =>
(ue1 -> ue2)
-> (fe1 -> fe2)
-> (w1 -> w2)
-> ConformT ue1 fe1 w1 m a
-> ConformT ue2 fe2 w2 m a
conformMapAll ue1 -> ue2
ueFunc fe1 -> fe2
feFunc forall a. a -> a
id
conformMapError ::
Monad m =>
(ue1 -> ue2) ->
ConformT ue1 fe w m a ->
ConformT ue2 fe w m a
conformMapError :: forall (m :: * -> *) ue1 ue2 fe w a.
Monad m =>
(ue1 -> ue2) -> ConformT ue1 fe w m a -> ConformT ue2 fe w m a
conformMapError ue1 -> ue2
func = forall (m :: * -> *) ue1 ue2 fe1 fe2 w a.
Monad m =>
(ue1 -> ue2)
-> (fe1 -> fe2) -> ConformT ue1 fe1 w m a -> ConformT ue2 fe2 w m a
conformMapErrors ue1 -> ue2
func forall a. a -> a
id
conformMapFixableError ::
Monad m =>
(fe1 -> fe2) ->
ConformT ue fe1 w m a ->
ConformT ue fe2 w m a
conformMapFixableError :: forall (m :: * -> *) fe1 fe2 ue w a.
Monad m =>
(fe1 -> fe2) -> ConformT ue fe1 w m a -> ConformT ue fe2 w m a
conformMapFixableError = forall (m :: * -> *) ue1 ue2 fe1 fe2 w a.
Monad m =>
(ue1 -> ue2)
-> (fe1 -> fe2) -> ConformT ue1 fe1 w m a -> ConformT ue2 fe2 w m a
conformMapErrors forall a. a -> a
id
emitWarning :: Monad m => w -> ConformT ue fe w m ()
emitWarning :: forall (m :: * -> *) w ue fe. Monad m => w -> ConformT ue fe w m ()
emitWarning w
w = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (forall fe w. [fe] -> [w] -> Notes fe w
Notes [] [w
w])
emitFixableError :: Monad m => fe -> ConformT ue fe w m ()
emitFixableError :: forall (m :: * -> *) fe ue w.
Monad m =>
fe -> ConformT ue fe w m ()
emitFixableError fe
fe = do
fe -> Bool
predicate <- forall r (m :: * -> *). MonadReader r m => m r
ask
if fe -> Bool
predicate fe
fe
then forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (forall fe w. [fe] -> [w] -> Notes fe w
Notes [fe
fe] [])
else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall ue fe. fe -> HaltReason ue fe
HaltedBecauseOfStrictness fe
fe)
unfixableError :: Monad m => ue -> ConformT ue fe w m a
unfixableError :: forall (m :: * -> *) ue fe w a.
Monad m =>
ue -> ConformT ue fe w m a
unfixableError ue
ue = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall ue fe. ue -> HaltReason ue fe
HaltedBecauseOfUnfixableError ue
ue)