-- {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
-- {-# LANGUAGE KindSignatures  #-}s
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Common combinators used across encodings.
--
-- @since 0.2.1.0
module Data.TypedEncoding.Combinators.Restriction.Common where 

import           GHC.TypeLits
import           Data.TypedEncoding.Internal.Util.TypeLits
import           Data.TypedEncoding.Instances.Support

-- $setup
-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds -XTypeApplications


-- | Universal decode for all "r-" types
decFR :: (IsR s ~ 'True, Applicative f) => 
            Enc (s ': xs) c str -> f (Enc xs c str) 
decFR = implTranP id 


-- | 
-- Manual recreate step combinator converting @"r-"@ encode function to a recreate step.
--
-- For "r-" encoding recreate and encode are the same other than the exception type used. 
--
-- The convention in @typed-encoding@ is to implement encode and convert it to recreate.
recWithEncR :: forall (s :: Symbol) xs c str . (IsR s ~ 'True) 
                       => (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) 
                       -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str)
recWithEncR = unsafeRecWithEncR


unsafeRecWithEncR :: forall (s :: Symbol) xs c str .
                       (Enc xs c str -> Either EncodeEx (Enc (s ': xs) c str)) 
                       -> Enc xs c str -> Either RecreateEx (Enc (s ': xs) c str)
unsafeRecWithEncR fn = either (Left . encToRecrEx) Right . fn

-- |
-- >>> :kind! IsR "r-UPPER"
-- ...
-- ... 'True
--
-- >>> :kind! IsR "do-UPPER"
-- ...
-- = (TypeError ... 
type family IsR (s :: Symbol) :: Bool where
    IsR s = AcceptEq ('Text "Not restriction encoding " ':<>: ShowType s ) (CmpSymbol "r-" (Take 2 s))


type family IsROrEmpty (s :: Symbol) :: Bool where
    IsROrEmpty "" = True
    IsROrEmpty x  = IsR x