{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Servant.Benchmark.ToText (ToText (..)) where

import qualified Data.ByteString as BS
import Data.Data (Proxy (Proxy))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Types (Method)

-- | Types that can be converted to Text and serialized.
class ToText a where
    toText :: a -> T.Text

instance (HasText a ~ textType, HasTextRepresentation textType a) => ToText a where
    toText :: a -> Text
toText = Proxy textType -> a -> Text
forall (s :: TextType) a.
HasTextRepresentation s a =>
Proxy s -> a -> Text
typeToText (Proxy textType
forall k (t :: k). Proxy t
Proxy @textType)

-- Types that have a Text representation as defined by the HasText type family.
-- The class helps to avoid using `show` on types that can be easily converted to `Text`
class HasTextRepresentation (s :: TextType) a where
    typeToText :: Proxy s -> a -> T.Text

instance HasTextRepresentation 'TypeString String where
    typeToText :: Proxy 'TypeString -> String -> Text
typeToText Proxy 'TypeString
_ = String -> Text
T.pack

instance HasTextRepresentation 'TypeText T.Text where
    typeToText :: Proxy 'TypeText -> Text -> Text
typeToText Proxy 'TypeText
_ = Text -> Text
forall a. a -> a
id

instance HasTextRepresentation 'TypeByteString BS.ByteString where
    typeToText :: Proxy 'TypeByteString -> ByteString -> Text
typeToText Proxy 'TypeByteString
_ = ByteString -> Text
T.decodeUtf8

instance HasTextRepresentation 'TypeMethod Method where
    typeToText :: Proxy 'TypeMethod -> ByteString -> Text
typeToText Proxy 'TypeMethod
_ = ByteString -> Text
T.decodeUtf8

instance Show a => HasTextRepresentation 'TypeShow a where
    typeToText :: Proxy 'TypeShow -> a -> Text
typeToText Proxy 'TypeShow
_ = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

data TextType
    = TypeString
    | TypeText
    | TypeByteString
    | TypeMethod
    | TypeShow

type family HasText a where
    HasText String = 'TypeString
    HasText T.Text = 'TypeText
    HasText BS.ByteString = 'TypeByteString
    HasText a = 'TypeShow