ToText.hs

{-# 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 = typeToText (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 _ = T.pack

instance HasTextRepresentation 'TypeText T.Text where
    typeToText _ = id

instance HasTextRepresentation 'TypeByteString BS.ByteString where
    typeToText _ = T.decodeUtf8

instance HasTextRepresentation 'TypeMethod Method where
    typeToText _ = T.decodeUtf8

instance Show a => HasTextRepresentation 'TypeShow a where
    typeToText _ = T.pack . 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