{-# LANGUAGE Haskell2010                #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE NumericUnderscores         #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PackageImports             #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE StrictData                 #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}

{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeSynonymInstances       #-}

module Data.Multibase.Types.Internal.IsMultibase 
  ( IsMultibase(..)
  , Multibase(..)
  , MultibaseLazy(..)
  , MultibaseShort(..)
  , MultibaseBytes(..)
  , MultibaseBytesLazy(..)
  , MultibaseBytesShort(..)
  , dispatching
  ) where

import           Control.DeepSeq
import           Data.Coerce
import qualified Data.ByteString.Lazy               as LBS
import qualified Data.ByteString.Short              as SBS
import qualified Data.Text.Encoding                 as TE
import qualified Data.Text.Lazy                     as LT
import qualified Data.Text.Lazy.Encoding            as LE
import qualified Data.Text.Short                    as ST
import           Data.Multibase.Types.Internal.IsCodec


class (ForMultibase m,ForMultibase b,ForMultibase t) => 
    IsMultibase m t b | m->t, m->b, t->b, b->t where
  encodingToMultibase       :: MbAlgorithm -> b -> m
  encodingTextToMultibase   :: MbAlgorithm -> t -> m
  encodingToMultibase_      :: IsCodec a => Proxy a -> b -> m
  encodingTextToMultibase_  :: IsCodec a => Proxy a -> t -> m
  decodingMultibase         :: m -> Either MbDecodeFailure b
  decodingMultibaseToText   :: m -> Either MbDecodeFailure t
  isMultibase               :: m -> Bool
  isValidMultibase          :: m -> Bool
  -- testing utilities
  mbFromText                :: Text -> m
  mbTextInputFromText       :: Proxy m -> Text -> t
  mbByteInputFromByteString :: Proxy m -> ByteString -> b
  mbPipeline                :: Proxy m -> MbPipeline

type ForMultibase a = (Eq a,IsString a,NFData a,Monoid a,Show a,Typeable a)


----------------------------------------------------------------------------------------------------
-- Multibase
----------------------------------------------------------------------------------------------------

newtype Multibase = Multibase { getMultibase :: Text }
  deriving stock (Eq,Generic,Show)
  deriving newtype (IsString,Monoid,Semigroup)
  deriving anyclass (NFData)

instance IsMultibase Multibase Text ByteString where
  encodingToMultibase       = encoding_with encodingToMultibase_
  encodingTextToMultibase   = encoding_with encodingTextToMultibase_
  encodingToMultibase_      = encoding                 mbEncode
  encodingTextToMultibase_  = encoding                 mbTextEncode
  decodingMultibase         = decodeMb $ decoding_with mbDecode
  decodingMultibaseToText   = decodeMb $ decoding_with mbTextDecode
  isMultibase               = validtMb $ decoding_with isMb
  isValidMultibase          = validtMb $ decoding_with isValidMb
  mbFromText                = coerce
  mbTextInputFromText       = const id
  mbByteInputFromByteString = const id
  mbPipeline                = const MP_Text
  {-# INLINE encodingToMultibase        #-}
  {-# INLINE encodingTextToMultibase    #-}
  {-# INLINE encodingToMultibase_       #-}
  {-# INLINE encodingTextToMultibase_   #-}
  {-# INLINE decodingMultibase          #-}
  {-# INLINE decodingMultibaseToText    #-}
  {-# INLINE isMultibase                #-}
  {-# INLINE isValidMultibase           #-}
  {-# INLINE mbFromText                 #-}
  {-# INLINE mbTextInputFromText        #-}
  {-# INLINE mbByteInputFromByteString  #-}
  {-# INLINE mbPipeline                 #-}


----------------------------------------------------------------------------------------------------
-- MultibaseLazy
----------------------------------------------------------------------------------------------------

newtype MultibaseLazy = MultibaseLazy { getMultibaseLazy :: TextLazy }
  deriving stock (Eq,Generic,Show)
  deriving newtype (IsString,Monoid,Semigroup)
  deriving anyclass (NFData)

instance IsMultibase MultibaseLazy TextLazy ByteStringLazy where
  encodingToMultibase       = encoding_with encodingToMultibase_
  encodingTextToMultibase   = encoding_with encodingTextToMultibase_
  encodingToMultibase_      = encoding                 mbLazyEncode
  encodingTextToMultibase_  = encoding                 mbTextLazyEncode
  decodingMultibase         = decodeMb $ decoding_with mbLazyDecode
  decodingMultibaseToText   = decodeMb $ decoding_with mbTextLazyDecode
  isMultibase               = validtMb $ decoding_with isMbLazy
  isValidMultibase          = validtMb $ decoding_with isValidMbLazy
  mbFromText                = coerce LT.fromStrict
  mbTextInputFromText       = const  LT.fromStrict
  mbByteInputFromByteString = const  LBS.fromStrict
  mbPipeline                = const MP_TextLazy
  {-# INLINE encodingToMultibase        #-}
  {-# INLINE encodingTextToMultibase    #-}
  {-# INLINE encodingToMultibase_       #-}
  {-# INLINE encodingTextToMultibase_   #-}
  {-# INLINE decodingMultibase          #-}
  {-# INLINE decodingMultibaseToText    #-}
  {-# INLINE isMultibase                #-}
  {-# INLINE isValidMultibase           #-}
  {-# INLINE mbFromText                 #-}
  {-# INLINE mbTextInputFromText        #-}
  {-# INLINE mbByteInputFromByteString  #-}
  {-# INLINE mbPipeline                 #-}


----------------------------------------------------------------------------------------------------
-- MultibaseShort
----------------------------------------------------------------------------------------------------

newtype MultibaseShort = MultibaseShort { getMultibaseShort :: TextShort }
  deriving stock (Eq,Generic,Show)
  deriving newtype (IsString,Monoid,Semigroup)
  deriving anyclass (NFData)

instance IsMultibase MultibaseShort TextShort ByteStringShort where
  encodingToMultibase       = encoding_with encodingToMultibase_
  encodingTextToMultibase   = encoding_with encodingTextToMultibase_
  encodingToMultibase_      = encoding             mbShortEncode
  encodingTextToMultibase_  = encoding             mbTextShortEncode
  decodingMultibase         = decodeMb $ decoding_with mbShortDecode
  decodingMultibaseToText   = decodeMb $ decoding_with mbTextShortDecode
  isMultibase               = validtMb $ decoding_with isMbShort
  isValidMultibase          = validtMb $ decoding_with isValidMbShort
  mbFromText                = coerce ST.fromText
  mbTextInputFromText       = const  ST.fromText
  mbByteInputFromByteString = const  SBS.toShort
  mbPipeline                = const MP_TextShort
  {-# INLINE encodingToMultibase        #-}
  {-# INLINE encodingTextToMultibase    #-}
  {-# INLINE encodingToMultibase_       #-}
  {-# INLINE encodingTextToMultibase_   #-}
  {-# INLINE decodingMultibase          #-}
  {-# INLINE decodingMultibaseToText    #-}
  {-# INLINE isMultibase                #-}
  {-# INLINE isValidMultibase           #-}
  {-# INLINE mbFromText                 #-}
  {-# INLINE mbTextInputFromText        #-}
  {-# INLINE mbByteInputFromByteString  #-}
  {-# INLINE mbPipeline                 #-}


----------------------------------------------------------------------------------------------------
-- MultibaseBytes
----------------------------------------------------------------------------------------------------

newtype MultibaseBytes = MultibaseBytes { getMultibaseBytes :: ByteString }
  deriving stock (Eq,Generic,Show)
  deriving newtype (IsString,Monoid,Semigroup)
  deriving anyclass (NFData)

instance IsMultibase MultibaseBytes Text ByteString where
  encodingToMultibase       = encoding_with encodingToMultibase_
  encodingTextToMultibase   = encoding_with encodingTextToMultibase_
  encodingToMultibase_      = encoding             mbEncode'
  encodingTextToMultibase_  = encoding             mbTextEncode'
  decodingMultibase         = decodeMb $ decoding_with mbDecode'
  decodingMultibaseToText   = decodeMb $ decoding_with mbTextDecode'
  isMultibase               = validtMb $ decoding_with isMb'
  isValidMultibase          = validtMb $ decoding_with isValidMb'
  mbFromText                = coerce TE.encodeUtf8
  mbTextInputFromText       = const id
  mbByteInputFromByteString = const id
  mbPipeline                = const MP_Byte
  {-# INLINE encodingToMultibase        #-}
  {-# INLINE encodingTextToMultibase    #-}
  {-# INLINE encodingToMultibase_       #-}
  {-# INLINE encodingTextToMultibase_   #-}
  {-# INLINE decodingMultibase          #-}
  {-# INLINE decodingMultibaseToText    #-}
  {-# INLINE isMultibase                #-}
  {-# INLINE isValidMultibase           #-}
  {-# INLINE mbFromText                 #-}
  {-# INLINE mbTextInputFromText        #-}
  {-# INLINE mbByteInputFromByteString  #-}
  {-# INLINE mbPipeline                 #-}


----------------------------------------------------------------------------------------------------
-- MultibaseBytesLazy
----------------------------------------------------------------------------------------------------

newtype MultibaseBytesLazy = MultibaseBytesLazy { getMultibaseBytesLazy :: ByteStringLazy }
  deriving stock (Eq,Generic,Show)
  deriving newtype (IsString,Monoid,Semigroup)
  deriving anyclass (NFData)

instance IsMultibase MultibaseBytesLazy TextLazy ByteStringLazy where
  encodingToMultibase       = encoding_with encodingToMultibase_
  encodingTextToMultibase   = encoding_with encodingTextToMultibase_
  encodingToMultibase_      = encoding                 mbLazyEncode'
  encodingTextToMultibase_  = encoding                 mbTextLazyEncode'
  decodingMultibase         = decodeMb $ decoding_with mbLazyDecode'
  decodingMultibaseToText   = decodeMb $ decoding_with mbTextLazyDecode'
  isMultibase               = validtMb $ decoding_with isMbLazy'
  isValidMultibase          = validtMb $ decoding_with isValidMbLazy'
  mbFromText                = coerce $ LE.encodeUtf8 . LT.fromStrict
  mbTextInputFromText       = const LT.fromStrict
  mbByteInputFromByteString = const LBS.fromStrict
  mbPipeline                = const MP_ByteLazy
  {-# INLINE encodingToMultibase        #-}
  {-# INLINE encodingTextToMultibase    #-}
  {-# INLINE encodingToMultibase_       #-}
  {-# INLINE encodingTextToMultibase_   #-}
  {-# INLINE decodingMultibase          #-}
  {-# INLINE decodingMultibaseToText    #-}
  {-# INLINE isMultibase                #-}
  {-# INLINE isValidMultibase           #-}
  {-# INLINE mbFromText                 #-}
  {-# INLINE mbTextInputFromText        #-}
  {-# INLINE mbByteInputFromByteString  #-}
  {-# INLINE mbPipeline                 #-}


----------------------------------------------------------------------------------------------------
-- MultibaseBytesShort
----------------------------------------------------------------------------------------------------

newtype MultibaseBytesShort = MultibaseBytesShort { getMultibaseBytesShort :: ByteStringShort }
  deriving stock (Eq,Generic,Show)
  deriving newtype (IsString,Monoid,Semigroup)
  deriving anyclass (NFData)

instance IsMultibase MultibaseBytesShort TextShort ByteStringShort where
  encodingToMultibase       = encoding_with encodingToMultibase_
  encodingTextToMultibase   = encoding_with encodingTextToMultibase_
  encodingToMultibase_      = encoding                  mbShortEncode'
  encodingTextToMultibase_  = encoding                  mbTextShortEncode'
  decodingMultibase         = decodeMb $ decoding_with  mbShortDecode'
  decodingMultibaseToText   = decodeMb $ decoding_with  mbTextShortDecode'
  isMultibase               = validtMb $ decoding_with  isMbShort'
  isValidMultibase          = validtMb $ decoding_with  isValidMbShort'
  mbFromText                = coerce $ ST.toShortByteString . ST.fromText
  mbTextInputFromText       = const ST.fromText
  mbByteInputFromByteString = const SBS.toShort
  mbPipeline                = const MP_ByteShort
  {-# INLINE encodingToMultibase        #-}
  {-# INLINE encodingTextToMultibase    #-}
  {-# INLINE encodingToMultibase_       #-}
  {-# INLINE encodingTextToMultibase_   #-}
  {-# INLINE decodingMultibase          #-}
  {-# INLINE decodingMultibaseToText    #-}
  {-# INLINE isMultibase                #-}
  {-# INLINE isValidMultibase           #-}
  {-# INLINE mbFromText                 #-}
  {-# INLINE mbTextInputFromText        #-}
  {-# INLINE mbByteInputFromByteString  #-}
  {-# INLINE mbPipeline                 #-}


----------------------------------------------------------------------------------------------------
-- encoding
----------------------------------------------------------------------------------------------------

encoding :: forall i a o m . (IsCodec a,MbEncodable o,Coercible o m) 
         => (i->MbString a o) -> Proxy a -> i -> m
encoding enc pxy = encodeMb enc' $ mbAlgorithm pxy
  where
    enc' :: i -> o
    enc' = coerce enc
{-# INLINE encoding #-}


----------------------------------------------------------------------------------------------------
-- encoding_with, decoding_with
----------------------------------------------------------------------------------------------------

encoding_with :: forall i o
              .  (forall a . IsCodec a => Proxy a -> i -> o) 
              -> MbAlgorithm 
              -> i 
              -> o
encoding_with bdy mba i = dispatching bdy' mba
  where
    bdy' :: forall a . IsCodec a => Proxy a -> o
    bdy' pxy = bdy pxy i
{-# INLINE encoding_with #-}

decoding_with :: forall i r
              .  (forall a . IsCodec a => MbString a i -> r) 
              -> i 
              -> MbAlgorithm 
              -> r
decoding_with bdy i mba = dispatching bdy' mba
  where
    bdy' :: forall a . IsCodec a => Proxy a -> r
    bdy' _ = bdy (MbString i :: MbString a i)
{-# INLINE decoding_with #-}