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

module Data.TypedEncoding.Internal.Class.Recreate where

import           Data.TypedEncoding.Internal.Types (Enc(..)
                                              , toEncoding
                                              , withUnsafeCoerce
                                              , RecreateEx(..)
                                              , getPayload
                                             )
import           Data.TypedEncoding.Internal.Class.Util
import           Data.Proxy
import           Data.Functor.Identity
import           GHC.TypeLits


-- | Used to safely recover encoded data validating all encodingss
class RecreateF f instr outstr where
    checkPrevF :: outstr -> f instr

class (Functor f) => RecreateFAll f (xs :: [Symbol]) c str where
    checkFAll :: Enc xs c str -> f (Enc '[] c str)
    recreateFAll :: Enc '[] c str -> f (Enc xs c str)
    recreateFAll str@(MkEnc _ _ pay) =
        let str0 :: Enc xs c str = withUnsafeCoerce id str
        in withUnsafeCoerce (const pay) <$> checkFAll str0

instance Applicative f => RecreateFAll f '[] c str where
    checkFAll (MkEnc _ c str) = pure $ toEncoding c str


instance (Monad f, RecreateFAll f xs c str, RecreateF f (Enc xs c str) (Enc (x ': xs) c str)) => RecreateFAll f (x ': xs) c str where
    checkFAll str =
        let re :: f (Enc xs c str) = checkPrevF str
        in re >>= checkFAll


recreateAll :: forall xs c str . RecreateFAll Identity xs c str =>
              Enc '[] c str
              -> Enc xs c str
recreateAll = runIdentity . recreateFAll


-- | Useful for partially manual recreation
recreateFPart_ :: forall f xs xsf c str . (Functor f, RecreateFAll f xs c str) => Proxy xs -> Enc xsf c str -> f (Enc (Append xs xsf) c str)
recreateFPart_ p (MkEnc _ conf str) =
    let re :: f (Enc xs c str) = recreateFAll $ MkEnc Proxy conf str
    in  MkEnc Proxy conf . getPayload <$> re


recreateFPart :: forall (xs :: [Symbol]) xsf f c str . (Functor f, RecreateFAll f xs c str) => Enc xsf c str -> f (Enc (Append xs xsf) c str)
recreateFPart = recreateFPart_ (Proxy :: Proxy xs)


recreatePart_ :: RecreateFAll Identity (xs :: [Symbol]) c str =>
              Proxy xs
              -> Enc xsf c str
              -> Enc (Append xs xsf) c str
recreatePart_ p = runIdentity . recreateFPart_ p

recreatePart :: forall (xs :: [Symbol]) xsf c str . RecreateFAll Identity xs c str =>
               Enc xsf c str
              -> Enc (Append xs xsf) c str
recreatePart = recreatePart_ (Proxy :: Proxy xs)

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

instance RecreateErr (Either RecreateEx) where
    recoveryErr = Left

asRecreateErr_ :: (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a
asRecreateErr_ p (Left err) = recoveryErr $ RecreateEx p err
asRecreateErr_ _ (Right r) = pure r


asRecreateErr :: forall x f err a . (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Either err a -> f a
asRecreateErr = asRecreateErr_ (Proxy :: Proxy x)