{-
  Copyright © 2023 Josep Bigorra

  This file is part of Keuringsdienst.
  Keuringsdienst is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation,
    either version 3 of the License, or (at your option) any later version.

  Keuringsdienst is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
    without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

  See the GNU General Public License for more details.
  You should have received a copy of the GNU General Public License along with Keuringsdienst.
  If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Keuringsdienst.Helpers
  ( filterFailedValidations,
    isEqualTo,
    isLesserThan,
    isNegative,
    isNegativeOrZero,
    isNonEmptyText,
    isPositive,
    isPositiveOrZero,
    isTextOfLength,
    isTextSmallerThan,
    isTextSmallerThanOrEqual,
    isNotEqualTo,
  )
where

import Data.Map as Map
import Data.Text as T
import Keuringsdienst as K

-- | Validate that a value is equal to another.
isEqualTo :: (Show a, Eq a) => a -> ValidationRule a
isEqualTo :: forall a. (Show a, Eq a) => a -> ValidationRule a
isEqualTo a
value = (a -> ValidationResult) -> ValidationRule a
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((a -> ValidationResult) -> ValidationRule a)
-> (a -> ValidationResult) -> ValidationRule a
forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
value
    then ValidationResult
forall err. Validation err
Success
    else
      [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure
        [String -> ErrMsg
pack (String -> ErrMsg) -> String -> ErrMsg
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
actual String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to equal " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
value]

-- | Validate that a value is different to another.
isNotEqualTo :: (Show a, Eq a) => a -> ValidationRule a
isNotEqualTo :: forall a. (Show a, Eq a) => a -> ValidationRule a
isNotEqualTo a
value = (a -> ValidationResult) -> ValidationRule a
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((a -> ValidationResult) -> ValidationRule a)
-> (a -> ValidationResult) -> ValidationRule a
forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
value
    then ValidationResult
forall err. Validation err
Success
    else
      [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure
        [String -> ErrMsg
pack (String -> ErrMsg) -> String -> ErrMsg
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
actual String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to not equal " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
value]

-- | Validate that a value is greater than another.
isGreaterThan :: (Show a, Ord a) => a -> ValidationRule a
isGreaterThan :: forall a. (Show a, Ord a) => a -> ValidationRule a
isGreaterThan a
ruleValue = (a -> ValidationResult) -> ValidationRule a
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((a -> ValidationResult) -> ValidationRule a)
-> (a -> ValidationResult) -> ValidationRule a
forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
ruleValue
    then ValidationResult
forall err. Validation err
Success
    else
      [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure
        [ String -> ErrMsg
pack (a -> String
forall a. Show a => a -> String
show a
actual String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" was expected to be greater than " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
ruleValue)
        ]

-- | Validate that a value is lesser than another.
isLesserThan :: (Show a, Ord a) => a -> ValidationRule a
isLesserThan :: forall a. (Show a, Ord a) => a -> ValidationRule a
isLesserThan a
ruleValue = (a -> ValidationResult) -> ValidationRule a
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((a -> ValidationResult) -> ValidationRule a)
-> (a -> ValidationResult) -> ValidationRule a
forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
ruleValue
    then ValidationResult
forall err. Validation err
Success
    else
      [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure
        [ String -> ErrMsg
pack (a -> String
forall a. Show a => a -> String
show a
actual String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" was expected to be lesser than " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
ruleValue)
        ]

-- | Validate that a value is a non empty @Text@.
isNonEmptyText :: ValidationRule Text
isNonEmptyText :: ValidationRule ErrMsg
isNonEmptyText = (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((ErrMsg -> ValidationResult) -> ValidationRule ErrMsg)
-> (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual ->
  if ErrMsg -> Bool
T.null ErrMsg
actual
    then [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure [String -> ErrMsg
T.pack String
"Text was expected to be non-empty"]
    else ValidationResult
forall err. Validation err
Success

-- | Validate that a value is a @Text@ of certain length.
isTextOfLength :: Int -> ValidationRule Text
isTextOfLength :: Int -> ValidationRule ErrMsg
isTextOfLength Int
ruleValue = (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((ErrMsg -> ValidationResult) -> ValidationRule ErrMsg)
-> (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual -> do
  let actualTextLength :: Int
actualTextLength = ErrMsg -> Int
T.length ErrMsg
actual
  if Int
actualTextLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ruleValue
    then
      [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure
        [ String -> ErrMsg
T.pack
            ( String
"Text was expected to be of size "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
ruleValue
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" but was "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualTextLength
            )
        ]
    else ValidationResult
forall err. Validation err
Success

-- | Validate that a value is a @Text@ of length smaller than n.
isTextSmallerThan :: Int -> ValidationRule Text
isTextSmallerThan :: Int -> ValidationRule ErrMsg
isTextSmallerThan Int
ruleValue = (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((ErrMsg -> ValidationResult) -> ValidationRule ErrMsg)
-> (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual -> do
  let actualTextLength :: Int
actualTextLength = ErrMsg -> Int
T.length ErrMsg
actual
  if Int
actualTextLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ruleValue
    then
      [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure
        [ String -> ErrMsg
T.pack
            ( String
"Text was expected to be smaller than "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
ruleValue
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" but was "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualTextLength
            )
        ]
    else ValidationResult
forall err. Validation err
Success

-- | Validate that a value is a @Text@ of length smaller or equal to n.
isTextSmallerThanOrEqual :: Int -> ValidationRule Text
isTextSmallerThanOrEqual :: Int -> ValidationRule ErrMsg
isTextSmallerThanOrEqual Int
ruleValue = (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule ((ErrMsg -> ValidationResult) -> ValidationRule ErrMsg)
-> (ErrMsg -> ValidationResult) -> ValidationRule ErrMsg
forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual -> do
  let actualTextLength :: Int
actualTextLength = ErrMsg -> Int
T.length ErrMsg
actual
  if Int
actualTextLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ruleValue
    then
      [ErrMsg] -> ValidationResult
forall err. err -> Validation err
Failure
        [ String -> ErrMsg
T.pack
            ( String
"Text was expected to be smaller than "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
ruleValue
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" but was "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualTextLength
            )
        ]
    else ValidationResult
forall err. Validation err
Success

-- | Validate that a value is lesser than 0.
isNegative :: ValidationRule Int
isNegative :: ValidationRule Int
isNegative = Int -> ValidationRule Int
forall a. (Show a, Ord a) => a -> ValidationRule a
isLesserThan Int
0

-- | Validate that a value is greater than 0.
isPositive :: ValidationRule Int
isPositive :: ValidationRule Int
isPositive = Int -> ValidationRule Int
forall a. (Show a, Ord a) => a -> ValidationRule a
isGreaterThan Int
0

-- | Validate that a value is positive or zero.
isPositiveOrZero :: ValidationRule Int
isPositiveOrZero :: ValidationRule Int
isPositiveOrZero = ValidationRule Int
isPositive ValidationRule Int -> ValidationRule Int -> ValidationRule Int
forall a. ValidationRule a -> ValidationRule a -> ValidationRule a
*||* Int -> ValidationRule Int
forall a. (Show a, Eq a) => a -> ValidationRule a
isEqualTo Int
0

-- | Validate that a value is negative or zero.
isNegativeOrZero :: ValidationRule Int
isNegativeOrZero :: ValidationRule Int
isNegativeOrZero = ValidationRule Int
isNegative ValidationRule Int -> ValidationRule Int -> ValidationRule Int
forall a. ValidationRule a -> ValidationRule a -> ValidationRule a
*||* Int -> ValidationRule Int
forall a. (Show a, Eq a) => a -> ValidationRule a
isEqualTo Int
0

-- | Filter a Map of @Validation err@ and keep only the failures.
filterFailedValidations :: Map Text (Validation err) -> Map Text (Validation err)
filterFailedValidations :: forall err.
Map ErrMsg (Validation err) -> Map ErrMsg (Validation err)
filterFailedValidations =
  (Validation err -> Bool)
-> Map ErrMsg (Validation err) -> Map ErrMsg (Validation err)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
    ( \Validation err
x -> do
        case Validation err
x of
          Failure err
_ -> Bool
True
          Validation err
Success -> Bool
False
    )