{-# Language CPP #-}
{-# Language OverloadedStrings #-}
-- | Utilities for data validation
module Data.ErrorOr.Validation
  ( (>!),
    (>=!),
    (<!),
    (<=!),
    (=!),
    (/=!),
    ensure,
    ensureIsNothing,
    ensureIsJust,
    approxEqual,
    ensureAll,
  )
where

import Data.ErrorOr
import qualified Data.Text as T
import Data.Foldable (sequenceA_)

#if __GLASGOW_HASKELL__ < 880
import Prelude hiding (fail)
import Data.Semigroup
import Control.Monad.Fail (MonadFail(..))
#endif

-- <> is infixr 6 :|, which forces parentheses around >! etc, but if I increase
-- priority on >! above 6, it will break relation to the arithmetic operators

infix 4 >!
(>!) :: (Ord a, Show a) => a -> a -> ErrorOr ()
a
a >! :: a -> a -> ErrorOr ()
>! a
b = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else a -> Text -> a -> ErrorOr ()
forall a. Show a => a -> Text -> a -> ErrorOr ()
binaryErr a
a Text
"is not greater than" a
b

infix 4 >=!
(>=!) :: (Ord a, Show a) => a -> a -> ErrorOr ()
a
a >=! :: a -> a -> ErrorOr ()
>=! a
b = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
b then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else a -> Text -> a -> ErrorOr ()
forall a. Show a => a -> Text -> a -> ErrorOr ()
binaryErr a
a Text
"is not >= than" a
b

infix 4 <!
(<!) :: (Ord a, Show a) => a -> a -> ErrorOr ()
a
a <! :: a -> a -> ErrorOr ()
<! a
b = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else a -> Text -> a -> ErrorOr ()
forall a. Show a => a -> Text -> a -> ErrorOr ()
binaryErr a
a Text
"is not smaller than" a
b

infix 4 <=!
(<=!) :: (Ord a, Show a) => a -> a -> ErrorOr ()
a
a <=! :: a -> a -> ErrorOr ()
<=! a
b = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else a -> Text -> a -> ErrorOr ()
forall a. Show a => a -> Text -> a -> ErrorOr ()
binaryErr a
a Text
"is not <= than" a
b

infix 4 =!
(=!) :: (Eq a, Show a) => a -> a -> ErrorOr ()
a
a =! :: a -> a -> ErrorOr ()
=! a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else a -> Text -> a -> ErrorOr ()
forall a. Show a => a -> Text -> a -> ErrorOr ()
binaryErr a
a Text
"is not equal to" a
b

infix 4 /=!
(/=!) :: (Eq a, Show a) => a -> a -> ErrorOr ()
a
a /=! :: a -> a -> ErrorOr ()
/=! a
b = if a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
b then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else a -> Text -> a -> ErrorOr ()
forall a. Show a => a -> Text -> a -> ErrorOr ()
binaryErr a
a Text
"is equal to" a
b

-- | Checks the difference of the numbers is less than ratio times
--   the average of the two numbers.
approxEqual :: (RealFrac a, Show a) =>
#if __GLASGOW_HASKELL__ >= 880
  -- | ratio
#endif
  Double
  -> a
  -> a
  -> ErrorOr ()
approxEqual :: Double -> a -> a -> ErrorOr ()
approxEqual Double
ratio a
x a
y =
  if Double -> Double
forall a. Num a => a -> a
abs (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
y) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double
forall a. Num a => a -> a
abs (Double
ratio Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
avg)
    then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else Text -> ErrorOr ()
forall a. Text -> ErrorOr a
err (Text
"The numbers are too far apart: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
y))
  where
    avg :: Double
    avg :: Double
avg = a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2

binaryErr :: Show a => a -> T.Text -> a -> ErrorOr ()
binaryErr :: a -> Text -> a -> ErrorOr ()
binaryErr a
a Text
label a
b = String -> ErrorOr ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ((a -> String
forall a. Show a => a -> String
show a
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b)

ensureIsNothing :: Show a => Maybe a -> ErrorOr ()
ensureIsNothing :: Maybe a -> ErrorOr ()
ensureIsNothing Maybe a
Nothing = () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ensureIsNothing Maybe a
x = Text -> ErrorOr ()
forall a. Text -> ErrorOr a
err (Text
"Expected Nothing, but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Maybe a -> String
forall a. Show a => a -> String
show Maybe a
x))

ensureIsJust :: Maybe a -> ErrorOr ()
ensureIsJust :: Maybe a -> ErrorOr ()
ensureIsJust Maybe a
Nothing = Text -> ErrorOr ()
forall a. Text -> ErrorOr a
err (Text
"Expected Just, but got Nothing")
ensureIsJust (Just a
_) = () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | It annotates a failure with the element's show result.
ensureAll :: Show a => (a -> ErrorOr ()) -> [a] -> ErrorOr ()
ensureAll :: (a -> ErrorOr ()) -> [a] -> ErrorOr ()
ensureAll a -> ErrorOr ()
p = [ErrorOr ()] -> ErrorOr ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ ([ErrorOr ()] -> ErrorOr ())
-> ([a] -> [ErrorOr ()]) -> [a] -> ErrorOr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ErrorOr ()) -> [a] -> [ErrorOr ()]
forall a b. (a -> b) -> [a] -> [b]
map a -> ErrorOr ()
p'
  where p' :: a -> ErrorOr ()
p' a
x = if a -> ErrorOr ()
p a
x ErrorOr () -> ErrorOr () -> Bool
forall a. Eq a => a -> a -> Bool
/= () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  then Text -> ErrorOr () -> ErrorOr ()
forall a. Text -> ErrorOr a -> ErrorOr a
tag (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x) (a -> ErrorOr ()
p a
x)
                  else () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

ensure :: T.Text -> Bool -> ErrorOr ()
ensure :: Text -> Bool -> ErrorOr ()
ensure Text
label Bool
condition = if Bool
condition then () -> ErrorOr ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else Text -> ErrorOr ()
forall a. Text -> ErrorOr a
err Text
label