{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-- {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

-- |
-- Type classes accompanying decoding types defined in "Data.TypedEncoding.Common.Types.Validation"
--
-- This module is re-exported in "Data.TypedEncoding" and it is best not to import it directly.
module Data.TypedEncoding.Common.Class.Validate where

import           Data.TypedEncoding.Common.Types (RecreateEx(..))
import           Data.TypedEncoding.Common.Types.Validation

import           Data.Proxy
import           GHC.TypeLits


class Validate f nm alg conf str where
    validation :: Validation f nm alg conf str

class ValidateAll f nms algs conf str where
    validations :: Validations f nms algs conf str

instance ValidateAll f '[] '[] conf str where  
    validations :: Validations f ('[] @Symbol) ('[] @Symbol) conf str
validations = Validations f ('[] @Symbol) ('[] @Symbol) conf str
forall (f :: * -> *) conf str.
Validations f ('[] @Symbol) ('[] @Symbol) conf str
ZeroV

instance (ValidateAll f nms algs conf str, Validate f nm alg conf str) => ValidateAll f (nm ': nms) (alg ': algs) conf str where  
    validations :: Validations
  f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
validations = Validation f nm alg conf str
-> Validations f nms algs conf str
-> Validations
     f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
forall (f :: * -> *) (nm :: Symbol) (alg :: Symbol) conf str
       (nms :: [Symbol]) (algs :: [Symbol]).
Validation f nm alg conf str
-> Validations f nms algs conf str
-> Validations
     f ((':) @Symbol nm nms) ((':) @Symbol alg algs) conf str
ConsV Validation f nm alg conf str
forall (f :: * -> *) (nm :: Symbol) (alg :: Symbol) conf str.
Validate f nm alg conf str =>
Validation f nm alg conf str
validation Validations f nms algs conf str
forall (f :: * -> *) (nms :: [Symbol]) (algs :: [Symbol]) conf str.
ValidateAll f nms algs conf str =>
Validations f nms algs conf str
validations      



-- | Recovery errors are expected unless Recovery allows Identity instance
--
-- @since 0.1.0.0
class RecreateErr f where 
    recoveryErr :: RecreateEx -> f a

instance RecreateErr (Either RecreateEx) where
    recoveryErr :: RecreateEx -> Either RecreateEx a
recoveryErr = RecreateEx -> Either RecreateEx a
forall a b. a -> Either a b
Left  

-- |
-- @since 0.2.1.0
asRecreateErr_ :: (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a
asRecreateErr_ :: Proxy @Symbol x -> Either err a -> f a
asRecreateErr_ Proxy @Symbol x
p (Left err
err) = RecreateEx -> f a
forall k (f :: k -> *) (a :: k).
RecreateErr @k f =>
RecreateEx -> f a
recoveryErr (RecreateEx -> f a) -> RecreateEx -> f a
forall a b. (a -> b) -> a -> b
$ Proxy @Symbol x -> err -> RecreateEx
forall e (x :: Symbol).
(Show e, KnownSymbol x) =>
Proxy @Symbol x -> e -> RecreateEx
RecreateEx Proxy @Symbol x
p err
err
asRecreateErr_ Proxy @Symbol x
_ (Right a
r) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r

-- |
-- @since 0.1.0.0 
asRecreateErr :: forall x f err a . (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Either err a -> f a
asRecreateErr :: Either err a -> f a
asRecreateErr = Proxy @Symbol x -> Either err a -> f a
forall (f :: * -> *) err (x :: Symbol) a.
(RecreateErr @* f, Applicative f, Show err, KnownSymbol x) =>
Proxy @Symbol x -> Either err a -> f a
asRecreateErr_ (Proxy @Symbol x
forall k (t :: k). Proxy @k t
Proxy :: Proxy x)