{-
  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 DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Keuringsdienst
  ( (*||*),
    (|??|),
    (|?|),
    ValidationResult,
    ValidationRule (..),
    Validation (..),
    keuren,
    misschienKeuren,
    validate,
    maybeValidate,
    ofDitOfDat,
  )
where

import Data.Aeson hiding (Success)
import Data.Text as T
import GHC.Generics

type ErrMsg = Text

data Validation err
  = Success
  | Failure err
  deriving (Validation err -> Validation err -> Bool
forall err. Eq err => Validation err -> Validation err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Validation err -> Validation err -> Bool
$c/= :: forall err. Eq err => Validation err -> Validation err -> Bool
== :: Validation err -> Validation err -> Bool
$c== :: forall err. Eq err => Validation err -> Validation err -> Bool
Eq, Int -> Validation err -> ShowS
forall err. Show err => Int -> Validation err -> ShowS
forall err. Show err => [Validation err] -> ShowS
forall err. Show err => Validation err -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Validation err] -> ShowS
$cshowList :: forall err. Show err => [Validation err] -> ShowS
show :: Validation err -> String
$cshow :: forall err. Show err => Validation err -> String
showsPrec :: Int -> Validation err -> ShowS
$cshowsPrec :: forall err. Show err => Int -> Validation err -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall err x. Rep (Validation err) x -> Validation err
forall err x. Validation err -> Rep (Validation err) x
$cto :: forall err x. Rep (Validation err) x -> Validation err
$cfrom :: forall err x. Validation err -> Rep (Validation err) x
Generic, forall err. FromJSON err => Value -> Parser [Validation err]
forall err. FromJSON err => Value -> Parser (Validation err)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Validation err]
$cparseJSONList :: forall err. FromJSON err => Value -> Parser [Validation err]
parseJSON :: Value -> Parser (Validation err)
$cparseJSON :: forall err. FromJSON err => Value -> Parser (Validation err)
FromJSON, forall err. ToJSON err => [Validation err] -> Encoding
forall err. ToJSON err => [Validation err] -> Value
forall err. ToJSON err => Validation err -> Encoding
forall err. ToJSON err => Validation err -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Validation err] -> Encoding
$ctoEncodingList :: forall err. ToJSON err => [Validation err] -> Encoding
toJSONList :: [Validation err] -> Value
$ctoJSONList :: forall err. ToJSON err => [Validation err] -> Value
toEncoding :: Validation err -> Encoding
$ctoEncoding :: forall err. ToJSON err => Validation err -> Encoding
toJSON :: Validation err -> Value
$ctoJSON :: forall err. ToJSON err => Validation err -> Value
ToJSON)

type ValidationResult = Validation [ErrMsg]

instance Semigroup ValidationResult where
  <> :: ValidationResult -> ValidationResult -> ValidationResult
(<>) ValidationResult
a ValidationResult
b = case ValidationResult
a of
    ValidationResult
Success -> case ValidationResult
b of
      ValidationResult
Success -> forall err. Validation err
Success
      Failure [ErrMsg]
errorsB -> forall err. err -> Validation err
Failure [ErrMsg]
errorsB
    Failure [ErrMsg]
errorsA -> case ValidationResult
b of
      ValidationResult
Success -> forall err. err -> Validation err
Failure [ErrMsg]
errorsA
      Failure [ErrMsg]
errorsB -> forall err. err -> Validation err
Failure ([ErrMsg]
errorsA forall a. Semigroup a => a -> a -> a
<> [ErrMsg]
errorsB)

instance Monoid ValidationResult where
  mempty :: ValidationResult
mempty = forall err. Validation err
Success

newtype ValidationRule a = ValidationRule
  { forall a. ValidationRule a -> a -> ValidationResult
performValidation :: a -> ValidationResult
  }

instance Semigroup (ValidationRule x) where
  <> :: ValidationRule x -> ValidationRule x -> ValidationRule x
(<>) ValidationRule x
a ValidationRule x
b = do
    ValidationRule
      { performValidation :: x -> ValidationResult
performValidation = \x
value -> forall a. ValidationRule a -> a -> ValidationResult
performValidation ValidationRule x
a x
value forall a. Semigroup a => a -> a -> a
<> forall a. ValidationRule a -> a -> ValidationResult
performValidation ValidationRule x
b x
value
      }

instance Monoid (ValidationRule a) where
  mempty :: ValidationRule a
mempty = ValidationRule {performValidation :: a -> ValidationResult
performValidation = forall a b. a -> b -> a
const forall err. Validation err
Success}

-- keuren operator
keuren :: a -> ValidationRule a -> ValidationResult
keuren :: forall a. a -> ValidationRule a -> ValidationResult
keuren a
x ValidationRule a
rule = forall a. ValidationRule a -> a -> ValidationResult
performValidation ValidationRule a
rule a
x

infixl 8 |?|

-- keuren operator
(|?|) :: a -> ValidationRule a -> ValidationResult
|?| :: forall a. a -> ValidationRule a -> ValidationResult
(|?|) = forall a. a -> ValidationRule a -> ValidationResult
keuren

-- keuren operator
validate :: a -> ValidationRule a -> ValidationResult
validate :: forall a. a -> ValidationRule a -> ValidationResult
validate = forall a. a -> ValidationRule a -> ValidationResult
keuren

-- misschienKeuren operator
misschienKeuren :: Maybe a -> ValidationRule a -> ValidationResult
misschienKeuren :: forall a. Maybe a -> ValidationRule a -> ValidationResult
misschienKeuren Maybe a
x ValidationRule a
rule = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall err. Validation err
Success (forall a. ValidationRule a -> a -> ValidationResult
performValidation ValidationRule a
rule) Maybe a
x

infixl 8 |??|

-- misschienKeuren operator
(|??|) :: Maybe a -> ValidationRule a -> ValidationResult
|??| :: forall a. Maybe a -> ValidationRule a -> ValidationResult
(|??|) = forall a. Maybe a -> ValidationRule a -> ValidationResult
misschienKeuren

-- misschienKeuren operator
maybeValidate :: Maybe a -> ValidationRule a -> ValidationResult
maybeValidate :: forall a. Maybe a -> ValidationRule a -> ValidationResult
maybeValidate = forall a. Maybe a -> ValidationRule a -> ValidationResult
misschienKeuren

-- if one of the validations has a successful result, then the validation is a success
ofDitOfDat :: ValidationRule a -> ValidationRule a -> ValidationRule a
ofDitOfDat :: forall x. ValidationRule x -> ValidationRule x -> ValidationRule x
ofDitOfDat ValidationRule a
rule1 ValidationRule a
rule2 = forall a. (a -> ValidationResult) -> ValidationRule a
ValidationRule forall a b. (a -> b) -> a -> b
$ \a
actual ->
  case (forall a. ValidationRule a -> a -> ValidationResult
performValidation ValidationRule a
rule1 a
actual, forall a. ValidationRule a -> a -> ValidationResult
performValidation ValidationRule a
rule2 a
actual) of
    (Failure [ErrMsg]
e1, Failure [ErrMsg]
e2) -> forall err. err -> Validation err
Failure ([ErrMsg]
e1 forall a. Semigroup a => a -> a -> a
<> [ErrMsg]
e2)
    (ValidationResult
Success, ValidationResult
_) -> forall err. Validation err
Success
    (ValidationResult
_, ValidationResult
Success) -> forall err. Validation err
Success

infixl 6 *||*

-- ofDitOfDat operator
(*||*) :: ValidationRule a -> ValidationRule a -> ValidationRule a
*||* :: forall x. ValidationRule x -> ValidationRule x -> ValidationRule x
(*||*) = forall x. ValidationRule x -> ValidationRule x -> ValidationRule x
ofDitOfDat