{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Data.Aeson.Schema.Utils.NameLike (
  NameLike (..),
  fromName,
  resolveName,
) where

import Data.Text (Text)
import Language.Haskell.TH.Syntax (Name, Q, lookupTypeName, nameBase)

data NameLike = NameRef String | NameTH Name

instance Eq NameLike where
  NameLike
ty1 == :: NameLike -> NameLike -> Bool
== NameLike
ty2 = NameLike -> String
fromName NameLike
ty1 forall a. Eq a => a -> a -> Bool
== NameLike -> String
fromName NameLike
ty2

instance Show NameLike where
  show :: NameLike -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameLike -> String
fromName

fromName :: NameLike -> String
fromName :: NameLike -> String
fromName = \case
  NameRef String
s -> String
s
  NameTH Name
name -> Name -> String
nameBase Name
name

resolveName :: NameLike -> Q Name
resolveName :: NameLike -> Q Name
resolveName = \case
  -- some hardcoded cases
  NameRef String
"Bool" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Bool
  NameRef String
"Int" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Int
  NameRef String
"Double" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Double
  NameRef String
"Text" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Text
  -- general cases
  NameRef String
name -> String -> Q (Maybe Name)
lookupTypeName String
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown type: " forall a. [a] -> [a] -> [a]
++ String
name) forall (f :: * -> *) a. Applicative f => a -> f a
pure
  NameTH Name
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name