{- |
Module      : Servant.API.Routes.Utils
Copyright   : (c) Frederick Pringle, 2024
License     : BSD-3-Clause
Maintainer  : freddyjepringle@gmail.com

Common useful functions.
-}
module Servant.API.Routes.Utils
  ( knownSymbolT
  , typeRepToJSON
  , showTypeRep
  , typeRepOf
  )
where

import Data.Aeson
import Data.Kind
import qualified Data.Text as T
import Data.Typeable
import GHC.TypeLits

-- | Get the term-level equivalent of a 'Symbol' as a 'T.Text'.
knownSymbolT :: forall name. KnownSymbol name => T.Text
knownSymbolT :: forall (name :: Symbol). KnownSymbol name => Text
knownSymbolT = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @name

-- | Convert a 'TypeRep' to a JSON 'Value' via its 'Show' instance.
typeRepToJSON :: TypeRep -> Value
typeRepToJSON :: TypeRep -> Value
typeRepToJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show @TypeRep

-- | Get the 'TypeRep' of a 'Typeable' type without having to mess around with 'Proxy'.
typeRepOf :: forall a. Typeable a => TypeRep
typeRepOf :: forall a. Typeable a => TypeRep
typeRepOf = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a

-- | Get the 'TypeRep' of a 'Typeable' type as a 'T.Text'.
showTypeRep :: forall (a :: Type). Typeable a => T.Text
showTypeRep :: forall a. Typeable a => Text
showTypeRep = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => TypeRep
typeRepOf @a