{-
  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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual forall a. Eq a => a -> a -> Bool
== a
value
    then forall err. Validation err
Success
    else
      forall err. err -> Validation err
Failure
        [String -> ErrMsg
pack forall a b. (a -> b) -> a -> b
$ String
"Expected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
actual forall a. Semigroup a => a -> a -> a
<> String
" to equal " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual forall a. Eq a => a -> a -> Bool
/= a
value
    then forall err. Validation err
Success
    else
      forall err. err -> Validation err
Failure
        [String -> ErrMsg
pack forall a b. (a -> b) -> a -> b
$ String
"Expected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
actual forall a. Semigroup a => a -> a -> a
<> String
" to not equal " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual forall a. Ord a => a -> a -> Bool
> a
ruleValue
    then forall err. Validation err
Success
    else
      forall err. err -> Validation err
Failure
        [ String -> ErrMsg
pack (forall a. Show a => a -> String
show a
actual forall a. Semigroup a => a -> a -> a
<> String
" was expected to be greater than " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \a
actual ->
  if a
actual forall a. Ord a => a -> a -> Bool
< a
ruleValue
    then forall err. Validation err
Success
    else
      forall err. err -> Validation err
Failure
        [ String -> ErrMsg
pack (forall a. Show a => a -> String
show a
actual forall a. Semigroup a => a -> a -> a
<> String
" was expected to be lesser than " forall a. Semigroup a => a -> a -> a
<> 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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual ->
  if ErrMsg -> Bool
T.null ErrMsg
actual
    then forall err. err -> Validation err
Failure [String -> ErrMsg
T.pack String
"Text was expected to be non-empty"]
    else 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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual -> do
  let actualTextLength :: Int
actualTextLength = ErrMsg -> Int
T.length ErrMsg
actual
  if Int
actualTextLength forall a. Eq a => a -> a -> Bool
/= Int
ruleValue
    then
      forall err. err -> Validation err
Failure
        [ String -> ErrMsg
T.pack
            ( String
"Text was expected to be of size "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ruleValue
                forall a. Semigroup a => a -> a -> a
<> String
" but was "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
actualTextLength
            )
        ]
    else 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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual -> do
  let actualTextLength :: Int
actualTextLength = ErrMsg -> Int
T.length ErrMsg
actual
  if Int
actualTextLength forall a. Ord a => a -> a -> Bool
>= Int
ruleValue
    then
      forall err. err -> Validation err
Failure
        [ String -> ErrMsg
T.pack
            ( String
"Text was expected to be smaller than "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ruleValue
                forall a. Semigroup a => a -> a -> a
<> String
" but was "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
actualTextLength
            )
        ]
    else 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 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \ErrMsg
actual -> do
  let actualTextLength :: Int
actualTextLength = ErrMsg -> Int
T.length ErrMsg
actual
  if Int
actualTextLength forall a. Ord a => a -> a -> Bool
> Int
ruleValue
    then
      forall err. err -> Validation err
Failure
        [ String -> ErrMsg
T.pack
            ( String
"Text was expected to be smaller than "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ruleValue
                forall a. Semigroup a => a -> a -> a
<> String
" but was "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
actualTextLength
            )
        ]
    else forall err. Validation err
Success

-- | Validate that a value is lesser than 0.
isNegative :: ValidationRule Int
isNegative :: ValidationRule Int
isNegative = 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 = 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 forall a. ValidationRule a -> ValidationRule a -> ValidationRule a
*||* 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 forall a. ValidationRule a -> ValidationRule a -> ValidationRule a
*||* 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 =
  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
    )