{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Monad.Validation
  ( ValidationT(..)
  , runValidationT
  , runValidationTEither
  , handleValidationT
  , vError
  , vWarning
  , vErrorL
  , vWarningL
  , vZoom
  , vZoomL
  , vPromote
  , mmSingleton
  , setMempty
  , neConcat
  , textErrors
  , _MonoidMap
  , MonoidMap(..)
  ) where

import Control.Applicative
import Control.Lens hiding ((.=))
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Fail
import Control.Monad.State.Strict
import Control.Monad.Trans.Control
import Data.Aeson
import Data.Foldable as F
import Data.Functor
import Data.List as L
import Data.Map.Strict as M
import Data.Monoid
import Data.Text as T
import Data.Vector as V
import Test.QuickCheck


-- | Collects all thrown warnings in 'StateT' and errors
-- in 'ExceptT' into a single value using 'Monoid'.
newtype ValidationT e m a = ValidationT
  { ValidationT e m a -> ExceptT e (StateT e m) a
unValidationT :: ExceptT e (StateT e m) a
  } deriving ( a -> ValidationT e m b -> ValidationT e m a
(a -> b) -> ValidationT e m a -> ValidationT e m b
(forall a b. (a -> b) -> ValidationT e m a -> ValidationT e m b)
-> (forall a b. a -> ValidationT e m b -> ValidationT e m a)
-> Functor (ValidationT e m)
forall a b. a -> ValidationT e m b -> ValidationT e m a
forall a b. (a -> b) -> ValidationT e m a -> ValidationT e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ValidationT e m b -> ValidationT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ValidationT e m a -> ValidationT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ValidationT e m b -> ValidationT e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ValidationT e m b -> ValidationT e m a
fmap :: (a -> b) -> ValidationT e m a -> ValidationT e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ValidationT e m a -> ValidationT e m b
Functor, Functor (ValidationT e m)
a -> ValidationT e m a
Functor (ValidationT e m)
-> (forall a. a -> ValidationT e m a)
-> (forall a b.
    ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b)
-> (forall a b c.
    (a -> b -> c)
    -> ValidationT e m a -> ValidationT e m b -> ValidationT e m c)
-> (forall a b.
    ValidationT e m a -> ValidationT e m b -> ValidationT e m b)
-> (forall a b.
    ValidationT e m a -> ValidationT e m b -> ValidationT e m a)
-> Applicative (ValidationT e m)
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
forall a. a -> ValidationT e m a
forall a b.
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
forall a b.
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall a b.
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
forall a b c.
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
forall e (m :: * -> *). Monad m => Functor (ValidationT e m)
forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e 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
<* :: ValidationT e m a -> ValidationT e m b -> ValidationT e m a
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m a
*> :: ValidationT e m a -> ValidationT e m b -> ValidationT e m b
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
liftA2 :: (a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ValidationT e m a -> ValidationT e m b -> ValidationT e m c
<*> :: ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m (a -> b) -> ValidationT e m a -> ValidationT e m b
pure :: a -> ValidationT e m a
$cpure :: forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
$cp1Applicative :: forall e (m :: * -> *). Monad m => Functor (ValidationT e m)
Applicative, Applicative (ValidationT e m)
a -> ValidationT e m a
Applicative (ValidationT e m)
-> (forall a b.
    ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b)
-> (forall a b.
    ValidationT e m a -> ValidationT e m b -> ValidationT e m b)
-> (forall a. a -> ValidationT e m a)
-> Monad (ValidationT e m)
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall a. a -> ValidationT e m a
forall a b.
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall a b.
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
forall e (m :: * -> *). Monad m => Applicative (ValidationT e m)
forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e 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 :: a -> ValidationT e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> ValidationT e m a
>> :: ValidationT e m a -> ValidationT e m b -> ValidationT e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> ValidationT e m b -> ValidationT e m b
>>= :: ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
ValidationT e m a -> (a -> ValidationT e m b) -> ValidationT e m b
$cp1Monad :: forall e (m :: * -> *). Monad m => Applicative (ValidationT e m)
Monad, Monad (ValidationT e m)
e -> ValidationT e m a
Monad (ValidationT e m)
-> (forall e a. Exception e => e -> ValidationT e m a)
-> MonadThrow (ValidationT e m)
forall e a. Exception e => e -> ValidationT e m a
forall e (m :: * -> *). MonadThrow m => Monad (ValidationT e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ValidationT e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ValidationT e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ValidationT e m a
$cp1MonadThrow :: forall e (m :: * -> *). MonadThrow m => Monad (ValidationT e m)
MonadThrow, MonadThrow (ValidationT e m)
MonadThrow (ValidationT e m)
-> (forall e a.
    Exception e =>
    ValidationT e m a -> (e -> ValidationT e m a) -> ValidationT e m a)
-> MonadCatch (ValidationT e m)
ValidationT e m a -> (e -> ValidationT e m a) -> ValidationT e m a
forall e a.
Exception e =>
ValidationT e m a -> (e -> ValidationT e m a) -> ValidationT e m a
forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ValidationT e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ValidationT e m a -> (e -> ValidationT e m a) -> ValidationT e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ValidationT e m a -> (e -> ValidationT e m a) -> ValidationT e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ValidationT e m a -> (e -> ValidationT e m a) -> ValidationT e m a
$cp1MonadCatch :: forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ValidationT e m)
MonadCatch
             , MonadBase b, Applicative (ValidationT e m)
ValidationT e m a
Applicative (ValidationT e m)
-> (forall a. ValidationT e m a)
-> (forall a.
    ValidationT e m a -> ValidationT e m a -> ValidationT e m a)
-> (forall a. ValidationT e m a -> ValidationT e m [a])
-> (forall a. ValidationT e m a -> ValidationT e m [a])
-> Alternative (ValidationT e m)
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
ValidationT e m a -> ValidationT e m [a]
ValidationT e m a -> ValidationT e m [a]
forall a. ValidationT e m a
forall a. ValidationT e m a -> ValidationT e m [a]
forall a.
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ValidationT e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m [a]
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: ValidationT e m a -> ValidationT e m [a]
$cmany :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m [a]
some :: ValidationT e m a -> ValidationT e m [a]
$csome :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m [a]
<|> :: ValidationT e m a -> ValidationT e m a -> ValidationT e m a
$c<|> :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
empty :: ValidationT e m a
$cempty :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
$cp1Alternative :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ValidationT e m)
Alternative, Monad (ValidationT e m)
Monad (ValidationT e m)
-> (forall a. (a -> ValidationT e m a) -> ValidationT e m a)
-> MonadFix (ValidationT e m)
(a -> ValidationT e m a) -> ValidationT e m a
forall a. (a -> ValidationT e m a) -> ValidationT e m a
forall e (m :: * -> *). MonadFix m => Monad (ValidationT e m)
forall e (m :: * -> *) a.
MonadFix m =>
(a -> ValidationT e m a) -> ValidationT e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ValidationT e m a) -> ValidationT e m a
$cmfix :: forall e (m :: * -> *) a.
MonadFix m =>
(a -> ValidationT e m a) -> ValidationT e m a
$cp1MonadFix :: forall e (m :: * -> *). MonadFix m => Monad (ValidationT e m)
MonadFix, Monad (ValidationT e m)
Monad (ValidationT e m)
-> (forall a. String -> ValidationT e m a)
-> MonadFail (ValidationT e m)
String -> ValidationT e m a
forall a. String -> ValidationT e m a
forall e (m :: * -> *). MonadFail m => Monad (ValidationT e m)
forall e (m :: * -> *) a.
MonadFail m =>
String -> ValidationT e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ValidationT e m a
$cfail :: forall e (m :: * -> *) a.
MonadFail m =>
String -> ValidationT e m a
$cp1MonadFail :: forall e (m :: * -> *). MonadFail m => Monad (ValidationT e m)
MonadFail, b -> ValidationT e m b -> ValidationT e m a
(a -> b) -> ValidationT e m b -> ValidationT e m a
(forall a b. (a -> b) -> ValidationT e m b -> ValidationT e m a)
-> (forall b a. b -> ValidationT e m b -> ValidationT e m a)
-> Contravariant (ValidationT e m)
forall b a. b -> ValidationT e m b -> ValidationT e m a
forall a b. (a -> b) -> ValidationT e m b -> ValidationT e m a
forall e (m :: * -> *) b a.
Contravariant m =>
b -> ValidationT e m b -> ValidationT e m a
forall e (m :: * -> *) a b.
Contravariant m =>
(a -> b) -> ValidationT e m b -> ValidationT e m a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> ValidationT e m b -> ValidationT e m a
$c>$ :: forall e (m :: * -> *) b a.
Contravariant m =>
b -> ValidationT e m b -> ValidationT e m a
contramap :: (a -> b) -> ValidationT e m b -> ValidationT e m a
$ccontramap :: forall e (m :: * -> *) a b.
Contravariant m =>
(a -> b) -> ValidationT e m b -> ValidationT e m a
Contravariant
             , Monad (ValidationT e m)
Monad (ValidationT e m)
-> (forall a. IO a -> ValidationT e m a)
-> MonadIO (ValidationT e m)
IO a -> ValidationT e m a
forall a. IO a -> ValidationT e m a
forall e (m :: * -> *). MonadIO m => Monad (ValidationT e m)
forall e (m :: * -> *) a. MonadIO m => IO a -> ValidationT e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ValidationT e m a
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> ValidationT e m a
$cp1MonadIO :: forall e (m :: * -> *). MonadIO m => Monad (ValidationT e m)
MonadIO, Monad (ValidationT e m)
Alternative (ValidationT e m)
ValidationT e m a
Alternative (ValidationT e m)
-> Monad (ValidationT e m)
-> (forall a. ValidationT e m a)
-> (forall a.
    ValidationT e m a -> ValidationT e m a -> ValidationT e m a)
-> MonadPlus (ValidationT e m)
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall a. ValidationT e m a
forall a.
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Monad (ValidationT e m)
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ValidationT e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ValidationT e m a -> ValidationT e m a -> ValidationT e m a
$cmplus :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ValidationT e m a -> ValidationT e m a -> ValidationT e m a
mzero :: ValidationT e m a
$cmzero :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ValidationT e m a
$cp2MonadPlus :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Monad (ValidationT e m)
$cp1MonadPlus :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ValidationT e m)
MonadPlus, MonadBaseControl b, MonadCatch (ValidationT e m)
MonadCatch (ValidationT e m)
-> (forall b.
    ((forall a. ValidationT e m a -> ValidationT e m a)
     -> ValidationT e m b)
    -> ValidationT e m b)
-> (forall b.
    ((forall a. ValidationT e m a -> ValidationT e m a)
     -> ValidationT e m b)
    -> ValidationT e m b)
-> (forall a b c.
    ValidationT e m a
    -> (a -> ExitCase b -> ValidationT e m c)
    -> (a -> ValidationT e m b)
    -> ValidationT e m (b, c))
-> MonadMask (ValidationT e m)
ValidationT e m a
-> (a -> ExitCase b -> ValidationT e m c)
-> (a -> ValidationT e m b)
-> ValidationT e m (b, c)
((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
forall b.
((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
forall a b c.
ValidationT e m a
-> (a -> ExitCase b -> ValidationT e m c)
-> (a -> ValidationT e m b)
-> ValidationT e m (b, c)
forall e (m :: * -> *). MonadMask m => MonadCatch (ValidationT e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
ValidationT e m a
-> (a -> ExitCase b -> ValidationT e m c)
-> (a -> ValidationT e m b)
-> ValidationT e m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: ValidationT e m a
-> (a -> ExitCase b -> ValidationT e m c)
-> (a -> ValidationT e m b)
-> ValidationT e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
ValidationT e m a
-> (a -> ExitCase b -> ValidationT e m c)
-> (a -> ValidationT e m b)
-> ValidationT e m (b, c)
uninterruptibleMask :: ((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
mask :: ((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ValidationT e m a -> ValidationT e m a)
 -> ValidationT e m b)
-> ValidationT e m b
$cp1MonadMask :: forall e (m :: * -> *). MonadMask m => MonadCatch (ValidationT e m)
MonadMask )

instance MonadTrans (ValidationT e) where
  lift :: m a -> ValidationT e m a
lift = ExceptT e (StateT e m) a -> ValidationT e m a
forall e (m :: * -> *) a.
ExceptT e (StateT e m) a -> ValidationT e m a
ValidationT (ExceptT e (StateT e m) a -> ValidationT e m a)
-> (m a -> ExceptT e (StateT e m) a) -> m a -> ValidationT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT e m a -> ExceptT e (StateT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT e m a -> ExceptT e (StateT e m) a)
-> (m a -> StateT e m a) -> m a -> ExceptT e (StateT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Map with 'Monoid' instance which 'mappend' its values
--
-- This can be used as the `e` in `ValidationT e m a` to provide different
-- sets of errors and warnings for different keys.
--
-- >>> :{
--   mconcat
--   [ MonoidMap $ M.fromList [(1, "foo"), (2, "hello, "), (3, "oh no")]
--   , MonoidMap $ M.fromList [(1, "bar"), (2, "world")]
--   ]
-- :}
-- MonoidMap (fromList [(1,"foobar"),(2,"hello, world"),(3,"oh no")])
newtype MonoidMap k v = MonoidMap (Map k v)
  deriving (MonoidMap k v -> MonoidMap k v -> Bool
(MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool) -> Eq (MonoidMap k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => MonoidMap k v -> MonoidMap k v -> Bool
/= :: MonoidMap k v -> MonoidMap k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => MonoidMap k v -> MonoidMap k v -> Bool
== :: MonoidMap k v -> MonoidMap k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => MonoidMap k v -> MonoidMap k v -> Bool
Eq, Eq (MonoidMap k v)
Eq (MonoidMap k v)
-> (MonoidMap k v -> MonoidMap k v -> Ordering)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> MonoidMap k v)
-> (MonoidMap k v -> MonoidMap k v -> MonoidMap k v)
-> Ord (MonoidMap k v)
MonoidMap k v -> MonoidMap k v -> Bool
MonoidMap k v -> MonoidMap k v -> Ordering
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k v. (Ord k, Ord v) => Eq (MonoidMap k v)
forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Ordering
forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
min :: MonoidMap k v -> MonoidMap k v -> MonoidMap k v
$cmin :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
max :: MonoidMap k v -> MonoidMap k v -> MonoidMap k v
$cmax :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
>= :: MonoidMap k v -> MonoidMap k v -> Bool
$c>= :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
> :: MonoidMap k v -> MonoidMap k v -> Bool
$c> :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
<= :: MonoidMap k v -> MonoidMap k v -> Bool
$c<= :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
< :: MonoidMap k v -> MonoidMap k v -> Bool
$c< :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
compare :: MonoidMap k v -> MonoidMap k v -> Ordering
$ccompare :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Ordering
$cp1Ord :: forall k v. (Ord k, Ord v) => Eq (MonoidMap k v)
Ord, Int -> MonoidMap k v -> ShowS
[MonoidMap k v] -> ShowS
MonoidMap k v -> String
(Int -> MonoidMap k v -> ShowS)
-> (MonoidMap k v -> String)
-> ([MonoidMap k v] -> ShowS)
-> Show (MonoidMap k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> MonoidMap k v -> ShowS
forall k v. (Show k, Show v) => [MonoidMap k v] -> ShowS
forall k v. (Show k, Show v) => MonoidMap k v -> String
showList :: [MonoidMap k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [MonoidMap k v] -> ShowS
show :: MonoidMap k v -> String
$cshow :: forall k v. (Show k, Show v) => MonoidMap k v -> String
showsPrec :: Int -> MonoidMap k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> MonoidMap k v -> ShowS
Show, Gen (MonoidMap k v)
Gen (MonoidMap k v)
-> (MonoidMap k v -> [MonoidMap k v]) -> Arbitrary (MonoidMap k v)
MonoidMap k v -> [MonoidMap k v]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall k v.
(Ord k, Arbitrary k, Arbitrary v) =>
Gen (MonoidMap k v)
forall k v.
(Ord k, Arbitrary k, Arbitrary v) =>
MonoidMap k v -> [MonoidMap k v]
shrink :: MonoidMap k v -> [MonoidMap k v]
$cshrink :: forall k v.
(Ord k, Arbitrary k, Arbitrary v) =>
MonoidMap k v -> [MonoidMap k v]
arbitrary :: Gen (MonoidMap k v)
$carbitrary :: forall k v.
(Ord k, Arbitrary k, Arbitrary v) =>
Gen (MonoidMap k v)
Arbitrary, a -> MonoidMap k a -> Bool
MonoidMap k m -> m
MonoidMap k a -> [a]
MonoidMap k a -> Bool
MonoidMap k a -> Int
MonoidMap k a -> a
MonoidMap k a -> a
MonoidMap k a -> a
MonoidMap k a -> a
(a -> m) -> MonoidMap k a -> m
(a -> m) -> MonoidMap k a -> m
(a -> b -> b) -> b -> MonoidMap k a -> b
(a -> b -> b) -> b -> MonoidMap k a -> b
(b -> a -> b) -> b -> MonoidMap k a -> b
(b -> a -> b) -> b -> MonoidMap k a -> b
(a -> a -> a) -> MonoidMap k a -> a
(a -> a -> a) -> MonoidMap k a -> a
(forall m. Monoid m => MonoidMap k m -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m)
-> (forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b)
-> (forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b)
-> (forall a. (a -> a -> a) -> MonoidMap k a -> a)
-> (forall a. (a -> a -> a) -> MonoidMap k a -> a)
-> (forall a. MonoidMap k a -> [a])
-> (forall a. MonoidMap k a -> Bool)
-> (forall a. MonoidMap k a -> Int)
-> (forall a. Eq a => a -> MonoidMap k a -> Bool)
-> (forall a. Ord a => MonoidMap k a -> a)
-> (forall a. Ord a => MonoidMap k a -> a)
-> (forall a. Num a => MonoidMap k a -> a)
-> (forall a. Num a => MonoidMap k a -> a)
-> Foldable (MonoidMap k)
forall a. Eq a => a -> MonoidMap k a -> Bool
forall a. Num a => MonoidMap k a -> a
forall a. Ord a => MonoidMap k a -> a
forall m. Monoid m => MonoidMap k m -> m
forall a. MonoidMap k a -> Bool
forall a. MonoidMap k a -> Int
forall a. MonoidMap k a -> [a]
forall a. (a -> a -> a) -> MonoidMap k a -> a
forall k a. Eq a => a -> MonoidMap k a -> Bool
forall k a. Num a => MonoidMap k a -> a
forall k a. Ord a => MonoidMap k a -> a
forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k m. Monoid m => MonoidMap k m -> m
forall k a. MonoidMap k a -> Bool
forall k a. MonoidMap k a -> Int
forall k a. MonoidMap k a -> [a]
forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b
forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
forall k a. (a -> a -> a) -> MonoidMap k a -> a
forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: MonoidMap k a -> a
$cproduct :: forall k a. Num a => MonoidMap k a -> a
sum :: MonoidMap k a -> a
$csum :: forall k a. Num a => MonoidMap k a -> a
minimum :: MonoidMap k a -> a
$cminimum :: forall k a. Ord a => MonoidMap k a -> a
maximum :: MonoidMap k a -> a
$cmaximum :: forall k a. Ord a => MonoidMap k a -> a
elem :: a -> MonoidMap k a -> Bool
$celem :: forall k a. Eq a => a -> MonoidMap k a -> Bool
length :: MonoidMap k a -> Int
$clength :: forall k a. MonoidMap k a -> Int
null :: MonoidMap k a -> Bool
$cnull :: forall k a. MonoidMap k a -> Bool
toList :: MonoidMap k a -> [a]
$ctoList :: forall k a. MonoidMap k a -> [a]
foldl1 :: (a -> a -> a) -> MonoidMap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldr1 :: (a -> a -> a) -> MonoidMap k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldl' :: (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldl :: (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldr' :: (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldr :: (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldMap' :: (a -> m) -> MonoidMap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
foldMap :: (a -> m) -> MonoidMap k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
fold :: MonoidMap k m -> m
$cfold :: forall k m. Monoid m => MonoidMap k m -> m
Foldable)

makePrisms ''MonoidMap

type instance IxValue (MonoidMap k v) = v
type instance Index (MonoidMap k v) = k
instance (Ord k) => Ixed (MonoidMap k v) where
  ix :: Index (MonoidMap k v)
-> Traversal' (MonoidMap k v) (IxValue (MonoidMap k v))
ix Index (MonoidMap k v)
key = (Map k v -> f (Map k v)) -> MonoidMap k v -> f (MonoidMap k v)
forall k v k v.
Iso (MonoidMap k v) (MonoidMap k v) (Map k v) (Map k v)
_MonoidMap ((Map k v -> f (Map k v)) -> MonoidMap k v -> f (MonoidMap k v))
-> ((v -> f v) -> Map k v -> f (Map k v))
-> (v -> f v)
-> MonoidMap k v
-> f (MonoidMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map k v) -> Traversal' (Map k v) (IxValue (Map k v))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map k v)
Index (MonoidMap k v)
key
instance (Ord k) => At (MonoidMap k v) where
  at :: Index (MonoidMap k v)
-> Lens' (MonoidMap k v) (Maybe (IxValue (MonoidMap k v)))
at Index (MonoidMap k v)
key = (Map k v -> f (Map k v)) -> MonoidMap k v -> f (MonoidMap k v)
forall k v k v.
Iso (MonoidMap k v) (MonoidMap k v) (Map k v) (Map k v)
_MonoidMap ((Map k v -> f (Map k v)) -> MonoidMap k v -> f (MonoidMap k v))
-> ((Maybe v -> f (Maybe v)) -> Map k v -> f (Map k v))
-> (Maybe v -> f (Maybe v))
-> MonoidMap k v
-> f (MonoidMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map k v) -> Lens' (Map k v) (Maybe (IxValue (Map k v)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map k v)
Index (MonoidMap k v)
key

#if MIN_VERSION_base(4,11,0)
instance (Ord k, Semigroup v) => Semigroup (MonoidMap k v) where
  <> :: MonoidMap k v -> MonoidMap k v -> MonoidMap k v
(<>) = MonoidMap k v -> MonoidMap k v -> MonoidMap k v
forall k v.
(Ord k, Semigroup v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
mmAppend
#endif

instance (Ord k, Monoid v) => Monoid (MonoidMap k v) where
  mempty :: MonoidMap k v
mempty = Map k v -> MonoidMap k v
forall k v. Map k v -> MonoidMap k v
MonoidMap Map k v
forall k a. Map k a
M.empty
  mappend :: MonoidMap k v -> MonoidMap k v -> MonoidMap k v
mappend = MonoidMap k v -> MonoidMap k v -> MonoidMap k v
forall k v.
(Ord k, Semigroup v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
mmAppend

instance (ToJSON k, ToJSON v) => ToJSON (MonoidMap k v) where
  toJSON :: MonoidMap k v -> Value
toJSON (MonoidMap Map k v
m) = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ ((k, v) -> Value) -> [(k, v)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
L.map (k, v) -> Value
forall v v. (ToJSON v, ToJSON v) => (v, v) -> Value
toObj ([(k, v)] -> [Value]) -> [(k, v)] -> [Value]
forall a b. (a -> b) -> a -> b
$ Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toList Map k v
m
    where
      toObj :: (v, v) -> Value
toObj (v
k, v
v) = [Pair] -> Value
object
        [ Text
"id" Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= v
k
        , Text
"value" Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= v
v ]

instance (Ord k, FromJSON k, FromJSON v) => FromJSON (MonoidMap k v) where
  parseJSON :: Value -> Parser (MonoidMap k v)
parseJSON = String
-> (Array -> Parser (MonoidMap k v))
-> Value
-> Parser (MonoidMap k v)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"MonoidMap" Array -> Parser (MonoidMap k v)
forall k v.
(FromJSON k, FromJSON v, Ord k) =>
Array -> Parser (MonoidMap k v)
go
    where
      go :: Array -> Parser (MonoidMap k v)
go Array
arr = do
        Vector (k, v)
keyvals <- (Value -> Parser (k, v)) -> Array -> Parser (Vector (k, v))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser (k, v)
forall a b. (FromJSON a, FromJSON b) => Value -> Parser (a, b)
fromObj Array
arr
        MonoidMap k v -> Parser (MonoidMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (MonoidMap k v -> Parser (MonoidMap k v))
-> MonoidMap k v -> Parser (MonoidMap k v)
forall a b. (a -> b) -> a -> b
$ Map k v -> MonoidMap k v
forall k v. Map k v -> MonoidMap k v
MonoidMap (Map k v -> MonoidMap k v) -> Map k v -> MonoidMap k v
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, v)] -> Map k v) -> [(k, v)] -> Map k v
forall a b. (a -> b) -> a -> b
$ Vector (k, v) -> [(k, v)]
forall a. Vector a -> [a]
V.toList Vector (k, v)
keyvals
      fromObj :: Value -> Parser (a, b)
fromObj Value
objV = ((Object -> Parser (a, b)) -> Value -> Parser (a, b))
-> Value -> (Object -> Parser (a, b)) -> Parser (a, b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (Object -> Parser (a, b)) -> Value -> Parser (a, b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"element of MonoidMap") Value
objV ((Object -> Parser (a, b)) -> Parser (a, b))
-> (Object -> Parser (a, b)) -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        a
key <- Object
obj Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        b
val <- Object
obj Object -> Text -> Parser b
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"value"
        (a, b) -> Parser (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
key, b
val)

#if MIN_VERSION_base(4,11,0)
mmAppend :: (Ord k, Semigroup v) => MonoidMap k v -> MonoidMap k v -> MonoidMap k v
#else
mmAppend :: (Ord k, Monoid v) => MonoidMap k v -> MonoidMap k v -> MonoidMap k v
#endif
mmAppend :: MonoidMap k v -> MonoidMap k v -> MonoidMap k v
mmAppend (MonoidMap Map k v
a) (MonoidMap Map k v
b) = Map k v -> MonoidMap k v
forall k v. Map k v -> MonoidMap k v
MonoidMap (Map k v -> MonoidMap k v) -> Map k v -> MonoidMap k v
forall a b. (a -> b) -> a -> b
$ (v -> v -> v) -> Map k v -> Map k v -> Map k v
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>) Map k v
a Map k v
b

-- | Convenient for 'vZoom' as first argument. Will prevent generation
-- of map with 'mempty' values.
mmSingleton :: (Eq v, Monoid v, Ord k) => k -> v -> MonoidMap k v
mmSingleton :: k -> v -> MonoidMap k v
mmSingleton k
k v
v
  | v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
forall a. Monoid a => a
mempty = MonoidMap k v
forall a. Monoid a => a
mempty
  | Bool
otherwise   = Map k v -> MonoidMap k v
forall k v. Map k v -> MonoidMap k v
MonoidMap (Map k v -> MonoidMap k v) -> (v -> Map k v) -> v -> MonoidMap k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> v -> Map k v
forall k a. k -> a -> Map k a
M.singleton k
k (v -> MonoidMap k v) -> v -> MonoidMap k v
forall a b. (a -> b) -> a -> b
$ v
v

-- | Sets given value to 'mempty'.
setMempty :: (Monoid s) => ASetter' s a -> a -> s
setMempty :: ASetter' s a -> a -> s
setMempty ASetter' s a
setter a
a = ASetter' s a -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter' s a
setter a
a s
forall a. Monoid a => a
mempty

neConcat :: Foldable f => (a -> a -> a) -> f a -> Maybe a
neConcat :: (a -> a -> a) -> f a -> Maybe a
neConcat a -> a -> a
f f a
a
  | f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null f a
a  = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> f a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldr1 a -> a -> a
f f a
a

-- | Returns the strings, concatanated with @", "@ if the list is not empty.
--
-- Returns Nothing if the list is empty
--
-- >>> textErrors ["foo", "bar"]
-- Just "foo, bar"
--
-- >>> textErrors ["foo"]
-- Just "foo"
--
-- >>> textErrors []
-- Nothing
textErrors :: [Text] -> Maybe Text
textErrors :: [Text] -> Maybe Text
textErrors = (Text -> Text -> Text) -> [Text] -> Maybe Text
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f a -> Maybe a
neConcat (\Text
a Text
b -> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b)

-- | Returns 'mempty' instead of error if no warnings have occurred.
-- Returns 'Nothing' as the second element of tuple if computation was
-- interrupted by 'vError'.
--
-- Returns all concatenated errors and warnings and the result if no
-- errors have occurred (warnings could have occurred).
--
-- >>> :{
--  runValidationT $ do
--    vWarning ["warning1"]
--    vError ["error"]
--    vWarning ["warning2"]
--    return 8
-- :}
-- (["error","warning1"],Nothing)
--
-- >>> :{
--  runValidationT $ do
--    vWarning ["warning1"]
--    vWarning ["warning2"]
--    return 8
-- :}
-- (["warning1","warning2"],Just 8)
runValidationT :: (Monoid e, Monad m) => ValidationT e m a -> m (e, Maybe a)
runValidationT :: ValidationT e m a -> m (e, Maybe a)
runValidationT (ValidationT ExceptT e (StateT e m) a
m) = do
  (Either e a
res, e
warnings) <- StateT e m (Either e a) -> e -> m (Either e a, e)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT e (StateT e m) a -> StateT e m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e (StateT e m) a
m) e
forall a. Monoid a => a
mempty
  (e, Maybe a) -> m (e, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((e, Maybe a) -> m (e, Maybe a)) -> (e, Maybe a) -> m (e, Maybe a)
forall a b. (a -> b) -> a -> b
$ case Either e a
res of
    Left e
err -> (e
err e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
warnings, Maybe a
forall a. Maybe a
Nothing)
    Right a
a  -> (e
warnings, a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- | Like 'runValidationT' but doesn't return the result
-- if any warning has occurred.
--
-- >>> :{
--  runValidationTEither $ do
--    vWarning ["warning1"]
--    vError ["error"]
--    vWarning ["warning2"]
--    return 8
-- :}
-- Left ["error","warning1"]
--
-- >>> :{
--  runValidationTEither $ do
--    vWarning ["warning1"]
--    vWarning ["warning2"]
--    return 8
-- :}
-- Left ["warning1","warning2"]
runValidationTEither
  :: (Monoid e, Eq e, Monad m)
  => ValidationT e m a
  -> m (Either e a)
runValidationTEither :: ValidationT e m a -> m (Either e a)
runValidationTEither ValidationT e m a
action = do
  (e
err, Maybe a
res) <- ValidationT e m a -> m (e, Maybe a)
forall e (m :: * -> *) a.
(Monoid e, Monad m) =>
ValidationT e m a -> m (e, Maybe a)
runValidationT ValidationT e m a
action
  Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ case Maybe a
res of
    Just a
a | e
err e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
forall a. Monoid a => a
mempty -> a -> Either e a
forall a b. b -> Either a b
Right a
a
    Maybe a
_                      -> e -> Either e a
forall a b. a -> Either a b
Left e
err

-- | Like 'runValidationTEither', but takes an error handler instead of
-- returning errors and warnings.
--
-- >>> :{
--  handleValidationT (\_ -> return 11) $ do
--    vWarning ["warning1"]
--    vError ["error"]
--    vWarning ["warning2"]
--    return 8
-- :}
-- 11
--
-- >>> :{
--  handleValidationT (\_ -> return 11) $ do
--    vWarning ["warning1"]
--    vWarning ["warning2"]
--    return 8
-- :}
-- 11
handleValidationT
  :: (Monoid e, Monad m, Eq e)
  => (e -> m a)
  -> ValidationT e m a
  -> m a
handleValidationT :: (e -> m a) -> ValidationT e m a -> m a
handleValidationT e -> m a
handler ValidationT e m a
action =
  ValidationT e m a -> m (Either e a)
forall e (m :: * -> *) a.
(Monoid e, Eq e, Monad m) =>
ValidationT e m a -> m (Either e a)
runValidationTEither ValidationT e m a
action m (Either e a) -> (Either e a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
handler a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Stops further execution and appends the given error.
vError :: (Monad m) => e -> ValidationT e m a
vError :: e -> ValidationT e m a
vError e
e = ExceptT e (StateT e m) a -> ValidationT e m a
forall e (m :: * -> *) a.
ExceptT e (StateT e m) a -> ValidationT e m a
ValidationT (ExceptT e (StateT e m) a -> ValidationT e m a)
-> ExceptT e (StateT e m) a -> ValidationT e m a
forall a b. (a -> b) -> a -> b
$ e -> ExceptT e (StateT e m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e

-- | Does not stop further execution and appends the given warning.
vWarning :: (Monad m, Monoid e) => e -> ValidationT e m ()
vWarning :: e -> ValidationT e m ()
vWarning e
e = ExceptT e (StateT e m) () -> ValidationT e m ()
forall e (m :: * -> *) a.
ExceptT e (StateT e m) a -> ValidationT e m a
ValidationT (ExceptT e (StateT e m) () -> ValidationT e m ())
-> ExceptT e (StateT e m) () -> ValidationT e m ()
forall a b. (a -> b) -> a -> b
$ (e -> e) -> ExceptT e (StateT e m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e)

-- | Like 'vError' but allows you to use a setter to insert an error somewhere
-- deeper into an empty ('mempty') "e" from "ValidationT e m x", which is then
-- combined with all gathered warnings.
vErrorL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m x
vErrorL :: ASetter' e a -> a -> ValidationT e m x
vErrorL ASetter' e a
l a
a = e -> ValidationT e m x
forall (m :: * -> *) e a. Monad m => e -> ValidationT e m a
vError (e -> ValidationT e m x) -> e -> ValidationT e m x
forall a b. (a -> b) -> a -> b
$ ASetter' e a -> a -> e
forall s a. Monoid s => ASetter' s a -> a -> s
setMempty ASetter' e a
l a
a

-- | Like 'vWarning' but allows you to use a setter to insert an error somewhere
-- deeper into an empty ('mempty') "e" from "ValidationT e m x", which is then
-- combined with all gathered warnings.
vWarningL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m ()
vWarningL :: ASetter' e a -> a -> ValidationT e m ()
vWarningL ASetter' e a
l a
a = e -> ValidationT e m ()
forall (m :: * -> *) e.
(Monad m, Monoid e) =>
e -> ValidationT e m ()
vWarning (e -> ValidationT e m ()) -> e -> ValidationT e m ()
forall a b. (a -> b) -> a -> b
$ ASetter' e a -> a -> e
forall s a. Monoid s => ASetter' s a -> a -> s
setMempty ASetter' e a
l a
a

-- | Allows you apply a transformation to the "e" in "ValidationT e m x".
--
-- >>> :{
--runValidationT . vZoom (Data.Map.singleton "password errors") $ do
--  vWarning ["warning1"]
--  vError ["error"]
--  vWarning ["warning2"]
--  return 8
-- :}
-- (fromList [("password errors",["error","warning1"])],Nothing)
--
-- >>> :{
--  runValidationT . vZoom (Data.Map.singleton "password errors") $ do
--    vWarning ["warning1"]
--    vWarning ["warning2"]
--    return 8
-- :}
-- (fromList [("password errors",["warning1","warning2"])],Just 8)
vZoom
  :: (Monad m, Monoid a, Monoid b)
  => (a -> b)
  -> ValidationT a m x
  -> ValidationT b m x
vZoom :: (a -> b) -> ValidationT a m x -> ValidationT b m x
vZoom a -> b
up ValidationT a m x
action = do
  (a
err, Maybe x
res) <- m (a, Maybe x) -> ValidationT b m (a, Maybe x)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, Maybe x) -> ValidationT b m (a, Maybe x))
-> m (a, Maybe x) -> ValidationT b m (a, Maybe x)
forall a b. (a -> b) -> a -> b
$ ValidationT a m x -> m (a, Maybe x)
forall e (m :: * -> *) a.
(Monoid e, Monad m) =>
ValidationT e m a -> m (e, Maybe a)
runValidationT ValidationT a m x
action
  case Maybe x
res of
    Maybe x
Nothing -> b -> ValidationT b m x
forall (m :: * -> *) e a. Monad m => e -> ValidationT e m a
vError (b -> ValidationT b m x) -> b -> ValidationT b m x
forall a b. (a -> b) -> a -> b
$ a -> b
up a
err
    Just x
a  -> b -> ValidationT b m ()
forall (m :: * -> *) e.
(Monad m, Monoid e) =>
e -> ValidationT e m ()
vWarning (a -> b
up a
err) ValidationT b m () -> x -> ValidationT b m x
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> x
a

-- | Like 'vZoom' but takes a setter instead of a function.
vZoomL
  :: (Monad m, Monoid a, Monoid b)
  => ASetter' b a
  -> ValidationT a m x
  -> ValidationT b m x
vZoomL :: ASetter' b a -> ValidationT a m x -> ValidationT b m x
vZoomL ASetter' b a
l = (a -> b) -> ValidationT a m x -> ValidationT b m x
forall (m :: * -> *) a b x.
(Monad m, Monoid a, Monoid b) =>
(a -> b) -> ValidationT a m x -> ValidationT b m x
vZoom (ASetter' b a -> a -> b
forall s a. Monoid s => ASetter' s a -> a -> s
setMempty ASetter' b a
l)

-- | Turn any warnings the have occurred into errors.
vPromote
  :: (Monad m, Monoid a, Eq a)
  => ValidationT a m x
  -> ValidationT a m x
vPromote :: ValidationT a m x -> ValidationT a m x
vPromote ValidationT a m x
m = do
  Either a x
err <- m (Either a x) -> ValidationT a m (Either a x)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either a x) -> ValidationT a m (Either a x))
-> m (Either a x) -> ValidationT a m (Either a x)
forall a b. (a -> b) -> a -> b
$ ValidationT a m x -> m (Either a x)
forall e (m :: * -> *) a.
(Monoid e, Eq e, Monad m) =>
ValidationT e m a -> m (Either e a)
runValidationTEither ValidationT a m x
m
  (a -> ValidationT a m x)
-> (x -> ValidationT a m x) -> Either a x -> ValidationT a m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> ValidationT a m x
forall (m :: * -> *) e a. Monad m => e -> ValidationT e m a
vError x -> ValidationT a m x
forall (m :: * -> *) a. Monad m => a -> m a
return Either a x
err