module Data.Valor.Internal where
newtype Valid a = Valid a
deriving ( Valid a -> Valid a -> Bool
(Valid a -> Valid a -> Bool)
-> (Valid a -> Valid a -> Bool) -> Eq (Valid a)
forall a. Eq a => Valid a -> Valid a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Valid a -> Valid a -> Bool
$c/= :: forall a. Eq a => Valid a -> Valid a -> Bool
== :: Valid a -> Valid a -> Bool
$c== :: forall a. Eq a => Valid a -> Valid a -> Bool
Eq , Int -> Valid a -> ShowS
[Valid a] -> ShowS
Valid a -> String
(Int -> Valid a -> ShowS)
-> (Valid a -> String) -> ([Valid a] -> ShowS) -> Show (Valid a)
forall a. Show a => Int -> Valid a -> ShowS
forall a. Show a => [Valid a] -> ShowS
forall a. Show a => Valid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Valid a] -> ShowS
$cshowList :: forall a. Show a => [Valid a] -> ShowS
show :: Valid a -> String
$cshow :: forall a. Show a => Valid a -> String
showsPrec :: Int -> Valid a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Valid a -> ShowS
Show )
unValid :: Valid a -> a
unValid :: Valid a -> a
unValid ( Valid a
a ) = a
a
newtype Valor i m e = Valor
{ Valor i m e -> i -> m (Wrong e)
unValor :: i -> m ( Wrong e )
}
instance ( Monad m , Semigroup e ) => Semigroup ( Valor i m e ) where
Valor i -> m (Wrong e)
b <> :: Valor i m e -> Valor i m e -> Valor i m e
<> Valor i -> m (Wrong e)
d = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ \ i
i -> Wrong e -> Wrong e -> Wrong e
forall a. Semigroup a => a -> a -> a
(<>) (Wrong e -> Wrong e -> Wrong e)
-> m (Wrong e) -> m (Wrong e -> Wrong e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( i -> m (Wrong e)
b i
i ) m (Wrong e -> Wrong e) -> m (Wrong e) -> m (Wrong e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( i -> m (Wrong e)
d i
i )
instance ( Monad m , Monoid e ) => Monoid ( Valor i m e ) where
mempty :: Valor i m e
mempty = (i -> m (Wrong e)) -> Valor i m e
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong e)) -> Valor i m e)
-> (i -> m (Wrong e)) -> Valor i m e
forall a b. (a -> b) -> a -> b
$ m (Wrong e) -> i -> m (Wrong e)
forall a b. a -> b -> a
const (m (Wrong e) -> i -> m (Wrong e))
-> m (Wrong e) -> i -> m (Wrong e)
forall a b. (a -> b) -> a -> b
$ Wrong e -> m (Wrong e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wrong e
forall a. Monoid a => a
mempty
instance Monad m => Functor ( Valor i m ) where
fmap :: (a -> b) -> Valor i m a -> Valor i m b
fmap a -> b
f ( Valor i -> m (Wrong a)
v ) = (i -> m (Wrong b)) -> Valor i m b
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong b)) -> Valor i m b)
-> (i -> m (Wrong b)) -> Valor i m b
forall a b. (a -> b) -> a -> b
$ \ i
i -> (a -> b) -> Wrong a -> Wrong b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Wrong a -> Wrong b) -> m (Wrong a) -> m (Wrong b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> m (Wrong a)
v i
i
instance Monad m => Applicative ( Valor i m ) where
pure :: a -> Valor i m a
pure = (i -> m (Wrong a)) -> Valor i m a
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong a)) -> Valor i m a)
-> (a -> i -> m (Wrong a)) -> a -> Valor i m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Wrong a) -> i -> m (Wrong a)
forall a b. a -> b -> a
const (m (Wrong a) -> i -> m (Wrong a))
-> (a -> m (Wrong a)) -> a -> i -> m (Wrong a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrong a -> m (Wrong a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wrong a -> m (Wrong a)) -> (a -> Wrong a) -> a -> m (Wrong a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Wrong a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Valor i -> m (Wrong (a -> b))
b <*> :: Valor i m (a -> b) -> Valor i m a -> Valor i m b
<*> Valor i -> m (Wrong a)
d = (i -> m (Wrong b)) -> Valor i m b
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong b)) -> Valor i m b)
-> (i -> m (Wrong b)) -> Valor i m b
forall a b. (a -> b) -> a -> b
$ \ i
i -> Wrong (a -> b) -> Wrong a -> Wrong b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (Wrong (a -> b) -> Wrong a -> Wrong b)
-> m (Wrong (a -> b)) -> m (Wrong a -> Wrong b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( i -> m (Wrong (a -> b))
b i
i ) m (Wrong a -> Wrong b) -> m (Wrong a) -> m (Wrong b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( i -> m (Wrong a)
d i
i )
instance Monad m => Monad ( Valor i m ) where
Valor i -> m (Wrong a)
v >>= :: Valor i m a -> (a -> Valor i m b) -> Valor i m b
>>= a -> Valor i m b
evv' = (i -> m (Wrong b)) -> Valor i m b
forall i (m :: * -> *) e. (i -> m (Wrong e)) -> Valor i m e
Valor ((i -> m (Wrong b)) -> Valor i m b)
-> (i -> m (Wrong b)) -> Valor i m b
forall a b. (a -> b) -> a -> b
$ \ i
i -> do
Wrong a
ve <- i -> m (Wrong a)
v i
i
case Wrong a
ve of
Inert a
e -> Valor i m b -> i -> m (Wrong b)
forall i (m :: * -> *) e. Valor i m e -> i -> m (Wrong e)
unValor ( a -> Valor i m b
evv' a
e ) i
i
Wrong a
e -> Valor i m b -> i -> m (Wrong b)
forall i (m :: * -> *) e. Valor i m e -> i -> m (Wrong e)
unValor ( a -> Valor i m b
evv' a
e ) i
i m (Wrong b) -> (Wrong b -> m (Wrong b)) -> m (Wrong b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Wrong b -> m (Wrong b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wrong b -> m (Wrong b))
-> (Wrong b -> Wrong b) -> Wrong b -> m (Wrong b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Wrong b
forall e. e -> Wrong e
Wrong (b -> Wrong b) -> (Wrong b -> b) -> Wrong b -> Wrong b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrong b -> b
forall e. Wrong e -> e
valW
data Wrong e = Inert e | Wrong e
deriving ( Wrong e -> Wrong e -> Bool
(Wrong e -> Wrong e -> Bool)
-> (Wrong e -> Wrong e -> Bool) -> Eq (Wrong e)
forall e. Eq e => Wrong e -> Wrong e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wrong e -> Wrong e -> Bool
$c/= :: forall e. Eq e => Wrong e -> Wrong e -> Bool
== :: Wrong e -> Wrong e -> Bool
$c== :: forall e. Eq e => Wrong e -> Wrong e -> Bool
Eq )
instance Semigroup e => Semigroup ( Wrong e ) where
Inert e
b <> :: Wrong e -> Wrong e -> Wrong e
<> Inert e
d = e -> Wrong e
forall e. e -> Wrong e
Inert (e -> Wrong e) -> e -> Wrong e
forall a b. (a -> b) -> a -> b
$ e
b e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
d
Inert e
b <> Wrong e
d = e -> Wrong e
forall e. e -> Wrong e
Wrong (e -> Wrong e) -> e -> Wrong e
forall a b. (a -> b) -> a -> b
$ e
b e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
d
Wrong e
b <> Inert e
d = e -> Wrong e
forall e. e -> Wrong e
Wrong (e -> Wrong e) -> e -> Wrong e
forall a b. (a -> b) -> a -> b
$ e
b e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
d
Wrong e
b <> Wrong e
d = e -> Wrong e
forall e. e -> Wrong e
Wrong (e -> Wrong e) -> e -> Wrong e
forall a b. (a -> b) -> a -> b
$ e
b e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
d
instance Monoid e => Monoid ( Wrong e ) where
mempty :: Wrong e
mempty = e -> Wrong e
forall e. e -> Wrong e
Inert e
forall a. Monoid a => a
mempty
instance Functor Wrong where
fmap :: (a -> b) -> Wrong a -> Wrong b
fmap a -> b
f ( Inert a
e ) = b -> Wrong b
forall e. e -> Wrong e
Inert (b -> Wrong b) -> b -> Wrong b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
fmap a -> b
f ( Wrong a
e ) = b -> Wrong b
forall e. e -> Wrong e
Wrong (b -> Wrong b) -> b -> Wrong b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
instance Applicative Wrong where
pure :: a -> Wrong a
pure = a -> Wrong a
forall e. e -> Wrong e
Inert
Inert a -> b
f <*> :: Wrong (a -> b) -> Wrong a -> Wrong b
<*> Inert a
e = b -> Wrong b
forall e. e -> Wrong e
Inert (b -> Wrong b) -> b -> Wrong b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
Inert a -> b
f <*> Wrong a
e = b -> Wrong b
forall e. e -> Wrong e
Wrong (b -> Wrong b) -> b -> Wrong b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
Wrong a -> b
f <*> Inert a
e = b -> Wrong b
forall e. e -> Wrong e
Wrong (b -> Wrong b) -> b -> Wrong b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
Wrong a -> b
f <*> Wrong a
e = b -> Wrong b
forall e. e -> Wrong e
Wrong (b -> Wrong b) -> b -> Wrong b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
conW :: Semigroup e => Wrong e -> Wrong e -> Wrong e
conW :: Wrong e -> Wrong e -> Wrong e
conW = Wrong e -> Wrong e -> Wrong e
forall a. Semigroup a => a -> a -> a
(<>)
appW :: Wrong ( a -> b ) -> Wrong a -> Wrong b
appW :: Wrong (a -> b) -> Wrong a -> Wrong b
appW = Wrong (a -> b) -> Wrong a -> Wrong b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
altW :: Wrong e -> Wrong e -> Wrong e
altW :: Wrong e -> Wrong e -> Wrong e
altW ( Inert e
e ) ( Inert e
_ ) = e -> Wrong e
forall e. e -> Wrong e
Inert e
e
altW ( Inert e
e ) ( Wrong e
_ ) = e -> Wrong e
forall e. e -> Wrong e
Inert e
e
altW ( Wrong e
_ ) ( Inert e
e ) = e -> Wrong e
forall e. e -> Wrong e
Inert e
e
altW ( Wrong e
_ ) ( Wrong e
e ) = e -> Wrong e
forall e. e -> Wrong e
Wrong e
e
accW :: Semigroup e => Wrong e -> Wrong e -> Wrong e
accW :: Wrong e -> Wrong e -> Wrong e
accW ( Inert e
e ) Wrong e
_ = e -> Wrong e
forall e. e -> Wrong e
Inert e
e
accW Wrong e
_ ( Inert e
e ) = e -> Wrong e
forall e. e -> Wrong e
Inert e
e
accW ( Wrong e
b ) ( Wrong e
d ) = e -> Wrong e
forall e. e -> Wrong e
Wrong (e -> Wrong e) -> e -> Wrong e
forall a b. (a -> b) -> a -> b
$ e
b e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
d
valW :: Wrong e -> e
valW :: Wrong e -> e
valW ( Inert e
e ) = e
e
valW ( Wrong e
e ) = e
e
wrong :: ( e -> a ) -> ( e -> a ) -> Wrong e -> a
wrong :: (e -> a) -> (e -> a) -> Wrong e -> a
wrong e -> a
_ e -> a
fi ( Inert e
e ) = e -> a
fi e
e
wrong e -> a
fw e -> a
_ ( Wrong e
e ) = e -> a
fw e
e
isInert :: Wrong e -> Bool
isInert :: Wrong e -> Bool
isInert ( Inert e
_ ) = Bool
True
isInert ( Wrong e
_ ) = Bool
False
isWrong :: Wrong e -> Bool
isWrong :: Wrong e -> Bool
isWrong ( Inert e
_ ) = Bool
False
isWrong ( Wrong e
_ ) = Bool
True